diff --git a/src/PHYEX/aux/gamma.f90 b/src/PHYEX/aux/gamma.f90
index cd7e04fbd7df5d80dd5e439b691f0f512197c981..6969c28cd46d69740ad6356478f1ba46ff2b6edf 100644
--- a/src/PHYEX/aux/gamma.f90
+++ b/src/PHYEX/aux/gamma.f90
@@ -3,23 +3,6 @@
!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_GAMMA
-!########################
-!
-INTERFACE GAMMA
-!
-FUNCTION GAMMA_X0D(PX) RESULT(PGAMMA)
-REAL, INTENT(IN) :: PX
-REAL :: PGAMMA
-END FUNCTION GAMMA_X0D
-!
-FUNCTION GAMMA_X1D(PX) RESULT(PGAMMA)
-REAL, DIMENSION(:), INTENT(IN) :: PX
-REAL, DIMENSION(SIZE(PX)) :: PGAMMA
-END FUNCTION GAMMA_X1D
-!
-END INTERFACE
-END MODULE MODI_GAMMA
!
!--------------------------------------------------------------------------
!
@@ -29,6 +12,8 @@ END MODULE MODI_GAMMA
!
! ######################################
FUNCTION GAMMA_X0D(PX) RESULT(PGAMMA)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ######################################
!
!
@@ -81,6 +66,8 @@ INTEGER :: JJ ! Loop index
REAL :: ZSER,ZSTP,ZTMP,ZX,ZY,ZCOEF(6)
REAL :: ZPI
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GAMMA_X0D',0,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
!* 1. SOME CONSTANTS
@@ -121,6 +108,7 @@ IF (PX .LT. 0.) THEN
ELSE
PGAMMA = EXP(ZTMP + ALOG(ZSTP*ZSER/ZX))
END IF
+IF (LHOOK) CALL DR_HOOK('GAMMA_X0D',1,ZHOOK_HANDLE)
RETURN
!
END FUNCTION GAMMA_X0D
@@ -133,6 +121,8 @@ END FUNCTION GAMMA_X0D
!
! ######################################
FUNCTION GAMMA_X1D(PX) RESULT(PGAMMA)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ######################################
!
!
@@ -183,10 +173,12 @@ REAL, DIMENSION(SIZE(PX)) :: PGAMMA
!* 0.2 declarations of local variables
!
INTEGER :: JJ ! Loop index
-REAL, DIMENSION(SIZE(PX)) :: ZSER,ZSTP,ZTMP,ZX,ZY
-REAL :: ZCOEF(6)
+INTEGER :: JI ! Loop index
+REAL :: ZSER, ZSTP, ZTMP, ZX, ZY, ZCOEF(6)
REAL :: ZPI
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GAMMA_X1D',0,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
!* 1. SOME CONSTANTS
@@ -201,24 +193,35 @@ ZCOEF(6) = -0.5395239384953E-5
ZSTP = 2.5066282746310005
!
ZPI = 3.141592654
-ZX(:) = PX(:)
-WHERE ( PX(:)<0.0 )
- ZX(:) = 1.- PX(:)
-END WHERE
-ZY(:) = ZX(:)
-ZTMP(:) = ZX(:) + 5.5
-ZTMP(:) = (ZX(:) + 0.5)*ALOG(ZTMP(:)) - ZTMP(:)
-ZSER(:) = 1.000000000190015
-!
-DO JJ = 1 , 6
- ZY(:) = ZY(:) + 1.0
- ZSER(:) = ZSER(:) + ZCOEF(JJ)/ZY(:)
-END DO
!
-PGAMMA(:) = EXP( ZTMP(:) + ALOG( ZSTP*ZSER(:)/ZX(:) ) )
-WHERE ( PX(:)<0.0 )
- PGAMMA(:) = ZPI/SIN(ZPI*PX(:))/PGAMMA(:)
-END WHERE
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE GAMMA
+! -------------
+!
+DO JI = 1, SIZE(PX)
+ IF (PX(JI) .LT. 0.) THEN
+ ZX = 1. - PX(JI)
+ ELSE
+ ZX = PX(JI)
+ END IF
+ ZY = ZX
+ ZTMP = ZX + 5.5
+ ZTMP = (ZX + 0.5) * ALOG(ZTMP) - ZTMP
+ ZSER = 1.000000000190015
+!
+ DO JJ = 1, 6
+ ZY = ZY + 1.0
+ ZSER = ZSER + ZCOEF(JJ) / ZY
+ END DO
+!
+ IF (PX(JI) .LT. 0.) THEN
+ PGAMMA = ZPI / SIN(ZPI*PX(JI)) / EXP(ZTMP + ALOG(ZSTP*ZSER/ZX))
+ ELSE
+ PGAMMA = EXP(ZTMP + ALOG(ZSTP*ZSER/ZX))
+ END IF
+END DO
+IF (LHOOK) CALL DR_HOOK('GAMMA_X1D',1,ZHOOK_HANDLE)
RETURN
!
END FUNCTION GAMMA_X1D
diff --git a/src/PHYEX/aux/gamma_inc.f90 b/src/PHYEX/aux/gamma_inc.f90
index 93e6247d062f1142e4365d64204aeac782c73a6c..abb9ebad8c19156a6108c0ce88c34806c7e70464 100644
--- a/src/PHYEX/aux/gamma_inc.f90
+++ b/src/PHYEX/aux/gamma_inc.f90
@@ -2,33 +2,18 @@
!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_GAMMA_INC
-!####################
-!
-INTERFACE
-!
-FUNCTION GAMMA_INC(PA,PX) RESULT(PGAMMA_INC)
-REAL, INTENT(IN) :: PA
-REAL, INTENT(IN) :: PX
-REAL :: PGAMMA_INC
-END FUNCTION GAMMA_INC
-!
-END INTERFACE
-!
-END MODULE MODI_GAMMA_INC
-! #############################################
FUNCTION GAMMA_INC(PA,PX) RESULT(PGAMMA_INC)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #############################################
-!
!
-!!**** *GAMMA_INC * - Generalized gamma function
-!!
+!
+!!**** *GAMMA_INC * - Generalized gamma function
+!!
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the generalized
+! The purpose of this function is to compute the generalized
!! incomplete Gamma function of its argument.
!!
!! /X
@@ -55,7 +40,7 @@ END MODULE MODI_GAMMA_INC
!!
!! AUTHOR
!! ------
-!! Jean-Pierre Pinty *LA/OMP*
+!! Jean-Pierre Pinty *LA/OMP*
!!
!! MODIFICATIONS
!! -------------
@@ -66,7 +51,7 @@ END MODULE MODI_GAMMA_INC
!* 0. DECLARATIONS
! ------------
!
-use mode_msg
+USE MODE_MSG
!
USE MODI_GAMMA
!
@@ -87,7 +72,11 @@ REAL :: ZFPMIN=1.E-30
REAL :: ZAP,ZDEL,ZSUM
REAL :: ZAN,ZB,ZC,ZD,ZH
!
-IF( PX<0.0 .OR. PA<=0.0 ) call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','invalid arguments: PX<0.0 .OR. PA<=0.0')
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GAMMA_INC',0,ZHOOK_HANDLE)
+IF(PX<0.0 .OR. PA<=0.0) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'GAMMA_INC', 'invalid arguments: PX<0.0 .OR. PA<=0.0')
+END IF
!
IF( (PX.LT.PA+1.0) ) THEN
ZAP = PA
@@ -102,7 +91,7 @@ IF( (PX.LT.PA+1.0) ) THEN
IF( ABS(ZDEL).LT.ABS(ZSUM)*ZEPS ) EXIT LOOP_SERIES
JN = JN + 1
IF( JN.GT.ITMAX ) THEN
- call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','PA argument is too large or ITMAX is too small,'// &
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'GAMMA_INC', 'PA argument is too large or ITMAX is too small,'// &
' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
' by the series method')
END IF
@@ -134,7 +123,7 @@ IF( (PX.LT.PA+1.0) ) THEN
IF( ABS(ZDEL-1.0).LT.ZEPS ) EXIT LOOP_FRACTION
JN = JN + 1
IF( JN.GT.ITMAX ) THEN
- call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','PA argument is too large or ITMAX is too small,'// &
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'GAMMA_INC', 'PA argument is too large or ITMAX is too small,'// &
' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
' by the continuous fraction method')
END IF
@@ -143,6 +132,7 @@ IF( (PX.LT.PA+1.0) ) THEN
!
END IF
!
+IF (LHOOK) CALL DR_HOOK('GAMMA_INC',1,ZHOOK_HANDLE)
RETURN
!
END FUNCTION GAMMA_INC
diff --git a/src/PHYEX/aux/general_gamma.f90 b/src/PHYEX/aux/general_gamma.f90
index 9aa715a3cb09cf3b8558f007ddddc4b8f504d8a0..7938d74fa1845b69c8871fb7e29f73f3210c2afb 100644
--- a/src/PHYEX/aux/general_gamma.f90
+++ b/src/PHYEX/aux/general_gamma.f90
@@ -2,42 +2,20 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-!########################
-MODULE MODI_GENERAL_GAMMA
-!########################
-!
-INTERFACE
-!
-FUNCTION GENERAL_GAMMA(PALPHA,PNU,PLBDA,PX) RESULT(PGENERAL_GAMMA)
-REAL, INTENT(IN) :: PALPHA
-REAL, INTENT(IN) :: PNU
-REAL, INTENT(IN) :: PLBDA
-REAL, INTENT(IN) :: PX
-REAL :: PGENERAL_GAMMA
-END FUNCTION GENERAL_GAMMA
-!
-END INTERFACE
-!
-END MODULE MODI_GENERAL_GAMMA
-! ###################################################################
FUNCTION GENERAL_GAMMA(PALPHA,PNU,PLBDA,PX) RESULT(PGENERAL_GAMMA)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ###################################################################
-!
!
-!!**** *GENERAL_GAMMA * - Generalized gamma function
-!!
+!
+!!**** *GENERAL_GAMMA * - Generalized gamma function
+!!
!!
!! PURPOSE
!! -------
! The purpose of this function is to compute the Generalized gamma
! function of its argument.
-!
+!
!
!!** METHOD
!! ------
@@ -57,7 +35,7 @@ END MODULE MODI_GENERAL_GAMMA
!!
!! AUTHOR
!! ------
-!! Jean-Pierre Pinty *LA/OMP*
+!! Jean-Pierre Pinty *LA/OMP*
!!
!! MODIFICATIONS
!! -------------
@@ -82,10 +60,13 @@ REAL :: PGENERAL_GAMMA
!
REAL :: ZARG,ZPOWER
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GENERAL_GAMMA',0,ZHOOK_HANDLE)
ZARG = PLBDA*PX
ZPOWER = PALPHA*PNU - 1.0
!
PGENERAL_GAMMA = (PALPHA/GAMMA(PNU))*(ZARG**ZPOWER)*PLBDA*EXP(-(ZARG**PALPHA))
+IF (LHOOK) CALL DR_HOOK('GENERAL_GAMMA',1,ZHOOK_HANDLE)
RETURN
!
END FUNCTION GENERAL_GAMMA
diff --git a/src/PHYEX/aux/get_halo.f90 b/src/PHYEX/aux/get_halo.f90
index b6da303a25dd113a588a1e0799119ee4bd2948d5..75e2c1a5aa0a5de9590e94c0ee0e2b9c297e0a94 100644
--- a/src/PHYEX/aux/get_halo.f90
+++ b/src/PHYEX/aux/get_halo.f90
@@ -26,6 +26,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
!
END SUBROUTINE GET_HALO
!
+SUBROUTINE GET_HALO_PHY(D,PSRC)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PSRC ! variable at t
+!
+END SUBROUTINE GET_HALO_PHY
+!
SUBROUTINE DEL_HALO2_ll(TPHALO2LIST)
!
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
@@ -92,6 +100,31 @@ CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR)
CALL CLEANLIST_ll(TZ_PSRC_ll)
!
END SUBROUTINE GET_HALO
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+! #########################
+ SUBROUTINE GET_HALO_PHY(D,PSRC)
+! #########################
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PSRC ! variable at t
+!
+TYPE(LIST_ll) , POINTER :: TZ_PSRC_ll ! halo
+INTEGER :: IERROR ! error return code
+!
+NULLIFY( TZ_PSRC_ll)
+!
+CALL ADD3DFIELD_ll( TZ_PSRC_ll, PSRC, 'GET_HALO::PSRC' )
+CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR)
+CALL CLEANLIST_ll(TZ_PSRC_ll)
+!
+END SUBROUTINE GET_HALO_PHY
!-----------------------------------------------------------------------
!
! ####################################
diff --git a/src/PHYEX/aux/gradient_m.f90 b/src/PHYEX/aux/gradient_m.f90
index b5ec025aacf1a6c83e0c74f0e68406ff736ab119..feb4c58f3910be0ba2ca717db206a06efcde2316 100644
--- a/src/PHYEX/aux/gradient_m.f90
+++ b/src/PHYEX/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:
@@ -157,7 +163,7 @@ END MODULE MODI_GRADIENT_M
!* 0. DECLARATIONS
!
!
-USE MODI_SHUMAN
+USE MODI_SHUMAN, ONLY: DXF, MZF, DZM, MXF, MXM
USE MODD_CONF, ONLY:LFLAT
!
IMPLICIT NONE
@@ -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
!
!
@@ -409,17 +419,17 @@ END FUNCTION GZ_M_M
!! a variable at a mass localization
!! FUNCTION MXM: compute an average in the x direction for a variable
!! at a mass localization
-!! FUNCTION MZF: compute an average in the z direction for a variable
+!! FUNCTION MZF: compute an average in the z direction for a variable
!! at a flux side
!!
!! IMPLICIT ARGUMENTS
-!! ------------------
+!! ------------------
!! MODD_CONF : LFLAT
!!
!! REFERENCE
!! ---------
!! Book2 of documentation (function GX_M_U)
-!!
+!!
!!
!! AUTHOR
!! ------
@@ -427,7 +437,7 @@ END FUNCTION GZ_M_M
!!
!! MODIFICATIONS
!! -------------
-!! Original 05/07/94
+!! Original 05/07/94
!! Modification 16/03/95 change the order of the arguments
!! 19/07/00 add the LFLAT switch + inlining(J. Stein)
!! 20/08/00 optimization (J. Escobar)
@@ -448,7 +458,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! d*xx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! d*zx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! d*zx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! d*zz
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
@@ -459,7 +469,7 @@ INTEGER IIU,IKU,JI,JK
!
INTEGER :: JJK,IJU
INTEGER :: JIJK,JIJKOR,JIJKEND
-INTEGER :: JI_1JK, JIJK_1, JI_1JK_1, JIJKP1, JI_1JKP1
+INTEGER :: JI_1JK, JIJK_1, JI_1JK_1, JIJKP1, JI_1JKP1
!
!
!-------------------------------------------------------------------------------
@@ -470,7 +480,7 @@ INTEGER :: JI_1JK, JIJK_1, JI_1JK_1, JIJKP1, JI_1JKP1
IIU=SIZE(PY,1)
IJU=SIZE(PY,2)
IKU=SIZE(PY,3)
-IF (.NOT. LFLAT) THEN
+IF (.NOT. LFLAT) THEN
! PGX_M_U = ( DXM(PY) - MZF ( MXM( DZM(PY) /PDZZ ) * PDZX ) )/PDXX
!! DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB
!! DO JI=1+JPHEXT,IIU
@@ -510,7 +520,7 @@ IF (.NOT. LFLAT) THEN
!
DO JI=1+JPHEXT,IIU
- PGX_M_U(JI,:,KKU)= ( PY(JI,:,KKU)-PY(JI-1,:,KKU) ) / PDXX(JI,:,KKU)
+ PGX_M_U(JI,:,KKU)= ( PY(JI,:,KKU)-PY(JI-1,:,KKU) ) / PDXX(JI,:,KKU)
PGX_M_U(JI,:,KKA)= PGX_M_U(JI,:,KKU) ! -999.
END DO
ELSE
diff --git a/src/PHYEX/aux/gradient_m_phy.f90 b/src/PHYEX/aux/gradient_m_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2b1636b6306e94862bb3086835ae484fd97d9c2a
--- /dev/null
+++ b/src/PHYEX/aux/gradient_m_phy.f90
@@ -0,0 +1,649 @@
+MODULE MODE_GRADIENT_M_PHY
+IMPLICIT NONE
+CONTAINS
+! #########################################
+ SUBROUTINE GZ_M_W_PHY(D,PY,PDZZ,PGZ_M_W)
+! #########################################
+!
+!!**** *GZ_M_W * - Compute the gradient along z direction for a
+!! variable localized at a mass point
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute a gradient along x,y,z
+! directions for a field PY localized at a mass point. The result PGZ_M_W
+! is localized at a z-flux point (w point)
+!
+!
+! dzm(PY)
+! PGZ_M_W = -------
+! d*zz
+!
+!!** METHOD
+!! ------
+!! We employ the Shuman operators to compute the derivatives and the
+!! averages. The metric coefficients PDZZ are dummy arguments.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTION DZM : compute a finite difference along the z
+!! direction for a variable at a mass localization
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODI_SHUMAN : interface for the Shuman functions
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (function GZ_M_W)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil and J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification 16/03/95 change the order of the arguments
+!! 19/07/00 inlining(J. Stein)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+! -------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGZ_M_W ! result at flux
+ ! side
+!
+INTEGER :: IKT,IKTB,IKTE,IIB,IJB,IIE,IJE,IKA,IKU,IKL
+INTEGER :: JI,JJ,JK
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Z
+! -----------------------------
+!
+IKT=D%NKT
+IKTB=D%NKTB
+IKTE=D%NKTE
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
+!
+DO JK=IKTB,IKTE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ PGZ_M_W(JI,JJ,JK) = (PY(JI,JJ,JK)-PY(JI,JJ,JK-IKL )) / PDZZ(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
+PGZ_M_W(IIB:IIE,IJB:IJE,IKU)= (PY(IIB:IIE,IJB:IJE,IKU)-PY(IIB:IIE,IJB:IJE,IKU-IKL)) &
+ / PDZZ(IIB:IIE,IJB:IJE,IKU)
+PGZ_M_W(IIB:IIE,IJB:IJE,IKA)= PGZ_M_W(IIB:IIE,IJB:IJE,IKU) ! -999.
+!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE GZ_M_W_PHY
+!
+SUBROUTINE GX_M_M_PHY(D,OFLAT,PA,PDXX,PDZZ,PDZX,PGX_M_M)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! #######################################################
+!
+!!**** *GX_M_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian X
+!! direction for a variable placed at the
+!! mass point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the X cartesian direction for a field PA placed at the
+! mass point. The result is placed at the mass point.
+!
+!
+! ( ______________z )
+! ( (___x ) )
+! 1 ( _x (d*zx dzm(PA) ) )
+! PGX_M_M = ---- (dxf(PA) - (------------)) )
+! ___x ( ( ) )
+! d*xx ( ( d*zz ) )
+!
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXM,MXF,MZF : Shuman functions (mean operators)
+!! DXF,DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CONF : LFLAT
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/07/94
+!! 19/07/00 add the LFLAT switch (J. Stein)
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE SHUMAN_PHY, ONLY: DXF_PHY, MZF_PHY, DZM_PHY, MXF_PHY, MXM_PHY
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZX ! metric coefficient dzx
+LOGICAL, INTENT(IN) :: OFLAT
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGX_M_M ! result mass point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, ZWORK6, ZMXF_PDXX
+!
+INTEGER :: IIB,IJB,IIE,IJE,IKT
+INTEGER :: JI,JJ,JK
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_M_M
+! --------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GX_M_M',0,ZHOOK_HANDLE)
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+!
+CALL MXF_PHY(D,PDXX,ZMXF_PDXX)
+CALL MXM_PHY(D,PA,ZWORK1)
+CALL DXF_PHY(D,ZWORK1,ZWORK2)
+!
+IF (.NOT. OFLAT) THEN
+ CALL DZM_PHY(D,PA,ZWORK3)
+ CALL MXF_PHY(D,PDZX,ZWORK4)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZWORK5(IIB:IIE,IJB:IJE,1:IKT) = ZWORK3(IIB:IIE,IJB:IJE,1:IKT) * ZWORK4(IIB:IIE,IJB:IJE,1:IKT) &
+ / PDZZ(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK5,ZWORK6)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGX_M_M(IIB:IIE,IJB:IJE,1:IKT)= (ZWORK2(IIB:IIE,IJB:IJE,1:IKT) - ZWORK6(IIB:IIE,IJB:IJE,1:IKT)) &
+ / ZMXF_PDXX(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGX_M_M(IIB:IIE,IJB:IJE,1:IKT)= ZWORK2(IIB:IIE,IJB:IJE,1:IKT) / ZMXF_PDXX(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GX_M_M',1,ZHOOK_HANDLE)
+END SUBROUTINE GX_M_M_PHY
+!
+ SUBROUTINE GY_M_M_PHY(D,OFLAT,PA,PDYY,PDZZ,PDZY,PGY_M_M)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! #######################################################
+!
+!!**** *GY_M_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Y
+!! direction for a variable placed at the
+!! mass point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Y cartesian direction for a field PA placed at the
+! mass point. The result is placed at the mass point.
+!
+!
+! ( ______________z )
+! ( (___y ) )
+! 1 ( _y (d*zy dzm(PA) ) )
+! PGY_M_M = ---- (dyf(PA) - (------------)) )
+! ___y ( ( ) )
+! d*yy ( ( d*zz ) )
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MYM,MYF,MZF : Shuman functions (mean operators)
+!! DYF,DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CONF : LFLAT
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/07/94
+!! 19/07/00 add the LFLAT switch (J. Stein)
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE SHUMAN_PHY, ONLY: DYF_PHY, MZF_PHY, DZM_PHY, MYF_PHY, MYM_PHY
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZY ! metric coefficient dzy
+LOGICAL, INTENT(IN) :: OFLAT
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT),INTENT(OUT) :: PGY_M_M ! result mass point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, ZMYF_PDYY
+!
+INTEGER :: IIB,IJB,IIE,IJE,IKT
+INTEGER :: JI,JJ,JK
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GY_M_M',0,ZHOOK_HANDLE)
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_M_M
+! --------------------
+!
+CALL MYM_PHY(D,PA,ZWORK1)
+CALL DYF_PHY(D,ZWORK1,ZWORK2)
+CALL MYF_PHY(D,PDYY,ZMYF_PDYY)
+!
+IF (.NOT. OFLAT) THEN
+ !
+ CALL DZM_PHY(D,PA,ZWORK3)
+ CALL MYF_PHY(D,PDZY,ZWORK4)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZWORK5(IIB:IIE,IJB:IJE,1:IKT) = ZWORK4(IIB:IIE,IJB:IJE,1:IKT) * ZWORK3(IIB:IIE,IJB:IJE,1:IKT) &
+ / PDZZ(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK5,ZWORK4)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGY_M_M(IIB:IIE,IJB:IJE,1:IKT)= (ZWORK2(IIB:IIE,IJB:IJE,1:IKT)-ZWORK4(IIB:IIE,IJB:IJE,1:IKT)) &
+ /ZMYF_PDYY(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGY_M_M(IIB:IIE,IJB:IJE,1:IKT) = ZWORK2(IIB:IIE,IJB:IJE,1:IKT)/ZMYF_PDYY(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GY_M_M',1,ZHOOK_HANDLE)
+END SUBROUTINE GY_M_M_PHY
+!
+! #######################################################
+ SUBROUTINE GX_M_U_PHY(D,OFLAT,PY,PDXX,PDZZ,PDZX,PGX_M_U)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! ##################################################
+!
+!!**** *GX_M_U * - Compute the gradient along x for a variable localized at
+!! a mass point
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute a gradient along x
+! direction for a field PY localized at a mass point. The result PGX_M_U
+! is localized at a x-flux point (u point).
+!
+! ( ____________z )
+! ( ________x )
+! 1 ( dzm(PY) )
+! PGX_M_U = ---- (dxm(PY) - d*zx -------- )
+! d*xx ( d*zz )
+!
+!
+!
+!!** METHOD
+!! ------
+!! We employ the Shuman operators to compute the derivatives and the
+!! averages. The metric coefficients PDXX,PDZX,PDZZ are dummy arguments.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTION DXM: compute a finite difference along the x direction for
+!! a variable at a mass localization
+!! FUNCTION DZM: compute a finite difference along the y direction for
+!! a variable at a mass localization
+!! FUNCTION MXM: compute an average in the x direction for a variable
+!! at a mass localization
+!! FUNCTION MZF: compute an average in the z direction for a variable
+!! at a flux side
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CONF : LFLAT
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (function GX_M_U)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil and J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification 16/03/95 change the order of the arguments
+!! 19/07/00 add the LFLAT switch + inlining(J. Stein)
+!! 20/08/00 optimization (J. Escobar)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT_TURB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+LOGICAL, INTENT(IN) :: OFLAT
+REAL, DIMENSION(D%NIT*D%NJT*D%NKT), INTENT(IN) :: PY ! variable at the mass point
+REAL, DIMENSION(D%NIT*D%NJT*D%NKT), INTENT(IN) :: PDXX ! metric coefficient dyy
+REAL, DIMENSION(D%NIT*D%NJT*D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(D%NIT*D%NJT*D%NKT), INTENT(IN) :: PDZX ! metric coefficient dzy
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGX_M_U ! result at flux
+ ! side
+REAL, DIMENSION(D%NIT*D%NJT*D%NKT) :: ZGX_M_U
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT):: ZY, ZDXX,ZDZZ,ZDZX
+INTEGER IIU,IKU,JI,JK,IKL, IKA
+!
+INTEGER :: JJK,IJU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+INTEGER :: JI_1JK, JIJK_1, JI_1JK_1, JIJKP1, JI_1JKP1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG X
+! -----------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GX_M_U',0,ZHOOK_HANDLE)
+IIU=D%NIT
+IJU=D%NJT
+IKU=D%NKT
+IKL=D%NKL
+IKA=D%NKA
+IF (.NOT. OFLAT) THEN
+ JIJKOR = 1 + JPHEXT + IIU*IJU*(JPVEXT_TURB+1 - 1)
+ JIJKEND = IIU*IJU*(IKU-JPVEXT_TURB)
+!CDIR NODEP
+!OCL NOVREC
+ DO JIJK=JIJKOR , JIJKEND
+! indexation
+ JI_1JK = JIJK - 1
+ JIJK_1 = JIJK - IIU*IJU*IKL
+ JI_1JK_1 = JIJK - 1 - IIU*IJU*IKL
+ JIJKP1 = JIJK + IIU*IJU*IKL
+ JI_1JKP1 = JIJK - 1 + IIU*IJU*IKL
+!
+ ZGX_M_U(JIJK)= &
+ ( PY(JIJK)-PY(JI_1JK) &
+ -( (PY(JIJK)-PY(JIJK_1)) / PDZZ(JIJK) &
+ +(PY(JI_1JK)-PY(JI_1JK_1)) / PDZZ(JI_1JK) &
+ ) * PDZX(JIJK)* 0.25 &
+ -( (PY(JIJKP1)-PY(JIJK)) / PDZZ(JIJKP1) &
+ +(PY(JI_1JKP1)-PY(JI_1JK)) / PDZZ(JI_1JKP1) &
+ ) * PDZX(JIJKP1)* 0.25 &
+ ) / PDXX(JIJK)
+ END DO
+
+CALL D1D_TO_3D(D,ZGX_M_U,PGX_M_U)
+CALL D1D_TO_3D(D,PDXX,ZDXX)
+CALL D1D_TO_3D(D,PDZZ,ZDZZ)
+CALL D1D_TO_3D(D,PDZX,ZDZX)
+CALL D1D_TO_3D(D,PY,ZY)
+!
+ DO JI=1+JPHEXT,IIU
+ PGX_M_U(JI,:,IKU)= ( ZY(JI,:,IKU)-ZY(JI-1,:,IKU) ) / ZDXX(JI,:,IKU)
+ PGX_M_U(JI,:,IKA)= -999.
+ END DO
+!
+ PGX_M_U(1,:,:)=PGX_M_U(IIU-2*JPHEXT+1,:,:)
+ELSE
+! PGX_M_U = DXM(PY) / PDXX
+ PGX_M_U(1+JPHEXT:IIU,:,:) = ( ZY(1+JPHEXT:IIU,:,:)-ZY(JPHEXT:IIU-1,:,:) ) &
+ / ZDXX(1+JPHEXT:IIU,:,:)
+!
+ PGX_M_U(1,:,:)=PGX_M_U(IIU-2*JPHEXT+1,:,:)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GX_M_U',1,ZHOOK_HANDLE)
+END SUBROUTINE GX_M_U_PHY
+!
+ SUBROUTINE GY_M_V_PHY(D,OFLAT,PY,PDYY,PDZZ,PDZY,PGY_M_V)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! ##################################################
+!
+!!**** *GY_M_V * - Compute the gradient along y for a variable localized at
+!! a mass point
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute a gradient along y
+! direction for a field PY localized at a mass point. The result PGY_M_V
+! is localized at a y-flux point (v point).
+!
+! ( ____________z )
+! ( ________y )
+! 1 ( dzm(PY) )
+! PGY_M_V = ---- (dym(PY) - d*zy -------- )
+! d*yy ( d*zz )
+!
+!
+!
+!
+!!** METHOD
+!! ------
+!! We employ the Shuman operators to compute the derivatives and the
+!! averages. The metric coefficients PDYY,PDZY,PDZZ are dummy arguments.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTION DYM: compute a finite difference along the y direction for
+!! a variable at a mass localization
+!! FUNCTION DZM: compute a finite difference along the y direction for
+!! a variable at a mass localization
+!! FUNCTION MYM: compute an average in the x direction for a variable
+!! at a mass localization
+!! FUNCTION MZF: compute an average in the z direction for a variable
+!! at a flux side
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CONF : LFLAT
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (function GY_M_V)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil and J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification 16/03/95 change the order of the arguments
+!! 19/07/00 add the LFLAT switch + inlining(J. Stein)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT_TURB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+! -------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+LOGICAL, INTENT(IN) :: OFLAT
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDYY !d*yy
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZY !d*zy
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ !d*zz
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PY ! variable at mass
+ ! localization
+
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT),INTENT(OUT) :: PGY_M_V ! result at flux
+ ! side
+!REAL, DIMENSION(D%NIT*D%NJT*D%NKT) :: ZGY_M_V
+!REAL, DIMENSION(D%NIT,D%NJT,D%NKT):: ZY, ZDYY,ZDZZ,ZDZY
+INTEGER IJU,IKU,JI,JJ,JK,IKL, IKA
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Y
+! ----------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GY_M_V',0,ZHOOK_HANDLE)
+IJU=D%NJT
+IKU=D%NKT
+IKL=D%NKL
+IKA=D%NKA
+IKU=D%NKU
+IF (.NOT. OFLAT) THEN
+! PGY_M_V = ( DYM(PY) - MZF ( MYM( DZM(PY) /PDZZ ) * PDZY ) )/PDYY
+ DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB
+ DO JJ=1+JPHEXT,IJU
+ PGY_M_V(:,JJ,JK)= &
+ ( PY(:,JJ,JK)-PY(:,JJ-1,JK) &
+ -( (PY(:,JJ,JK)-PY(:,JJ,JK-IKL)) / PDZZ(:,JJ,JK) &
+ +(PY(:,JJ-1,JK)-PY(:,JJ-IKL,JK-IKL)) / PDZZ(:,JJ-1,JK) &
+ ) * PDZY(:,JJ,JK)* 0.25 &
+ -( (PY(:,JJ,JK+IKL)-PY(:,JJ,JK)) / PDZZ(:,JJ,JK+IKL) &
+ +(PY(:,JJ-1,JK+IKL)-PY(:,JJ-1,JK)) / PDZZ(:,JJ-1,JK+IKL) &
+ ) * PDZY(:,JJ,JK+IKL)* 0.25 &
+ ) / PDYY(:,JJ,JK)
+ END DO
+ END DO
+!
+ DO JJ=1+JPHEXT,IJU
+ PGY_M_V(:,JJ,IKU)= ( PY(:,JJ,IKU)-PY(:,JJ-1,IKU) ) / PDYY(:,JJ,IKU)
+ PGY_M_V(:,JJ,IKA)= -999.
+ END DO
+!
+ PGY_M_V(:,1,:)=PGY_M_V(:,IJU-2*JPHEXT+1,:)
+ELSE
+! PGY_M_V = DYM(PY)/PDYY
+ PGY_M_V(:,1+JPHEXT:IJU,:) = ( PY(:,1+JPHEXT:IJU,:)-PY(:,JPHEXT:IJU-1,:) ) &
+ / PDYY(:,1+JPHEXT:IJU,:)
+!
+ PGY_M_V(:,1,:)=PGY_M_V(:,IJU-2*JPHEXT+1,:)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GY_M_V',1,ZHOOK_HANDLE)
+END SUBROUTINE GY_M_V_PHY
+!
+SUBROUTINE D1D_TO_3D (D,P1D,P3D)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: P1D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: P3D
+
+P3D = P1D
+END SUBROUTINE D1D_TO_3D
+END MODULE MODE_GRADIENT_M_PHY
diff --git a/src/PHYEX/aux/gradient_u.f90 b/src/PHYEX/aux/gradient_u.f90
index 3d32ffa807c906ac2984bbbb8e83b00936d619a4..1b82a616a9d4fa55add91fa4b321b2b93f586bf9 100644
--- a/src/PHYEX/aux/gradient_u.f90
+++ b/src/PHYEX/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/PHYEX/aux/gradient_u_phy.f90 b/src/PHYEX/aux/gradient_u_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ff685a0c1319532998fddd9a0051fd17dd1fc4eb
--- /dev/null
+++ b/src/PHYEX/aux/gradient_u_phy.f90
@@ -0,0 +1,229 @@
+MODULE MODE_GRADIENT_U_PHY
+IMPLICIT NONE
+CONTAINS
+! #######################################################
+ SUBROUTINE GZ_U_UW_PHY(D,PA,PDZZ,PGZ_U_UW)
+! #######################################################
+!
+!!**** *GZ_U_UW - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Z
+!! direction for a variable placed at the
+!! U point and the result is placed at
+!! the UW vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Z cartesian direction for a field PA placed at the
+! U point. The result is placed at the UW vorticity point.
+!
+! dzm(PA)
+! PGZ_U_UW = ------
+! ____x
+! d*zz
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXM : Shuman functions (mean operators)
+!! DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE SHUMAN_PHY, ONLY : DZM_PHY, MXM_PHY
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGZ_U_UW ! result UW point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: PA_WORK, PDZZ_WORK
+!
+INTEGER :: JI,JJ,JK, IIB, IIE, IJB, IJE,IKT
+
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_U_UW
+! ---------------------
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+!
+CALL DZM_PHY(D,PA,PA_WORK)
+CALL MXM_PHY(D,PDZZ,PDZZ_WORK)
+!
+!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+PGZ_U_UW(IIB:IIE,IJB:IJE,1:IKT)= PA_WORK(IIB:IIE,IJB:IJE,1:IKT) &
+ / PDZZ_WORK(IIB:IIE,IJB:IJE,1:IKT)
+!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GZ_U_UW_PHY
+!
+ SUBROUTINE GX_U_M_PHY(D,OFLAT,PA,PDXX,PDZZ,PDZX,PGX_U_M)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! #######################################################
+!
+!!**** *GX_U_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian X
+!! direction for a variable placed at the
+!! U point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the X cartesian direction for a field PA placed at the
+! U point. The result is placed at the mass point.
+!
+!
+! ( ______________z )
+! ( (___________x ) )
+! 1 ( (d*zx dzm(PA) ) )
+! PGX_U_M = ---- (dxf(PA) - (------------)) )
+! ___x ( ( ) )
+! d*xx ( ( d*zz ) )
+!
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXF,MZF : Shuman functions (mean operators)
+!! DXF,DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE SHUMAN_PHY, ONLY : DZM_PHY, DXF_PHY, MXF_PHY, MZF_PHY
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+!
+LOGICAL, INTENT(IN) :: OFLAT
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: PGX_U_M ! result mass point
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4
+INTEGER :: IIB,IJB,IIE,IJE,IKT
+INTEGER :: JI,JJ,JK
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_U_M
+! --------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GX_U_M',0,ZHOOK_HANDLE)
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+!
+CALL DXF_PHY(D,PA,ZWORK1)
+CALL MXF_PHY(D,PDXX,ZWORK2)
+
+IF (.NOT. OFLAT) THEN
+ CALL DZM_PHY(D,PA,ZWORK3)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZWORK3(IIB:IIE,IJB:IJE,1:IKT) = ZWORK3(IIB:IIE,IJB:IJE,1:IKT) * PDZX(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ CALL MXF_PHY(D,ZWORK3,ZWORK4)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZWORK4(IIB:IIE,IJB:IJE,1:IKT) = ZWORK4(IIB:IIE,IJB:IJE,1:IKT) / PDZZ(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK4,ZWORK3)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGX_U_M(IIB:IIE,IJB:IJE,1:IKT) = ( ZWORK1(IIB:IIE,IJB:IJE,1:IKT) - ZWORK3(IIB:IIE,IJB:IJE,1:IKT)) &
+ / ZWORK2(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGX_U_M(IIB:IIE,IJB:IJE,1:IKT)= ZWORK1(IIB:IIE,IJB:IJE,1:IKT) / ZWORK2(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GX_U_M',1,ZHOOK_HANDLE)
+END SUBROUTINE GX_U_M_PHY
+!
+END MODULE MODE_GRADIENT_U_PHY
diff --git a/src/PHYEX/aux/gradient_v.f90 b/src/PHYEX/aux/gradient_v.f90
index 12c1be749d779a02648de8bb380dbdf9004a2907..2e976258486d0007a443b96f03861d61715dae0b 100644
--- a/src/PHYEX/aux/gradient_v.f90
+++ b/src/PHYEX/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/PHYEX/aux/gradient_v_phy.f90 b/src/PHYEX/aux/gradient_v_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..66ec0b4ca7708bd3dffd385752e336a49910f9d6
--- /dev/null
+++ b/src/PHYEX/aux/gradient_v_phy.f90
@@ -0,0 +1,223 @@
+MODULE MODE_GRADIENT_V_PHY
+IMPLICIT NONE
+CONTAINS
+ ! #######################################################
+ SUBROUTINE GZ_V_VW_PHY(D,PA,PDZZ,PGZ_V_VW)
+! #######################################################
+!
+!!**** *GZ_V_VW - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Z
+!! direction for a variable placed at the
+!! V point and the result is placed at
+!! the VW vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Z cartesian direction for a field PA placed at the
+! V point. The result is placed at the VW vorticity point.
+!
+!
+! dzm(PA)
+! PGZ_V_VW = ------
+! ____y
+! d*zz
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MYM : Shuman functions (mean operators)
+!! DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE SHUMAN_PHY, ONLY : DZM_PHY, MYM_PHY
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGZ_V_VW ! result UW point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: PA_WORK, PDZZ_WORK
+!
+INTEGER :: JI,JJ,JK
+INTEGER :: IIB,IJB,IIE,IJE,IKT
+!
+!* 0.2 declaration of local variables
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_V_VW
+! ---------------------
+!
+CALL DZM_PHY(D,PA,PA_WORK)
+CALL MYM_PHY(D,PDZZ,PDZZ_WORK)
+!
+!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+PGZ_V_VW(IIB:IIE,IJB:IJE,1:IKT)= PA_WORK(IIB:IIE,IJB:IJE,1:IKT) &
+ / PDZZ_WORK(IIB:IIE,IJB:IJE,1:IKT)
+!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GZ_V_VW_PHY
+ SUBROUTINE GY_V_M_PHY(D,OFLAT,PA,PDYY,PDZZ,PDZY,PGY_V_M)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! #######################################################
+!
+!!**** *GY_V_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Y
+!! direction for a variable placed at the
+!! V point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Y cartesian direction for a field PA placed at the
+! V point. The result is placed at the mass point.
+!
+!
+! ( ______________z )
+! ( (___________y ) )
+! 1 ( (d*zy dzm(PA) ) )
+! PGY_V_M = ---- (dyf(PA) - (------------)) )
+! ___y ( ( ) )
+! d*yy ( ( d*zz ) )
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MYF,MZF : Shuman functions (mean operators)
+!! DYF,DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE SHUMAN_PHY, ONLY : DZM_PHY, DYF_PHY, MYF_PHY, MZF_PHY
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+!
+LOGICAL, INTENT(IN) :: OFLAT
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: PGY_V_M ! result mass point
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4
+INTEGER :: IIB,IJB,IIE,IJE,IKT
+INTEGER :: JI,JJ,JK
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GY_V_M',0,ZHOOK_HANDLE)
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_V_M
+! --------------------
+!
+CALL DYF_PHY(D,PA,ZWORK1)
+CALL MYF_PHY(D,PDYY,ZWORK2)
+!
+IF (.NOT. OFLAT) THEN
+ CALL DZM_PHY(D,PA,ZWORK3)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZWORK3(IIB:IIE,IJB:IJE,1:IKT) = ZWORK3(IIB:IIE,IJB:IJE,1:IKT) * PDZY(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ CALL MYF_PHY(D,ZWORK3,ZWORK4)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZWORK4(IIB:IIE,IJB:IJE,1:IKT) = ZWORK4(IIB:IIE,IJB:IJE,1:IKT) / PDZZ(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK4,ZWORK3)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGY_V_M(IIB:IIE,IJB:IJE,1:IKT) = ( ZWORK1(IIB:IIE,IJB:IJE,1:IKT) - ZWORK3(IIB:IIE,IJB:IJE,1:IKT)) &
+ / ZWORK2(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGY_V_M(IIB:IIE,IJB:IJE,1:IKT)= ZWORK1(IIB:IIE,IJB:IJE,1:IKT) / ZWORK2(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GY_V_M',1,ZHOOK_HANDLE)
+END SUBROUTINE GY_V_M_PHY
+!
+END MODULE MODE_GRADIENT_V_PHY
diff --git a/src/PHYEX/aux/gradient_w.f90 b/src/PHYEX/aux/gradient_w.f90
index 1ef8f6916a266f0dc74a2cd5b8a79dceb85b979d..097016ea94da162d1ba2b7ca0f84cf6c64a38de0 100644
--- a/src/PHYEX/aux/gradient_w.f90
+++ b/src/PHYEX/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/PHYEX/aux/gradient_w_phy.f90 b/src/PHYEX/aux/gradient_w_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0377f0991ceffd5f90533f5af1091b9bc653dc36
--- /dev/null
+++ b/src/PHYEX/aux/gradient_w_phy.f90
@@ -0,0 +1,328 @@
+MODULE MODE_GRADIENT_W_PHY
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE GX_W_UW_PHY(D,OFLAT,PA,PDXX,PDZZ,PDZX,PGX_W_UW)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! #########################################################
+!
+!!**** *GX_W_UW* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian X
+!! direction for a variable placed at the
+!! V point and the result is placed at
+!! the UW vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the X cartesian direction for a field PA placed at the
+! W point. The result is placed at the UW vorticity point.
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXM,MZM,MZF : Shuman functions (mean operators)
+!! DXM,DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY, MXM_PHY, DXM_PHY, MZM_PHY, DZM_PHY
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZX ! metric coefficient dzx
+LOGICAL, INTENT(IN) :: OFLAT
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT),INTENT(OUT) :: PGX_W_UW ! result UW point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
+INTEGER :: IIB,IJB,IIE,IJE,IKT
+INTEGER :: JI,JJ,JK
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_W_UW
+! ---------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GX_W_UW',0,ZHOOK_HANDLE)
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+CALL MZM_PHY(D,PDXX,ZWORK1)
+CALL DXM_PHY(D,PA,ZWORK2)
+!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ZWORK3(IIB:IIE,IJB:IJE,1:IKT) = ZWORK2(IIB:IIE,IJB:IJE,1:IKT) / ZWORK1(IIB:IIE,IJB:IJE,1:IKT)
+!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+!
+IF (.NOT. OFLAT) THEN
+ CALL MZF_PHY(D,PA,ZWORK2)
+ CALL MXM_PHY(D,ZWORK2,ZWORK4)
+ CALL DZM_PHY(D,ZWORK4,ZWORK5)
+ !
+ CALL MXM_PHY(D,PDZZ,ZWORK2)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGX_W_UW(IIB:IIE,IJB:IJE,1:IKT)= ZWORK3(IIB:IIE,IJB:IJE,1:IKT) &
+ - ZWORK5(IIB:IIE,IJB:IJE,1:IKT)*PDZX(IIB:IIE,IJB:IJE,1:IKT) &
+ / (ZWORK1(IIB:IIE,IJB:IJE,1:IKT)*ZWORK2(IIB:IIE,IJB:IJE,1:IKT))
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ELSE
+ PGX_W_UW = ZWORK3
+END IF
+!
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GX_W_UW',1,ZHOOK_HANDLE)
+END SUBROUTINE GX_W_UW_PHY
+!
+ SUBROUTINE GY_W_VW_PHY(D,OFLAT,PA,PDYY,PDZZ,PDZY,PGY_W_VW)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! #########################################################
+!
+!!**** *GY_W_VW* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Y
+!! direction for a variable placed at the
+!! W point and the result is placed at
+!! the VW vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Y cartesian direction for a field PA placed at the
+! W point. The result is placed at the VW vorticity point.
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MYM,MZM,MZF : Shuman functions (mean operators)
+!! DYM,DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY, MYM_PHY, DYM_PHY, MZM_PHY, DZM_PHY
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDYY ! metric coefficient dxx
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZY ! metric coefficient dzx
+LOGICAL, INTENT(IN) :: OFLAT
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT),INTENT(OUT) :: PGY_W_VW ! result UW point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
+INTEGER :: IIB,IJB,IIE,IJE,IKT
+INTEGER :: JI,JJ,JK
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_W_VW
+! ---------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GY_W_VW',0,ZHOOK_HANDLE)
+!IF (.NOT. LFLAT) THEN
+! PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(PDYY(:,:,:), KKA, KKU, KL)) &
+! -DZM(MYM(MZF(PA(:,:,:), KKA, KKU, KL)), KKA, KKU, KL)*PDZY(:,:,:) &
+! /( MZM(PDYY(:,:,:), KKA, KKU, KL)*MYM(PDZZ(:,:,:)) )
+!ELSE
+! PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(PDYY(:,:,:), KKA, KKU, KL))
+!END IF
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+CALL MZM_PHY(D,PDYY,ZWORK1)
+CALL DYM_PHY(D,PA,ZWORK2)
+!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ZWORK3(IIB:IIE,IJB:IJE,1:IKT) = ZWORK2(IIB:IIE,IJB:IJE,1:IKT) / ZWORK1(IIB:IIE,IJB:IJE,1:IKT)
+!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+!
+IF (.NOT. OFLAT) THEN
+ CALL MZF_PHY(D,PA,ZWORK2)
+ CALL MYM_PHY(D,ZWORK2,ZWORK4)
+ CALL DZM_PHY(D,ZWORK4,ZWORK5)
+ !
+ CALL MYM_PHY(D,PDZZ,ZWORK2)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PGY_W_VW(IIB:IIE,IJB:IJE,1:IKT)= ZWORK3(IIB:IIE,IJB:IJE,1:IKT) &
+ - ZWORK5(IIB:IIE,IJB:IJE,1:IKT)*PDZY(IIB:IIE,IJB:IJE,1:IKT) &
+ / (ZWORK1(IIB:IIE,IJB:IJE,1:IKT)*ZWORK2(IIB:IIE,IJB:IJE,1:IKT))
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ELSE
+ PGY_W_VW = ZWORK3
+END IF
+
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GY_W_VW',1,ZHOOK_HANDLE)
+END SUBROUTINE GY_W_VW_PHY
+!
+ SUBROUTINE GZ_W_M_PHY(D,PA,PDZZ,PGZ_W_M)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! #######################################################
+!
+!!**** *GZ_W_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Z
+!! direction for a variable placed at the
+!! W point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Z cartesian direction for a field PA placed at the
+! W point. The result is placed at the mass point.
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MZF : Shuman functions (mean operators)
+!! DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/07/94
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) , INTENT(OUT):: PGZ_W_M ! result mass point
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2
+INTEGER :: IIB,IJB,IIE,IJE,IKT
+INTEGER :: JI,JJ,JK
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_W_M
+! --------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GZ_W_M',0,ZHOOK_HANDLE)
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+CALL DZF_PHY(D,PA,ZWORK1)
+CALL MZF_PHY(D,PDZZ,ZWORK2)
+!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+PGZ_W_M(IIB:IIE,IJB:IJE,1:IKT)= ZWORK1(IIB:IIE,IJB:IJE,1:IKT)/ZWORK2(IIB:IIE,IJB:IJE,1:IKT)
+!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+!
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GZ_W_M',1,ZHOOK_HANDLE)
+END SUBROUTINE GZ_W_M_PHY
+!
+END MODULE MODE_GRADIENT_W_PHY
diff --git a/src/PHYEX/aux/ini_cst.f90 b/src/PHYEX/aux/ini_cst.f90
index 7c3170c4cb7e9e48a0fb645cc70efa30d6a6cae8..c51e7149fe22b573f6e8ee1e3d048c155d86c059 100644
--- a/src/PHYEX/aux/ini_cst.f90
+++ b/src/PHYEX/aux/ini_cst.f90
@@ -2,22 +2,6 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_INI_CST
-! ###################
-!
-INTERFACE
-!
-SUBROUTINE INI_CST
-END SUBROUTINE INI_CST
-!
-END INTERFACE
-!
-END MODULE MODI_INI_CST
-!
-!
-!
! ##################
SUBROUTINE INI_CST
! ##################
@@ -60,7 +44,9 @@ END MODULE MODI_INI_CST
!! V. Masson 05/10/98 add XRHOLI
!! C. Mari 31/10/00 add NDAYSEC
!! V. Masson 01/03/03 add XCONDI
-!! J. Escobar 28/03/2014 for pb with emissivity/aerosol reset XMNH_TINY=1.0e-80 in real8 case
+!! J. Escobar 28/03/2014 for pb with emissivity/aerosol reset XMNH_TINY=1.0e-80 in real8 case
+!! R. El Khatib 04/08/14 add pre-computed quantities
+!! P. Marguinaud 04/10/16 Port to single precision
!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! J.Escobar : 5/10/2018 : for real*4 ,higher value for XEPS_DT = 1.5e-4
@@ -71,11 +57,17 @@ END MODULE MODI_INI_CST
! ------------
!
USE MODD_CST
-use modd_precision, only: MNHREAL
+USE MODD_PRECISION, ONLY: MNHREAL, MNHREAL32, MNHREAL64
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('INI_CST',0,ZHOOK_HANDLE)
+CALL CST_ASSOCIATE()
!
!* 1. FUNDAMENTAL CONSTANTS
! ---------------------
@@ -114,7 +106,7 @@ XG = 9.80665
!
! Ocean model cst same as in 1D/CMO SURFEX
! values used in ini_cst to overwrite XP00 and XTH00
-XRH00OCEAN =1024.
+XRH00OCEAN =1024.
XTH00OCEAN = 286.65
XSA00OCEAN= 32.6
XP00OCEAN = 201.E5
@@ -126,8 +118,11 @@ XTH00 = 300.
!* 5. RADIATION CONSTANTS
! -------------------
!
-!JUAN OVERFLOW XSTEFAN = 2.* XPI**5 * XBOLTZ**4 / (15.* XLIGHTSPEED**2 * XPLANCK**3)
-XSTEFAN = ( 2.* XPI**5 / 15. ) * ( (XBOLTZ / XPLANCK) * XBOLTZ ) * (XBOLTZ/(XLIGHTSPEED*XPLANCK))**2
+! Original: XSTEFAN = 2.* XPI**5 * XBOLTZ**4 / (15.* XLIGHTSPEED**2 * XPLANCK**3)
+! Juan: XSTEFAN = ( 2.* XPI**5 / 15. ) * ( (XBOLTZ / XPLANCK) * XBOLTZ ) * (XBOLTZ/(XLIGHTSPEED*XPLANCK))**2
+! Philippe Marguinaud: XSTEFAN = REAL (2._8* REAL (XPI, 8)**5 * REAL (XBOLTZ, 8)**4 / (15._8* REAL (XLIGHTSPEED, 8)**2 * REAL (XPLANCK, 8)**3))
+XSTEFAN = REAL (2._MNHREAL64* REAL (XPI, MNHREAL64)**5 * REAL (XBOLTZ, MNHREAL64)**4 / &
+ & (15._MNHREAL64* REAL (XLIGHTSPEED, MNHREAL64)**2 * REAL (XPLANCK, MNHREAL64)**3))
XI0 = 1370.
!
!-------------------------------------------------------------------------------
@@ -161,37 +156,40 @@ XALPI = LOG(XESTT) + (XBETAI /XTT) + (XGAMI *LOG(XTT))
! Values identical to ones used in CMO1D in SURFEX /could be modified
! Coefficient of thermal expansion of water (K-1)
XALPHAOC = 1.9E-4
-! Coeff of Haline contraction coeff (S-1)
+! Coeff of Haline contraction coeff (S-1)
XBETAOC= 7.7475E-4
!
+!* 7. PRECOMPUTED CONSTANTS
+! ---------------------
+!
+RDSRV = XRD/XRV
+RDSCPD = XRD/XCPD
+RINVXP00 = 1./XP00
+!
! Some machine precision value depending of real4/8 use
!
-
-
XMNH_EPSILON = EPSILON (XMNH_EPSILON )
XMNH_HUGE = HUGE (XMNH_HUGE )
XMNH_HUGE_12_LOG = LOG ( SQRT(XMNH_HUGE) )
-#if (MNH_REAL == 8)
+IF (MNHREAL == MNHREAL64) THEN
XMNH_TINY = 1.0e-80_MNHREAL
XEPS_DT = 1.0e-5_MNHREAL
XRES_FLAT_CART = 1.0e-12_MNHREAL
XRES_OTHER = 1.0e-9_MNHREAL
XRES_PREP = 1.0e-8_MNHREAL
-#elif (MNH_REAL == 4)
+ELSEIF (MNHREAL == MNHREAL32) THEN
XMNH_TINY = TINY (XMNH_TINY )
XEPS_DT = 1.5e-4_MNHREAL
XRES_FLAT_CART = 1.0e-12_MNHREAL
XRES_OTHER = 1.0e-7_MNHREAL
XRES_PREP = 1.0e-4_MNHREAL
-#else
-#error "Invalid MNH_REAL"
-#endif
+ELSE
+CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'INI_CST', 'Invalid MNH_REAL')
+ENDIF
XMNH_TINY_12 = SQRT (XMNH_TINY )
-
-
-
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('INI_CST',1,ZHOOK_HANDLE)
END SUBROUTINE INI_CST
diff --git a/src/PHYEX/aux/modd_budget.f90 b/src/PHYEX/aux/modd_budget.f90
index cf07928ba558bf5422b5296976c16968e4e2c189..65d6ce37bebf22b6490e804acf4cc6552176b36d 100644
--- a/src/PHYEX/aux/modd_budget.f90
+++ b/src/PHYEX/aux/modd_budget.f90
@@ -163,13 +163,31 @@ type tbudgetdata
type(tburhodata), pointer :: trhodj => null() ! Budget array for rhodj
end type tbudgetdata
-
+TYPE TBUDGETCONF_t
+ LOGICAL :: LBU_ENABLE
+ LOGICAL :: LBUDGET_U ! flag to compute budget of RhoJu and/or LES budgets with u
+ LOGICAL :: LBUDGET_V ! flag to compute budget of RhoJv and/or LES budgets with u
+ LOGICAL :: LBUDGET_W ! flag to compute budget of RhoJw and/or LES budgets with u
+ LOGICAL :: LBUDGET_TH ! flag to compute budget of RhoJTh and/or LES budgets with th
+ LOGICAL :: LBUDGET_TKE! flag to compute budget of RhoJTke and/or LES budgets with Tke
+ LOGICAL :: LBUDGET_RV ! flag to compute budget of RhoJrv and/or LES budgets with rv
+ LOGICAL :: LBUDGET_RC ! flag to compute budget of RhoJrc and/or LES budgets with rc
+ LOGICAL :: LBUDGET_RR ! flag to compute budget of RhoJrr and/or LES budgets with rr
+ LOGICAL :: LBUDGET_RI ! flag to compute budget of RhoJri and/or LES budgets with ri
+ LOGICAL :: LBUDGET_RS ! flag to compute budget of RhoJrs and/or LES budgets with rs
+ LOGICAL :: LBUDGET_RG ! flag to compute budget of RhoJrg and/or LES budgets with rg
+ LOGICAL :: LBUDGET_RH ! flag to compute budget of RhoJrh and/or LES budgets with rh
+ LOGICAL :: LBUDGET_SV ! flag to compute budget of RhoJsv and/or LES budgets with sv
+END TYPE TBUDGETCONF_t
+!
+TYPE(TBUDGETCONF_t), TARGET :: TBUCONF
+!
type(tbudgetdata), dimension(:), allocatable, save :: tbudgets
type(tburhodata), pointer, save :: tburhodj => null() ! Budget array for rhodj used inside some tbudgets
! General variables
-LOGICAL, SAVE :: LBU_ENABLE
+LOGICAL, POINTER :: LBU_ENABLE=>TBUCONF%LBU_ENABLE
!
CHARACTER (LEN=4), SAVE :: CBUTYPE ! type of desired budget 'CART'
! (cartesian box) or 'MASK' (budget
@@ -351,18 +369,18 @@ CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RSV
REAL :: XTIME_BU ! budget time in this time-step
REAL :: XTIME_BU_PROCESS ! budget time per process for this time-step
!
-LOGICAL :: LBUDGET_U ! flag to compute budget of RhoJu and/or LES budgets with u
-LOGICAL :: LBUDGET_V ! flag to compute budget of RhoJv and/or LES budgets with u
-LOGICAL :: LBUDGET_W ! flag to compute budget of RhoJw and/or LES budgets with u
-LOGICAL :: LBUDGET_TH ! flag to compute budget of RhoJTh and/or LES budgets with th
-LOGICAL :: LBUDGET_TKE! flag to compute budget of RhoJTke and/or LES budgets with Tke
-LOGICAL :: LBUDGET_RV ! flag to compute budget of RhoJrv and/or LES budgets with rv
-LOGICAL :: LBUDGET_RC ! flag to compute budget of RhoJrc and/or LES budgets with rc
-LOGICAL :: LBUDGET_RR ! flag to compute budget of RhoJrr and/or LES budgets with rr
-LOGICAL :: LBUDGET_RI ! flag to compute budget of RhoJri and/or LES budgets with ri
-LOGICAL :: LBUDGET_RS ! flag to compute budget of RhoJrs and/or LES budgets with rs
-LOGICAL :: LBUDGET_RG ! flag to compute budget of RhoJrg and/or LES budgets with rg
-LOGICAL :: LBUDGET_RH ! flag to compute budget of RhoJrh and/or LES budgets with rh
-LOGICAL :: LBUDGET_SV ! flag to compute budget of RhoJsv and/or LES budgets with sv
+LOGICAL, POINTER :: LBUDGET_U=>TBUCONF%LBUDGET_U ! flag to compute budget of RhoJu and/or LES budgets with u
+LOGICAL, POINTER :: LBUDGET_V=>TBUCONF%LBUDGET_V ! flag to compute budget of RhoJv and/or LES budgets with u
+LOGICAL, POINTER :: LBUDGET_W=>TBUCONF%LBUDGET_W ! flag to compute budget of RhoJw and/or LES budgets with u
+LOGICAL, POINTER :: LBUDGET_TH=>TBUCONF%LBUDGET_TH ! flag to compute budget of RhoJTh and/or LES budgets with th
+LOGICAL, POINTER :: LBUDGET_TKE=>TBUCONF%LBUDGET_TKE ! flag to compute budget of RhoJTke and/or LES budgets with Tke
+LOGICAL, POINTER :: LBUDGET_RV=>TBUCONF%LBUDGET_RV ! flag to compute budget of RhoJrv and/or LES budgets with rv
+LOGICAL, POINTER :: LBUDGET_RC=>TBUCONF%LBUDGET_RC ! flag to compute budget of RhoJrc and/or LES budgets with rc
+LOGICAL, POINTER :: LBUDGET_RR=>TBUCONF%LBUDGET_RR ! flag to compute budget of RhoJrr and/or LES budgets with rr
+LOGICAL, POINTER :: LBUDGET_RI=>TBUCONF%LBUDGET_RI ! flag to compute budget of RhoJri and/or LES budgets with ri
+LOGICAL, POINTER :: LBUDGET_RS=>TBUCONF%LBUDGET_RS ! flag to compute budget of RhoJrs and/or LES budgets with rs
+LOGICAL, POINTER :: LBUDGET_RG=>TBUCONF%LBUDGET_RG ! flag to compute budget of RhoJrg and/or LES budgets with rg
+LOGICAL, POINTER :: LBUDGET_RH=>TBUCONF%LBUDGET_RH ! flag to compute budget of RhoJrh and/or LES budgets with rh
+LOGICAL, POINTER :: LBUDGET_SV=>TBUCONF%LBUDGET_SV ! flag to compute budget of RhoJsv and/or LES budgets with sv
!
END MODULE MODD_BUDGET
diff --git a/src/PHYEX/aux/modd_conf.f90 b/src/PHYEX/aux/modd_conf.f90
index a7995fec5548247b67356044fe285d76f13b68f6..ea493d3a32e075aa3e9c80506a89a1c5bc4d3b01 100644
--- a/src/PHYEX/aux/modd_conf.f90
+++ b/src/PHYEX/aux/modd_conf.f90
@@ -12,30 +12,30 @@
!! PURPOSE
!! -------
! The purpose of this declarative module is to specify the variables
-! which concern the configuration of all models. For exemple,
-! the type of geometry (Cartesian or conformal projection plane).
+! which concern the configuration of all models. For exemple,
+! the type of geometry (Cartesian or conformal projection plane).
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
-!! None
+!! None
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (module MODD_CONF)
!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
-!!
+!!
!! AUTHOR
!! ------
-!! V. Ducrocq *Meteo France*
+!! V. Ducrocq *Meteo France*
!!
!! MODIFICATIONS
!! -------------
-!! Original 05/05/94
-!! J. Stein 09/01/95 add the 1D switch
-!! J. Stein and P. Jabouille 30/04/96 add the storage type
+!! Original 05/05/94
+!! J. Stein 09/01/95 add the 1D switch
+!! J. Stein and P. Jabouille 30/04/96 add the storage type
!! J.-P. Pinty 13/02/96 add LFORCING switch
-!! J. Stein 25/07/97 add the equation system switch
+!! J. Stein 25/07/97 add the equation system switch
!! P. Jabouille 07/05/98 add LPACK
!! V. Masson 18/03/98 add the VERSION switch
!! V. Masson 15/03/99 add PROGRAM swith
@@ -56,15 +56,19 @@
IMPLICIT NONE
!
CHARACTER (LEN=5),SAVE :: CCONF ! Configuration of models
- ! 'START' for start configuration
- ! 'RESTART' for restart configuration
+ ! 'START' for start configuration (variables
+ ! at time t and t-dt are the same in the
+ ! initial file)
+ ! 'RESTART' for restart configuration
+ ! (variables at time t and t-dt are different)
+ ! 'POST' for post-treatment configuration
LOGICAL,SAVE :: LTHINSHELL ! Logical for thinshell approximation
! .TRUE. = thinshell approximation
! .FALSE. = no thinshell approximation
LOGICAL,SAVE :: LCARTESIAN ! Logical for cartesian geometry :
- ! .TRUE. = cartesian geometry
+ ! .TRUE. = cartesian geometry
! .FALSE. = conformal projection
-LOGICAL,SAVE :: L2D = .FALSE. ! Logical for 2D model version
+LOGICAL,SAVE :: L2D=.FALSE. ! Logical for 2D model version
! .TRUE. = 2D model version
! .FALSE. = 3D model version
LOGICAL,SAVE :: L1D ! Logical for 1D model version
@@ -72,12 +76,12 @@ LOGICAL,SAVE :: L1D ! Logical for 1D model version
! .FALSE. = 2D or 3D model version
LOGICAL,SAVE :: LFLAT ! Logical for zero ororography
! .TRUE. = no orography (zs=0.)
- ! .FALSE. = orography
+ ! .FALSE. = orography
INTEGER,SAVE :: NMODEL ! Number of nested models
INTEGER,SAVE :: NVERB ! Level of informations on output-listing
! 0 for minimum of prints
! 5 for intermediate level of prints
- ! 10 for maximum of prints
+ ! 10 for maximum of prints
CHARACTER (LEN=5),SAVE :: CEXP ! Experiment name
CHARACTER (LEN=5),SAVE :: CSEG ! name of segment
LOGICAL,SAVE :: LFORCING ! Logical for forcing sources
@@ -107,8 +111,6 @@ CHARACTER(LEN=6),SAVE :: CPROGRAM ! CPROGRAM is the program currently running:
!
INTEGER,SAVE :: NHALO ! Size of the halo for parallel distribution
!
-!INTEGER,SAVE :: JPHEXT = 1 ! Horizontal External points number
-!
CHARACTER (LEN=10),SAVE :: CSPLIT ! kind of domain splitting for parallel distribution
! "BSPLITTING","XSPLITTING","YSPLITTING"
LOGICAL,SAVE :: LLG ! Logical to use lagrangian variables
diff --git a/src/PHYEX/aux/modd_cst.f90 b/src/PHYEX/aux/modd_cst.f90
index e1ecd59a354d5945a1d6c616156c5e2ff12f16ce..544c754648621b3c66d725c261c57bedf412b244 100644
--- a/src/PHYEX/aux/modd_cst.f90
+++ b/src/PHYEX/aux/modd_cst.f90
@@ -36,81 +36,206 @@
!! V. Masson 05/10/98 add XRHOLI
!! C. Mari 31/10/00 add NDAYSEC
!! V. Masson 01/03/03 add conductivity of ice
+!! R. El Khatib 04/08/14 add pre-computed quantities
!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
!! J.L. Redelsperger 03/2021 add constants for ocean penetrating solar
+!! S. Riette: Jan 2022: introduction of a strucuture
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
IMPLICIT NONE
-REAL,SAVE :: XPI ! Pi
+TYPE CST_t
+REAL :: XPI ! Pi
!
-REAL,SAVE :: XDAY,XSIYEA,XSIDAY ! day duration, sideral year duration,
+REAL :: XDAY,XSIYEA,XSIDAY ! day duration, sideral year duration,
! sideral day duration
!
-REAL,SAVE :: XKARMAN ! von karman constant
-REAL,SAVE :: XLIGHTSPEED ! light speed
-REAL,SAVE :: XPLANCK ! Planck constant
-REAL,SAVE :: XBOLTZ ! Boltzman constant
-REAL,SAVE :: XAVOGADRO ! Avogadro number
-!
-REAL,SAVE :: XRADIUS,XOMEGA ! Earth radius, earth rotation
-REAL,SAVE :: XG ! Gravity constant
-!
-REAL,SAVE :: XP00 ! Reference pressure
-REAL,SAVE :: XP00OCEAN ! Reference pressure for ocean model
-REAL,SAVE :: XRH00OCEAN ! Reference density for ocean model
-!
-REAL,SAVE :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
-!
-REAL,SAVE :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
-REAL,SAVE :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
-REAL,SAVE :: XEPSILO ! XMV/XMD
-REAL,SAVE :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
-REAL,SAVE :: XRHOLW ! Volumic mass of liquid water
-REAL,SAVE :: XCL,XCI ! Cl (liquid), Ci (ice)
-REAL,SAVE :: XTT ! Triple point temperature
-REAL,SAVE :: XLVTT ! Vaporization heat constant
-REAL,SAVE :: XLSTT ! Sublimation heat constant
-REAL,SAVE :: XLMTT ! Melting heat constant
-REAL,SAVE :: XESTT ! Saturation vapor pressure at triple point
+REAL :: XKARMAN ! von karman constant
+REAL :: XLIGHTSPEED ! light speed
+REAL :: XPLANCK ! Planck constant
+REAL :: XBOLTZ ! Boltzman constant
+REAL :: XAVOGADRO ! Avogadro number
+!
+REAL :: XRADIUS,XOMEGA ! Earth radius, earth rotation
+REAL :: XG ! Gravity constant
+!
+REAL :: XP00 ! Reference pressure
+REAL :: XP00OCEAN ! Reference pressure for ocean model
+REAL :: XRH00OCEAN ! Reference density for ocean model
+!
+REAL :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
+!
+REAL :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
+REAL :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+REAL :: XEPSILO ! XMV/XMD
+REAL :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+REAL :: XRHOLW ! Volumic mass of liquid water
+REAL :: XCL,XCI ! Cl (liquid), Ci (ice)
+REAL :: XTT ! Triple point temperature
+REAL :: XLVTT ! Vaporization heat constant
+REAL :: XLSTT ! Sublimation heat constant
+REAL :: XLMTT ! Melting heat constant
+REAL :: XESTT ! Saturation vapor pressure at triple point
! temperature
-REAL,SAVE :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+REAL :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
! pressure function
-REAL,SAVE :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
+REAL :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
! pressure function over solid ice
-REAL,SAVE :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
-REAL,SAVE :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
-REAL,SAVE :: XBETAOC ! Haline contraction coeff for ocean (S-1)
-REAL,SAVE :: XTH00 ! reference value for the potential temperature
-REAL,SAVE :: XTH00OCEAN ! Ref value for pot temp in ocean model
-REAL,SAVE :: XSA00OCEAN ! Ref value for SAlinity in ocean model
-REAL,SAVE :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
-REAL,SAVE :: XD1=1.1
-REAL,SAVE :: XD2=23.
+REAL :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
+REAL :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
+REAL :: XBETAOC ! Haline contraction coeff for ocean (S-1)
+REAL :: XTH00 ! reference value for the potential temperature
+REAL :: XTH00OCEAN ! Ref value for pot temp in ocean model
+REAL :: XSA00OCEAN ! Ref value for SAlinity in ocean model
+REAL :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
+REAL :: XD1=1.1
+REAL :: XD2=23.
! Values used in SURFEX CMO
-!REAL,SAVE :: XROC=0.58
-!REAL,SAVE :: XD1=0.35
-!REAL,SAVE :: XD2=23.
+!REAL :: XROC=0.58
+!REAL :: XD1=0.35
+!REAL :: XD2=23.
-REAL,SAVE :: XRHOLI ! Volumic mass of ice
+REAL :: XRHOLI ! Volumic mass of ice
!
-INTEGER, SAVE :: NDAYSEC ! Number of seconds in a day
+INTEGER :: NDAYSEC ! Number of seconds in a day
!
+REAL :: RDSRV ! XRD/XRV
+REAL :: RDSCPD ! XRD/XCPD
+REAL :: RINVXP00 ! 1./XP00
!
! Some machine precision value depending of real4/8 use
!
-REAL,SAVE :: XMNH_TINY ! minimum real on this machine
-REAL,SAVE :: XMNH_TINY_12 ! sqrt(minimum real on this machine)
-REAL,SAVE :: XMNH_EPSILON ! minimum space with 1.0
-REAL,SAVE :: XMNH_HUGE ! maximum real on this machine
-REAL,SAVE :: XMNH_HUGE_12_LOG ! maximum log(sqrt(real)) on this machine
+REAL :: XMNH_TINY ! minimum real on this machine
+REAL :: XMNH_TINY_12 ! sqrt(minimum real on this machine)
+REAL :: XMNH_EPSILON ! minimum space with 1.0
+REAL :: XMNH_HUGE ! maximum real on this machine
+REAL :: XMNH_HUGE_12_LOG ! maximum log(sqrt(real)) on this machine
-REAL,SAVE :: XEPS_DT ! default value for DT test
-REAL,SAVE :: XRES_FLAT_CART ! default flat&cart residual tolerance
-REAL,SAVE :: XRES_OTHER ! default not flat&cart residual tolerance
-REAL,SAVE :: XRES_PREP ! default prep residual tolerance
+REAL :: XEPS_DT ! default value for DT test
+REAL :: XRES_FLAT_CART ! default flat&cart residual tolerance
+REAL :: XRES_OTHER ! default not flat&cart residual tolerance
+REAL :: XRES_PREP ! default prep residual tolerance
+END TYPE CST_t
+TYPE(CST_t), TARGET, SAVE :: CST
+
+REAL, POINTER :: XPI=>NULL()
+REAL, POINTER :: XDAY=>NULL(), XSIYEA=>NULL(), XSIDAY=>NULL()
+REAL, POINTER :: XKARMAN=>NULL()
+REAL, POINTER :: XLIGHTSPEED=>NULL()
+REAL, POINTER :: XPLANCK=>NULL()
+REAL, POINTER :: XBOLTZ=>NULL()
+REAL, POINTER :: XAVOGADRO=>NULL()
+REAL, POINTER :: XRADIUS=>NULL(), XOMEGA=>NULL()
+REAL, POINTER :: XG=>NULL()
+REAL, POINTER :: XP00=>NULL()
+REAL, POINTER :: XP00OCEAN=>NULL()
+REAL, POINTER :: XRH00OCEAN=>NULL()
+REAL, POINTER :: XSTEFAN=>NULL(), XI0=>NULL()
+REAL, POINTER :: XMD=>NULL(), XMV=>NULL()
+REAL, POINTER :: XRD=>NULL(), XRV=>NULL()
+REAL, POINTER :: XEPSILO=>NULL()
+REAL, POINTER :: XCPD=>NULL(), XCPV=>NULL()
+REAL, POINTER :: XRHOLW=>NULL()
+REAL, POINTER :: XCL=>NULL(), XCI=>NULL()
+REAL, POINTER :: XTT=>NULL()
+REAL, POINTER :: XLVTT=>NULL()
+REAL, POINTER :: XLSTT=>NULL()
+REAL, POINTER :: XLMTT=>NULL()
+REAL, POINTER :: XESTT=>NULL()
+REAL, POINTER :: XALPW=>NULL(), XBETAW=>NULL(), XGAMW=>NULL()
+REAL, POINTER :: XALPI=>NULL(), XBETAI=>NULL(), XGAMI=>NULL()
+REAL, POINTER :: XCONDI=>NULL()
+REAL, POINTER :: XALPHAOC=>NULL()
+REAL, POINTER :: XBETAOC=>NULL()
+REAL, POINTER :: XTH00=>NULL()
+REAL, POINTER :: XTH00OCEAN=>NULL()
+REAL, POINTER :: XSA00OCEAN=>NULL()
+REAL, POINTER :: XROC=>NULL()
+REAL, POINTER :: XD1=>NULL()
+REAL, POINTER :: XD2=>NULL()
+REAL, POINTER :: XRHOLI=>NULL()
+INTEGER, POINTER :: NDAYSEC=>NULL()
+REAL, POINTER :: RDSRV=>NULL()
+REAL, POINTER :: RDSCPD=>NULL()
+REAL, POINTER :: RINVXP00=>NULL()
+REAL, POINTER :: XMNH_TINY=>NULL()
+REAL, POINTER :: XMNH_TINY_12=>NULL()
+REAL, POINTER :: XMNH_EPSILON=>NULL()
+REAL, POINTER :: XMNH_HUGE=>NULL()
+REAL, POINTER :: XMNH_HUGE_12_LOG=>NULL()
+REAL, POINTER :: XEPS_DT=>NULL()
+REAL, POINTER :: XRES_FLAT_CART=>NULL()
+REAL, POINTER :: XRES_OTHER=>NULL()
+REAL, POINTER :: XRES_PREP=>NULL()
+!
+CONTAINS
+SUBROUTINE CST_ASSOCIATE()
+ IMPLICIT NONE
+ XPI=>CST%XPI
+ XDAY=>CST%XDAY
+ XSIYEA=>CST%XSIYEA
+ XSIDAY=>CST%XSIDAY
+ XKARMAN=>CST%XKARMAN
+ XLIGHTSPEED=>CST%XLIGHTSPEED
+ XPLANCK=>CST%XPLANCK
+ XBOLTZ=>CST%XBOLTZ
+ XAVOGADRO=>CST%XAVOGADRO
+ XRADIUS=>CST%XRADIUS
+ XOMEGA=>CST%XOMEGA
+ XG=>CST%XG
+ XP00=>CST%XP00
+ XP00OCEAN=>CST%XP00OCEAN
+ XRH00OCEAN=>CST%XRH00OCEAN
+ XSTEFAN=>CST%XSTEFAN
+ XI0=>CST%XI0
+ XMD=>CST%XMD
+ XMV=>CST%XMV
+ XRD=>CST%XRD
+ XRV=>CST%XRV
+ XEPSILO=>CST%XEPSILO
+ XCPD=>CST%XCPD
+ XCPV=>CST%XCPV
+ XRHOLW=>CST%XRHOLW
+ XCL=>CST%XCL
+ XCI=>CST%XCI
+ XTT=>CST%XTT
+ XLVTT=>CST%XLVTT
+ XLSTT=>CST%XLSTT
+ XLMTT=>CST%XLMTT
+ XESTT=>CST%XESTT
+ XALPW=>CST%XALPW
+ XBETAW=>CST%XBETAW
+ XGAMW=>CST%XGAMW
+ XALPI=>CST%XALPI
+ XBETAI=>CST%XBETAI
+ XGAMI=>CST%XGAMI
+ XCONDI=>CST%XCONDI
+ XALPHAOC=>CST%XALPHAOC
+ XBETAOC=>CST%XBETAOC
+ XTH00=>CST%XTH00
+ XTH00OCEAN=>CST%XTH00OCEAN
+ XSA00OCEAN=>CST%XSA00OCEAN
+ XROC=>CST%XROC
+ XD1=>CST%XD1
+ XD2=>CST%XD2
+ XRHOLI=>CST%XRHOLI
+ NDAYSEC=>CST%NDAYSEC
+ RDSRV=>CST%RDSRV
+ RDSCPD=>CST%RDSCPD
+ RINVXP00=>CST%RINVXP00
+ XMNH_TINY=>CST%XMNH_TINY
+ XMNH_TINY_12=>CST%XMNH_TINY_12
+ XMNH_EPSILON=>CST%XMNH_EPSILON
+ XMNH_HUGE=>CST%XMNH_HUGE
+ XMNH_HUGE_12_LOG=>CST%XMNH_HUGE_12_LOG
+ XEPS_DT=>CST%XEPS_DT
+ XRES_FLAT_CART=>CST%XRES_FLAT_CART
+ XRES_OTHER=>CST%XRES_OTHER
+ XRES_PREP=>CST%XRES_PREP
+END SUBROUTINE CST_ASSOCIATE
!
END MODULE MODD_CST
+
diff --git a/src/PHYEX/aux/modd_dimphyexn.f90 b/src/PHYEX/aux/modd_dimphyexn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a2767fe04d1d746f47a742200d17f1f97522477d
--- /dev/null
+++ b/src/PHYEX/aux/modd_dimphyexn.f90
@@ -0,0 +1,83 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODD_DIMPHYEX
+! ####################
+!
+!!**** *MODD_DIMPHYEX* - declaration of dimensions for the physics
+!!
+!! PURPOSE
+!! -------
+! Declaration of array dimensions used by the physics
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! S. Riette, Météo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 2022
+!
+!-----------------------------------------------------------------
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+TYPE DIMPHYEX_t
+ !
+ !On x direction
+ INTEGER :: NIT ! Array total dimension
+ INTEGER :: NIB ! First inner mass point index
+ INTEGER :: NIE ! Last inner mass point index
+ !
+ !On y direction
+ INTEGER :: NJT ! Array total dimension
+ INTEGER :: NJB ! First inner mass point index
+ INTEGER :: NJE ! Last inner mass point index
+ !
+ !On z direction
+ !Ordering can be different depending on the host model
+ INTEGER :: NKL ! Order of the vertical levels
+ ! 1: as for Méso-NH, levels are numbered from ground to space
+ ! -1: as for AROME, levels are numbered from space to ground
+ INTEGER :: NKT ! Array total dimension
+ INTEGER :: NKLES ! Total physical k dimension (for LES diag)
+ INTEGER :: NKA ! Near ground array index (is an unphysical level if JPVEXT!=0)
+ INTEGER :: NKU ! Uppest atmosphere array index (is an unphysical level if JPVEXT!=0)
+ INTEGER :: NKB ! Near ground physical array index (e.g. equal to 1+JPVEXT if NKL==1)
+ INTEGER :: NKE ! Uppest physical atmosphere array index (e.g. equal to 1+JPVEXT if NKL==-1)
+ INTEGER :: NKTB ! Smaller index of the physical domain (equals to MIN(NKB, NKE)=1+JPVEXT)
+ INTEGER :: NKTE ! Greater index of the physical domain (equals to MAX(NKB, NKE)=NKT-JPVEXT)
+ !Explanations about the different values. To loop on:
+ !* all (including non physical) levels from ground to top of atm: DO JK=NKA, NKU, KKL
+ !* all (including non physical) levels from top of atm to ground: DO JK=NKU, NKA, -KKL
+ !* physical levels only from ground to top of atm: DO JK=NKB, NKE, KKL
+ !* physical levels only from top of atm to ground: DO JK=NKE, NKB, -KKL
+ !* all (including non physical) following the array ordering: DO JK=1, NKT
+ !* physical levels only following the array ordering: DO JK=NKTB, NKTE
+ INTEGER :: NIBC ! Computational indices used in DO LOOP
+ INTEGER :: NJBC ! = NIB/NJC/NIE/NJE in all schemes
+ INTEGER :: NIEC ! except in turbulence where external HALO points must be
+ INTEGER :: NJEC ! included so NIBC=NJBC=1 and NIEC/NJEC=NIT/NJT
+ INTEGER :: NIJT ! NIT*NJT for horizontal packing
+ INTEGER :: NIJB ! First horizontal inner mass point index
+ INTEGER :: NIJE ! Last horizontal inner mass point index
+ !
+ INTEGER :: NLESMASK ! Number of LES masks
+!
+END TYPE DIMPHYEX_t
+!
+END MODULE MODD_DIMPHYEX
+
diff --git a/src/PHYEX/aux/modd_les.f90 b/src/PHYEX/aux/modd_les.f90
index db71d6f33aa854d4fa66308dece4c9cc7ad7bbcd..d4c91693e2326d7ce29c37f158b16db813b7f7c9 100644
--- a/src/PHYEX/aux/modd_les.f90
+++ b/src/PHYEX/aux/modd_les.f90
@@ -3,7 +3,7 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ###############
+! ###############
MODULE MODD_LES
! ###############
!
@@ -11,34 +11,34 @@
!!
!! PURPOSE
!! -------
-! The purpose of this declarative module is to specify the
+! The purpose of this declarative module is to specify the
! resolved fluxes and the spectra computed in LES mode
!
!!
!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
+!! ------------------
+!! None
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (module MODD_LES)
!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
-!!
+!!
!!
!! AUTHOR
!! ------
-!! J. Cuxart *INM and Meteo France*
+!! J. Cuxart *INM and Meteo France*
!!
!! MODIFICATIONS
!! -------------
-!! Original March 10, 1995
+!! Original March 10, 1995
!!
!! (J.Stein) Sept. 25, 1995 add the model number in LES mode
!! J. Cuxart Oct. 4, 1996 New time series
!! V. Masson Jan. 20, 2000 New LES routines variables & //
!! V. Masson Nov. 6, 2002 LES budgets
!! F. Couvreux Oct 1, 2006 LES PDF
-!! J.Pergaud Oct , 2007 MF LES
+!! J.Pergaud Oct , 2007 MF LES
!! P. Aumond Oct ,2009 User multimaskS + 4th order
!! C.Lac Oct ,2014 Correction on user masks
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
@@ -53,6 +53,16 @@ USE MODD_PARAMETERS
!
IMPLICIT NONE
!
+PUBLIC :: LES_ALLOCATE_DIM
+INTERFACE LES_ALLOCATE_DIM
+ MODULE PROCEDURE LES_ALLOCATE_1DIMX, LES_ALLOCATE_2DIMX, &
+ LES_ALLOCATE_3DIMX, LES_ALLOCATE_4DIMX, &
+ LES_ALLOCATE_3DIML, LES_ALLOCATE_4DIML, &
+ LES_ALLOCATE_3DIMI, LES_ALLOCATE_1DIMI, &
+ LES_ALLOCATE_2DIMC
+END INTERFACE LES_ALLOCATE_DIM
+
+TYPE TLES_t
!-------------------------------------------------------------------------------
!
!* namelist variables
@@ -63,16 +73,16 @@ LOGICAL :: LLES_SUBGRID ! flag to activate the subgrid var. computations
LOGICAL :: LLES_UPDRAFT ! flag to activate the computations in updrafts
LOGICAL :: LLES_DOWNDRAFT ! flag to activate the computations in downdrafts
LOGICAL :: LLES_SPECTRA ! flag to activate the spectra computations
-LOGICAL :: LLES_PDF ! flag to activate the pdf computations
+LOGICAL :: LLES_PDF ! flag to activate the pdf computations
!
INTEGER, DIMENSION(900) :: NLES_LEVELS ! physical model levels for LES comp.
REAL, DIMENSION(900) :: XLES_ALTITUDES ! alt. levels for LES comp.
INTEGER, DIMENSION(900) :: NSPECTRA_LEVELS ! physical model levels for spectra comp.
REAL, DIMENSION(900) :: XSPECTRA_ALTITUDES ! alt. levels for spectra comp.
!
-INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_I ! I, J and Z point
-INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_J ! localizations to
-INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_Z ! record temporal data
+INTEGER, DIMENSION(10) :: NLES_TEMP_SERIE_I ! I, J and Z point
+INTEGER, DIMENSION(10) :: NLES_TEMP_SERIE_J ! localizations to
+INTEGER, DIMENSION(10) :: NLES_TEMP_SERIE_Z ! record temporal data
CHARACTER(LEN=4) :: CLES_NORM_TYPE ! type of turbulence normalization
CHARACTER(LEN=3) :: CBL_HEIGHT_DEF ! definition of the boundary layer height
@@ -391,15 +401,15 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DETR ! Detrainment
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ENTR ! Entrainment
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_FRACUP ! Updraft Fraction
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_FRACUP ! Updraft Fraction
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_THVUP_MF ! Thv of the Updraft
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTHLMF ! Flux of thl
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTHLMF ! Flux of thl
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRTMF ! Flux of rt
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTHVMF ! Flux of thv
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTHVMF ! Flux of thv
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WUMF ! Flux of u
!
@@ -452,7 +462,1373 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RG ! rg pdf
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RT ! rt pdf
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_THL ! thetal pdf
!
+END TYPE TLES_t
+!
+TYPE(TLES_t), SAVE, TARGET :: TLES
+!
+!-------------------------------------------------------------------------------
+!
+!* namelist variables
+!
+LOGICAL, POINTER :: LLES_MEAN => NULL() ! flag to activate the mean computations
+LOGICAL, POINTER :: LLES_RESOLVED => NULL() ! flag to activate the resolved var. computations
+LOGICAL, POINTER :: LLES_SUBGRID => NULL() ! flag to activate the subgrid var. computations
+LOGICAL, POINTER :: LLES_UPDRAFT => NULL() ! flag to activate the computations in updrafts
+LOGICAL, POINTER :: LLES_DOWNDRAFT=> NULL() ! flag to activate the computations in downdrafts
+LOGICAL, POINTER :: LLES_SPECTRA => NULL() ! flag to activate the spectra computations
+LOGICAL, POINTER :: LLES_PDF => NULL() ! flag to activate the pdf computations
+!
+INTEGER, DIMENSION(:), POINTER :: NLES_LEVELS => NULL() ! physical model levels for LES comp.
+REAL, DIMENSION(:), POINTER :: XLES_ALTITUDES => NULL() ! alt. levels for LES comp.
+INTEGER, DIMENSION(:), POINTER :: NSPECTRA_LEVELS => NULL() ! physical model levels for spectra comp.
+REAL, DIMENSION(:), POINTER :: XSPECTRA_ALTITUDES => NULL() ! alt. levels for spectra comp.
+!
+INTEGER, DIMENSION(:), POINTER :: NLES_TEMP_SERIE_I => NULL() ! I, J and Z point
+INTEGER, DIMENSION(:), POINTER :: NLES_TEMP_SERIE_J => NULL() ! localizations to
+INTEGER, DIMENSION(:), POINTER :: NLES_TEMP_SERIE_Z => NULL() ! record temporal data
+
+CHARACTER(LEN=4), POINTER :: CLES_NORM_TYPE=> NULL() ! type of turbulence normalization
+CHARACTER(LEN=3), POINTER :: CBL_HEIGHT_DEF=> NULL() ! definition of the boundary layer height
+
+REAL, POINTER :: XLES_TEMP_SAMPLING => NULL() ! temporal sampling between each computation
+REAL, POINTER :: XLES_TEMP_MEAN_START => NULL() ! time (in s) from the beginning of the simulation
+REAL, POINTER :: XLES_TEMP_MEAN_END => NULL() ! for start and end of the temporal averaged comp.
+REAL, POINTER :: XLES_TEMP_MEAN_STEP => NULL() ! time step for each averaging
+
+LOGICAL, POINTER :: LLES_CART_MASK => NULL() ! flag to use a cartesian mask
+INTEGER, POINTER :: NLES_IINF => NULL() ! definition of the cartesians mask in physical domain
+INTEGER, POINTER :: NLES_ISUP => NULL() ! for NLES_CART_MODNBR model
+INTEGER, POINTER :: NLES_JINF => NULL() ! "
+INTEGER, POINTER :: NLES_JSUP => NULL() ! "
+LOGICAL, POINTER :: LLES_NEB_MASK => NULL() ! flag to use a 2D nebulosity mask
+LOGICAL, POINTER :: LLES_CORE_MASK => NULL() ! flag to use a 3D cloud core mask
+LOGICAL, POINTER :: LLES_MY_MASK => NULL() ! flag to use its own mask (must be coded by user)
+INTEGER, POINTER :: NLES_MASKS_USER => NULL() ! number of user masks for LES computations
+LOGICAL, POINTER :: LLES_CS_MASK => NULL() ! flag to use conditional sampling mask
+INTEGER, POINTER :: NPDF => NULL() ! number of pdf intervals
+!
+!-------------------------------------------------------------------------------
+!
+INTEGER, DIMENSION(:), POINTER :: NLESn_IINF=> NULL() ! definition of the cartesians mask in physical domain
+INTEGER, DIMENSION(:), POINTER :: NLESn_ISUP=> NULL() ! for all models
+INTEGER, DIMENSION(:), POINTER :: NLESn_JINF=> NULL() ! "
+INTEGER, DIMENSION(:), POINTER :: NLESn_JSUP=> NULL() ! "
+!
+CHARACTER(LEN=4), DIMENSION(:,:), POINTER :: CLES_LBCX=> NULL()
+! X boundary conditions for 2 points correlations computations for all models
+!
+CHARACTER(LEN=4), DIMENSION(:,:), POINTER :: CLES_LBCY=> NULL()
+! Y boundary conditions for 2 points correlations computations for all models
+!
+!-------------------------------------------------------------------------------
+!
+LOGICAL, POINTER :: LLES => NULL() ! flag to compute the LES diagnostics
+!
+LOGICAL, POINTER :: LLES_CALL => NULL() ! flag to compute the LES diagnostics at current
+! => NULL() ! time step
+!
+!
+LOGICAL, DIMENSION(:,:,:), POINTER :: LLES_CURRENT_CART_MASK=> NULL()
+! 2D cartesian mask of the current model
+!
+LOGICAL, DIMENSION(:,:,:), POINTER :: LLES_CURRENT_NEB_MASK=> NULL()
+! 2D nebulosity mask of the current model
+!
+LOGICAL, DIMENSION(:,:,:), POINTER :: LLES_CURRENT_CORE_MASK=> NULL()
+! 2D surface precipitations mask of the current model
+!
+! 2D owner mask of the current model
+LOGICAL, DIMENSION(:,:,:,:), POINTER :: LLES_CURRENT_MY_MASKS=> NULL()
+!
+LOGICAL, DIMENSION(:,:,:), POINTER :: LLES_CURRENT_CS1_MASK=> NULL()
+LOGICAL, DIMENSION(:,:,:), POINTER :: LLES_CURRENT_CS2_MASK=> NULL()
+LOGICAL, DIMENSION(:,:,:), POINTER :: LLES_CURRENT_CS3_MASK=> NULL()
+! 2D conditional sampling mask of the current model
+!
+INTEGER, POINTER :: NLES_CURRENT_TCOUNT=> NULL()
+! current model LES time counter
+!
+INTEGER, POINTER :: NLES_CURRENT_TIMES=> NULL()
+! current model NLES_TIMES (number of LES samplings)
+!
+INTEGER, POINTER :: NLES_CURRENT_IINF=> NULL(), NLES_CURRENT_ISUP=> NULL(), &
+ NLES_CURRENT_JINF=> NULL(), NLES_CURRENT_JSUP=> NULL()
+! coordinates (in physical domain) for write_diachro, set to NLESn_IINF(current model), etc...
+!
+REAL, POINTER :: XLES_CURRENT_DOMEGAX=> NULL(), XLES_CURRENT_DOMEGAY=> NULL()
+! minimum wavelength in spectra analysis
+!
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: CLES_CURRENT_LBCX=> NULL()
+! current model X boundary conditions for 2 points correlations computations
+!
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: CLES_CURRENT_LBCY=> NULL()
+! current model Y boundary conditions for 2 points correlations computations
+!
+REAL, DIMENSION(:), POINTER :: XLES_CURRENT_Z=> NULL()
+! altitudes for diachro
+!
+REAL, POINTER :: XLES_CURRENT_ZS=> NULL()
+! orography (used for normalization of altitudes)
+!
+INTEGER, DIMENSION(:,:,:), POINTER :: NKLIN_CURRENT_LES=> NULL()
+! levels for vertical interpolation
+!
+REAL, DIMENSION(:,:,:), POINTER :: XCOEFLIN_CURRENT_LES=> NULL()
+! coefficients for vertical interpolation
+!
+INTEGER, DIMENSION(:,:,:), POINTER :: NKLIN_CURRENT_SPEC=> NULL()
+! levels for vertical interpolation
+!
+REAL, DIMENSION(:,:,:), POINTER :: XCOEFLIN_CURRENT_SPEC=> NULL()
+! coefficients for vertical interpolation
+!
+REAL,DIMENSION(:), POINTER :: XTIME_LES=> NULL()
+! time spent in subgrid LES computations in this time-step in TURB
!
!-------------------------------------------------------------------------------
!
+!* normalization variables
+!
+REAL, DIMENSION(:), POINTER :: XLES_NORM_M=> NULL()
+! normalization coefficient for distances (Meters)
+!
+REAL, DIMENSION(:), POINTER :: XLES_NORM_K=> NULL()
+! normalization coefficient for temperatures (Kelvin)
+!
+REAL, DIMENSION(:), POINTER :: XLES_NORM_S=> NULL()
+! normalization coefficient for times (Seconds)
+!
+REAL, DIMENSION(:), POINTER :: XLES_NORM_RHO=> NULL()
+! normalization coefficient for densities
+!
+REAL, DIMENSION(:), POINTER :: XLES_NORM_RV=> NULL()
+! normalization coefficient for mixing ratio
+!
+REAL, DIMENSION(:,:), POINTER :: XLES_NORM_SV=> NULL()
+! normalization coefficient for scalar variables
+!
+REAL, DIMENSION(:), POINTER :: XLES_NORM_P=> NULL()
+! normalization coefficient for pressure
+!
+!-------------------------------------------------------------------------------
+!
+!* monitoring variables
+!
+INTEGER, POINTER :: NLES_MASKS => NULL() ! number of masks for LES computations
+INTEGER, POINTER :: NLES_K => NULL() ! number of vertical levels for local diagnostics
+INTEGER, POINTER :: NSPECTRA_K => NULL() ! number of vertical levels for spectra
+!
+CHARACTER(LEN=1), POINTER :: CLES_LEVEL_TYPE => NULL() ! type of vertical levels for local diag.
+CHARACTER(LEN=1), POINTER :: CSPECTRA_LEVEL_TYPE=> NULL() ! type of vertical levels for spectra
+!
+!-------------------------------------------------------------------------------
+!
+!* subgrid variables for current model
+!
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_W_SBG_WThl=> NULL() ! <w'w'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_W_SBG_WRt => NULL() ! <w'w'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_W_SBG_Thl2=> NULL() ! <w'Thl'2>
+! ____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_W_SBG_Rt2 => NULL() ! <w'Rt'2>
+! _______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_W_SBG_ThlRt=> NULL()! <w'Thl'Rt'>
+! _____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_RES_W_SBG_WSv => NULL() ! <w'w'Sv'>
+! ____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_RES_W_SBG_Sv2=> NULL() ! <w'Sv'2>
+!
+REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_RCSIGS=> NULL() ! rc sigmas
+!
+REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_RCSIGC=> NULL() ! rc sigmac
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_U_SBG_UaU => NULL() ! <du'/dxa ua'u'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_V_SBG_UaV => NULL() ! <dv'/dxa ua'v'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_W_SBG_UaW => NULL() ! <dw'/dxa ua'w'>
+! _______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_W_SBG_UaThl=> NULL() ! <dw'/dxa ua'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_Thl_SBG_UaW=> NULL() ! <dThl'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddz_Thl_SBG_W2 => NULL() ! <dThl'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_W_SBG_UaRt => NULL() ! <dw'/dxa ua'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_Rt_SBG_UaW => NULL() ! <dRt'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddz_Rt_SBG_W2 => NULL() ! <dRt'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_Thl_SBG_UaRt=> NULL()! <dThl'/dxa ua'Rt'>
+! _______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_Rt_SBG_UaThl=> NULL()! <dRt'/dxa ua'Thl'>
+! _______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_Thl_SBG_UaThl=> NULL()! <dThl'/dxa ua'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_RES_ddxa_Rt_SBG_UaRt=> NULL() ! <dRt'/dxa ua'Rt'>
+! ______
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_RES_ddxa_W_SBG_UaSv => NULL() ! <dw'/dxa ua'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_RES_ddxa_Sv_SBG_UaW => NULL() ! <dSv'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_RES_ddz_Sv_SBG_W2 => NULL() ! <dSv'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_RES_ddxa_Sv_SBG_UaSv=> NULL() ! <dSv'/dxa ua'Sv'>
+!
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_U2 => NULL() ! <u'2>
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_V2 => NULL() ! <v'2>
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_W2 => NULL() ! <w'2>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_Thl2 => NULL() ! <Thl'2>
+! ____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_Rt2 => NULL() ! <Rt'2>
+! ____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_Rc2 => NULL() ! <Rc'2>
+! ____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_Ri2 => NULL() ! <Ri'2>
+! _______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_ThlRt=> NULL() ! <Thl'Rt'>
+! ____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_Sv2 => NULL() ! <Sv'2>
+! ____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_UV => NULL() ! <u'v'>
+! ____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WU => NULL() ! <w'u'>
+! ____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WV => NULL() ! <w'v'>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_UThl => NULL() ! <u'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_VThl => NULL() ! <v'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WThl => NULL() ! <w'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_URt => NULL() ! <u'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_VRt => NULL() ! <v'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WRt => NULL() ! <w'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_URc => NULL() ! <u'Rc'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_VRc => NULL() ! <v'Rc'>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WRc => NULL() ! <w'Rc'>
+! _____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_USv=> NULL() ! <u'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_VSv=> NULL() ! <v'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_WSv=> NULL() ! <w'Sv'>
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_UTke => NULL() ! <u'e>
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_VTke => NULL() ! <v'e>
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WTke => NULL() ! <w'e>
+! ___
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_ddz_WTke => NULL() ! <dw'e/dz>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WThv => NULL() ! <w'Thv'>
+! ________
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_ThlThv=> NULL() ! <Thl'Thv'>
+! _______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_RtThv => NULL() ! <Rt'Thv'>
+! _______
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_SvThv => NULL() ! <Sv'Thv'>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_W2Thl => NULL() ! <w'2Thl>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_W2Rt => NULL() ! <w'2Rt>
+! _____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_W2Sv => NULL() ! <w'2Sv>
+! _______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WThlRt=> NULL() ! <w'ThlRt>
+! ______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WThl2 => NULL() ! <w'Thl2>
+! _____
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WRt2 => NULL() ! <w'Rt2>
+! _____
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_WSv2 => NULL() ! <w'Sv2>
+! _______
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_DISS_Tke=> NULL() ! <epsilon>
+! ____________
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_DISS_Thl2=> NULL() ! <epsilon_Thl2>
+! ___________
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_DISS_Rt2 => NULL() ! <epsilon_Rt2>
+! ______________
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_DISS_ThlRt=> NULL()! <epsilon_ThlRt>
+! ___________
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_DISS_Sv2 => NULL() ! <epsilon_Sv2>
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WP => NULL() ! <w'p'>
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_ThlPz => NULL() ! <Thl'dp'/dz>
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_RtPz => NULL() ! <Rt'dp'/dz>
+!
+REAL, DIMENSION(:,:,:,:), POINTER :: X_LES_SUBGRID_SvPz => NULL() ! <Sv'dp'/dz>
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_PHI3 => NULL() ! phi3
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_PSI3 => NULL() ! psi3
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_LMix => NULL() ! mixing length
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_LDiss => NULL() ! dissipative length
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_Km => NULL() ! eddy diffusivity for momentum
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_Kh => NULL() ! eddy diffusivity for heat
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_THLUP_MF => NULL() ! Thl of the Updraft
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_RTUP_MF => NULL() ! Rt of the Updraft
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_RVUP_MF => NULL() ! Rv of the Updraft
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_RCUP_MF => NULL() ! Rc of the Updraft
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_RIUP_MF => NULL() ! Ri of the Updraft
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WUP_MF => NULL() ! Thl of the Updraft
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_MASSFLUX => NULL() ! Mass Flux
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_DETR => NULL() ! Detrainment
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_ENTR => NULL() ! Entrainment
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_FRACUP => NULL() ! Updraft Fraction
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_THVUP_MF => NULL() ! Thv of the Updraft
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WTHLMF=> NULL() ! Flux of thl
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WRTMF => NULL() ! Flux of rt
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WTHVMF=> NULL() ! Flux of thv
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WUMF => NULL() ! Flux of u
+!
+REAL, DIMENSION(:,:,:), POINTER :: X_LES_SUBGRID_WVMF => NULL() ! Flux of v
+!
+!* surface variables
+!
+REAL, DIMENSION(:), POINTER :: X_LES_USTAR => NULL() ! local u* temporal series
+REAL, DIMENSION(:), POINTER :: X_LES_UW0 => NULL() ! uw temporal series
+REAL, DIMENSION(:), POINTER :: X_LES_VW0 => NULL() ! vw temporal series
+REAL, DIMENSION(:), POINTER :: X_LES_Q0 => NULL() ! Qo temporal series
+REAL, DIMENSION(:), POINTER :: X_LES_E0 => NULL() ! Eo temporal series
+REAL, DIMENSION(:,:), POINTER :: X_LES_SV0 => NULL() ! scalar surface fluxes
+!
+!* pdf variables
+REAL , POINTER :: XRV_PDF_MIN => NULL() ! min of rv pdf
+REAL , POINTER :: XRV_PDF_MAX => NULL() ! max of rv pdf
+REAL , POINTER :: XTH_PDF_MIN => NULL() ! min of theta pdf
+REAL , POINTER :: XTH_PDF_MAX => NULL() ! max of theta pdf
+REAL , POINTER :: XW_PDF_MIN => NULL() ! min of w pdf
+REAL , POINTER :: XW_PDF_MAX => NULL() ! max of w pdf
+REAL , POINTER :: XTHV_PDF_MIN => NULL() ! min of thetav pdf
+REAL , POINTER :: XTHV_PDF_MAX => NULL() ! max of thetav pdf
+REAL , POINTER :: XRC_PDF_MIN => NULL() ! min of rc pdf
+REAL , POINTER :: XRC_PDF_MAX => NULL() ! max of rc pdf
+REAL , POINTER :: XRR_PDF_MIN => NULL() ! min of rr pdf
+REAL , POINTER :: XRR_PDF_MAX => NULL() ! max of rr pdf
+REAL , POINTER :: XRI_PDF_MIN => NULL() ! min of ri pdf
+REAL , POINTER :: XRI_PDF_MAX => NULL() ! max of ri pdf
+REAL , POINTER :: XRS_PDF_MIN => NULL() ! min of rs pdf
+REAL , POINTER :: XRS_PDF_MAX => NULL() ! max of rs pdf
+REAL , POINTER :: XRG_PDF_MIN => NULL() ! min of rg pdf
+REAL , POINTER :: XRG_PDF_MAX => NULL() ! max of rg pdf
+REAL , POINTER :: XRT_PDF_MIN => NULL() ! min of rt pdf
+REAL , POINTER :: XRT_PDF_MAX => NULL() ! max of rt pdf
+REAL , POINTER :: XTHL_PDF_MIN => NULL() ! min of thetal pdf
+REAL , POINTER :: XTHL_PDF_MAX => NULL() ! max of thetal pdf
+!-------------------------------------------------------------------------------
+!* pdf distribution
+!
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_RV => NULL() ! rv pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_TH => NULL() ! theta pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_W => NULL() ! w pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_THV => NULL() ! thetav pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_RC => NULL() ! rc pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_RR => NULL() ! rr pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_RI => NULL() ! ri pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_RS => NULL() ! rs pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_RG => NULL() ! rg pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_RT => NULL() ! rt pdf
+REAL, DIMENSION(:,:,:,:), POINTER :: XLES_PDF_THL => NULL() ! thetal pdf
+!-------------------------------------------------------------------------------
+!!
+CONTAINS
+SUBROUTINE LES_ASSOCIATE()
+ ! Associate all LES non-allocatable variables to the TYPE LES
+ IMPLICIT NONE
+ NLES_LEVELS => TLES%NLES_LEVELS
+ XLES_ALTITUDES => TLES%XLES_ALTITUDES
+ NSPECTRA_LEVELS => TLES%NSPECTRA_LEVELS
+ XSPECTRA_ALTITUDES => TLES%XSPECTRA_ALTITUDES
+ XTIME_LES => TLES%XTIME_LES
+ CLES_LBCX => TLES%CLES_LBCX
+ CLES_LBCY => TLES%CLES_LBCY
+ CLES_CURRENT_LBCY => TLES%CLES_CURRENT_LBCY
+ CLES_CURRENT_LBCX => TLES%CLES_CURRENT_LBCX
+ NLESn_IINF => TLES%NLESn_IINF
+ NLESn_ISUP => TLES%NLESn_ISUP
+ NLESn_JINF => TLES%NLESn_JINF
+ NLESn_JSUP => TLES%NLESn_JSUP
+ NLES_TEMP_SERIE_I => TLES%NLES_TEMP_SERIE_I
+ NLES_TEMP_SERIE_J => TLES%NLES_TEMP_SERIE_J
+ NLES_TEMP_SERIE_Z => TLES%NLES_TEMP_SERIE_Z
+ LLES_MEAN => TLES%LLES_MEAN
+ LLES_RESOLVED => TLES%LLES_RESOLVED
+ LLES_SUBGRID => TLES%LLES_SUBGRID
+ LLES_UPDRAFT => TLES%LLES_UPDRAFT
+ LLES_DOWNDRAFT => TLES%LLES_DOWNDRAFT
+ LLES_SPECTRA => TLES%LLES_SPECTRA
+ LLES_PDF => TLES%LLES_PDF
+ CLES_NORM_TYPE => TLES%CLES_NORM_TYPE
+ CBL_HEIGHT_DEF => TLES%CBL_HEIGHT_DEF
+ XLES_TEMP_SAMPLING => TLES%XLES_TEMP_SAMPLING
+ XLES_TEMP_MEAN_START => TLES%XLES_TEMP_MEAN_START
+ XLES_TEMP_MEAN_END => TLES%XLES_TEMP_MEAN_END
+ XLES_TEMP_MEAN_STEP => TLES%XLES_TEMP_MEAN_STEP
+ LLES_CART_MASK => TLES%LLES_CART_MASK
+ NLES_IINF => TLES%NLES_IINF
+ NLES_ISUP => TLES%NLES_ISUP
+ NLES_JINF => TLES%NLES_JINF
+ NLES_JSUP => TLES%NLES_JSUP
+ LLES_NEB_MASK => TLES%LLES_NEB_MASK
+ LLES_CORE_MASK => TLES%LLES_CORE_MASK
+ LLES_MY_MASK => TLES%LLES_MY_MASK
+ NLES_MASKS_USER => TLES%NLES_MASKS_USER
+ LLES_CS_MASK => TLES%LLES_CS_MASK
+ NPDF => TLES%NPDF
+ LLES => TLES%LLES
+ LLES_CALL => TLES%LLES_CALL
+ NLES_CURRENT_TCOUNT => TLES%NLES_CURRENT_TCOUNT
+ NLES_CURRENT_TIMES => TLES%NLES_CURRENT_TIMES
+ NLES_CURRENT_IINF => TLES%NLES_CURRENT_IINF
+ NLES_CURRENT_ISUP => TLES%NLES_CURRENT_ISUP
+ NLES_CURRENT_JINF => TLES%NLES_CURRENT_JINF
+ NLES_CURRENT_JSUP => TLES%NLES_CURRENT_JSUP
+ XLES_CURRENT_DOMEGAX => TLES%XLES_CURRENT_DOMEGAX
+ XLES_CURRENT_DOMEGAY => TLES%XLES_CURRENT_DOMEGAY
+ XLES_CURRENT_ZS => TLES%XLES_CURRENT_ZS
+ NLES_MASKS => TLES%NLES_MASKS
+ NLES_K => TLES%NLES_K
+ NSPECTRA_K => TLES%NSPECTRA_K
+ CLES_LEVEL_TYPE => TLES%CLES_LEVEL_TYPE
+ CSPECTRA_LEVEL_TYPE => TLES%CSPECTRA_LEVEL_TYPE
+ XRV_PDF_MIN => TLES%XRV_PDF_MIN
+ XRV_PDF_MAX => TLES%XRV_PDF_MAX
+ XTH_PDF_MIN => TLES%XTH_PDF_MIN
+ XTH_PDF_MAX => TLES%XTH_PDF_MAX
+ XW_PDF_MIN => TLES%XW_PDF_MIN
+ XW_PDF_MAX => TLES%XW_PDF_MAX
+ XTHV_PDF_MIN => TLES%XTHV_PDF_MIN
+ XTHV_PDF_MAX => TLES%XTHV_PDF_MAX
+ XRC_PDF_MIN => TLES%XRC_PDF_MIN
+ XRC_PDF_MAX => TLES%XRC_PDF_MAX
+ XRR_PDF_MIN => TLES%XRR_PDF_MIN
+ XRR_PDF_MAX => TLES%XRR_PDF_MAX
+ XRI_PDF_MIN => TLES%XRI_PDF_MIN
+ XRI_PDF_MAX => TLES%XRI_PDF_MAX
+ XRS_PDF_MIN => TLES%XRS_PDF_MIN
+ XRS_PDF_MAX => TLES%XRS_PDF_MAX
+ XRG_PDF_MIN => TLES%XRG_PDF_MIN
+ XRG_PDF_MAX => TLES%XRG_PDF_MAX
+ XRT_PDF_MIN => TLES%XRT_PDF_MIN
+ XRT_PDF_MAX => TLES%XRT_PDF_MAX
+ XTHL_PDF_MIN => TLES%XTHL_PDF_MIN
+ XTHL_PDF_MAX => TLES%XTHL_PDF_MAX
+END SUBROUTINE LES_ASSOCIATE
+!
+SUBROUTINE LES_ALLOCATE(HNAME,NDIMS)
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ INTEGER, DIMENSION(:) :: NDIMS
+ !
+ SELECT CASE(HNAME)
+ !
+ CASE('LLES_CURRENT_CART_MASK')
+ CALL LES_ALLOCATE_DIM(TLES%LLES_CURRENT_CART_MASK,NDIMS)
+ LLES_CURRENT_CART_MASK=>TLES%LLES_CURRENT_CART_MASK
+ CASE('LLES_CURRENT_NEB_MASK')
+ CALL LES_ALLOCATE_DIM(TLES%LLES_CURRENT_NEB_MASK,NDIMS)
+ LLES_CURRENT_NEB_MASK=>TLES%LLES_CURRENT_NEB_MASK
+ CASE('LLES_CURRENT_CORE_MASK')
+ CALL LES_ALLOCATE_DIM(TLES%LLES_CURRENT_CORE_MASK,NDIMS)
+ LLES_CURRENT_CORE_MASK=>TLES%LLES_CURRENT_CORE_MASK
+ CASE('LLES_CURRENT_MY_MASKS')
+ CALL LES_ALLOCATE_DIM(TLES%LLES_CURRENT_MY_MASKS,NDIMS)
+ LLES_CURRENT_MY_MASKS=>TLES%LLES_CURRENT_MY_MASKS
+ CASE('LLES_CURRENT_CS1_MASK')
+ CALL LES_ALLOCATE_DIM(TLES%LLES_CURRENT_CS1_MASK,NDIMS)
+ LLES_CURRENT_CS1_MASK=>TLES%LLES_CURRENT_CS1_MASK
+ CASE('LLES_CURRENT_CS2_MASK')
+ CALL LES_ALLOCATE_DIM(TLES%LLES_CURRENT_CS2_MASK,NDIMS)
+ LLES_CURRENT_CS2_MASK=>TLES%LLES_CURRENT_CS2_MASK
+ CASE('LLES_CURRENT_CS3_MASK')
+ CALL LES_ALLOCATE_DIM(TLES%LLES_CURRENT_CS3_MASK,NDIMS)
+ LLES_CURRENT_CS3_MASK=>TLES%LLES_CURRENT_CS3_MASK
+ CASE('XLES_CURRENT_Z')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_CURRENT_Z,NDIMS)
+ XLES_CURRENT_Z=>TLES%XLES_CURRENT_Z
+ CASE('NKLIN_CURRENT_LES')
+ CALL LES_ALLOCATE_DIM(TLES%NKLIN_CURRENT_LES,NDIMS)
+ NKLIN_CURRENT_LES=>TLES%NKLIN_CURRENT_LES
+ CASE('XCOEFLIN_CURRENT_LES')
+ CALL LES_ALLOCATE_DIM(TLES%XCOEFLIN_CURRENT_LES,NDIMS)
+ XCOEFLIN_CURRENT_LES=>TLES%XCOEFLIN_CURRENT_LES
+ CASE('NKLIN_CURRENT_SPEC')
+ CALL LES_ALLOCATE_DIM(TLES%NKLIN_CURRENT_SPEC,NDIMS)
+ NKLIN_CURRENT_SPEC=>TLES%NKLIN_CURRENT_SPEC
+ CASE('XCOEFLIN_CURRENT_SPEC')
+ CALL LES_ALLOCATE_DIM(TLES%XCOEFLIN_CURRENT_SPEC,NDIMS)
+ XCOEFLIN_CURRENT_SPEC=>TLES%XCOEFLIN_CURRENT_SPEC
+ CASE('XLES_NORM_M')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_NORM_M,NDIMS)
+ XLES_NORM_M=>TLES%XLES_NORM_M
+ CASE('XLES_NORM_K')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_NORM_K,NDIMS)
+ XLES_NORM_K=>TLES%XLES_NORM_K
+ CASE('XLES_NORM_S')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_NORM_S,NDIMS)
+ XLES_NORM_S=>TLES%XLES_NORM_S
+ CASE('XLES_NORM_RHO')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_NORM_RHO,NDIMS)
+ XLES_NORM_RHO=>TLES%XLES_NORM_RHO
+ CASE('XLES_NORM_RV')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_NORM_RV,NDIMS)
+ XLES_NORM_RV=>TLES%XLES_NORM_RV
+ CASE('XLES_NORM_SV')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_NORM_SV,NDIMS)
+ XLES_NORM_SV=>TLES%XLES_NORM_SV
+ CASE('XLES_NORM_P')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_NORM_P,NDIMS)
+ XLES_NORM_P=>TLES%XLES_NORM_P
+ CASE('X_LES_RES_W_SBG_WThl')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_W_SBG_WThl,NDIMS)
+ X_LES_RES_W_SBG_WThl=>TLES%X_LES_RES_W_SBG_WThl
+ CASE('X_LES_RES_W_SBG_WRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_W_SBG_WRt,NDIMS)
+ X_LES_RES_W_SBG_WRt=>TLES%X_LES_RES_W_SBG_WRt
+ CASE('X_LES_RES_W_SBG_Thl2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_W_SBG_Thl2,NDIMS)
+ X_LES_RES_W_SBG_Thl2=>TLES%X_LES_RES_W_SBG_Thl2
+ CASE('X_LES_RES_W_SBG_Rt2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_W_SBG_Rt2,NDIMS)
+ X_LES_RES_W_SBG_Rt2=>TLES%X_LES_RES_W_SBG_Rt2
+ CASE('X_LES_RES_W_SBG_ThlRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_W_SBG_ThlRt,NDIMS)
+ X_LES_RES_W_SBG_ThlRt=>TLES%X_LES_RES_W_SBG_ThlRt
+ CASE('X_LES_RES_W_SBG_WSv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_W_SBG_WSv,NDIMS)
+ X_LES_RES_W_SBG_WSv=>TLES%X_LES_RES_W_SBG_WSv
+ CASE('X_LES_RES_W_SBG_Sv2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_W_SBG_Sv2,NDIMS)
+ X_LES_RES_W_SBG_Sv2=>TLES%X_LES_RES_W_SBG_Sv2
+ CASE('XLES_SUBGRID_RCSIGS')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_SUBGRID_RCSIGS,NDIMS)
+ XLES_SUBGRID_RCSIGS=>TLES%XLES_SUBGRID_RCSIGS
+ CASE('XLES_SUBGRID_RCSIGC')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_SUBGRID_RCSIGC,NDIMS)
+ XLES_SUBGRID_RCSIGC=>TLES%XLES_SUBGRID_RCSIGC
+ CASE('X_LES_RES_ddxa_U_SBG_UaU')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_U_SBG_UaU,NDIMS)
+ X_LES_RES_ddxa_U_SBG_UaU=>TLES%X_LES_RES_ddxa_U_SBG_UaU
+ CASE('X_LES_RES_ddxa_V_SBG_UaV')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_V_SBG_UaV,NDIMS)
+ X_LES_RES_ddxa_V_SBG_UaV=>TLES%X_LES_RES_ddxa_V_SBG_UaV
+ CASE('X_LES_RES_ddxa_W_SBG_UaW')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_W_SBG_UaW,NDIMS)
+ X_LES_RES_ddxa_W_SBG_UaW=>TLES%X_LES_RES_ddxa_W_SBG_UaW
+ CASE('X_LES_RES_ddxa_W_SBG_UaThl')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_W_SBG_UaThl,NDIMS)
+ X_LES_RES_ddxa_W_SBG_UaThl=>TLES%X_LES_RES_ddxa_W_SBG_UaThl
+ CASE('X_LES_RES_ddxa_Thl_SBG_UaW')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_Thl_SBG_UaW,NDIMS)
+ X_LES_RES_ddxa_Thl_SBG_UaW=>TLES%X_LES_RES_ddxa_Thl_SBG_UaW
+ CASE('X_LES_RES_ddz_Thl_SBG_W2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddz_Thl_SBG_W2,NDIMS)
+ X_LES_RES_ddz_Thl_SBG_W2=>TLES%X_LES_RES_ddz_Thl_SBG_W2
+ CASE('X_LES_RES_ddxa_W_SBG_UaRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_W_SBG_UaRt,NDIMS)
+ X_LES_RES_ddxa_W_SBG_UaRt=>TLES%X_LES_RES_ddxa_W_SBG_UaRt
+ CASE('X_LES_RES_ddxa_Rt_SBG_UaW')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_Rt_SBG_UaW,NDIMS)
+ X_LES_RES_ddxa_Rt_SBG_UaW=>TLES%X_LES_RES_ddxa_Rt_SBG_UaW
+ CASE('X_LES_RES_ddz_Rt_SBG_W2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddz_Rt_SBG_W2,NDIMS)
+ X_LES_RES_ddz_Rt_SBG_W2=>TLES%X_LES_RES_ddz_Rt_SBG_W2
+ CASE('X_LES_RES_ddxa_Thl_SBG_UaRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_Thl_SBG_UaRt,NDIMS)
+ X_LES_RES_ddxa_Thl_SBG_UaRt=>TLES%X_LES_RES_ddxa_Thl_SBG_UaRt
+ CASE('X_LES_RES_ddxa_Rt_SBG_UaThl')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_Rt_SBG_UaThl,NDIMS)
+ X_LES_RES_ddxa_Rt_SBG_UaThl=>TLES%X_LES_RES_ddxa_Rt_SBG_UaThl
+ CASE('X_LES_RES_ddxa_Thl_SBG_UaThl')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_Thl_SBG_UaThl,NDIMS)
+ X_LES_RES_ddxa_Thl_SBG_UaThl=>TLES%X_LES_RES_ddxa_Thl_SBG_UaThl
+ CASE('X_LES_RES_ddxa_Rt_SBG_UaRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_Rt_SBG_UaRt,NDIMS)
+ X_LES_RES_ddxa_Rt_SBG_UaRt=>TLES%X_LES_RES_ddxa_Rt_SBG_UaRt
+ CASE('X_LES_RES_ddxa_W_SBG_UaSv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_W_SBG_UaSv,NDIMS)
+ X_LES_RES_ddxa_W_SBG_UaSv=>TLES%X_LES_RES_ddxa_W_SBG_UaSv
+ CASE('X_LES_RES_ddxa_Sv_SBG_UaW')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_Sv_SBG_UaW,NDIMS)
+ X_LES_RES_ddxa_Sv_SBG_UaW=>TLES%X_LES_RES_ddxa_Sv_SBG_UaW
+ CASE('X_LES_RES_ddz_Sv_SBG_W2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddz_Sv_SBG_W2,NDIMS)
+ X_LES_RES_ddz_Sv_SBG_W2=>TLES%X_LES_RES_ddz_Sv_SBG_W2
+ CASE('X_LES_RES_ddxa_Sv_SBG_UaSv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_RES_ddxa_Sv_SBG_UaSv,NDIMS)
+ X_LES_RES_ddxa_Sv_SBG_UaSv=>TLES%X_LES_RES_ddxa_Sv_SBG_UaSv
+ CASE('X_LES_SUBGRID_U2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_U2,NDIMS)
+ X_LES_SUBGRID_U2=>TLES%X_LES_SUBGRID_U2
+ CASE('X_LES_SUBGRID_V2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_V2,NDIMS)
+ X_LES_SUBGRID_V2=>TLES%X_LES_SUBGRID_V2
+ CASE('X_LES_SUBGRID_W2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_W2,NDIMS)
+ X_LES_SUBGRID_W2=>TLES%X_LES_SUBGRID_W2
+ CASE('X_LES_SUBGRID_Thl2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_Thl2,NDIMS)
+ X_LES_SUBGRID_Thl2=>TLES%X_LES_SUBGRID_Thl2
+ CASE('X_LES_SUBGRID_Rt2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_Rt2,NDIMS)
+ X_LES_SUBGRID_Rt2=>TLES%X_LES_SUBGRID_Rt2
+ CASE('X_LES_SUBGRID_Rc2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_Rc2,NDIMS)
+ X_LES_SUBGRID_Rc2=>TLES%X_LES_SUBGRID_Rc2
+ CASE('X_LES_SUBGRID_Ri2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_Ri2,NDIMS)
+ X_LES_SUBGRID_Ri2=>TLES%X_LES_SUBGRID_Ri2
+ CASE('X_LES_SUBGRID_ThlRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_ThlRt,NDIMS)
+ X_LES_SUBGRID_ThlRt=>TLES%X_LES_SUBGRID_ThlRt
+ CASE('X_LES_SUBGRID_Sv2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_Sv2,NDIMS)
+ X_LES_SUBGRID_Sv2=>TLES%X_LES_SUBGRID_Sv2
+ CASE('X_LES_SUBGRID_UV')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_UV,NDIMS)
+ X_LES_SUBGRID_UV=>TLES%X_LES_SUBGRID_UV
+ CASE('X_LES_SUBGRID_WU')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WU,NDIMS)
+ X_LES_SUBGRID_WU=>TLES%X_LES_SUBGRID_WU
+ CASE('X_LES_SUBGRID_WV')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WV,NDIMS)
+ X_LES_SUBGRID_WV=>TLES%X_LES_SUBGRID_WV
+ CASE('X_LES_SUBGRID_UThl')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_UThl,NDIMS)
+ X_LES_SUBGRID_UThl=>TLES%X_LES_SUBGRID_UThl
+ CASE('X_LES_SUBGRID_VThl')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_VThl,NDIMS)
+ X_LES_SUBGRID_VThl=>TLES%X_LES_SUBGRID_VThl
+ CASE('X_LES_SUBGRID_WThl')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WThl,NDIMS)
+ X_LES_SUBGRID_WThl=>TLES%X_LES_SUBGRID_WThl
+ CASE('X_LES_SUBGRID_URt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_URt,NDIMS)
+ X_LES_SUBGRID_URt=>TLES%X_LES_SUBGRID_URt
+ CASE('X_LES_SUBGRID_VRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_VRt,NDIMS)
+ X_LES_SUBGRID_VRt=>TLES%X_LES_SUBGRID_VRt
+ CASE('X_LES_SUBGRID_WRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WRt,NDIMS)
+ X_LES_SUBGRID_WRt=>TLES%X_LES_SUBGRID_WRt
+ CASE('X_LES_SUBGRID_URc')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_URc,NDIMS)
+ X_LES_SUBGRID_URc=>TLES%X_LES_SUBGRID_URc
+ CASE('X_LES_SUBGRID_VRc')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_VRc,NDIMS)
+ X_LES_SUBGRID_VRc=>TLES%X_LES_SUBGRID_VRc
+ CASE('X_LES_SUBGRID_WRc')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WRc,NDIMS)
+ X_LES_SUBGRID_WRc=>TLES%X_LES_SUBGRID_WRc
+ CASE('X_LES_SUBGRID_USv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_USv,NDIMS)
+ X_LES_SUBGRID_USv=>TLES%X_LES_SUBGRID_USv
+ CASE('X_LES_SUBGRID_VSv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_VSv,NDIMS)
+ X_LES_SUBGRID_VSv=>TLES%X_LES_SUBGRID_VSv
+ CASE('X_LES_SUBGRID_WSv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WSv,NDIMS)
+ X_LES_SUBGRID_WSv=>TLES%X_LES_SUBGRID_WSv
+ CASE('X_LES_SUBGRID_UTke')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_UTke,NDIMS)
+ X_LES_SUBGRID_UTke=>TLES%X_LES_SUBGRID_UTke
+ CASE('X_LES_SUBGRID_VTke')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_VTke,NDIMS)
+ X_LES_SUBGRID_VTke=>TLES%X_LES_SUBGRID_VTke
+ CASE('X_LES_SUBGRID_WTke')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WTke,NDIMS)
+ X_LES_SUBGRID_WTke=>TLES%X_LES_SUBGRID_WTke
+ CASE('X_LES_SUBGRID_ddz_WTke')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_ddz_WTke,NDIMS)
+ X_LES_SUBGRID_ddz_WTke=>TLES%X_LES_SUBGRID_ddz_WTke
+ CASE('X_LES_SUBGRID_WThv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WThv,NDIMS)
+ X_LES_SUBGRID_WThv=>TLES%X_LES_SUBGRID_WThv
+ CASE('X_LES_SUBGRID_ThlThv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_ThlThv,NDIMS)
+ X_LES_SUBGRID_ThlThv=>TLES%X_LES_SUBGRID_ThlThv
+ CASE('X_LES_SUBGRID_RtThv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_RtThv,NDIMS)
+ X_LES_SUBGRID_RtThv=>TLES%X_LES_SUBGRID_RtThv
+ CASE('X_LES_SUBGRID_SvThv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_SvThv,NDIMS)
+ X_LES_SUBGRID_SvThv=>TLES%X_LES_SUBGRID_SvThv
+ CASE('X_LES_SUBGRID_W2Thl')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_W2Thl,NDIMS)
+ X_LES_SUBGRID_W2Thl=>TLES%X_LES_SUBGRID_W2Thl
+ CASE('X_LES_SUBGRID_W2Rt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_W2Rt,NDIMS)
+ X_LES_SUBGRID_W2Rt=>TLES%X_LES_SUBGRID_W2Rt
+ CASE('X_LES_SUBGRID_W2Sv')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_W2Sv,NDIMS)
+ X_LES_SUBGRID_W2Sv=>TLES%X_LES_SUBGRID_W2Sv
+ CASE('X_LES_SUBGRID_WThlRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WThlRt,NDIMS)
+ X_LES_SUBGRID_WThlRt=>TLES%X_LES_SUBGRID_WThlRt
+ CASE('X_LES_SUBGRID_WThl2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WThl2,NDIMS)
+ X_LES_SUBGRID_WThl2=>TLES%X_LES_SUBGRID_WThl2
+ CASE('X_LES_SUBGRID_WRt2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WRt2,NDIMS)
+ X_LES_SUBGRID_WRt2=>TLES%X_LES_SUBGRID_WRt2
+ CASE('X_LES_SUBGRID_WSv2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WSv2,NDIMS)
+ X_LES_SUBGRID_WSv2=>TLES%X_LES_SUBGRID_WSv2
+ CASE('X_LES_SUBGRID_DISS_Tke')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_DISS_Tke,NDIMS)
+ X_LES_SUBGRID_DISS_Tke=>TLES%X_LES_SUBGRID_DISS_Tke
+ CASE('X_LES_SUBGRID_DISS_Thl2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_DISS_Thl2,NDIMS)
+ X_LES_SUBGRID_DISS_Thl2=>TLES%X_LES_SUBGRID_DISS_Thl2
+ CASE('X_LES_SUBGRID_DISS_Rt2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_DISS_Rt2,NDIMS)
+ X_LES_SUBGRID_DISS_Rt2=>TLES%X_LES_SUBGRID_DISS_Rt2
+ CASE('X_LES_SUBGRID_DISS_ThlRt')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_DISS_ThlRt,NDIMS)
+ X_LES_SUBGRID_DISS_ThlRt=>TLES%X_LES_SUBGRID_DISS_ThlRt
+ CASE('X_LES_SUBGRID_DISS_Sv2')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_DISS_Sv2,NDIMS)
+ X_LES_SUBGRID_DISS_Sv2=>TLES%X_LES_SUBGRID_DISS_Sv2
+ CASE('X_LES_SUBGRID_WP')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WP,NDIMS)
+ X_LES_SUBGRID_WP=>TLES%X_LES_SUBGRID_WP
+ CASE('X_LES_SUBGRID_ThlPz')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_ThlPz,NDIMS)
+ X_LES_SUBGRID_ThlPz=>TLES%X_LES_SUBGRID_ThlPz
+ CASE('X_LES_SUBGRID_RtPz')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_RtPz,NDIMS)
+ X_LES_SUBGRID_RtPz=>TLES%X_LES_SUBGRID_RtPz
+ CASE('X_LES_SUBGRID_SvPz')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_SvPz,NDIMS)
+ X_LES_SUBGRID_SvPz=>TLES%X_LES_SUBGRID_SvPz
+ CASE('X_LES_SUBGRID_PHI3')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_PHI3,NDIMS)
+ X_LES_SUBGRID_PHI3=>TLES%X_LES_SUBGRID_PHI3
+ CASE('X_LES_SUBGRID_PSI3')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_PSI3,NDIMS)
+ X_LES_SUBGRID_PSI3=>TLES%X_LES_SUBGRID_PSI3
+ CASE('X_LES_SUBGRID_LMix')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_LMix,NDIMS)
+ X_LES_SUBGRID_LMix=>TLES%X_LES_SUBGRID_LMix
+ CASE('X_LES_SUBGRID_LDiss')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_LDiss,NDIMS)
+ X_LES_SUBGRID_LDiss=>TLES%X_LES_SUBGRID_LDiss
+ CASE('X_LES_SUBGRID_Km')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_Km,NDIMS)
+ X_LES_SUBGRID_Km=>TLES%X_LES_SUBGRID_Km
+ CASE('X_LES_SUBGRID_Kh')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_Kh,NDIMS)
+ X_LES_SUBGRID_Kh=>TLES%X_LES_SUBGRID_Kh
+ CASE('X_LES_SUBGRID_THLUP_MF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_THLUP_MF,NDIMS)
+ X_LES_SUBGRID_THLUP_MF=>TLES%X_LES_SUBGRID_THLUP_MF
+ CASE('X_LES_SUBGRID_RTUP_MF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_RTUP_MF,NDIMS)
+ X_LES_SUBGRID_RTUP_MF=>TLES%X_LES_SUBGRID_RTUP_MF
+ CASE('X_LES_SUBGRID_RVUP_MF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_RVUP_MF,NDIMS)
+ X_LES_SUBGRID_RVUP_MF=>TLES%X_LES_SUBGRID_RVUP_MF
+ CASE('X_LES_SUBGRID_RCUP_MF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_RCUP_MF,NDIMS)
+ X_LES_SUBGRID_RCUP_MF=>TLES%X_LES_SUBGRID_RCUP_MF
+ CASE('X_LES_SUBGRID_RIUP_MF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_RIUP_MF,NDIMS)
+ X_LES_SUBGRID_RIUP_MF=>TLES%X_LES_SUBGRID_RIUP_MF
+ CASE('X_LES_SUBGRID_WUP_MF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WUP_MF,NDIMS)
+ X_LES_SUBGRID_WUP_MF=>TLES%X_LES_SUBGRID_WUP_MF
+ CASE('X_LES_SUBGRID_MASSFLUX')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_MASSFLUX,NDIMS)
+ X_LES_SUBGRID_MASSFLUX=>TLES%X_LES_SUBGRID_MASSFLUX
+ CASE('X_LES_SUBGRID_DETR')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_DETR,NDIMS)
+ X_LES_SUBGRID_DETR=>TLES%X_LES_SUBGRID_DETR
+ CASE('X_LES_SUBGRID_ENTR')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_ENTR,NDIMS)
+ X_LES_SUBGRID_ENTR=>TLES%X_LES_SUBGRID_ENTR
+ CASE('X_LES_SUBGRID_FRACUP')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_FRACUP,NDIMS)
+ X_LES_SUBGRID_FRACUP=>TLES%X_LES_SUBGRID_FRACUP
+ CASE('X_LES_SUBGRID_THVUP_MF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_THVUP_MF,NDIMS)
+ X_LES_SUBGRID_THVUP_MF=>TLES%X_LES_SUBGRID_THVUP_MF
+ CASE('X_LES_SUBGRID_WTHLMF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WTHLMF,NDIMS)
+ X_LES_SUBGRID_WTHLMF=>TLES%X_LES_SUBGRID_WTHLMF
+ CASE('X_LES_SUBGRID_WRTMF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WRTMF,NDIMS)
+ X_LES_SUBGRID_WRTMF=>TLES%X_LES_SUBGRID_WRTMF
+ CASE('X_LES_SUBGRID_WTHVMF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WTHVMF,NDIMS)
+ X_LES_SUBGRID_WTHVMF=>TLES%X_LES_SUBGRID_WTHVMF
+ CASE('X_LES_SUBGRID_WUMF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WUMF,NDIMS)
+ X_LES_SUBGRID_WUMF=>TLES%X_LES_SUBGRID_WUMF
+ CASE('X_LES_SUBGRID_WVMF')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SUBGRID_WVMF,NDIMS)
+ X_LES_SUBGRID_WVMF=>TLES%X_LES_SUBGRID_WVMF
+ CASE('X_LES_USTAR')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_USTAR,NDIMS)
+ X_LES_USTAR=>TLES%X_LES_USTAR
+ CASE('X_LES_UW0')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_UW0,NDIMS)
+ X_LES_UW0=>TLES%X_LES_UW0
+ CASE('X_LES_VW0')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_VW0,NDIMS)
+ X_LES_VW0=>TLES%X_LES_VW0
+ CASE('X_LES_Q0')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_Q0,NDIMS)
+ X_LES_Q0=>TLES%X_LES_Q0
+ CASE('X_LES_E0')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_E0,NDIMS)
+ X_LES_E0=>TLES%X_LES_E0
+ CASE('X_LES_SV0')
+ CALL LES_ALLOCATE_DIM(TLES%X_LES_SV0,NDIMS)
+ X_LES_SV0=>TLES%X_LES_SV0
+ CASE('XLES_PDF_RV')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_RV,NDIMS)
+ XLES_PDF_RV=>TLES%XLES_PDF_RV
+ CASE('XLES_PDF_TH')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_TH,NDIMS)
+ XLES_PDF_TH=>TLES%XLES_PDF_TH
+ CASE('XLES_PDF_W')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_W,NDIMS)
+ XLES_PDF_W=>TLES%XLES_PDF_W
+ CASE('XLES_PDF_THV')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_THV,NDIMS)
+ XLES_PDF_THV=>TLES%XLES_PDF_THV
+ CASE('XLES_PDF_RC')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_RC,NDIMS)
+ XLES_PDF_RC=>TLES%XLES_PDF_RC
+ CASE('XLES_PDF_RR')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_RR,NDIMS)
+ XLES_PDF_RR=>TLES%XLES_PDF_RR
+ CASE('XLES_PDF_RI')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_RI,NDIMS)
+ XLES_PDF_RI=>TLES%XLES_PDF_RI
+ CASE('XLES_PDF_RS')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_RS,NDIMS)
+ XLES_PDF_RS=>TLES%XLES_PDF_RS
+ CASE('XLES_PDF_RG')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_RG,NDIMS)
+ XLES_PDF_RG=>TLES%XLES_PDF_RG
+ CASE('XLES_PDF_RT')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_RT,NDIMS)
+ XLES_PDF_RT=>TLES%XLES_PDF_RT
+ CASE('XLES_PDF_THL')
+ CALL LES_ALLOCATE_DIM(TLES%XLES_PDF_THL,NDIMS)
+ XLES_PDF_THL=>TLES%XLES_PDF_THL
+ END SELECT
+ !
+END SUBROUTINE LES_ALLOCATE
+!
+SUBROUTINE LES_DEALLOCATE(HNAME)
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+!
+ SELECT CASE(HNAME)
+ CASE('LLES_CURRENT_CART_MASK')
+ LLES_CURRENT_CART_MASK=>NULL()
+ DEALLOCATE(TLES%LLES_CURRENT_CART_MASK)
+ CASE('LLES_CURRENT_NEB_MASK')
+ LLES_CURRENT_NEB_MASK=>NULL()
+ DEALLOCATE(TLES%LLES_CURRENT_NEB_MASK)
+ CASE('LLES_CURRENT_CORE_MASK')
+ LLES_CURRENT_CORE_MASK=>NULL()
+ DEALLOCATE(TLES%LLES_CURRENT_CORE_MASK)
+ CASE('LLES_CURRENT_MY_MASKS')
+ LLES_CURRENT_MY_MASKS=>NULL()
+ DEALLOCATE(TLES%LLES_CURRENT_MY_MASKS)
+ CASE('LLES_CURRENT_CS1_MASK')
+ LLES_CURRENT_CS1_MASK=>NULL()
+ DEALLOCATE(TLES%LLES_CURRENT_CS1_MASK)
+ CASE('LLES_CURRENT_CS2_MASK')
+ LLES_CURRENT_CS2_MASK=>NULL()
+ DEALLOCATE(TLES%LLES_CURRENT_CS2_MASK)
+ CASE('LLES_CURRENT_CS3_MASK')
+ LLES_CURRENT_CS3_MASK=>NULL()
+ DEALLOCATE(TLES%LLES_CURRENT_CS3_MASK)
+ CASE('XLES_CURRENT_Z')
+ XLES_CURRENT_Z=>NULL()
+ DEALLOCATE(TLES%XLES_CURRENT_Z)
+ CASE('NKLIN_CURRENT_LES')
+ NKLIN_CURRENT_LES=>NULL()
+ DEALLOCATE(TLES%NKLIN_CURRENT_LES)
+ CASE('XCOEFLIN_CURRENT_LES')
+ XCOEFLIN_CURRENT_LES=>NULL()
+ DEALLOCATE(TLES%XCOEFLIN_CURRENT_LES)
+ CASE('NKLIN_CURRENT_SPEC')
+ NKLIN_CURRENT_SPEC=>NULL()
+ DEALLOCATE(TLES%NKLIN_CURRENT_SPEC)
+ CASE('XCOEFLIN_CURRENT_SPEC')
+ XCOEFLIN_CURRENT_SPEC=>NULL()
+ DEALLOCATE(TLES%XCOEFLIN_CURRENT_SPEC)
+ CASE('XLES_NORM_M')
+ XLES_NORM_M=>NULL()
+ DEALLOCATE(TLES%XLES_NORM_M)
+ CASE('XLES_NORM_K')
+ XLES_NORM_K=>NULL()
+ DEALLOCATE(TLES%XLES_NORM_K)
+ CASE('XLES_NORM_S')
+ XLES_NORM_S=>NULL()
+ DEALLOCATE(TLES%XLES_NORM_S)
+ CASE('XLES_NORM_RHO')
+ XLES_NORM_RHO=>NULL()
+ DEALLOCATE(TLES%XLES_NORM_RHO)
+ CASE('XLES_NORM_RV')
+ XLES_NORM_RV=>NULL()
+ DEALLOCATE(TLES%XLES_NORM_RV)
+ CASE('XLES_NORM_SV')
+ XLES_NORM_SV=>NULL()
+ DEALLOCATE(TLES%XLES_NORM_SV)
+ CASE('XLES_NORM_P')
+ XLES_NORM_P=>NULL()
+ DEALLOCATE(TLES%XLES_NORM_P)
+ CASE('X_LES_RES_W_SBG_WThl')
+ X_LES_RES_W_SBG_WThl=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_W_SBG_WThl)
+ CASE('X_LES_RES_W_SBG_WRt')
+ X_LES_RES_W_SBG_WRt=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_W_SBG_WRt)
+ CASE('X_LES_RES_W_SBG_Thl2')
+ X_LES_RES_W_SBG_Thl2=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_W_SBG_Thl2)
+ CASE('X_LES_RES_W_SBG_Rt2')
+ X_LES_RES_W_SBG_Rt2=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_W_SBG_Rt2)
+ CASE('X_LES_RES_W_SBG_ThlRt')
+ X_LES_RES_W_SBG_ThlRt=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_W_SBG_ThlRt)
+ CASE('X_LES_RES_W_SBG_WSv')
+ X_LES_RES_W_SBG_WSv=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_W_SBG_WSv)
+ CASE('X_LES_RES_W_SBG_Sv2')
+ X_LES_RES_W_SBG_Sv2=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_W_SBG_Sv2)
+ CASE('XLES_SUBGRID_RCSIGS')
+ XLES_SUBGRID_RCSIGS=>NULL()
+ DEALLOCATE(TLES%XLES_SUBGRID_RCSIGS)
+ CASE('XLES_SUBGRID_RCSIGC')
+ XLES_SUBGRID_RCSIGC=>NULL()
+ DEALLOCATE(TLES%XLES_SUBGRID_RCSIGC)
+ CASE('X_LES_RES_ddxa_U_SBG_UaU')
+ X_LES_RES_ddxa_U_SBG_UaU=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_U_SBG_UaU)
+ CASE('X_LES_RES_ddxa_V_SBG_UaV')
+ X_LES_RES_ddxa_V_SBG_UaV=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_V_SBG_UaV)
+ CASE('X_LES_RES_ddxa_W_SBG_UaW')
+ X_LES_RES_ddxa_W_SBG_UaW=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_W_SBG_UaW)
+ CASE('X_LES_RES_ddxa_W_SBG_UaThl')
+ X_LES_RES_ddxa_W_SBG_UaThl=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_W_SBG_UaThl)
+ CASE('X_LES_RES_ddxa_Thl_SBG_UaW')
+ X_LES_RES_ddxa_Thl_SBG_UaW=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_Thl_SBG_UaW)
+ CASE('X_LES_RES_ddz_Thl_SBG_W2')
+ X_LES_RES_ddz_Thl_SBG_W2=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddz_Thl_SBG_W2)
+ CASE('X_LES_RES_ddxa_W_SBG_UaRt')
+ X_LES_RES_ddxa_W_SBG_UaRt=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_W_SBG_UaRt)
+ CASE('X_LES_RES_ddxa_Rt_SBG_UaW')
+ X_LES_RES_ddxa_Rt_SBG_UaW=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_Rt_SBG_UaW)
+ CASE('X_LES_RES_ddz_Rt_SBG_W2')
+ X_LES_RES_ddz_Rt_SBG_W2=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddz_Rt_SBG_W2)
+ CASE('X_LES_RES_ddxa_Thl_SBG_UaRt')
+ X_LES_RES_ddxa_Thl_SBG_UaRt=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_Thl_SBG_UaRt)
+ CASE('X_LES_RES_ddxa_Rt_SBG_UaThl')
+ X_LES_RES_ddxa_Rt_SBG_UaThl=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_Rt_SBG_UaThl)
+ CASE('X_LES_RES_ddxa_Thl_SBG_UaThl')
+ X_LES_RES_ddxa_Thl_SBG_UaThl=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_Thl_SBG_UaThl)
+ CASE('X_LES_RES_ddxa_Rt_SBG_UaRt')
+ X_LES_RES_ddxa_Rt_SBG_UaRt=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_Rt_SBG_UaRt)
+ CASE('X_LES_RES_ddxa_W_SBG_UaSv')
+ X_LES_RES_ddxa_W_SBG_UaSv=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_W_SBG_UaSv)
+ CASE('X_LES_RES_ddxa_Sv_SBG_UaW')
+ X_LES_RES_ddxa_Sv_SBG_UaW=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_Sv_SBG_UaW)
+ CASE('X_LES_RES_ddz_Sv_SBG_W2')
+ X_LES_RES_ddz_Sv_SBG_W2=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddz_Sv_SBG_W2)
+ CASE('X_LES_RES_ddxa_Sv_SBG_UaSv')
+ X_LES_RES_ddxa_Sv_SBG_UaSv=>NULL()
+ DEALLOCATE(TLES%X_LES_RES_ddxa_Sv_SBG_UaSv)
+ CASE('X_LES_SUBGRID_U2')
+ X_LES_SUBGRID_U2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_U2)
+ CASE('X_LES_SUBGRID_V2')
+ X_LES_SUBGRID_V2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_V2)
+ CASE('X_LES_SUBGRID_W2')
+ X_LES_SUBGRID_W2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_W2)
+ CASE('X_LES_SUBGRID_Thl2')
+ X_LES_SUBGRID_Thl2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_Thl2)
+ CASE('X_LES_SUBGRID_Rt2')
+ X_LES_SUBGRID_Rt2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_Rt2)
+ CASE('X_LES_SUBGRID_Rc2')
+ X_LES_SUBGRID_Rc2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_Rc2)
+ CASE('X_LES_SUBGRID_Ri2')
+ X_LES_SUBGRID_Ri2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_Ri2)
+ CASE('X_LES_SUBGRID_ThlRt')
+ X_LES_SUBGRID_ThlRt=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_ThlRt)
+ CASE('X_LES_SUBGRID_Sv2')
+ X_LES_SUBGRID_Sv2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_Sv2)
+ CASE('X_LES_SUBGRID_UV')
+ X_LES_SUBGRID_UV=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_UV)
+ CASE('X_LES_SUBGRID_WU')
+ X_LES_SUBGRID_WU=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WU)
+ CASE('X_LES_SUBGRID_WV')
+ X_LES_SUBGRID_WV=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WV)
+ CASE('X_LES_SUBGRID_UThl')
+ X_LES_SUBGRID_UThl=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_UThl)
+ CASE('X_LES_SUBGRID_VThl')
+ X_LES_SUBGRID_VThl=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_VThl)
+ CASE('X_LES_SUBGRID_WThl')
+ X_LES_SUBGRID_WThl=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WThl)
+ CASE('X_LES_SUBGRID_URt')
+ X_LES_SUBGRID_URt=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_URt)
+ CASE('X_LES_SUBGRID_VRt')
+ X_LES_SUBGRID_VRt=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_VRt)
+ CASE('X_LES_SUBGRID_WRt')
+ X_LES_SUBGRID_WRt=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WRt)
+ CASE('X_LES_SUBGRID_URc')
+ X_LES_SUBGRID_URc=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_URc)
+ CASE('X_LES_SUBGRID_VRc')
+ X_LES_SUBGRID_VRc=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_VRc)
+ CASE('X_LES_SUBGRID_WRc')
+ X_LES_SUBGRID_WRc=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WRc)
+ CASE('X_LES_SUBGRID_USv')
+ X_LES_SUBGRID_USv=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_USv)
+ CASE('X_LES_SUBGRID_VSv')
+ X_LES_SUBGRID_VSv=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_VSv)
+ CASE('X_LES_SUBGRID_WSv')
+ X_LES_SUBGRID_WSv=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WSv)
+ CASE('X_LES_SUBGRID_UTke')
+ X_LES_SUBGRID_UTke=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_UTke)
+ CASE('X_LES_SUBGRID_VTke')
+ X_LES_SUBGRID_VTke=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_VTke)
+ CASE('X_LES_SUBGRID_WTke')
+ X_LES_SUBGRID_WTke=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WTke)
+ CASE('X_LES_SUBGRID_ddz_WTke')
+ X_LES_SUBGRID_ddz_WTke=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_ddz_WTke)
+ CASE('X_LES_SUBGRID_WThv')
+ X_LES_SUBGRID_WThv=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WThv)
+ CASE('X_LES_SUBGRID_ThlThv')
+ X_LES_SUBGRID_ThlThv=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_ThlThv)
+ CASE('X_LES_SUBGRID_RtThv')
+ X_LES_SUBGRID_RtThv=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_RtThv)
+ CASE('X_LES_SUBGRID_SvThv')
+ X_LES_SUBGRID_SvThv=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_SvThv)
+ CASE('X_LES_SUBGRID_W2Thl')
+ X_LES_SUBGRID_W2Thl=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_W2Thl)
+ CASE('X_LES_SUBGRID_W2Rt')
+ X_LES_SUBGRID_W2Rt=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_W2Rt)
+ CASE('X_LES_SUBGRID_W2Sv')
+ X_LES_SUBGRID_W2Sv=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_W2Sv)
+ CASE('X_LES_SUBGRID_WThlRt')
+ X_LES_SUBGRID_WThlRt=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WThlRt)
+ CASE('X_LES_SUBGRID_WThl2')
+ X_LES_SUBGRID_WThl2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WThl2)
+ CASE('X_LES_SUBGRID_WRt2')
+ X_LES_SUBGRID_WRt2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WRt2)
+ CASE('X_LES_SUBGRID_WSv2')
+ X_LES_SUBGRID_WSv2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WSv2)
+ CASE('X_LES_SUBGRID_DISS_Tke')
+ X_LES_SUBGRID_DISS_Tke=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_DISS_Tke)
+ CASE('X_LES_SUBGRID_DISS_Thl2')
+ X_LES_SUBGRID_DISS_Thl2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_DISS_Thl2)
+ CASE('X_LES_SUBGRID_DISS_Rt2')
+ X_LES_SUBGRID_DISS_Rt2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_DISS_Rt2)
+ CASE('X_LES_SUBGRID_DISS_ThlRt')
+ X_LES_SUBGRID_DISS_ThlRt=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_DISS_ThlRt)
+ CASE('X_LES_SUBGRID_DISS_Sv2')
+ X_LES_SUBGRID_DISS_Sv2=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_DISS_Sv2)
+ CASE('X_LES_SUBGRID_WP')
+ X_LES_SUBGRID_WP=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WP)
+ CASE('X_LES_SUBGRID_ThlPz')
+ X_LES_SUBGRID_ThlPz=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_ThlPz)
+ CASE('X_LES_SUBGRID_RtPz')
+ X_LES_SUBGRID_RtPz=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_RtPz)
+ CASE('X_LES_SUBGRID_SvPz')
+ X_LES_SUBGRID_SvPz=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_SvPz)
+ CASE('X_LES_SUBGRID_PHI3')
+ X_LES_SUBGRID_PHI3=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_PHI3)
+ CASE('X_LES_SUBGRID_PSI3')
+ X_LES_SUBGRID_PSI3=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_PSI3)
+ CASE('X_LES_SUBGRID_LMix')
+ X_LES_SUBGRID_LMix=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_LMix)
+ CASE('X_LES_SUBGRID_LDiss')
+ X_LES_SUBGRID_LDiss=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_LDiss)
+ CASE('X_LES_SUBGRID_Km')
+ X_LES_SUBGRID_Km=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_Km)
+ CASE('X_LES_SUBGRID_Kh')
+ X_LES_SUBGRID_Kh=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_Kh)
+ CASE('X_LES_SUBGRID_THLUP_MF')
+ X_LES_SUBGRID_THLUP_MF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_THLUP_MF)
+ CASE('X_LES_SUBGRID_RTUP_MF')
+ X_LES_SUBGRID_RTUP_MF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_RTUP_MF)
+ CASE('X_LES_SUBGRID_RVUP_MF')
+ X_LES_SUBGRID_RVUP_MF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_RVUP_MF)
+ CASE('X_LES_SUBGRID_RCUP_MF')
+ X_LES_SUBGRID_RCUP_MF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_RCUP_MF)
+ CASE('X_LES_SUBGRID_RIUP_MF')
+ X_LES_SUBGRID_RIUP_MF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_RIUP_MF)
+ CASE('X_LES_SUBGRID_WUP_MF')
+ X_LES_SUBGRID_WUP_MF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WUP_MF)
+ CASE('X_LES_SUBGRID_MASSFLUX')
+ X_LES_SUBGRID_MASSFLUX=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_MASSFLUX)
+ CASE('X_LES_SUBGRID_DETR')
+ X_LES_SUBGRID_DETR=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_DETR)
+ CASE('X_LES_SUBGRID_ENTR')
+ X_LES_SUBGRID_ENTR=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_ENTR)
+ CASE('X_LES_SUBGRID_FRACUP')
+ X_LES_SUBGRID_FRACUP=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_FRACUP)
+ CASE('X_LES_SUBGRID_THVUP_MF')
+ X_LES_SUBGRID_THVUP_MF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_THVUP_MF)
+ CASE('X_LES_SUBGRID_WTHLMF')
+ X_LES_SUBGRID_WTHLMF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WTHLMF)
+ CASE('X_LES_SUBGRID_WRTMF')
+ X_LES_SUBGRID_WRTMF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WRTMF)
+ CASE('X_LES_SUBGRID_WTHVMF')
+ X_LES_SUBGRID_WTHVMF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WTHVMF)
+ CASE('X_LES_SUBGRID_WUMF')
+ X_LES_SUBGRID_WUMF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WUMF)
+ CASE('X_LES_SUBGRID_WVMF')
+ X_LES_SUBGRID_WVMF=>NULL()
+ DEALLOCATE(TLES%X_LES_SUBGRID_WVMF)
+ CASE('X_LES_USTAR')
+ X_LES_USTAR=>NULL()
+ DEALLOCATE(TLES%X_LES_USTAR)
+ CASE('X_LES_UW0')
+ X_LES_UW0=>NULL()
+ DEALLOCATE(TLES%X_LES_UW0)
+ CASE('X_LES_VW0')
+ X_LES_VW0=>NULL()
+ DEALLOCATE(TLES%X_LES_VW0)
+ CASE('X_LES_Q0')
+ X_LES_Q0=>NULL()
+ DEALLOCATE(TLES%X_LES_Q0)
+ CASE('X_LES_E0')
+ X_LES_E0=>NULL()
+ DEALLOCATE(TLES%X_LES_E0)
+ CASE('X_LES_SV0')
+ X_LES_SV0=>NULL()
+ DEALLOCATE(TLES%X_LES_SV0)
+ CASE('XLES_PDF_RV')
+ XLES_PDF_RV=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_RV)
+ CASE('XLES_PDF_TH')
+ XLES_PDF_TH=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_TH)
+ CASE('XLES_PDF_W')
+ XLES_PDF_W=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_W)
+ CASE('XLES_PDF_THV')
+ XLES_PDF_THV=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_THV)
+ CASE('XLES_PDF_RC')
+ XLES_PDF_RC=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_RC)
+ CASE('XLES_PDF_RR')
+ XLES_PDF_RR=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_RR)
+ CASE('XLES_PDF_RI')
+ XLES_PDF_RI=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_RI)
+ CASE('XLES_PDF_RS')
+ XLES_PDF_RS=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_RS)
+ CASE('XLES_PDF_RG')
+ XLES_PDF_RG=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_RG)
+ CASE('XLES_PDF_RT')
+ XLES_PDF_RT=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_RT)
+ CASE('XLES_PDF_THL')
+ XLES_PDF_THL=>NULL()
+ DEALLOCATE(TLES%XLES_PDF_THL)
+ END SELECT
+END SUBROUTINE LES_DEALLOCATE
+!!
+!SUBROUTINE LES_INI_TIMESTEP_DEALLOCATE()
+! IMPLICIT NONE
+! XCOEFLIN_CURRENT_SPEC=>NULL()
+! DEALLOCATE(TLES%XCOEFLIN_CURRENT_SPEC)
+!END SUBROUTINE LES_INI_TIMESTEP_DEALLOCATE
+!
+SUBROUTINE LES_ALLOCATE_1DIMX(PVAR,KDIM)
+ IMPLICIT NONE
+ REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PVAR
+ INTEGER, DIMENSION(1), INTENT(IN) :: KDIM
+ ALLOCATE(PVAR(KDIM(1)))
+END SUBROUTINE LES_ALLOCATE_1DIMX
+!
+SUBROUTINE LES_ALLOCATE_2DIMX(PVAR,KDIM)
+ IMPLICIT NONE
+ REAL, DIMENSION(:,:),ALLOCATABLE, INTENT(OUT) :: PVAR
+ INTEGER, DIMENSION(2), INTENT(IN) :: KDIM
+ ALLOCATE(PVAR(KDIM(1),KDIM(2)))
+END SUBROUTINE LES_ALLOCATE_2DIMX
+!
+SUBROUTINE LES_ALLOCATE_3DIMX(PVAR,KDIM)
+ IMPLICIT NONE
+ REAL, DIMENSION(:,:,:),ALLOCATABLE, INTENT(OUT) :: PVAR
+ INTEGER, DIMENSION(3), INTENT(IN) :: KDIM
+ ALLOCATE(PVAR(KDIM(1),KDIM(2),KDIM(3)))
+END SUBROUTINE LES_ALLOCATE_3DIMX
+!
+SUBROUTINE LES_ALLOCATE_4DIMX(PVAR,KDIM)
+ IMPLICIT NONE
+ REAL, DIMENSION(:,:,:,:),ALLOCATABLE, INTENT(OUT) :: PVAR
+ INTEGER, DIMENSION(4), INTENT(IN) :: KDIM
+ ALLOCATE(PVAR(KDIM(1),KDIM(2),KDIM(3),KDIM(4)))
+END SUBROUTINE LES_ALLOCATE_4DIMX
+!
+SUBROUTINE LES_ALLOCATE_1DIMI(KVAR,KDIM)
+ IMPLICIT NONE
+ INTEGER, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: KVAR
+ INTEGER, DIMENSION(1), INTENT(IN) :: KDIM
+ ALLOCATE(KVAR(KDIM(1)))
+END SUBROUTINE LES_ALLOCATE_1DIMI
+!
+SUBROUTINE LES_ALLOCATE_3DIMI(KVAR,KDIM)
+ IMPLICIT NONE
+ INTEGER, DIMENSION(:,:,:),ALLOCATABLE, INTENT(OUT) :: KVAR
+ INTEGER, DIMENSION(3), INTENT(IN) :: KDIM
+ ALLOCATE(KVAR(KDIM(1),KDIM(2),KDIM(3)))
+END SUBROUTINE LES_ALLOCATE_3DIMI
+!
+SUBROUTINE LES_ALLOCATE_3DIML(OVAR,KDIM)
+ IMPLICIT NONE
+ LOGICAL, DIMENSION(:,:,:),ALLOCATABLE, INTENT(OUT) :: OVAR
+ INTEGER, DIMENSION(3), INTENT(IN) :: KDIM
+ ALLOCATE(OVAR(KDIM(1),KDIM(2),KDIM(3)))
+END SUBROUTINE LES_ALLOCATE_3DIML
+!
+SUBROUTINE LES_ALLOCATE_4DIML(OVAR,KDIM)
+ IMPLICIT NONE
+ LOGICAL, DIMENSION(:,:,:,:),ALLOCATABLE, INTENT(OUT) :: OVAR
+ INTEGER, DIMENSION(4), INTENT(IN) :: KDIM
+ ALLOCATE(OVAR(KDIM(1),KDIM(2),KDIM(3),KDIM(4)))
+END SUBROUTINE LES_ALLOCATE_4DIML
+!
+SUBROUTINE LES_ALLOCATE_2DIMC(HVAR,KDIM)
+ IMPLICIT NONE
+ LOGICAL, DIMENSION(:,:),ALLOCATABLE, INTENT(OUT) :: HVAR
+ INTEGER, DIMENSION(2), INTENT(IN) :: KDIM
+ ALLOCATE(HVAR(KDIM(1),KDIM(2)))
+END SUBROUTINE LES_ALLOCATE_2DIMC
+!
END MODULE MODD_LES
diff --git a/src/PHYEX/aux/mode_budget.f90 b/src/PHYEX/aux/mode_budget.f90
index 5e7dd0809c8f6296aca79452016cafe437950254..89aad3a6eb956fdeddfcf552472c115ccc794a02 100644
--- a/src/PHYEX/aux/mode_budget.f90
+++ b/src/PHYEX/aux/mode_budget.f90
@@ -7,7 +7,6 @@
! P. Wautelet 28/01/2020: new subroutines: Budget_store_init, Budget_store_end and Budget_source_id_find in new module mode_budget
! P. Wautelet 17/08/2020: treat LES budgets correctly
! P. Wautelet 05/03/2021: measure cpu_time for budgets
-! J.Escobar : 06/10/2021 :for bit reproductiblity use MPPDB_CHECK if LCHECK=T
!-----------------------------------------------------------------
!#################
@@ -27,18 +26,49 @@ implicit none
private
-public :: Budget_store_init
-public :: Budget_store_end
-public :: Budget_store_add
+public :: Budget_store_init,Budget_store_init_phy
+public :: Budget_store_end, Budget_store_end_phy
+public :: Budget_store_add, Budget_store_add_phy
real :: ztime1, ztime2
contains
+subroutine Budget_store_init_phy(D, tpbudget, hsource, pvars)
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: pvars ! Current value to be stored
+!
+ call Budget_store_init(tpbudget, hsource, pvars)
+!
+end subroutine Budget_store_init_phy
+!
+subroutine Budget_store_end_phy(D, tpbudget, hsource, pvars)
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: pvars ! Current value to be stored
+!
+ call Budget_store_end(tpbudget, hsource, pvars)
+!
+end subroutine Budget_store_end_phy
+!
+subroutine Budget_store_add_phy(D, tpbudget, hsource, pvars)
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: pvars ! Current value to be stored
+!
+ call Budget_store_add(tpbudget, hsource, pvars)
+!
+end subroutine Budget_store_add_phy
+!
subroutine Budget_store_init( tpbudget, hsource, pvars )
use modd_les, only: lles_call
- USE MODE_MPPDB
- USE MODD_CONF, ONLY : LCHECK
type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
character(len=*), intent(in) :: hsource ! Name of the source term
@@ -46,15 +76,7 @@ subroutine Budget_store_init( tpbudget, hsource, pvars )
integer :: iid ! Reference number of the current source term
- character(len=:),allocatable :: hbudget
-
- hbudget = trim( tpbudget%cname )//':'//trim( hsource )
-
- IF (LCHECK) THEN
- CALL MPPDB_CHECK3D(PVARS,'BUD_INI::'//hbudget,PRECISION)
- END IF
-
- call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_init', hbudget )
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_init', trim( tpbudget%cname )//':'//trim( hsource ) )
if ( lles_call ) then
call Second_mnh( ztime1 )
@@ -123,8 +145,6 @@ subroutine Budget_store_init( tpbudget, hsource, pvars )
subroutine Budget_store_end( tpbudget, hsource, pvars )
use modd_les, only: lles_call
- USE MODE_MPPDB
- USE MODD_CONF, ONLY : LCHECK
use modi_les_budget, only: Les_budget
@@ -136,14 +156,7 @@ subroutine Budget_store_end( tpbudget, hsource, pvars )
integer :: igroup ! Number of the group where to store the source term
real, dimension(:,:,:), allocatable :: zvars_add
- character(len=:),allocatable :: hbudget
-
- hbudget = trim( tpbudget%cname )//':'//trim( hsource )
-
- IF (LCHECK) THEN
- CALL MPPDB_CHECK3D(PVARS,'BUD_END::'//hbudget,PRECISION)
- END IF
- call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_end', hbudget )
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_end', trim( tpbudget%cname )//':'//trim( hsource ) )
if ( lles_call ) then
if ( hsource /= tpbudget%clessource ) &
diff --git a/src/PHYEX/aux/mode_fill_dimphyexn.f90 b/src/PHYEX/aux/mode_fill_dimphyexn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..80679f8e1929dfc71b47905a1d88abf6ebffd437
--- /dev/null
+++ b/src/PHYEX/aux/mode_fill_dimphyexn.f90
@@ -0,0 +1,107 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODE_FILL_DIMPHYEX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB)
+! #########################
+!
+!!
+!! PURPOSE
+!! -------
+! This subroutine computes the dimensions according to the running model.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! S. Riette, Météo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 2022
+!
+!-----------------------------------------------------------------
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_LES, ONLY : LLES_NEB_MASK, LLES_CORE_MASK, LLES_CS_MASK, LLES_MY_MASK, &
+ NLES_MASKS_USER
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(DIMPHYEX_t), INTENT(OUT) :: YDDIMPHYEX ! Structure to fill in
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! Array dimensions
+LOGICAL, INTENT(IN), OPTIONAL :: LTURB ! Flag to replace array dimensions I/JB and I/JE to the full array size
+ ! needed if computation in HALO points (e.g. in turbulence)
+LOGICAL :: YTURB
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('FILL_DIMPHYEX', 0, ZHOOK_HANDLE)
+!
+YDDIMPHYEX%NIT=KIT
+YDDIMPHYEX%NJT=KJT
+YDDIMPHYEX%NIJT=KIT*KJT
+CALL GET_INDICE_ll(YDDIMPHYEX%NIB, YDDIMPHYEX%NJB,&
+ &YDDIMPHYEX%NIE, YDDIMPHYEX%NJE)
+!
+YDDIMPHYEX%NIJB=1
+YDDIMPHYEX%NIJE=KIT*KJT
+!
+YDDIMPHYEX%NKL=1
+YDDIMPHYEX%NKT=KKT
+YDDIMPHYEX%NKA=1
+YDDIMPHYEX%NKU=KKT
+YDDIMPHYEX%NKB=1+JPVEXT
+YDDIMPHYEX%NKE=KKT-JPVEXT
+YDDIMPHYEX%NKLES=KKT-2*JPVEXT
+YDDIMPHYEX%NKTB=1+JPVEXT
+YDDIMPHYEX%NKTE=KKT-JPVEXT
+!
+IF(PRESENT(LTURB)) THEN
+ YTURB=LTURB
+ELSE
+ YTURB=.FALSE. ! Default value
+END IF
+!
+IF(YTURB) THEN
+ YDDIMPHYEX%NIBC=1
+ YDDIMPHYEX%NJBC=1
+ YDDIMPHYEX%NIEC=YDDIMPHYEX%NIT
+ YDDIMPHYEX%NJEC=YDDIMPHYEX%NJT
+ELSE
+ YDDIMPHYEX%NIBC=YDDIMPHYEX%NIB
+ YDDIMPHYEX%NJBC=YDDIMPHYEX%NJB
+ YDDIMPHYEX%NIEC=YDDIMPHYEX%NIE
+ YDDIMPHYEX%NJEC=YDDIMPHYEX%NJE
+END IF
+IF (LHOOK) CALL DR_HOOK('FILL_DIMPHYEX', 1, ZHOOK_HANDLE)
+!
+YDDIMPHYEX%NLESMASK = 1
+IF (LLES_MY_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + NLES_MASKS_USER
+IF (LLES_NEB_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 2
+IF (LLES_CORE_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 2
+IF (LLES_CS_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 3
+!
+END SUBROUTINE FILL_DIMPHYEX
+END MODULE MODE_FILL_DIMPHYEX
diff --git a/src/PHYEX/aux/mode_io_field_write.f90 b/src/PHYEX/aux/mode_io_field_write.f90
index 9e95c6e518de2c22d3c373e9d8994cfe72e12a11..a4a6a28c0f76c12701db46b997a5cf1cc96fbb80 100644
--- a/src/PHYEX/aux/mode_io_field_write.f90
+++ b/src/PHYEX/aux/mode_io_field_write.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -43,6 +43,7 @@ MODULE MODE_IO_FIELD_WRITE
PRIVATE
public :: IO_Field_write, IO_Field_write_box, IO_Field_write_lb
+ public :: IO_Field_write_phy
public :: IO_Fieldlist_write, IO_Field_user_write
public :: IO_Header_write, IO_Field_create
@@ -69,6 +70,10 @@ MODULE MODE_IO_FIELD_WRITE
IO_Field_write_byfield_T0,IO_Field_write_byfield_T1
END INTERFACE
+ INTERFACE IO_Field_write_phy
+ MODULE PROCEDURE IO_Field_write_phy_byfield_X2, IO_Field_write_phy_byfield_X1
+ END INTERFACE
+
INTERFACE IO_Field_write_box
MODULE PROCEDURE IO_Field_write_box_byfield_X2, IO_Field_write_box_byfield_X3, &
IO_Field_write_box_byfield_X4, IO_Field_write_box_byfield_X5
@@ -619,6 +624,77 @@ end subroutine IO_Ndimlist_reduce
!
END SUBROUTINE IO_Field_write_byname_X1
+ SUBROUTINE IO_Field_write_phy_byfield_X2(D, TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(D%NIJT,D%NKT),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ CALL IO_Field_write_phy_unpack2D(D,TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ !
+ END SUBROUTINE IO_Field_write_phy_byfield_X2
+!
+ SUBROUTINE IO_Field_write_phy_unpack2D(D, TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(D%NIT,D%NJT,D%NKT),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ CALL IO_Field_write_byfield_X3(TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ !
+ END SUBROUTINE IO_Field_write_phy_unpack2D
+!
+ SUBROUTINE IO_Field_write_phy_byfield_X1(D, TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(D%NIJT),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ CALL IO_Field_write_phy_unpack1D(D,TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ !
+ END SUBROUTINE IO_Field_write_phy_byfield_X1
+!
+ SUBROUTINE IO_Field_write_phy_unpack1D(D, TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(D%NIT,D%NJT),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ CALL IO_Field_write_byfield_X2(TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ !
+ END SUBROUTINE IO_Field_write_phy_unpack1D
SUBROUTINE IO_Field_write_byfield_X1( TPFILE, TPFIELD, PFIELD, KRESP, koffset )
USE MODD_IO, ONLY: GSMONOPROC, ISP
@@ -1079,8 +1155,6 @@ end subroutine IO_Ndimlist_reduce
iresp = 0
iresp_lfi = 0
iresp_nc4 = 0
- iresp_tmp_lfi = 0
- iresp_tmp_nc4 = 0
GALLOC = .FALSE.
GALLOC_ll = .FALSE.
IHEXTOT = 2*JPHEXT+1
diff --git a/src/PHYEX/aux/mode_thermo.f90 b/src/PHYEX/aux/mode_thermo.f90
index 36f4d593a2c798021ca2fe939744710aaf19893d..935ffebd0606833ea3979137886485da05f041bd 100644
--- a/src/PHYEX/aux/mode_thermo.f90
+++ b/src/PHYEX/aux/mode_thermo.f90
@@ -7,19 +7,19 @@
MODULE MODE_THERMO
! #######################
!
-!!**** *MODE_THERMO_MONO* - module for routines SM_FOES,SM_PMR_HU
+!!**** *MODE_THERMO_MONO* - module for routines SM_FOES,SM_PMR_HU
!!
!! PURPOSE
!! -------
-! The purpose of this executive module is to package
+! The purpose of this executive module is to package
! the routine SM_FOES, SM_PMR_HU without use of comlib parallel routine
-!
-!
+!
+!
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
-!! NONE
+!! NONE
!!
!! REFERENCE
!! ---------
@@ -27,11 +27,11 @@
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 28/08/94
+!! Original 28/08/94
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! J.Escobar : 5/10/2018 : add FLUSH , for better logging in case of PB
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
@@ -41,14 +41,14 @@
! ------------
!
!-------------------------------------------------------------------------------
+USE MODE_MSG
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+IMPLICIT NONE
-use mode_msg
-
-implicit none
-
-private
+PRIVATE
-public :: DQSAT, DQSATI, QSAT, QSATI, SM_FOES, SM_PMR_HU
+PUBLIC :: DQSAT, DQSATI, QSAT, QSATI, SM_FOES, SM_PMR_HU
INTERFACE SM_FOES
MODULE PROCEDURE SM_FOES_0D
@@ -81,7 +81,7 @@ INTERFACE DQSATI
MODULE PROCEDURE DQSATI_O_DT_1D
MODULE PROCEDURE DQSATI_O_DT_3D
END INTERFACE
-INTERFACE SM_PMR_HU
+INTERFACE SM_PMR_HU
MODULE PROCEDURE SM_PMR_HU_1D
MODULE PROCEDURE SM_PMR_HU_3D
END INTERFACE
@@ -96,23 +96,23 @@ CONTAINS
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
-!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! EXTERNAL
!! --------
@@ -123,26 +123,26 @@ CONTAINS
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 28/08/94
+!! Original 28/08/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -151,9 +151,9 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!* 0.2 Declarations of local variables
!
@@ -162,9 +162,12 @@ REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PFOES ! saturation vapor
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_3D',0,ZHOOK_HANDLE)
PFOES(:,:,:) = EXP( XALPW - XBETAW/PT(:,:,:) - XGAMW*LOG(PT(:,:,:)) )
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_3D',1,ZHOOK_HANDLE)
END FUNCTION SM_FOES_3D
! ####################################
FUNCTION SM_FOES_1D(PT) RESULT(PFOES)
@@ -175,23 +178,23 @@ END FUNCTION SM_FOES_3D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
-!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! EXTERNAL
!! --------
@@ -202,26 +205,26 @@ END FUNCTION SM_FOES_3D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 28/08/94
+!! Original 28/08/94
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -230,9 +233,9 @@ IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
-REAL, DIMENSION(SIZE(PT)) :: PFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT)) :: PFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!* 0.2 Declarations of local variables
!
@@ -241,9 +244,12 @@ REAL, DIMENSION(SIZE(PT)) :: PFOES ! saturation vapor
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_1D',0,ZHOOK_HANDLE)
PFOES(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*LOG(PT(:)) )
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_1D',1,ZHOOK_HANDLE)
END FUNCTION SM_FOES_1D
!-------------------------------------------------------------------------------
! ####################################################
@@ -255,21 +261,21 @@ END FUNCTION SM_FOES_1D
!! PURPOSE
!! -------
! The purpose of this function is to compute the vapor mixing ratio
-! from pressure, virtual temperature and relative humidity
-!
+! from pressure, virtual temperature and relative humidity
+!
!
!!** METHOD
!! ------
!! Given Pressure (PP), Virtual temperature (PTV) and Relative
!! humidity (PHU), the vapor mixing ratio is computed by iterating
!! the following procedure :
-!! T ----> es(T)
+!! T ----> es(T)
!! es(T) ,HU ----> es(Td)
!! es(Td), P ----> r
!! r , Tv ----> T
!!
!! at the beginning T=Tv
-!!
+!!
!! EXTERNAL
!! --------
!! SM_FOES : to compute saturation vapor pressure
@@ -279,19 +285,19 @@ END FUNCTION SM_FOES_1D
!! Module MODD_CST : comtains physical constants
!! XRV : gas constant for vapor
!! XRD : gas constant for dry air
-!!
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 30/08/94
+!! Original 30/08/94
!! Modification 16/03/95 remove the EPSILON function
!! Modification 15/09/97 (V. Masson) add solid and liquid water phases
!! in thetav computation
@@ -302,7 +308,7 @@ END FUNCTION SM_FOES_1D
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
USE MODD_LUNIT_n, ONLY: TLUOUT
!
IMPLICIT NONE
@@ -311,7 +317,7 @@ IMPLICIT NONE
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
- ! (Pa)
+ ! (Pa)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTV ! Virtual Temperature
! (Kelvin)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PHU ! Relative humidity
@@ -334,22 +340,24 @@ REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2),SIZE(PP,3)) :: ZDT ! increment of
REAL :: ZRDSRV ! Rd/Rv
REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2),SIZE(PP,3)) :: ZESTD ! es(Td)
REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2),SIZE(PP,3)) :: ZRSLW ! total solid and liquid water mixing ratio
-INTEGER :: ITERMAX ! Maximum number
- ! of iteration
+INTEGER :: ITERMAX ! Maximum number
+ ! of iteration
INTEGER :: ITER ! iteration number of
REAL :: ZEPS ! a small number
INTEGER, DIMENSION(3) :: IMAXLOC ! localisation of
- ! a maximum
-INTEGER :: ILUOUT
+ ! a maximum
+INTEGER :: ILUOUT
! logical unit for
! output-listing
- ! and error code
+ ! and error code
INTEGER :: JRR ! loop counter
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE VAPOR MIXING RATIO
! --------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_3D',0,ZHOOK_HANDLE)
ITERMAX = 10
IF (PRESENT(KITERMAX)) ITERMAX=KITERMAX
ZRDSRV = XRD /XRV
@@ -360,7 +368,6 @@ DO JRR=2,SIZE(PR,4)
ZRSLW(:,:,:)=ZRSLW(:,:,:)+PR(:,:,:,JRR)
END DO
!
-ITER=0
ZT(:,:,:) = PTV(:,:,:)
DO ITER=1,ITERMAX
ZESTD(:,:,:) = PHU(:,:,:) * SM_FOES(ZT(:,:,:)) * 0.01
@@ -371,25 +378,26 @@ DO ITER=1,ITERMAX
END DO
!-------------------------------------------------------------------------------
!
-!* 2. NO CONVERGENCE
+!* 2. NO CONVERGENCE
! --------------
!
IF ( ANY(ZDT > ZEPS) ) THEN
ILUOUT = TLUOUT%NLU
WRITE(ILUOUT,*) 'ERROR IN FUNCTION SM_PMR_HU (module MODE_THERMO)'
- WRITE(ILUOUT,*) 'FUNCTION FAILS TO CONVERGE AFTER ', ITER,' ITERATIONS'
+ WRITE(ILUOUT,*) 'FUNCTION FAILS TO CONVERGE AFTER ', ITERMAX,' ITERATIONS'
WRITE(ILUOUT,*) 'EPS = ' , ZEPS
IMAXLOC(:) = MAXLOC(ZDT)
- WRITE(ILUOUT,*) 'MAXIMUM RESIDUAL DT :', MAXVAL(ZDT)
+ WRITE(ILUOUT,*) 'MAXIMUM RESIDUAL DT :', MAXVAL(ZDT)
! WRITE(ILUOUT,*) 'LOCATION OF THIS MAXIMUM I=',IMAXLOC(1),' J=',IMAXLOC(2), &
-! ' K=',IMAXLOC(3)
+! ' K=',IMAXLOC(3)
WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
WRITE(ILUOUT,*) 'JOB ABORTED '
FLUSH(unit=ILUOUT)
- call Print_msg( NVERB_FATAL, 'GEN', 'SM_PMR_HU_3D', 'failed to converge' )
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SM_PMR_HU_3D', 'failed to converge' )
END IF
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_3D',1,ZHOOK_HANDLE)
END FUNCTION SM_PMR_HU_3D
! ################################################################
FUNCTION SM_PMR_HU_1D(PP,PTV,PHU,PR,KITERMAX) RESULT(PMR)
@@ -400,21 +408,21 @@ END FUNCTION SM_PMR_HU_3D
!! PURPOSE
!! -------
! The purpose of this function is to compute the vapor mixing ratio
-! from pressure, virtual temperature and relative humidity
-!
+! from pressure, virtual temperature and relative humidity
+!
!
!!** METHOD
!! ------
!! Given Pressure (PP), Virtual temperature (PTV) and Relative
!! humidity (PHU), the vapor mixing ratio is computed by iterating
!! the following procedure :
-!! T ----> es(T)
+!! T ----> es(T)
!! es(T) ,HU ----> es(Td)
!! es(Td), P ----> r
!! r , Tv ----> T
!!
!! at the beginning T=Tv
-!!
+!!
!! EXTERNAL
!! --------
!! SM_FOES : to compute saturation vapor pressure
@@ -424,19 +432,19 @@ END FUNCTION SM_PMR_HU_3D
!! Module MODD_CST : comtains physical constants
!! XRV : gas constant for vapor
!! XRD : gas constant for dry air
-!!
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 30/08/94
+!! Original 30/08/94
!! Modification 16/03/95 remove the EPSILON function
!! Modification 15/09/97 (V. Masson) add solid and liquid water phases
!! in thetav computation
@@ -445,7 +453,7 @@ END FUNCTION SM_PMR_HU_3D
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
USE MODD_LUNIT_n, ONLY: TLUOUT
!
IMPLICIT NONE
@@ -454,7 +462,7 @@ IMPLICIT NONE
!
!
REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
- ! (Pa)
+ ! (Pa)
REAL, DIMENSION(:), INTENT(IN) :: PTV ! Virtual Temperature
! (Kelvin)
REAL, DIMENSION(:), INTENT(IN) :: PHU ! Relative humidity
@@ -475,13 +483,13 @@ REAL, DIMENSION(SIZE(PP)) :: ZDT ! increment of
REAL :: ZRDSRV ! Rd/Rv
REAL, DIMENSION(SIZE(PP)) :: ZESTD ! es(Td)
REAL, DIMENSION(SIZE(PP)) :: ZRSLW ! total solid and liquid water mixing ratio
-INTEGER :: ITERMAX ! Maximum number
- ! of iteration
+INTEGER :: ITERMAX ! Maximum number
+ ! of iteration
INTEGER :: ITER ! iteration number of
REAL :: ZEPS ! a small number
INTEGER,DIMENSION(1) :: IMAXLOC ! localisation of
- ! a maximum
-INTEGER :: ILUOUT,IRESP
+ ! a maximum
+INTEGER :: ILUOUT,IRESP
! logical unit for
! output-listing
! and error code
@@ -490,6 +498,8 @@ INTEGER :: ILUOUT,IRESP
!* 1. COMPUTE VAPOR MIXING RATIO
! --------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_1D',0,ZHOOK_HANDLE)
ITERMAX = 10
IF (PRESENT(KITERMAX)) ITERMAX=KITERMAX
ZRDSRV = XRD /XRV
@@ -501,7 +511,6 @@ ELSE
ZRSLW(:)=0.
END IF
!
-ITER=0
ZT(:) = PTV(:)
DO ITER=1,ITERMAX
ZESTD(:) = PHU(:) * SM_FOES(ZT(:)) * 0.01
@@ -512,22 +521,23 @@ DO ITER=1,ITERMAX
END DO
!-------------------------------------------------------------------------------
!
-!* 2. NO CONVERGENCE
+!* 2. NO CONVERGENCE
! --------------
!
IF (ANY(ZDT>ZEPS)) THEN
ILUOUT = TLUOUT%NLU
WRITE(ILUOUT,*) 'ERROR IN FUNCTION SM_PMR_HU (module MODE_THERMO)'
- WRITE(ILUOUT,*) 'FUNCTION FAILS TO CONVERGE AFTER ', ITER,' ITERATIONS'
+ WRITE(ILUOUT,*) 'FUNCTION FAILS TO CONVERGE AFTER ', ITERMAX,' ITERATIONS'
WRITE(ILUOUT,*) 'EPS = ' , ZEPS
IMAXLOC = MAXLOC(ZDT)
- WRITE(ILUOUT,*) 'MAXIMUM RESIDUAL DT :', MAXVAL(ZDT)
+ WRITE(ILUOUT,*) 'MAXIMUM RESIDUAL DT :', MAXVAL(ZDT)
WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC)
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC)
WRITE(ILUOUT,*) 'JOB ABORTED '
- call Print_msg( NVERB_FATAL, 'GEN', 'SM_PMR_HU_1D', 'failed to converge' )
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SM_PMR_HU_1D', 'failed to converge' )
END IF
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_1D',1,ZHOOK_HANDLE)
END FUNCTION SM_PMR_HU_1D
! ####################################
FUNCTION SM_FOES_0D(PT) RESULT(PFOES)
@@ -538,23 +548,23 @@ END FUNCTION SM_PMR_HU_1D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
-!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! EXTERNAL
!! --------
@@ -565,27 +575,27 @@ END FUNCTION SM_PMR_HU_1D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 28/08/94
+!! Original 28/08/94
!! 24/12/97 (V. Masson) version for 0D arrays
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -594,9 +604,9 @@ IMPLICIT NONE
!
REAL, INTENT(IN) :: PT ! Temperature
! (Kelvin)
-REAL :: PFOES ! saturation vapor
+REAL :: PFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!* 0.2 Declarations of local variables
!
@@ -605,9 +615,12 @@ REAL :: PFOES ! saturation vapor
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_0D',0,ZHOOK_HANDLE)
PFOES = EXP( XALPW - XBETAW/PT - XGAMW*LOG(PT) )
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_0D',1,ZHOOK_HANDLE)
END FUNCTION SM_FOES_0D
!
!-------------------------------------------------------------------------------
@@ -620,23 +633,23 @@ END FUNCTION SM_FOES_0D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
-!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! EXTERNAL
!! --------
@@ -647,27 +660,27 @@ END FUNCTION SM_FOES_0D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 28/08/94
+!! Original 28/08/94
!! 24/12/97 (V. Masson) version for 2D arrays
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -676,9 +689,9 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!* 0.2 Declarations of local variables
!
@@ -687,9 +700,12 @@ REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PFOES ! saturation vapor
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_2D',0,ZHOOK_HANDLE)
PFOES(:,:) = EXP( XALPW - XBETAW/PT(:,:) - XGAMW*LOG(PT(:,:)) )
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_2D',1,ZHOOK_HANDLE)
END FUNCTION SM_FOES_2D
!
!-------------------------------------------------------------------------------
@@ -703,23 +719,23 @@ END FUNCTION SM_FOES_2D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
-!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! EXTERNAL
!! --------
@@ -730,27 +746,27 @@ END FUNCTION SM_FOES_2D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 28/08/94
+!! Original 28/08/94
!! 24/12/97 (V. Masson) version for 2D arrays
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -760,9 +776,9 @@ IMPLICIT NONE
LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK ! Localization mask
REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!* 0.2 Declarations of local variables
!
@@ -771,11 +787,14 @@ REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PFOES ! saturation vapor
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_2D_MASK',0,ZHOOK_HANDLE)
WHERE (OMASK(:,:))
PFOES(:,:) = EXP( XALPW - XBETAW/PT(:,:) - XGAMW*LOG(PT(:,:)) )
END WHERE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_2D_MASK',1,ZHOOK_HANDLE)
END FUNCTION SM_FOES_2D_MASK
!
!-------------------------------------------------------------------------------
@@ -789,26 +808,26 @@ END FUNCTION SM_FOES_2D_MASK
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -819,27 +838,27 @@ END FUNCTION SM_FOES_2D_MASK
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -850,22 +869,24 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PQSAT ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_3D',0,ZHOOK_HANDLE)
ZFOES(:,:,:) = MIN(EXP( XALPW - XBETAW/PT(:,:,:) - XGAMW*LOG(PT(:,:,:)) ), 0.99*PP(:,:,:))
!
!* 2. COMPUTE SATURATION HUMIDITY
@@ -875,6 +896,7 @@ PQSAT(:,:,:) = XRD/XRV*ZFOES(:,:,:)/PP(:,:,:) &
/ (1.+(XRD/XRV-1.)*ZFOES(:,:,:)/PP(:,:,:))
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_3D',1,ZHOOK_HANDLE)
END FUNCTION QSATW_3D
!
!-------------------------------------------------------------------------------
@@ -888,26 +910,26 @@ END FUNCTION QSATW_3D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -918,27 +940,27 @@ END FUNCTION QSATW_3D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -949,22 +971,24 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_2D',0,ZHOOK_HANDLE)
ZFOES(:,:) = MIN(EXP( XALPW - XBETAW/PT(:,:) - XGAMW*LOG(PT(:,:)) ), 0.99*PP(:,:))
!
!* 2. COMPUTE SATURATION HUMIDITY
@@ -974,6 +998,7 @@ PQSAT(:,:) = XRD/XRV*ZFOES(:,:)/PP(:,:) &
/ (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:))
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_2D',1,ZHOOK_HANDLE)
END FUNCTION QSATW_2D
!
!-------------------------------------------------------------------------------
@@ -987,26 +1012,26 @@ END FUNCTION QSATW_2D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -1017,27 +1042,27 @@ END FUNCTION QSATW_2D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -1049,19 +1074,21 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_2D_MASK',0,ZHOOK_HANDLE)
WHERE (OMASK(:,:))
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
@@ -1083,6 +1110,7 @@ ELSEWHERE
END WHERE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_2D_MASK',1,ZHOOK_HANDLE)
END FUNCTION QSATW_2D_MASK
!
!-------------------------------------------------------------------------------
@@ -1096,26 +1124,26 @@ END FUNCTION QSATW_2D_MASK
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -1126,27 +1154,27 @@ END FUNCTION QSATW_2D_MASK
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -1157,22 +1185,24 @@ REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(SIZE(PT,1)) :: PQSAT ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1)) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_1D',0,ZHOOK_HANDLE)
ZFOES(:) = MIN(EXP( XALPW - XBETAW/PT(:) - XGAMW*LOG(PT(:)) ), 0.99*PP(:))
!
!* 2. COMPUTE SATURATION HUMIDITY
@@ -1182,6 +1212,7 @@ PQSAT(:) = XRD/XRV*ZFOES(:)/PP(:) &
/ (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:))
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_1D',1,ZHOOK_HANDLE)
END FUNCTION QSATW_1D
!
!-------------------------------------------------------------------------------
@@ -1195,26 +1226,26 @@ END FUNCTION QSATW_1D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -1225,27 +1256,27 @@ END FUNCTION QSATW_1D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -1256,22 +1287,24 @@ REAL, INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL :: PQSAT ! saturation vapor
+REAL :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL :: ZFOES ! saturation vapor
+REAL :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_0D',0,ZHOOK_HANDLE)
ZFOES = MIN(EXP( XALPW - XBETAW/PT - XGAMW*LOG(PT) ), 0.99*PP)
!
!* 2. COMPUTE SATURATION HUMIDITY
@@ -1280,6 +1313,7 @@ ZFOES = MIN(EXP( XALPW - XBETAW/PT - XGAMW*LOG(PT) ), 0.99*PP)
PQSAT = XRD/XRV*ZFOES/PP / (1.+(XRD/XRV-1.)*ZFOES/PP)
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_0D',1,ZHOOK_HANDLE)
END FUNCTION QSATW_0D
!
!-------------------------------------------------------------------------------
@@ -1293,28 +1327,28 @@ END FUNCTION QSATW_0D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
!!
!! Finally, dqsat / dT (T) is computed.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -1325,26 +1359,26 @@ END FUNCTION QSATW_0D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -1356,25 +1390,27 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(:,:), INTENT(IN) :: PQSAT ! saturation vapor
+REAL, DIMENSION(:,:), INTENT(IN) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg))
REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PDQSAT ! derivative according
! to temperature of
- ! saturation vapor
+ ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg))
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATW_O_DT_2D_MASK',0,ZHOOK_HANDLE)
WHERE (OMASK(:,:))
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
@@ -1396,6 +1432,7 @@ ELSEWHERE
END WHERE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATW_O_DT_2D_MASK',1,ZHOOK_HANDLE)
END FUNCTION DQSATW_O_DT_2D_MASK
!
!-------------------------------------------------------------------------------
@@ -1408,28 +1445,28 @@ END FUNCTION DQSATW_O_DT_2D_MASK
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
!!
!! Finally, dqsat / dT (T) is computed.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -1440,26 +1477,26 @@ END FUNCTION DQSATW_O_DT_2D_MASK
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -1470,11 +1507,11 @@ REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(:), INTENT(IN) :: PQSAT ! saturation vapor
+REAL, DIMENSION(:), INTENT(IN) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg))
-REAL, DIMENSION(SIZE(PT)) :: PDQSAT ! derivative according
+REAL, DIMENSION(SIZE(PT)) :: PDQSAT ! derivative according
! to temperature of
! saturation vapor
! specific humidity
@@ -1483,7 +1520,7 @@ REAL, DIMENSION(SIZE(PT)) :: PDQSAT ! derivative according
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT)) :: ZFOES ! saturation vapor
! pressure
! (Pascal)
!
@@ -1493,6 +1530,8 @@ REAL, DIMENSION(SIZE(PT)) :: ZFOES ! saturation vapor
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATW_O_DT_1D',0,ZHOOK_HANDLE)
ZFOES(:) = PP(:) / (1.+XRD/XRV*(1./PQSAT(:)-1.))
!
!* 2. DERIVATION ACCORDING TO TEMPERATURE
@@ -1503,6 +1542,7 @@ PDQSAT(:) = PQSAT(:) / (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:) ) &
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATW_O_DT_1D',1,ZHOOK_HANDLE)
END FUNCTION DQSATW_O_DT_1D
!
!-------------------------------------------------------------------------------
@@ -1556,7 +1596,7 @@ END FUNCTION DQSATW_O_DT_1D
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
@@ -1583,7 +1623,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PQSAT ! saturation vapor
! water (kg/kg))
REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PDQSAT ! derivative according
! to temperature of
- ! saturation vapor
+ ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg))
@@ -1592,7 +1632,7 @@ REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PDQSAT ! derivative ac
!
REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
@@ -1624,28 +1664,28 @@ END FUNCTION DQSATW_O_DT_3D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
!!
!! Finally, dqsat / dT (T) is computed.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -1656,26 +1696,26 @@ END FUNCTION DQSATW_O_DT_3D
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -1687,25 +1727,27 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(:,:), INTENT(IN) :: PQSAT ! saturation vapor
+REAL, DIMENSION(:,:), INTENT(IN) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg))
REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PDQSAT ! derivative according
! to temperature of
- ! saturation vapor
+ ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg))
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATI_O_DT_2D_MASK',0,ZHOOK_HANDLE)
WHERE (OMASK(:,:))
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
@@ -1727,6 +1769,7 @@ ELSEWHERE
END WHERE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATI_O_DT_2D_MASK',1,ZHOOK_HANDLE)
END FUNCTION DQSATI_O_DT_2D_MASK
!
!-------------------------------------------------------------------------------
@@ -1740,28 +1783,28 @@ END FUNCTION DQSATI_O_DT_2D_MASK
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMW) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
!!
!! Finally, dqsat / dT (T) is computed.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -1772,26 +1815,26 @@ END FUNCTION DQSATI_O_DT_2D_MASK
!! Module MODD_CST : comtains physical constants
!! XALPW : Constant for saturation vapor pressure function
!! XBETAW : Constant for saturation vapor pressure function
-!! XGAMW : Constant for saturation vapor pressure function
-!!
+!! XGAMW : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -1802,22 +1845,22 @@ REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(:), INTENT(IN) :: PQSAT ! saturation vapor
+REAL, DIMENSION(:), INTENT(IN) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg))
REAL, DIMENSION(SIZE(PT)) :: PDQSAT ! derivative according
! to temperature of
- ! saturation vapor
+ ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg))
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
@@ -1825,6 +1868,8 @@ REAL, DIMENSION(SIZE(PT)) :: ZFOES ! saturation vapor
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATI_O_DT_1D',0,ZHOOK_HANDLE)
ZFOES(:) = PP(:) / (1.+XRD/XRV*(1./PQSAT(:)-1.))
!
!* 3. DERIVATION ACCORDING TO TEMPERATURE
@@ -1835,6 +1880,7 @@ PDQSAT(:) = PQSAT(:) / (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:) ) &
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATI_O_DT_1D',1,ZHOOK_HANDLE)
END FUNCTION DQSATI_O_DT_1D
!
!-------------------------------------------------------------------------------
@@ -1889,7 +1935,7 @@ END FUNCTION DQSATI_O_DT_1D
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
@@ -1957,26 +2003,26 @@ END FUNCTION DQSATI_O_DT_3D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMI) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -1987,27 +2033,27 @@ END FUNCTION DQSATI_O_DT_3D
!! Module MODD_CST : comtains physical constants
!! XALPI : Constant for saturation vapor pressure function
!! XBETAI : Constant for saturation vapor pressure function
-!! XGAMI : Constant for saturation vapor pressure function
-!!
+!! XGAMI : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -2018,22 +2064,24 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PQSAT ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_3D',0,ZHOOK_HANDLE)
ZFOES(:,:,:) = MIN(EXP( XALPI - XBETAI/PT(:,:,:) - XGAMI*LOG(PT(:,:,:)) ), 0.99*PP(:,:,:))
!
!* 2. COMPUTE SATURATION HUMIDITY
@@ -2043,6 +2091,7 @@ PQSAT(:,:,:) = XRD/XRV*ZFOES(:,:,:)/PP(:,:,:) &
/ (1.+(XRD/XRV-1.)*ZFOES(:,:,:)/PP(:,:,:))
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_3D',1,ZHOOK_HANDLE)
END FUNCTION QSATI_3D
!
!-------------------------------------------------------------------------------
@@ -2056,26 +2105,26 @@ END FUNCTION QSATI_3D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMI) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -2086,27 +2135,27 @@ END FUNCTION QSATI_3D
!! Module MODD_CST : comtains physical constants
!! XALPI : Constant for saturation vapor pressure function
!! XBETAI : Constant for saturation vapor pressure function
-!! XGAMI : Constant for saturation vapor pressure function
-!!
+!! XGAMI : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -2117,22 +2166,24 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_2D',0,ZHOOK_HANDLE)
ZFOES(:,:) = MIN(EXP( XALPI - XBETAI/PT(:,:) - XGAMI*LOG(PT(:,:)) ), 0.99*PP(:,:))
!
!* 2. COMPUTE SATURATION HUMIDITY
@@ -2142,6 +2193,7 @@ PQSAT(:,:) = XRD/XRV*ZFOES(:,:)/PP(:,:) &
/ (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:))
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_2D',1,ZHOOK_HANDLE)
END FUNCTION QSATI_2D
!
!-------------------------------------------------------------------------------
@@ -2155,26 +2207,26 @@ END FUNCTION QSATI_2D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMI) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -2185,27 +2237,27 @@ END FUNCTION QSATI_2D
!! Module MODD_CST : comtains physical constants
!! XALPI : Constant for saturation vapor pressure function
!! XBETAI : Constant for saturation vapor pressure function
-!! XGAMI : Constant for saturation vapor pressure function
-!!
+!! XGAMI : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -2217,19 +2269,21 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_2D_MASK',0,ZHOOK_HANDLE)
WHERE (OMASK(:,:))
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
@@ -2251,6 +2305,7 @@ ELSEWHERE
END WHERE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_2D_MASK',1,ZHOOK_HANDLE)
END FUNCTION QSATI_2D_MASK
!
!-------------------------------------------------------------------------------
@@ -2264,26 +2319,26 @@ END FUNCTION QSATI_2D_MASK
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMI) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -2294,27 +2349,27 @@ END FUNCTION QSATI_2D_MASK
!! Module MODD_CST : comtains physical constants
!! XALPI : Constant for saturation vapor pressure function
!! XBETAI : Constant for saturation vapor pressure function
-!! XGAMI : Constant for saturation vapor pressure function
-!!
+!! XGAMI : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -2325,22 +2380,24 @@ REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL, DIMENSION(SIZE(PT,1)) :: PQSAT ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1)) :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PT,1)) :: ZFOES ! saturation vapor
+REAL, DIMENSION(SIZE(PT,1)) :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_1D',0,ZHOOK_HANDLE)
ZFOES(:) = MIN(EXP( XALPI - XBETAI/PT(:) - XGAMI*LOG(PT(:)) ), 0.99*PP(:))
!
!* 2. COMPUTE SATURATION HUMIDITY
@@ -2350,6 +2407,7 @@ PQSAT(:) = XRD/XRV*ZFOES(:)/PP(:) &
/ (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:))
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_1D',1,ZHOOK_HANDLE)
END FUNCTION QSATI_1D
!
!-------------------------------------------------------------------------------
@@ -2363,26 +2421,26 @@ END FUNCTION QSATI_1D
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute the saturation vapor
-! pressure from temperature
-!
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
!
!!** METHOD
!! ------
!! Given temperature T (PT), the saturation vapor pressure es(T)
!! (FOES(PT)) is computed by integration of the Clapeyron equation
-!! from the triple point temperature Tt (XTT) and the saturation vapor
-!! pressure of the triple point es(Tt) (XESTT), i.e
-!!
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
-!!
+!!
!! with :
-!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
!! gammaw (XGAMI) = (Cl -Cpv) /Rv
!!
!! Then, the specific humidity at saturation is deduced.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -2393,27 +2451,27 @@ END FUNCTION QSATI_1D
!! Module MODD_CST : comtains physical constants
!! XALPI : Constant for saturation vapor pressure function
!! XBETAI : Constant for saturation vapor pressure function
-!! XGAMI : Constant for saturation vapor pressure function
-!!
+!! XGAMI : Constant for saturation vapor pressure function
+!!
!! REFERENCE
!! ---------
-!! Book2 of documentation of Meso-NH
+!! Book2 of documentation of Meso-NH
!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 21/09/98
+!! Original 21/09/98
!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_CST
!
IMPLICIT NONE
!
@@ -2424,22 +2482,24 @@ REAL, INTENT(IN) :: PT ! Temperature
! (Kelvin)
REAL, INTENT(IN) :: PP ! Pressure
! (Pa)
-REAL :: PQSAT ! saturation vapor
+REAL :: PQSAT ! saturation vapor
! specific humidity
! with respect to
! water (kg/kg)
!
!* 0.2 Declarations of local variables
!
-REAL :: ZFOES ! saturation vapor
+REAL :: ZFOES ! saturation vapor
! pressure
- ! (Pascal)
+ ! (Pascal)
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE SATURATION VAPOR PRESSURE
! ---------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_0D',0,ZHOOK_HANDLE)
ZFOES = MIN(EXP( XALPI - XBETAI/PT - XGAMI*LOG(PT) ), 0.99*PP)
!
!* 2. COMPUTE SATURATION HUMIDITY
@@ -2448,6 +2508,7 @@ ZFOES = MIN(EXP( XALPI - XBETAI/PT - XGAMI*LOG(PT) ), 0.99*PP)
PQSAT = XRD/XRV*ZFOES/PP / (1.+(XRD/XRV-1.)*ZFOES/PP)
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_0D',1,ZHOOK_HANDLE)
END FUNCTION QSATI_0D
!
!-------------------------------------------------------------------------------
diff --git a/src/PHYEX/aux/mode_tools_ll.f90 b/src/PHYEX/aux/mode_tools_ll.f90
index 6736a75bd4ce68d5d2d8060d0f123ac49991c54c..a617c26fbbcb83687687c02881242b89ac2c2411 100644
--- a/src/PHYEX/aux/mode_tools_ll.f90
+++ b/src/PHYEX/aux/mode_tools_ll.f90
@@ -658,7 +658,7 @@ CONTAINS
END SUBROUTINE GET_OR_ll
!
! ####################################################
- SUBROUTINE GET_INDICE_ll( KXOR, KYOR, KXEND, KYEND )
+ SUBROUTINE GET_INDICE_ll( KXOR, KYOR, KXEND, KYEND, KSIZE1, KSIZE2 )
! ####################################################
!
!!**** *GET_INDICE_ll* - returns the origin's coordinates and the end's
@@ -709,6 +709,7 @@ CONTAINS
!* 0.1 declarations of arguments
!
INTEGER, INTENT(OUT) :: KXOR, KYOR, KXEND, KYEND
+ INTEGER, INTENT(IN),OPTIONAL :: KSIZE1, KSIZE2
!
!* 0.2 declarations of local variables
!
diff --git a/src/PHYEX/aux/modi_gamma.f90 b/src/PHYEX/aux/modi_gamma.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4f10dab67e1a8d1d68ade60fa71f6f5cb19f9767
--- /dev/null
+++ b/src/PHYEX/aux/modi_gamma.f90
@@ -0,0 +1,23 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!########################
+ MODULE MODI_GAMMA
+! #################
+!
+INTERFACE GAMMA
+!
+FUNCTION GAMMA_X0D(PX) RESULT(PGAMMA)
+REAL, INTENT(IN) :: PX
+REAL :: PGAMMA
+END FUNCTION GAMMA_X0D
+!
+FUNCTION GAMMA_X1D(PX) RESULT(PGAMMA)
+REAL, DIMENSION(:), INTENT(IN) :: PX
+REAL, DIMENSION(SIZE(PX)) :: PGAMMA
+END FUNCTION GAMMA_X1D
+!
+END INTERFACE GAMMA
+!
+END MODULE MODI_GAMMA
diff --git a/src/PHYEX/aux/modi_gamma_inc.f90 b/src/PHYEX/aux/modi_gamma_inc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2b54c25acdd9fa4d45c450acf758e1bce0f0f0aa
--- /dev/null
+++ b/src/PHYEX/aux/modi_gamma_inc.f90
@@ -0,0 +1,19 @@
+!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!####################
+MODULE MODI_GAMMA_INC
+!####################
+!
+INTERFACE
+!
+FUNCTION GAMMA_INC(PA,PX) RESULT(PGAMMA_INC)
+REAL, INTENT(IN) :: PA
+REAL, INTENT(IN) :: PX
+REAL :: PGAMMA_INC
+END FUNCTION GAMMA_INC
+!
+END INTERFACE
+!
+END MODULE MODI_GAMMA_INC
diff --git a/src/PHYEX/aux/modi_general_gamma.f90 b/src/PHYEX/aux/modi_general_gamma.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7868333a612a9b5866f88c6d856d071ae1eb1773
--- /dev/null
+++ b/src/PHYEX/aux/modi_general_gamma.f90
@@ -0,0 +1,21 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!########################
+MODULE MODI_GENERAL_GAMMA
+!########################
+!
+INTERFACE
+!
+FUNCTION GENERAL_GAMMA(PALPHA,PNU,PLBDA,PX) RESULT(PGENERAL_GAMMA)
+REAL, INTENT(IN) :: PALPHA
+REAL, INTENT(IN) :: PNU
+REAL, INTENT(IN) :: PLBDA
+REAL, INTENT(IN) :: PX
+REAL :: PGENERAL_GAMMA
+END FUNCTION GENERAL_GAMMA
+!
+END INTERFACE
+!
+END MODULE MODI_GENERAL_GAMMA
diff --git a/src/PHYEX/aux/modi_gradient_u.f90 b/src/PHYEX/aux/modi_gradient_u.f90
new file mode 100644
index 0000000000000000000000000000000000000000..14de7c2623bc70f52b55b78f400e6a07e190f312
--- /dev/null
+++ b/src/PHYEX/aux/modi_gradient_u.f90
@@ -0,0 +1,53 @@
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_GRADIENT_U
+! ######################
+!
+INTERFACE
+!
+!
+FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
+!
+END FUNCTION GX_U_M
+!
+!
+FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_U_UV)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
+!
+END FUNCTION GY_U_UV
+!
+!
+FUNCTION GZ_U_UW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_U_UW)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_U_UW ! result UW point
+!
+END FUNCTION GZ_U_UW
+!
+END INTERFACE
+!
+END MODULE MODI_GRADIENT_U
diff --git a/src/PHYEX/aux/modi_gradient_v.f90 b/src/PHYEX/aux/modi_gradient_v.f90
new file mode 100644
index 0000000000000000000000000000000000000000..406ff5450e3b23da921a0bf128899818bb6fc3d4
--- /dev/null
+++ b/src/PHYEX/aux/modi_gradient_v.f90
@@ -0,0 +1,54 @@
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_GRADIENT_V
+! ######################
+!
+INTERFACE
+!
+!
+FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_V_M ! result mass point
+!
+END FUNCTION GY_V_M
+!
+FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_V_UV)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_V_UV ! result UV point
+!
+END FUNCTION GX_V_UV
+!
+!
+FUNCTION GZ_V_VW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_V_VW)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_V_VW ! result VW point
+!
+END FUNCTION GZ_V_VW
+!
+!
+END INTERFACE
+!
+END MODULE MODI_GRADIENT_V
diff --git a/src/PHYEX/aux/modi_gradient_w.f90 b/src/PHYEX/aux/modi_gradient_w.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a277d269440d717c9eca7a8971c24627fbfc016a
--- /dev/null
+++ b/src/PHYEX/aux/modi_gradient_w.f90
@@ -0,0 +1,54 @@
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_GRADIENT_W
+! ######################
+!
+INTERFACE
+!
+!
+FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
+!
+END FUNCTION GZ_W_M
+!
+FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_W_UW)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_W_UW ! result UW point
+!
+END FUNCTION GX_W_UW
+!
+!
+FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_W_VW)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_W_VW ! result VW point
+!
+END FUNCTION GY_W_VW
+!
+!
+END INTERFACE
+!
+END MODULE MODI_GRADIENT_W
diff --git a/src/PHYEX/aux/modi_ini_cst.f90 b/src/PHYEX/aux/modi_ini_cst.f90
new file mode 100644
index 0000000000000000000000000000000000000000..08f587f77df0ce8b2b6db1b487af365ea20cf9d5
--- /dev/null
+++ b/src/PHYEX/aux/modi_ini_cst.f90
@@ -0,0 +1,12 @@
+! ######spl
+ MODULE MODI_INI_CST
+! ###################
+!
+INTERFACE
+!
+SUBROUTINE INI_CST
+END SUBROUTINE INI_CST
+!
+END INTERFACE
+!
+END MODULE MODI_INI_CST
diff --git a/src/PHYEX/aux/shuman.f90 b/src/PHYEX/aux/shuman.f90
index a0f0e3a59792a6463c05963b11ccf73615cafffe..f0a1e3f12f08d5f1132de0e102030230bd0f1c61 100644
--- a/src/PHYEX/aux/shuman.f90
+++ b/src/PHYEX/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)
@@ -79,16 +83,20 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass l
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYM ! result at flux localization
END FUNCTION MYM
!
-FUNCTION MZF(PA) RESULT(PMZF)
+FUNCTION MZF(PA,KKA,KKU,KL) RESULT(PMZF)
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
+ ! 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 MZF
!
-FUNCTION MZM(PA) RESULT(PMZM)
+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 (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
END FUNCTION MZM
!
END INTERFACE
@@ -497,7 +505,7 @@ END DO
!
END FUNCTION MYM
! ###############################
- FUNCTION MZF(PA) RESULT(PMZF)
+ FUNCTION MZF(PA,KKA,KKU,KL) RESULT(PMZF)
! ###############################
!
!!**** *MZF* - Shuman operator : mean operator in z direction for a
@@ -551,6 +559,8 @@ 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)
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -591,7 +601,7 @@ END DO
!
END FUNCTION MZF
! ###############################
- FUNCTION MZM(PA) RESULT(PMZM)
+ FUNCTION MZM(PA,KKA,KKU,KL) RESULT(PMZM)
! ###############################
!
!!**** *MZM* - Shuman operator : mean operator in z direction for a
@@ -643,6 +653,8 @@ IMPLICIT NONE
!
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)
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -1086,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
@@ -1140,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
! -------------------------------
@@ -1180,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
@@ -1234,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/PHYEX/aux/shuman_phy.f90 b/src/PHYEX/aux/shuman_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..98ab1fd072d37acd923bc6c7a417c848c9934999
--- /dev/null
+++ b/src/PHYEX/aux/shuman_phy.f90
@@ -0,0 +1,1608 @@
+MODULE SHUMAN_PHY
+IMPLICIT NONE
+CONTAINS
+! ###############################
+ SUBROUTINE MXM_PHY(D,PA,PMXM)
+! ###############################
+!
+!!**** *MXM* - Shuman operator : mean operator in x direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the x direction (I index) for a field PA localized at a mass
+! point. The result is localized at a x-flux point (u point).
+!
+!!** METHOD
+!! ------
+!! The result PMXM(i,:,:) is defined by 0.5*(PA(i,:,:)+PA(i-1,:,:))
+!! At i=1, PMXM(1,:,:) are replaced by the values of PMXM,
+!! which are the right values in the x-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PMXM ! result at flux localization
+
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI,JJ,JK ! Loop index in x direction
+INTEGER :: IIU ! Size of the array in the x direction
+!
+INTEGER :: JJK,IJU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MXM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMXM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-1,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJK=1,IJU*IKU
+ PMXM(JI,JJK,1) = PMXM(IIU-2*JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+END SUBROUTINE MXM_PHY
+!-------------------------------------------------------------------------------
+!
+! ###############################
+ SUBROUTINE MXM2D_PHY(D,PA,PMXM)
+! ###############################
+!
+!!**** *MXM* - Shuman operator : mean operator in x direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the x direction (I index) for a field PA localized at a mass
+! point. The result is localized at a x-flux point (u point).
+!
+!!** METHOD
+!! ------
+!! The result PMXM(i,:,:) is defined by 0.5*(PA(i,:,:)+PA(i-1,:,:))
+!! At i=1, PMXM(1,:,:) are replaced by the values of PMXM,
+!! which are the right values in the x-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PMXM ! result at flux localization
+
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI,JJ ! Loop index in x direction
+INTEGER :: IIU ! Size of the array in the x direction
+!
+INTEGER :: JJK,IJU
+INTEGER :: JIJ,JIJOR,JIJEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MXM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+!
+JIJOR = 1 + 1
+JIJEND = IIU*IJU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=JIJOR , JIJEND
+ PMXM(JIJ,1) = 0.5*( PA(JIJ,1)+PA(JIJ-1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJ=1,IJU
+ PMXM(JI,JJ) = PMXM(IIU-2*JPHEXT+JI,JJ) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MXM2D_PHY
+!
+! ###############################
+ SUBROUTINE MZM_PHY(D,PA,PMZM)
+! ###############################
+!
+!!**** *MZM* - Shuman operator : mean operator in z direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the z direction (K index) for a field PA localized at a mass
+! point. The result is localized at a z-flux point (w point).
+!
+!!** METHOD
+!! ------
+!! The result PMZM(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k-1))
+!! At k=1, PMZM(:,:,1) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PMZM ! result at flux localization
+
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: IKU ! upper bound in z direction of PA
+!
+INTEGER :: IIU,IJU
+INTEGER :: JIJ,JI,JJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MZM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMZM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-IIU*IJU,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PMZM(JIJ,1,1) = -999.
+END DO
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MZM_PHY
+! ###############################
+ SUBROUTINE MYM2D_PHY(D,PA,PMYM)
+! ###############################
+!
+!!**** *MYM* - Shuman operator : mean operator in y direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the y direction (J index) for a field PA localized at a mass
+! point. The result is localized at a y-flux point (v point).
+!
+!!** METHOD
+!! ------
+!! The result PMYM(:,j,:) is defined by 0.5*(PA(:,j,:)+PA(:,j-1,:))
+!! At j=1, PMYM(:,j,:) are replaced by the values of PMYM,
+!! which are the right values in the y-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PMYM ! result at flux localization
+
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! Size of the array in the y direction
+!
+!
+INTEGER :: IIU
+INTEGER :: JIJ,JIJOR,JIJEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MYM
+! ------------------
+!
+IIU=SIZE(PA,1)
+IJU=SIZE(PA,2)
+!
+JIJOR = 1 + IIU
+JIJEND = IIU*IJU
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=JIJOR , JIJEND
+ PMYM(JIJ,1) = 0.5*( PA(JIJ,1)+PA(JIJ-IIU,1) )
+END DO
+!
+DO JJ=1,JPHEXT
+ PMYM(:,JJ) = PMYM(:,IJU-2*JPHEXT+JJ) ! for reprod JPHEXT <> 1
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MYM2D_PHY
+! ###############################
+ SUBROUTINE MYM_PHY(D,PA,PMYM)
+! ###############################
+!
+!!**** *MYM* - Shuman operator : mean operator in y direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the y direction (J index) for a field PA localized at a mass
+! point. The result is localized at a y-flux point (v point).
+!
+!!** METHOD
+!! ------
+!! The result PMYM(:,j,:) is defined by 0.5*(PA(:,j,:)+PA(:,j-1,:))
+!! At j=1, PMYM(:,j,:) are replaced by the values of PMYM,
+!! which are the right values in the y-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PMYM ! result at flux localization
+
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! Size of the array in the y direction
+!
+!
+INTEGER :: IIU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MYM
+! ------------------
+!
+IIU=SIZE(PA,1)
+IJU=SIZE(PA,2)
+IKU=SIZE(PA,3)
+!
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMYM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-IIU,1,1) )
+END DO
+!
+DO JJ=1,JPHEXT
+ PMYM(:,JJ,:) = PMYM(:,IJU-2*JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MYM_PHY
+! ###############################
+ SUBROUTINE DZM_PHY(D,PA,PDZM)
+! ###############################
+!
+!!**** *DZM* - Shuman operator : finite difference operator in z direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the z direction (K index) for a field PA localized at a mass
+! point. The result is localized at a z-flux point (w point).
+!
+!!** METHOD
+!! ------
+!! The result PDZM(:,j,:) is defined by (PA(:,:,k)-PA(:,:,k-1))
+!! At k=1, PDZM(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: PDZM ! result at flux
+ ! side
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: IKU ! upper bound in z direction of PA
+!
+!
+INTEGER :: IIU,IJU
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DZM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDZM(JIJK,1,1) = PA(JIJK,1,1)-PA(JIJK-IIU*IJU,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PDZM(JIJ,1,1) = -999.
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DZM_PHY
+! ###############################
+ SUBROUTINE MZF_PHY(D,PA,PMZF)
+! ###############################
+!
+!!**** *MZF* - Shuman operator : mean operator in z direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the z direction (K index) for a field PA localized at a z-flux
+! point (w point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMZF(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k+1))
+!! At k=size(PA,3), PMZF(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at flux localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PMZF ! result at mass localization
+
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: IKU ! upper bound in z direction of PA
+!
+INTEGER :: IIU,IJU
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MZF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMZF(JIJK-IIU*IJU,1,1) = 0.5*( PA(JIJK-IIU*IJU,1,1)+PA(JIJK,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PMZF(JIJ,1,IKU) = PMZF(JIJ,1,IKU-1) !-999.
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MZF_PHY
+! ###############################
+ SUBROUTINE MXF_PHY(D,PA,PMXF)
+! ###############################
+!
+!!**** *MXF* - Shuman operator : mean operator in x direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the x direction (I index) for a field PA localized at a x-flux
+! point (u point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMXF(i,:,:) is defined by 0.5*(PA(i,:,:)+PA(i+1,:,:))
+!! At i=size(PA,1), PMXF(i,:,:) are replaced by the values of PMXF,
+!! which are the right values in the x-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at flux localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PMXF ! result at mass localization
+
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! Loop index in x direction
+INTEGER :: IIU ! upper bound in x direction of PA
+!
+INTEGER :: JJK,IJU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MXF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMXF(JIJK-1,1,1) = 0.5*( PA(JIJK-1,1,1)+PA(JIJK,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJK=1,IJU*IKU
+ PMXF(IIU-JPHEXT+JI,JJK,1) = PMXF(JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MXF_PHY
+!
+! ###############################
+ SUBROUTINE MXF2D_PHY(D,PA,PMXF)
+! ###############################
+!
+!!**** *MXF* - Shuman operator : mean operator in x direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the x direction (I index) for a field PA localized at a x-flux
+! point (u point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMXF(i,:,:) is defined by 0.5*(PA(i,:,:)+PA(i+1,:,:))
+!! At i=size(PA,1), PMXF(i,:,:) are replaced by the values of PMXF,
+!! which are the right values in the x-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PA ! variable at flux localization
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PMXF ! result at mass localization
+
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! Loop index in x direction
+INTEGER :: IIU ! upper bound in x direction of PA
+!
+INTEGER :: JJ,IJU
+INTEGER :: JIJ,JIJOR,JIJEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MXF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+!
+JIJOR = 1 + 1
+JIJEND = IIU*IJU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=JIJOR , JIJEND
+ PMXF(JIJ-1,1) = 0.5*( PA(JIJ-1,1)+PA(JIJ,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJ=1,IJU
+ PMXF(IIU-JPHEXT+JI,JJ) = PMXF(JPHEXT+JI,JJ) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MXF2D_PHY
+! ###############################
+ SUBROUTINE MYF_PHY(D,PA,PMYF)
+! ###############################
+!
+!!**** *MYF* - Shuman operator : mean operator in y direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the y direction (J index) for a field PA localized at a y-flux
+! point (v point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMYF(i,:,:) is defined by 0.5*(PA(:,j,:)+PA(:,j+1,:))
+!! At j=size(PA,2), PMYF(:,j,:) are replaced by the values of PMYF,
+!! which are the right values in the y-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at flux localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PMYF ! result at mass localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! upper bound in y direction of PA
+!
+INTEGER :: IIU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MYF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMYF(JIJK-IIU,1,1) = 0.5*( PA(JIJK-IIU,1,1)+PA(JIJK,1,1) )
+END DO
+!
+DO JJ=1,JPHEXT
+ PMYF(:,IJU-JPHEXT+JJ,:) = PMYF(:,JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MYF_PHY
+!
+! ###############################
+ SUBROUTINE MYF2D_PHY(D,PA,PMYF)
+! ###############################
+!
+!!**** *MYF* - Shuman operator : mean operator in y direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the y direction (J index) for a field PA localized at a y-flux
+! point (v point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMYF(i,:,:) is defined by 0.5*(PA(:,j,:)+PA(:,j+1,:))
+!! At j=size(PA,2), PMYF(:,j,:) are replaced by the values of PMYF,
+!! which are the right values in the y-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PA ! variable at flux localization
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PMYF ! result at mass localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! upper bound in y direction of PA
+!
+INTEGER :: IIU
+INTEGER :: JIJ,JIJOR,JIJEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MYF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+!
+JIJOR = 1 + IIU
+JIJEND = IIU*IJU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=JIJOR , JIJEND
+ PMYF(JIJ-IIU,1) = 0.5*( PA(JIJ-IIU,1)+PA(JIJ,1) )
+END DO
+!
+DO JJ=1,JPHEXT
+ PMYF(:,IJU-JPHEXT+JJ) = PMYF(:,JPHEXT+JJ) ! for reprod JPHEXT <> 1
+END DO
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MYF2D_PHY
+! ###############################
+ SUBROUTINE DZF_PHY(D,PA,PDZF)
+! ###############################
+!
+!!**** *DZF* - Shuman operator : finite difference operator in z direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the z direction (K index) for a field PA localized at a z-flux
+! point (w point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDZF(:,:,k) is defined by (PA(:,:,k+1)-PA(:,:,k))
+!! At k=size(PA,3), PDZF(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at flux localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PDZF ! result at mass localization
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: IKU ! upper bound in z direction of PA
+!
+!
+INTEGER :: IIU,IJU
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DZF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDZF(JIJK-IIU*IJU,1,1) = PA(JIJK,1,1)-PA(JIJK-IIU*IJU,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PDZF(JIJ,1,IKU) = -999.
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DZF_PHY
+!
+! ###############################
+ SUBROUTINE DXF_PHY(D,PA,PDXF)
+! ###############################
+!
+!!**** *DXF* - Shuman operator : finite difference operator in x direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the x direction (I index) for a field PA localized at a x-flux
+! point (u point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDXF(i,:,:) is defined by (PA(i+1,:,:)-PA(i,:,:))
+!! At i=size(PA,1), PDXF(i,:,:) are replaced by the values of PDXF,
+!! which are the right values in the x-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY: JPHEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PDXF ! result at mass
+ ! localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! Loop index in x direction
+INTEGER :: IIU ! upper bound in x direction of PA
+!
+INTEGER :: JJK,IJU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DXF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDXF(JIJK-1,1,1) = PA(JIJK,1,1) - PA(JIJK-1,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJK=1,IJU*IKU
+ PDXF(IIU-JPHEXT+JI,JJK,1) = PDXF(JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DXF_PHY
+!
+! ###############################
+ SUBROUTINE DXM_PHY(D,PA,PDXM)
+! ###############################
+!
+!!**** *DXM* - Shuman operator : finite difference operator in x direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the x direction (I index) for a field PA localized at a mass
+! point. The result is localized at a x-flux point (u point).
+!
+!!** METHOD
+!! ------
+!! The result PDXM(i,:,:) is defined by (PA(i,:,:)-PA(i-1,:,:))
+!! At i=1, PDXM(1,:,:) are replaced by the values of PDXM,
+!! which are the right values in the x-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPHEXT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PDXM ! result at flux
+ ! side
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+!
+INTEGER :: JI ! Loop index in x direction
+INTEGER :: IIU ! upper bound in x direction of PA
+!
+INTEGER :: JJK,IJU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DXM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDXM(JIJK,1,1) = PA(JIJK,1,1) - PA(JIJK-1,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJK=1,IJU*IKU
+ PDXM(JI,JJK,1) = PDXM(IIU-2*JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DXM_PHY
+!
+! ###############################
+ SUBROUTINE DYM_PHY(D,PA,PDYM)
+! ###############################
+!
+!!**** *DYM* - Shuman operator : finite difference operator in y direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the y direction (J index) for a field PA localized at a mass
+! point. The result is localized at a y-flux point (v point).
+!
+!!** METHOD
+!! ------
+!! The result PDYM(:,j,:) is defined by (PA(:,j,:)-PA(:,j-1,:))
+!! At j=1, PDYM(:,1,:) are replaced by the values of PDYM,
+!! which are the right values in the y-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPHEXT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PDYM ! result at flux
+ ! side
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! Size of the array in the y direction
+!
+!
+INTEGER :: IIU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DYM
+! ------------------
+!
+IIU=SIZE(PA,1)
+IJU=SIZE(PA,2)
+IKU=SIZE(PA,3)
+!
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDYM(JIJK,1,1) = PA(JIJK,1,1) - PA(JIJK-IIU,1,1)
+END DO
+!
+DO JJ=1,JPHEXT
+ PDYM(:,JJ,:) = PDYM(:,IJU-2*JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DYM_PHY
+! ###############################
+ SUBROUTINE DYF_PHY(D,PA,PDYF)
+! ###############################
+!
+!!**** *DYF* - Shuman operator : finite difference operator in y direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the y direction (J index) for a field PA localized at a y-flux
+! point (v point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDYF(:,j,:) is defined by (PA(:,j+1,:)-PA(:,j,:))
+!! At j=size(PA,2), PDYF(:,j,:) are replaced by the values of PDYM,
+!! which are the right values in the y-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY: JPHEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PDYF ! result at mass
+ ! localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! upper bound in y direction of PA
+!
+!
+INTEGER :: IIU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DYF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDYF(JIJK-IIU,1,1) = PA(JIJK,1,1) - PA(JIJK-IIU,1,1)
+END DO
+!
+DO JJ=1,JPHEXT
+ PDYF(:,IJU-JPHEXT+JJ,:) = PDYF(:,JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DYF_PHY
+!
+END MODULE SHUMAN_PHY
diff --git a/src/PHYEX/aux/sources_neg_correct.f90 b/src/PHYEX/aux/sources_neg_correct.f90
index 3e41b1feb1a5fb63f19f0d9d98cc6471b48b9c01..a1e83273438f5385109ad6a35844d083b44317ca 100644
--- a/src/PHYEX/aux/sources_neg_correct.f90
+++ b/src/PHYEX/aux/sources_neg_correct.f90
@@ -15,10 +15,34 @@ implicit none
private
-public :: Sources_neg_correct
+public :: Sources_neg_correct,Sources_neg_correct_phy
contains
+subroutine Sources_neg_correct_phy(D, KSV, hcloud, hbudname, KRR, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj)
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+INTEGER, INTENT(IN) :: KSV
+character(len=*), intent(in) :: hcloud ! Kind of cloud parameterization
+character(len=*), intent(in) :: hbudname ! Budget name
+integer, intent(in) :: KRR ! Number of moist variables
+real, intent(in) :: ptstep ! Timestep
+real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: ppabst ! Absolute pressure at time t
+real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: ptht ! Theta at time t
+real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(in) :: prt ! Moist variables at time t
+real, dimension(D%NIT,D%NJT,D%NKT), intent(inout) :: prths ! Source terms
+real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(inout) :: prrs ! Source terms
+real, dimension(D%NIT,D%NJT,D%NKT, KSV), intent(inout) :: prsvs ! Source terms
+real, dimension(D%NIT,D%NJT,D%NKT), intent(in), optional :: prhodj ! Dry density * jacobian
+!
+CALL SOURCES_NEG_CORRECT(HCLOUD, 'NETUR',KRR,PTSTEP,PPABST,PTHT,PRT,PRTHS,PRRS,PRSVS)
+!
+end subroutine Sources_neg_correct_phy
+!
subroutine Sources_neg_correct( hcloud, hbudname, krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj )
use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
diff --git a/src/PHYEX/ext/deallocate_model1.f90 b/src/PHYEX/ext/deallocate_model1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4a940c6d89977fc8eef400fc57aac4f123ba5138
--- /dev/null
+++ b/src/PHYEX/ext/deallocate_model1.f90
@@ -0,0 +1,703 @@
+!MNH_LIC Copyright 1997-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_DEALLOCATE_MODEL1
+!############################
+!
+INTERFACE
+!
+SUBROUTINE DEALLOCATE_MODEL1 (KCALL)
+!
+INTEGER, INTENT(IN) :: KCALL
+!
+END SUBROUTINE DEALLOCATE_MODEL1
+!
+END INTERFACE
+!
+END MODULE MODI_DEALLOCATE_MODEL1
+!
+!
+! ####################################
+ SUBROUTINE DEALLOCATE_MODEL1 (KCALL)
+! ####################################
+!
+!!**** *DEALLOCATE_MODEL1* - deallocate all model1 fields
+!!
+!! PURPOSE
+!! -------
+! deallocate all model #1 fields in order to spare memory in spawning
+!
+!!** METHOD
+!! ------
+!!
+!! KCALL = 1 --> deallocates all SOURCES, LES, FORCING and SOLVER variables
+!!
+!! KCALL = 2 --> deallocates all METRIC, RADIATION and CORIOLIS variables
+!!
+!! KCALL = 3 --> deallocates all other variables of model1
+!!
+!! KCALL = 4 --> deallocates all variables common to ALL models
+!!
+!! 1 + 2 --> all variables used in spawning
+!! 1 + 2 + 3 + 4 --> in diag after a file has been treated
+!!
+!! EXTERNAL
+!! --------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/12/97
+!!
+!! 20/05/98 use the LB fields
+!! 15/03/99 new PGD fields
+!! 08/03/01 D.Gazen add chemical emission field
+!! 01/2004 V. Masson surface externalization
+!! 06/2012 M.Tomasini add 2D nesting ADVFRC
+!! 10/2016 M.Mazoyer New KHKO output fields
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! C. Lac 02/2019: add rain fraction as an output field
+! P. Wautelet 07/06/2019: bugfix: deallocate XLSRVM only if allocated
+! S. Riette 04/2020: XHL* fields
+! A. Costes 12:2021: Blaze Fire model variables
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_REF
+!
+USE MODD_METRICS_n
+USE MODD_FIELD_n
+USE MODD_DUMMY_GR_FIELD_n
+USE MODD_LSFIELD_n
+USE MODD_GRID_n
+USE MODD_REF_n
+USE MODD_CURVCOR_n
+USE MODD_DYN_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_RADIATIONS_n
+USE MODD_FRC
+USE MODD_PRECIP_n
+USE MODD_ELEC_n
+USE MODD_PASPOL_n
+USE MODD_RAIN_ICE_PARAM
+USE MODD_RAIN_ICE_DESCR
+USE MODD_PARAM_n , ONLY : CCLOUD
+USE MODE_MODELN_HANDLER
+!
+! Modif 2D
+USE MODD_LATZ_EDFLX ! For ADVFRC and EDDY FLUXES
+USE MODD_DEF_EDDY_FLUX_n ! For EDDY FLUXES
+USE MODD_DEF_EDDYUV_FLUX_n ! For EDDY FLUXES
+!
+USE MODD_2D_FRC
+USE MODD_ADVFRC_n ! For ADVFRC and EDDY FLUXES
+USE MODD_RELFRC_n
+USE MODD_ADV_n
+USE MODD_PAST_FIELD_n
+USE MODD_TURB_n
+USE MODD_PARAM_C2R2, ONLY :LSUPSAT
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KCALL ! number of times this routine has been called
+INTEGER :: IMI ! Current Model index
+!
+!* 0.2 declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+! Save current Model index and switch to model 1 variables
+IMI = GET_CURRENT_MODEL_INDEX()
+CALL GOTO_MODEL(1)
+!* 1. Module MODD_FIELD$n
+!
+IF ( KCALL==3 ) THEN
+ IF (CUVW_ADV_SCHEME(1:3)=='CEN'.AND. CTEMP_SCHEME=='LEFR') THEN
+ DEALLOCATE(XUM)
+ DEALLOCATE(XVM)
+ DEALLOCATE(XWM)
+ DEALLOCATE(XDUM)
+ DEALLOCATE(XDVM)
+ DEALLOCATE(XDWM)
+ END IF
+ DEALLOCATE(XUT)
+ DEALLOCATE(XVT)
+ DEALLOCATE(XWT)
+ DEALLOCATE(XTHT)
+ IF (L2D_ADV_FRC) THEN
+ IF (ASSOCIATED(XDTHFRC)) DEALLOCATE(XDTHFRC)
+ IF (ASSOCIATED(XDRVFRC)) DEALLOCATE(XDRVFRC)
+ IF (ASSOCIATED(TDTADVFRC)) DEALLOCATE(TDTADVFRC)
+ END IF
+ IF (L2D_REL_FRC) THEN
+ IF (ASSOCIATED(XTHREL)) DEALLOCATE(XTHREL)
+ IF (ASSOCIATED(XRVREL)) DEALLOCATE(XRVREL)
+ IF (ASSOCIATED(TDTRELFRC)) DEALLOCATE(TDTRELFRC)
+ END IF
+ ! DEALLOCATE EDDY FLUXES
+ IF (LTH_FLX) THEN
+ DEALLOCATE(XVTH_FLUX_M)
+ DEALLOCATE(XWTH_FLUX_M)
+ END IF
+ IF (LUV_FLX) THEN
+ DEALLOCATE(XVU_FLUX_M)
+ END IF
+END IF
+IF ( KCALL==1 ) THEN
+ DEALLOCATE(XRUS)
+ DEALLOCATE(XRVS)
+ DEALLOCATE(XRWS)
+ DEALLOCATE(XRTHS)
+ DEALLOCATE(XRUS_PRES, XRVS_PRES, XRWS_PRES )
+ DEALLOCATE(XRTHS_CLD )
+END IF
+!
+IF ( KCALL==3 ) THEN
+ IF (ASSOCIATED(XTKET)) DEALLOCATE(XTKET)
+END IF
+IF ( ASSOCIATED(XRTKES) .AND. KCALL==1 ) THEN
+ DEALLOCATE(XRTKES)
+END IF
+!
+IF ( KCALL==3 ) THEN
+ DEALLOCATE(XPABST)
+!
+ DEALLOCATE(XRT)
+END IF
+!
+IF ( KCALL==1 ) THEN
+ DEALLOCATE(XRRS)
+ DEALLOCATE(XRRS_CLD)
+END IF
+!
+IF ( ASSOCIATED(XSRCT) .AND. KCALL==3 ) THEN
+ DEALLOCATE(XSRCT)
+ DEALLOCATE(XSIGS)
+END IF
+!
+IF ( ASSOCIATED(XHLC_HRC) .AND. KCALL==3 ) THEN
+ DEALLOCATE(XHLC_HRC)
+ DEALLOCATE(XHLC_HCF)
+ DEALLOCATE(XHLI_HRI)
+ DEALLOCATE(XHLI_HCF)
+END IF
+!
+IF ( ASSOCIATED(XCLDFR) .AND. KCALL==2 ) THEN
+ DEALLOCATE(XCLDFR)
+END IF
+!
+IF ( ASSOCIATED(XICEFR) .AND. KCALL==2 ) THEN
+ DEALLOCATE(XICEFR)
+END IF
+!
+IF ( ASSOCIATED(XRAINFR) .AND. KCALL==2 ) THEN
+ DEALLOCATE(XRAINFR)
+END IF
+!
+IF ( KCALL == 3 ) THEN
+ DEALLOCATE(XSVT)
+END IF
+IF ( KCALL == 1 ) THEN
+ DEALLOCATE(XRSVS)
+ DEALLOCATE(XRSVS_CLD)
+END IF
+!
+IF ((CCLOUD == 'KHKO') .AND. LSUPSAT) THEN
+ DEALLOCATE(XSUPSAT)
+ DEALLOCATE(XNACT)
+ DEALLOCATE(XNPRO)
+ DEALLOCATE(XSSPRO)
+END IF
+!
+IF (ASSOCIATED(XDUMMY_GR_FIELDS) .AND. KCALL==3 ) THEN
+ DEALLOCATE(XDUMMY_GR_FIELDS)
+END IF
+
+IF (ASSOCIATED(XLSPHI)) THEN
+ DEALLOCATE(XLSPHI)
+END IF
+
+IF (ASSOCIATED(XBMAP)) THEN
+ DEALLOCATE(XBMAP)
+END IF
+
+IF (ASSOCIATED(XFMRFA)) THEN
+ DEALLOCATE(XFMRFA)
+END IF
+
+IF (ASSOCIATED(XFMWF0)) THEN
+ DEALLOCATE(XFMWF0)
+END IF
+
+IF (ASSOCIATED(XFMR0)) THEN
+ DEALLOCATE(XFMR0)
+END IF
+
+IF (ASSOCIATED(XFMR00)) THEN
+ DEALLOCATE(XFMR00)
+END IF
+
+IF (ASSOCIATED(XFMIGNITION)) THEN
+ DEALLOCATE(XFMIGNITION)
+END IF
+
+IF (ASSOCIATED(XFMFUELTYPE)) THEN
+ DEALLOCATE(XFMFUELTYPE)
+END IF
+
+IF (ASSOCIATED(XFIRETAU)) THEN
+ DEALLOCATE(XFIRETAU)
+END IF
+
+IF (ASSOCIATED(XFLUXPARAMH)) THEN
+ DEALLOCATE(XFLUXPARAMH)
+END IF
+
+IF (ASSOCIATED(XFLUXPARAMW)) THEN
+ DEALLOCATE(XFLUXPARAMW)
+END IF
+
+IF (ASSOCIATED(XFIRERW)) THEN
+ DEALLOCATE(XFIRERW)
+END IF
+
+IF (ASSOCIATED(XFMASE)) THEN
+ DEALLOCATE(XFMASE)
+END IF
+
+IF (ASSOCIATED(XFMAWC)) THEN
+ DEALLOCATE(XFMAWC)
+END IF
+
+IF (ASSOCIATED(XFMWALKIG)) THEN
+ DEALLOCATE(XFMWALKIG)
+END IF
+
+IF (ASSOCIATED(XFMFLUXHDH)) THEN
+ DEALLOCATE(XFMFLUXHDH)
+END IF
+
+IF (ASSOCIATED(XFMFLUXHDW)) THEN
+ DEALLOCATE(XFMFLUXHDW)
+END IF
+
+IF (ASSOCIATED(XFMHWS)) THEN
+ DEALLOCATE(XFMHWS)
+END IF
+
+IF (ASSOCIATED(XFMWINDU)) THEN
+ DEALLOCATE(XFMWINDU)
+END IF
+
+IF (ASSOCIATED(XFMWINDV)) THEN
+ DEALLOCATE(XFMWINDV)
+END IF
+
+IF (ASSOCIATED(XFMWINDW)) THEN
+ DEALLOCATE(XFMWINDW)
+END IF
+
+IF (ASSOCIATED(XFMGRADOROX)) THEN
+ DEALLOCATE(XFMGRADOROX)
+END IF
+
+IF (ASSOCIATED(XFMGRADOROY)) THEN
+ DEALLOCATE(XFMGRADOROY)
+END IF
+
+IF (ASSOCIATED(XGRADLSPHIX)) THEN
+ DEALLOCATE(XGRADLSPHIX)
+END IF
+
+IF (ASSOCIATED(XGRADLSPHIY)) THEN
+ DEALLOCATE(XGRADLSPHIY)
+END IF
+
+IF (ASSOCIATED(XFIREWIND)) THEN
+ DEALLOCATE(XFIREWIND)
+END IF
+
+IF (ASSOCIATED(XLSPHI2D)) THEN
+ DEALLOCATE(XLSPHI2D)
+END IF
+
+IF (ASSOCIATED(XGRADLSPHIX2D)) THEN
+ DEALLOCATE(XGRADLSPHIX2D)
+END IF
+
+IF (ASSOCIATED(XGRADLSPHIY2D)) THEN
+ DEALLOCATE(XGRADLSPHIY2D)
+END IF
+
+IF (ASSOCIATED(XGRADMASKX)) THEN
+ DEALLOCATE(XGRADMASKX)
+END IF
+
+IF (ASSOCIATED(XGRADMASKY)) THEN
+ DEALLOCATE(XGRADMASKY)
+END IF
+
+IF (ASSOCIATED(XSURFRATIO2D)) THEN
+ DEALLOCATE(XSURFRATIO2D)
+END IF
+
+IF (ASSOCIATED(XLSDIFFUX2D)) THEN
+ DEALLOCATE(XLSDIFFUX2D)
+END IF
+
+IF (ASSOCIATED(XLSDIFFUY2D)) THEN
+ DEALLOCATE(XLSDIFFUY2D)
+END IF
+
+IF (ASSOCIATED(XFIRERW2D)) THEN
+ DEALLOCATE(XFIRERW2D)
+END IF
+!
+!* 3. Module MODD_GRID$n
+!
+IF ( ASSOCIATED(XLON) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XLON)
+ DEALLOCATE(XLAT)
+ DEALLOCATE(XMAP)
+END IF
+!
+IF ( KCALL == 3 ) THEN
+ !Philippe W.: do not deallocate XXHAT, XYHAT and XZHAT because they are needed later on
+ !As they are 1D, their memory footprint is negligible
+ ! DEALLOCATE(XXHAT)
+ DEALLOCATE(XDXHAT)
+ ! DEALLOCATE(XYHAT)
+ DEALLOCATE(XDYHAT)
+ DEALLOCATE(XZS)
+ DEALLOCATE(XZSMT)
+ DEALLOCATE(XZZ)
+ ! DEALLOCATE(XZHAT)
+END IF
+!
+IF ( KCALL == 2 ) THEN
+ DEALLOCATE(XDIRCOSZW)
+ DEALLOCATE(XDIRCOSXW)
+ DEALLOCATE(XDIRCOSYW)
+ DEALLOCATE(XCOSSLOPE)
+ DEALLOCATE(XSINSLOPE)
+END IF
+
+IF ( KCALL == 2 ) THEN
+ DEALLOCATE(XDXX)
+ DEALLOCATE(XDYY)
+ DEALLOCATE(XDZX)
+ DEALLOCATE(XDZY)
+ DEALLOCATE(XDZZ)
+END IF
+!
+!* 4. Modules MODD_REF and MODD_REF$n
+!
+IF ( KCALL == 4 ) THEN
+ DEALLOCATE(XRHODREFZ)
+ DEALLOCATE(XTHVREFZ)
+END IF
+!
+IF ( KCALL == 3 ) THEN
+ DEALLOCATE(XRHODREF)
+ DEALLOCATE(XTHVREF)
+ DEALLOCATE(XEXNREF)
+ DEALLOCATE(XRHODJ)
+ IF ( ASSOCIATED(XRVREF) ) THEN
+ DEALLOCATE(XRVREF)
+ END IF
+END IF
+!
+!* 5. Module MODD_CURVCOR$n
+!
+IF ( ASSOCIATED(XCORIOX) .AND. KCALL == 2 ) THEN
+ DEALLOCATE(XCORIOX)
+ DEALLOCATE(XCORIOY)
+END IF
+IF ( KCALL == 2 ) THEN
+ DEALLOCATE(XCORIOZ)
+END IF
+IF ( ASSOCIATED(XCURVX) .AND. KCALL == 2) THEN
+ DEALLOCATE(XCURVX)
+ DEALLOCATE(XCURVY)
+END IF
+!
+!* 6. Module MODD_DYN$n
+!
+IF ( KCALL == 1 ) THEN
+ DEALLOCATE(XBFY)
+ DEALLOCATE(XAF,XCF)
+ DEALLOCATE(XTRIGSX)
+ DEALLOCATE(XTRIGSY)
+ DEALLOCATE(XRHOM)
+ DEALLOCATE(XALK)
+ DEALLOCATE(XALKW)
+ DEALLOCATE(XALKBAS)
+ DEALLOCATE(XALKWBAS)
+ IF ( ASSOCIATED(XKURELAX) ) THEN
+ DEALLOCATE(XKURELAX)
+ DEALLOCATE(XKVRELAX)
+ DEALLOCATE(XKWRELAX)
+ DEALLOCATE(LMASK_RELAX)
+ END IF
+END IF
+!
+!* 7. Larger Scale variables (Module MODD_LSFIELD$n)
+!
+IF ( KCALL == 3 ) THEN
+ DEALLOCATE(XLSUM)
+ DEALLOCATE(XLSVM)
+ DEALLOCATE(XLSWM)
+ DEALLOCATE(XLSTHM)
+ IF(ASSOCIATED(XLSRVM)) DEALLOCATE(XLSRVM)
+ IF (ASSOCIATED(XLBXUM)) THEN
+ DEALLOCATE(XLBXUM)
+ DEALLOCATE(XLBYUM)
+ DEALLOCATE(XLBXVM)
+ DEALLOCATE(XLBYVM)
+ DEALLOCATE(XLBXWM)
+ DEALLOCATE(XLBYWM)
+ DEALLOCATE(XLBXTHM)
+ DEALLOCATE(XLBYTHM)
+ END IF
+ IF (ASSOCIATED(XLBXTKEM)) THEN
+ DEALLOCATE(XLBXTKEM)
+ DEALLOCATE(XLBYTKEM)
+ END IF
+ IF (ASSOCIATED(XLBXRM)) THEN
+ DEALLOCATE(XLBXRM)
+ DEALLOCATE(XLBYRM)
+ END IF
+ IF (ASSOCIATED(XLBXSVM)) THEN
+ DEALLOCATE(XLBXSVM)
+ DEALLOCATE(XLBYSVM)
+ END IF
+END IF
+!
+ ! steady LS fields only for model 1 or independent models
+!
+IF( ASSOCIATED(XLSUS) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XLSUS)
+ DEALLOCATE(XLSVS)
+ DEALLOCATE(XLSWS)
+ DEALLOCATE(XLSTHS)
+ IF(ASSOCIATED(XLSRVS)) DEALLOCATE(XLSRVS)
+!
+ IF ( ASSOCIATED(XLBXUS) ) THEN
+ DEALLOCATE(XLBXUS)
+ DEALLOCATE(XLBYUS)
+ DEALLOCATE(XLBXVS)
+ DEALLOCATE(XLBYVS)
+ DEALLOCATE(XLBXWS)
+ DEALLOCATE(XLBYWS)
+ DEALLOCATE(XLBXTHS)
+ DEALLOCATE(XLBYTHS)
+ END IF
+ IF ( ASSOCIATED(XLBXTKES) ) THEN
+ DEALLOCATE(XLBXTKES)
+ DEALLOCATE(XLBYTKES)
+ END IF
+!
+ IF ( ASSOCIATED(XLBXRS) ) THEN
+ DEALLOCATE(XLBXRS)
+ DEALLOCATE(XLBYRS)
+ END IF
+!
+ IF ( ASSOCIATED(XLBXSVS) ) THEN
+ DEALLOCATE(XLBXSVS)
+ DEALLOCATE(XLBYSVS)
+ END IF
+!
+ IF ( ASSOCIATED(XCOEFLIN_LBXM) ) THEN
+ DEALLOCATE(XCOEFLIN_LBXM)
+ DEALLOCATE(NKLIN_LBXM)
+ END IF
+
+ IF ( ASSOCIATED(XCOEFLIN_LBYM) ) THEN
+ DEALLOCATE(XCOEFLIN_LBYM)
+ DEALLOCATE(NKLIN_LBYM)
+ END IF
+
+ IF ( ASSOCIATED(XCOEFLIN_LBXU) ) THEN
+ DEALLOCATE(XCOEFLIN_LBXU)
+ DEALLOCATE(NKLIN_LBXU)
+ DEALLOCATE(XCOEFLIN_LBYU)
+ DEALLOCATE(NKLIN_LBYU)
+ DEALLOCATE(XCOEFLIN_LBXV)
+ DEALLOCATE(NKLIN_LBXV)
+ DEALLOCATE(XCOEFLIN_LBYV)
+ DEALLOCATE(NKLIN_LBYV)
+ DEALLOCATE(XCOEFLIN_LBXW)
+ DEALLOCATE(NKLIN_LBXW)
+ DEALLOCATE(XCOEFLIN_LBYW)
+ DEALLOCATE(NKLIN_LBYW)
+ END IF
+END IF
+!
+!* 8. L.E.S. variables
+!
+
+!
+!* 9. Module MODD_RADIATIONS$n
+!
+!
+IF ( ASSOCIATED(XSLOPANG) .AND. KCALL == 2 ) THEN
+ DEALLOCATE(XSLOPANG)
+ DEALLOCATE(XSLOPAZI)
+ DEALLOCATE(XDTHRAD)
+ DEALLOCATE(XFLALWD)
+ DEALLOCATE(XDIRFLASWD)
+ DEALLOCATE(XSCAFLASWD)
+ DEALLOCATE(XDIRSRFSWD)
+ DEALLOCATE(XSWU)
+ DEALLOCATE(XSWD)
+ DEALLOCATE(XLWU)
+ DEALLOCATE(XLWD)
+ DEALLOCATE(XDTHRADSW)
+ DEALLOCATE(XDTHRADLW)
+ DEALLOCATE(XRADEFF)
+ DEALLOCATE(NCLEARCOL_TM1)
+END IF
+IF (ASSOCIATED(XSTATM)) DEALLOCATE(XSTATM)
+!
+!* 10. Module MODD_DEEP_CONVECTION$n
+!
+IF ( ASSOCIATED(XDTHCONV) .AND. KCALL == 2 ) THEN
+ DEALLOCATE(NCOUNTCONV)
+ DEALLOCATE(XDTHCONV)
+ DEALLOCATE(XDRVCONV)
+ DEALLOCATE(XDRCCONV)
+ DEALLOCATE(XDRICONV)
+END IF
+!
+IF ( ASSOCIATED(XPRCONV) .AND. KCALL == 2 ) THEN
+ DEALLOCATE(XPRCONV)
+ DEALLOCATE(XPACCONV)
+END IF
+IF ( ASSOCIATED(XPRSCONV) .AND. KCALL == 2 ) THEN
+ DEALLOCATE(XPRSCONV)
+END IF
+!
+IF ( ASSOCIATED(XDSVCONV) .AND. KCALL == 2 ) THEN
+ DEALLOCATE(XDSVCONV)
+END IF
+!
+!* 11. Forcing variables (Module MODD_FRC)
+!
+IF ( ALLOCATED(XUFRC) .AND. KCALL == 4 ) THEN
+ DEALLOCATE(TDTFRC)
+ DEALLOCATE(XUFRC)
+ DEALLOCATE(XVFRC)
+ DEALLOCATE(XWFRC)
+ DEALLOCATE(XTHFRC)
+ DEALLOCATE(XRVFRC)
+ DEALLOCATE(XTENDTHFRC)
+ DEALLOCATE(XTENDRVFRC)
+ DEALLOCATE(XGXTHFRC)
+ DEALLOCATE(XGYTHFRC)
+ DEALLOCATE(XPGROUNDFRC)
+END IF
+!
+!* 12. Module MODD_ICE_CONC$n
+!
+IF ( ASSOCIATED(XCIT) .AND. KCALL == 2 ) THEN
+ DEALLOCATE(XCIT)
+END IF
+!
+!* 13. Module MODD_PRECIP$n
+!
+IF ( ASSOCIATED(XINPRC) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XINPRC)
+ DEALLOCATE(XACPRC)
+END IF
+!
+IF ( ASSOCIATED(XINPRR) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XINPRR)
+ DEALLOCATE(XACPRR)
+END IF
+!
+IF ( ASSOCIATED(XINPRR3D) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XINPRR3D)
+ DEALLOCATE(XEVAP3D)
+END IF
+!
+IF ( ASSOCIATED(XINPRS) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XINPRS)
+ DEALLOCATE(XACPRS)
+ DEALLOCATE(XINPRG)
+ DEALLOCATE(XACPRG)
+END IF
+!
+IF ( ASSOCIATED(XINPRH) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XINPRH)
+ DEALLOCATE(XACPRH)
+END IF
+!
+!* 13b. Module MODD_ELEC$n
+!
+IF ( ASSOCIATED(XNI_SDRYG) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XNI_SDRYG)
+ DEALLOCATE(XNI_IDRYG)
+ DEALLOCATE(XNI_IAGGS)
+ DEALLOCATE(XEW)
+ DEALLOCATE(XIND_RATE)
+END IF
+!
+IF ( ASSOCIATED(XEFIELDU) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XEFIELDU)
+ DEALLOCATE(XEFIELDV)
+ DEALLOCATE(XEFIELDW)
+ DEALLOCATE(XESOURCEFW)
+ DEALLOCATE(XIONSOURCEFW)
+ DEALLOCATE(XCION_POS_FW)
+ DEALLOCATE(XCION_NEG_FW)
+ DEALLOCATE(XMOBIL_POS)
+ DEALLOCATE(XMOBIL_NEG)
+END IF
+!
+IF ( ASSOCIATED(XRHOM_E) .AND. KCALL == 3 ) THEN
+ DEALLOCATE (XRHOM_E)
+ DEALLOCATE (XAF_E)
+ DEALLOCATE (XCF_E)
+ DEALLOCATE (XBFY_E)
+END IF
+!
+!* 14. Modules RAIN_ICE_DESCR and MODD_RAIN_ICE_PARAM
+!
+IF ( ASSOCIATED(XRTMIN) .AND. KCALL == 4 ) THEN
+ CALL RAIN_ICE_DESCR_DEALLOCATE()
+ CALL RAIN_ICE_PARAM_DEALLOCATE()
+END IF
+!
+!* 15. Module PASPOLn
+!
+IF ( ASSOCIATED(XATC) .AND. KCALL == 3 ) THEN
+ DEALLOCATE(XATC)
+END IF
+!
+!* 16. Module TURBn
+!
+IF ( KCALL==3 ) THEN
+ IF (ASSOCIATED(XDYP)) DEALLOCATE(XDYP)
+ IF (ASSOCIATED(XTHP)) DEALLOCATE(XTHP)
+ IF (ASSOCIATED(XTR)) DEALLOCATE(XTR)
+ IF (ASSOCIATED(XDISS)) DEALLOCATE(XDISS)
+ IF (ASSOCIATED(XLEM)) DEALLOCATE(XLEM)
+END IF
+!-------------------------------------------------------------------------------
+!
+CALL GOTO_MODEL(IMI)
+!
+END SUBROUTINE DEALLOCATE_MODEL1
diff --git a/src/PHYEX/ext/default_desfmn.f90 b/src/PHYEX/ext/default_desfmn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ade773022d23c3b0a5a10956b158429b0fde831d
--- /dev/null
+++ b/src/PHYEX/ext/default_desfmn.f90
@@ -0,0 +1,1481 @@
+!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_DEFAULT_DESFM_n
+! ###########################
+!
+INTERFACE
+!
+SUBROUTINE DEFAULT_DESFM_n(KMI)
+INTEGER, INTENT(IN) :: KMI ! Model index
+END SUBROUTINE DEFAULT_DESFM_n
+!
+END INTERFACE
+!
+END MODULE MODI_DEFAULT_DESFM_n
+!
+!
+!
+! ###############################
+ SUBROUTINE DEFAULT_DESFM_n(KMI)
+! ###############################
+!
+!!**** *DEFAULT_DESFM_n * - set default values for descriptive variables of
+!! model KMI
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to set default values for the variables
+! in descriptor files by filling the corresponding variables which
+! are stored in modules.
+!
+!
+!!** METHOD
+!! ------
+!! Each variable in modules, which can be initialized by reading its
+!! value in the descriptor file is set to a default value.
+!! When this routine is used during INIT, the modules of the first model
+!! are used to temporarily store the variables associated with a nested
+!! model.
+!! When this routine is used during SPAWNING, the modules of a second
+!! model must be initialized.
+!! Default values for variables common to all models are set only
+!! at the first call of DEFAULT_DESFM_n (i.e. when KMI=1)
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : JPHEXT,JPVEXT
+!!
+!! Module MODD_CONF : CCONF,L2D,L1D,LFLAT,NMODEL,NVERB
+!!
+!! Module MODD_DYN : XSEGLEN,XASSELIN,LCORIO,LNUMDIFF
+!! XALKTOP,XALZBOT
+!!
+!! Module MODD_BAKOUT
+!!
+!! Module MODD_NESTING : NDAD(m),NDTRATIO(m),XWAY(m)
+!!
+!! Module MODD_CONF_n : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS
+!! LUSERG,LUSERH,CSEG,CEXP
+!!
+!! Module MODD_LUNIT_n : CINIFILE,CCPLFILE
+!!
+!!
+!! Module MODD_DYN_n : XTSTEP,CPRESOPT,NITR,XRELAX,LHO_RELAX
+!! LVE_RELAX,XRIMKMAX,NRIMX,NRIMY
+!!
+!! Module MODD_ADV_n : CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME,NLITER
+!!
+!! Module MODD_PARAM_n : CTURB,CRAD,CDCONV,CSCONV
+!!
+!! Module MODD_LBC_n : CLBCX, CLBCY,NLBLX,NLBLY,XCPHASE,XCPHASE_PBL,XPOND
+!!
+!! Module MODD_TURB_n : XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG,LSUBG_COND
+!! LTGT_FLX
+!!
+!!
+!! Module MODD_PARAM_RAD_n:
+!! XDTRAD,XDTRAD_CLONLY,LCLEAR_SKY,NRAD_COLNBR, NRAD_DIAG
+!!
+!! Module MODD_BUDGET : CBUTYPE,NBUMOD,XBULEN,NBUKL, NBUKH,LBU_KCP,XBUWRI
+!! NBUIL, NBUIH,NBUJL, NBUJH,LBU_ICP,LBU_JCP,NBUMASK
+!!
+!! Module MODD_BLANK_n:
+!!
+!! XDUMMYi, NDUMMYi, LDUMMYi, CDUMMYi
+!!
+!! Module MODD_FRC :
+!!
+!! LGEOST_UV_FRC,LGEOST_TH_FRC,LTEND_THRV_FRC
+!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,LRELAX_UVMEAN_FRC,
+!! XRELAX_TIME_FRC
+!! XRELAX_HEIGHT_FRC,CRELAX_HEIGHT_TYPE,LTRANS,XUTRANS,XVTRANS,
+!! LPGROUND_FRC
+!!
+!! Module MODD_PARAM_ICE :
+!!
+!! LWARM,CPRISTINE_ICE
+!!
+!! Module MODD_PARAM_KAFR_n :
+!!
+!! XDTCONV,LREFRESH_ALL,LDOWN,NICE,LCHTRANS
+!!
+!! Module MODD_PARAM_MFSHALL_n :
+!!
+!! CMF_UPDRAFT,LMIXUV,CMF_CLOUD,XIMPL_MF,LMF_FLX
+!!
+!!
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine DEFAULT_DESFM_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/06/94
+!! Modifications 17/10/94 (Stein) For LCORIO
+!! Modifications 06/12/94 (Stein) remove LBOUSS+add LABSLAYER, LNUMDIFF
+!! ,LSTEADYLS
+!! Modifications 06/12/94 (Stein) remove LABSLAYER, add LHO_RELAX,
+!! LVE_RELAX, NRIMX, NRIMY, XRIMKMAX
+!! Modifications 09/01/95 (Lafore) add LSTEADY_DMASS
+!! Modifications 09/01/95 (Stein) add the turbulence scheme namelist
+!! Modifications 09/01/95 (Stein) add the 1D switch
+!! Modifications 10/03/95 (Mallet) add the coupling files
+!! 29/06/95 ( Stein, Nicolau, Hereil) add the budgets
+!! Modifications 25/09/95 ( Stein )add the LES tools
+!! Modifications 25/10/95 ( Stein )add the radiations
+!! Modifications 23/10/95 (Vila, lafore) new scalar advection scheme
+!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE
+!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for
+!! spawning
+!! Modifications 25/04/96 (Suhre) add the blank module
+!! Modifications 29/07/96 (Pinty&Suhre) add module MODD_FRC
+!! Modifications 11/04/96 (Pinty) add the rain-ice scheme and modify
+!! the split arrays in MODD_PARAM_RAD_n
+!! Modifications 11/01/97 (Pinty) add the deep convection scheme
+!! Modifications 24/11/96 (Masson) add LREFRESH_ALL in deep convection
+!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for spawning
+!! Modifications 22/07/96 (Lafore) gridnesting implementation
+!! Modifications 29/07/96 (Lafore) add the module MODD_FMOUT (renamed MODD_BAKOUT)
+!! Modifications 23/06/97 (Stein) add the equation system name
+!! Modifications 10/07/97 (Masson) add MODD_PARAM_GROUNDn : CROUGH
+!! Modifications 28/07/97 (Masson) remove LREFRESH_ALL and LSTEADY_DMASS
+!! Modifications 08/10/97 (Stein) switch (_n=1) to initialize the
+!! parameters common to all models
+!! Modifications 24/01/98 (Bechtold) add LREFRESH_ALL, LCHTRANS,
+!! LTEND_THRV_FR and LSST_FRC
+!! Modifications 18/07/99 (Stein) add LRAD_DIAG
+!! Modification 15/03/99 (Masson) use of XUNDEF
+!! Modification 11/12/00 (Tomasini) Add CSEA_FLUX to MODD_PARAMn
+!! Modification 22/01/01 (Gazen) delete NSV and add LHORELAX_SVC2R2
+!! LHORELAX_SVCHEM,LHORELAX_SVLG
+!! Modification 15/03/02 (Solmon) radiation scheme: remove NSPOT and add
+!! default for aerosol and cloud rad. prop. control
+!! Modification 22/05/02 (Jabouille) put chimical default here
+!! Modification 01/2004 (Masson) removes surface (externalization)
+!! 09/04 (M. Tomasini) New namelist to modify the
+!! Cloud mixing length
+!! 07/05 (P.Tulet) New namelists for dust and aerosol
+!! Modification 01/2007 (Malardel, Pergaud) Add MODD_PARAM_MFSHALL_n
+!! Modification 10/2009 (Aumond) Add user multimasks for LES
+!! Modification 10/2009 (Aumond) Add MEAN_FIELD
+!! Modification 12/04/07 (Leriche) add LUSECHAQ for aqueous chemistry
+!! Modification 30/05/07 (Leriche) add LCH_PH and XCH_PHINIT for pH
+!! Modification 25/04/08 (Leriche) add XRTMIN_AQ LWC threshold for aq. chemistry
+!! 16/07/10 add LHORELAX_SVIC
+!! 16/09/10 add LUSECHIC
+!! 13/01/11 add LCH_RET_ICE
+!! 01/07/11 (F.Couvreux) Add CONDSAMP
+!! 01/07/11 (B.Aouizerats) Add CAOP
+!! 07/2013 (C.Lac) add WENO, LCHECK
+!! 07/2013 (Bosseur & Filippi) adds Forefire
+!! 08/2015 (Redelsperger & Pianezze) add XPOND coefficient for LBC
+!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
+!! put NCH_VEC_LENGTH = 50 instead of 1000
+!!
+!! 04/2016 (C.LAC) negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
+!! put NCH_VEC_LENGTH = 50 instead of 1000
+!! 10/2016 (C.Lac) VSIGQSAT change from 0 to 0.02 for coherence with AROME
+!! 10/2016 (C.Lac) Add droplet deposition
+!! 10/2016 (R.Honnert and S.Riette) : Improvement of EDKF and adaptation to the grey zone
+!! 10/2016 (F Brosse) add prod/loss terms computation for chemistry
+!! 07/2017 (V. Masson) adds time step for output files writing.
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 02/2018 Q.Libois ECRAD
+! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 01/2018 (S. Riette) new budgets and variables for ICE3/ICE4
+!! 01/2018 (J.Colin) add VISC and DRAG
+!! 07/2017 (V. Vionnet) add blowing snow variables
+!! 01/2019 (R. Honnert) add reduction of the mass-flux surface closure with the resolution
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!! 05/2019 F.Brient add tracer emission from the top of the boundary-layer
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! P. Wautelet 17/04/2020: move budgets switch values into modd_budget
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! F. Auguste, T. Nagel 02/2021: add IBM defaults parameters
+! T. Nagel 02/2021: add turbulence recycling defaults parameters
+! P-A Joulin 21/05/2021: add Wind turbines
+! S. Riette 21/05/2021: add options to PDF subgrid scheme
+! D. Ricard 05/2021: add the contribution of Leonard terms in the turbulence scheme
+! JL Redelsperger 06/2021: add parameters allowing to active idealized oceanic convection
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation)
+! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
+! Q. Rodier 07/2021: modify XPOND=1
+! A. Costes 12/2021: Blaze fire model
+! C. Barthe 03/2022: add CIBU and RDSF options in LIMA
+! Delbeke/Vie 03/2022 : KHKO option in LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_PARAMETERS
+USE MODD_CONF ! For INIT only DEFAULT_DESFM1
+USE MODD_CONFZ
+USE MODD_DYN
+USE MODD_NESTING
+USE MODD_BAKOUT
+USE MODD_SERIES
+USE MODD_CONF_n ! modules used to set the default values is only
+USE MODD_LUNIT_n ! the one corresponding to model 1. These memory
+USE MODD_DIM_n ! addresses will then be filled by the values read in
+USE MODD_DYN_n ! the DESFM corresponding to model n which may have
+USE MODD_ADV_n ! missing values. This is why we affect default values.
+USE MODD_PARAM_n ! For SPAWNING DEFAULT_DESFM2 is also used
+USE MODD_LBC_n
+USE MODD_OUT_n
+USE MODD_TURB_n
+USE MODD_BUDGET
+USE MODD_LES
+USE MODD_PARAM_RAD_n
+#ifdef MNH_ECRAD
+USE MODD_PARAM_ECRAD_n
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
+#endif
+USE MODD_BLANK_n
+USE MODD_FRC
+USE MODD_PARAM_ICE
+USE MODD_PARAM_C2R2
+USE MODD_TURB_CLOUD
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_MFSHALL_n
+USE MODD_CH_MNHC_n
+USE MODD_SERIES_n
+USE MODD_NUDGING_n
+USE MODD_CH_AEROSOL
+USE MODD_DUST
+USE MODD_SALT
+USE MODD_PASPOL
+USE MODD_CONDSAMP
+USE MODD_MEAN_FIELD
+USE MODD_DRAGTREE_n
+USE MODD_DRAGBLDG_n
+USE MODD_EOL_MAIN
+USE MODD_EOL_ADNR
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO
+USE MODD_ALLSTATION_n
+!
+!
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS, &
+ NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, &
+ CINT_MIXING, NMOD_IMM, NIND_SPECIE, LMURAKAMI, &
+ YSNOW_T=>LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ XFACTNUC_DEP, XFACTNUC_CON, &
+ OWARM=>LWARM, LACTI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
+ OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, LKHKO, NMOM_C, NMOM_R, &
+ NMOD_CCN, XCCN_CONC, LKESSLERAC, &
+ LCCN_HOM, CCCN_MODES, &
+ YALPHAR=>XALPHAR, YNUR=>XNUR, &
+ YALPHAC=>XALPHAC, YNUC=>XNUC, CINI_CCN=>HINI_CCN, &
+ CTYPE_CCN=>HTYPE_CCN, YFSOLUB_CCN=>XFSOLUB_CCN, &
+ YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, &
+ YAERHEIGHT=>XAERHEIGHT, &
+ LSCAV, LAERO_MASS, NPHILLIPS, &
+ LCIBU, XNDEBRIS_CIBU, LRDSF, &
+ ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC, OACTTKE=>LACTTKE, &
+ LPTSPLIT, L_LFEEDBACKT=>LFEEDBACKT, L_NMAXITER=>NMAXITER, &
+ L_XMRSTEP=>XMRSTEP, L_XTSTEP_TS=>XTSTEP_TS
+!
+USE MODD_LATZ_EDFLX
+USE MODD_2D_FRC
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+USE MODD_DRAG_n
+USE MODD_VISCOSITY
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n
+USE MODD_IBM_LSF
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_FIRE
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JM ! loop index
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. SET DEFAULT VALUES FOR MODD_LUNIT_n :
+! ----------------------------------
+!
+! CINIFILE='INIFILE'
+CINIFILEPGD='' !Necessary to keep this line to prevent problems with spawning
+CCPLFILE(:)=' '
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. SET DEFAULT VALUES FOR MODD_CONF AND MODD_CONF_n :
+! ------------------------------------------------
+!
+IF (KMI == 1) THEN
+ CCONF ='START'
+ LTHINSHELL = .FALSE.
+ L2D = .FALSE.
+ L1D = .FALSE.
+ LFLAT = .FALSE.
+ NMODEL = 1
+ CEQNSYS = 'DUR'
+ NVERB = 5
+ CEXP = 'EXP01'
+ CSEG = 'SEG01'
+ LFORCING = .FALSE.
+ L2D_ADV_FRC= .FALSE.
+ L2D_REL_FRC= .FALSE.
+ XRELAX_HEIGHT_BOT = 0.
+ XRELAX_HEIGHT_TOP = 30000.
+ XRELAX_TIME = 864000.
+ LPACK = .TRUE.
+ NHALO = 1
+#ifdef MNH_SX5
+ CSPLIT ='YSPLITTING' ! NEC vectoriel architecture , low number of PROC
+#else
+ CSPLIT ='BSPLITTING' ! Scalaire architecture , high number of PROC
+#endif
+ NZ_PROC = 0 !JUAN Z_SPLITTING :: number of proc in Z splitting
+ NZ_SPLITTING = 10 !JUAN Z_SPLITTING :: for debug NZ=1=flat_inv; NZ=10=flat_invz; NZ=1+2 the two
+ LLG = .FALSE.
+ LINIT_LG = .FALSE.
+ CINIT_LG = 'FMOUT'
+ LNOMIXLG = .FALSE.
+ LCHECK = .FALSE.
+END IF
+!
+CCLOUD = 'NONE'
+LUSERV = .TRUE.
+LUSERC = .FALSE.
+LUSERR = .FALSE.
+LUSERI = .FALSE.
+LUSERS = .FALSE.
+LUSERG = .FALSE.
+LUSERH = .FALSE.
+LOCEAN = .FALSE.
+!NSV = 0
+!NSV_USER = 0
+LUSECI = .FALSE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. SET DEFAULT VALUES FOR MODD_DYN AND MODD_DYN_n :
+! -----------------------------------------------
+!
+IF (KMI == 1) THEN
+ XSEGLEN = 43200.
+ XASSELIN = 0.2
+ XASSELIN_SV = 0.02
+ LCORIO = .TRUE.
+ LNUMDIFU = .TRUE.
+ LNUMDIFTH = .FALSE.
+ LNUMDIFSV = .FALSE.
+ XALZBOT = 4000.
+ XALKTOP = 0.01
+ XALKGRD = 0.01
+ XALZBAS = 0.01
+END IF
+!
+XTSTEP = 60.
+CPRESOPT = 'CRESI'
+NITR = 4
+LITRADJ = .TRUE.
+LRES = .FALSE.
+XRES = 1.E-07
+XRELAX = 1.
+LVE_RELAX = .FALSE.
+LVE_RELAX_GRD = .FALSE.
+XRIMKMAX = 0.01 / XTSTEP
+XT4DIFU = 1800.
+XT4DIFTH = 1800.
+XT4DIFSV = 1800.
+!
+IF (KMI == 1) THEN ! for model 1 we have a Large scale information
+ NRIMX = JPRIMMAX ! for U,V,W,TH,Rv used for the hor. relaxation
+ NRIMY = JPRIMMAX
+ELSE
+ NRIMX = 0 ! for inner models we use only surfacic fields to
+ NRIMY = 0 ! give the lbc and no hor. relaxation is used
+END IF
+!
+LHORELAX_UVWTH = .FALSE.
+LHORELAX_RV = .FALSE.
+LHORELAX_RC = .FALSE. ! for all these fields, no large scale is usally available
+LHORELAX_RR = .FALSE. ! for model 1 and for inner models, we only use surfacic
+LHORELAX_RS = .FALSE. ! fiels ( no hor. relax. )
+LHORELAX_RI = .FALSE.
+LHORELAX_RG = .FALSE.
+LHORELAX_RH = .FALSE.
+LHORELAX_TKE = .FALSE.
+LHORELAX_SV(:) = .FALSE.
+LHORELAX_SVC2R2 = .FALSE.
+LHORELAX_SVC1R3 = .FALSE.
+LHORELAX_SVELEC = .FALSE.
+LHORELAX_SVLG = .FALSE.
+LHORELAX_SVCHEM = .FALSE.
+LHORELAX_SVCHIC = .FALSE.
+LHORELAX_SVDST = .FALSE.
+LHORELAX_SVSLT = .FALSE.
+LHORELAX_SVPP = .FALSE.
+LHORELAX_SVCS = .FALSE.
+LHORELAX_SVAER = .FALSE.
+!
+LHORELAX_SVLIMA = .FALSE.
+!
+#ifdef MNH_FOREFIRE
+LHORELAX_SVFF = .FALSE.
+#endif
+LHORELAX_SVSNW = .FALSE.
+LHORELAX_SVFIRE = .FALSE.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. SET DEFAULT VALUES FOR MODD_NESTING :
+! -----------------------------------
+!
+IF (KMI == 1) THEN
+ NDAD(1)=1
+ DO JM=2,JPMODELMAX
+ NDAD(JM) = JM - 1
+ END DO
+ NDTRATIO(:) = 1
+ XWAY(:) = 2. ! two-way interactive gridnesting
+ XWAY(1) = 0. ! except for model 1
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. SET DEFAULT VALUES FOR MODD_ADV_n :
+! ----------------------------------
+!
+CUVW_ADV_SCHEME = 'CEN4TH'
+CMET_ADV_SCHEME = 'PPM_01'
+CSV_ADV_SCHEME = 'PPM_01'
+CTEMP_SCHEME = 'RKC4'
+NWENO_ORDER = 3
+NSPLIT = 1
+LSPLIT_CFL = .TRUE.
+LSPLIT_WENO = .TRUE.
+XSPLIT_CFL = 0.8
+LCFL_WRIT = .FALSE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. SET DEFAULT VALUES FOR MODD_PARAM_n :
+! -----------------------------------
+!
+CTURB = 'NONE'
+CRAD = 'NONE'
+CDCONV = 'NONE'
+CSCONV = 'NONE'
+CELEC = 'NONE'
+CACTCCN = 'NONE'
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. SET DEFAULT VALUES FOR MODD_LBC_n :
+! ---------------------------------
+!
+CLBCX(1) ='CYCL'
+CLBCX(2) ='CYCL'
+CLBCY(1) ='CYCL'
+CLBCY(2) ='CYCL'
+NLBLX(:) = 1
+NLBLY(:) = 1
+XCPHASE = 20.
+XCPHASE_PBL = 0.
+XCARPKMAX = XUNDEF
+XPOND = 1.0
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. SET DEFAULT VALUES FOR MODD_NUDGING_n :
+! ---------------------------------
+!
+LNUDGING = .FALSE.
+XTNUDGING = 21600.
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. SET DEFAULT VALUES FOR MODD_BAKOUT and MODD_OUT_n :
+! ------------------------------------------------
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SET DEFAULT VALUES FOR MODD_TURB_n :
+! ----------------------------------
+!
+XIMPL = 1.
+XKEMIN = 0.01
+XCEDIS = 0.84
+XCADAP = 0.5
+CTURBLEN = 'BL89'
+CTURBDIM = '1DIM'
+LTURB_FLX =.FALSE.
+LTURB_DIAG=.FALSE.
+LSUBG_COND=.FALSE.
+CSUBG_AUCV='NONE'
+CSUBG_AUCV_RI='NONE'
+LSIGMAS =.TRUE.
+LSIG_CONV =.FALSE.
+LRMC01 =.FALSE.
+CTOM ='NONE'
+VSIGQSAT = 0.02
+CCONDENS='CB02'
+CLAMBDA3='CB'
+CSUBG_MF_PDF='TRIANGLE'
+LLEONARD =.FALSE.
+XCOEFHGRADTHL = 1.0
+XCOEFHGRADRM = 1.0
+XALTHGRAD = 2000.0
+XCLDTHOLD = -1.0
+
+!-------------------------------------------------------------------------------
+!
+!* 10b. SET DEFAULT VALUES FOR MODD_DRAGTREE :
+! ----------------------------------
+!
+LDRAGTREE = .FALSE.
+LDEPOTREE = .FALSE.
+XVDEPOTREE = 0.02 ! 2 cm/s
+!------------------------------------------------------------------------------
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
+!
+!* 10d. SET DEFAULT VALUES FOR MODD_EOL* :
+! ----------------------------------
+!
+! 10d.i) MODD_EOL_MAIN
+!
+LMAIN_EOL = .FALSE.
+CMETH_EOL = 'ADNR'
+CSMEAR = '3LIN'
+NMODEL_EOL = 1
+!
+! 10d.ii) MODD_EOL_SHARED_IO
+!
+CFARM_CSVDATA = 'data_farm.csv'
+CTURBINE_CSVDATA = 'data_turbine.csv'
+CBLADE_CSVDATA = 'data_blade.csv'
+CAIRFOIL_CSVDATA = 'data_airfoil.csv'
+!
+CINTERP = 'CLS'
+!
+! 10d.iii) MODD_EOL_ALM
+!
+NNB_BLAELT = 42
+LTIMESPLIT = .FALSE.
+LTIPLOSSG = .TRUE.
+LTECOUTPTS = .FALSE.
+!
+!------------------------------------------------------------------------------
+!* 10.e SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
+! ----------------------------------
+!
+NNUMB_STAT = 0
+XSTEP_STAT = 60.0
+XX_STAT(:) = XUNDEF
+XY_STAT(:) = XUNDEF
+XZ_STAT(:) = XUNDEF
+XLAT_STAT(:) = XUNDEF
+XLON_STAT(:) = XUNDEF
+CNAME_STAT(:) = ''
+CTYPE_STAT(:) = ''
+CFILE_STAT = 'NO_INPUT_CSV'
+LDIAG_SURFRAD = .TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. SET DEFAULT VALUES FOR MODD_BUDGET :
+! ------------------------------------
+!
+! 11.1 General budget variables
+!
+IF (KMI == 1) THEN
+ CBUTYPE = 'NONE'
+ NBUMOD = 1
+ XBULEN = XSEGLEN
+ XBUWRI = XSEGLEN
+ NBUKL = 1
+ NBUKH = 0
+ LBU_KCP = .TRUE.
+!
+! 11.2 Variables for the cartesian box
+!
+ NBUIL = 1
+ NBUIH = 0
+ NBUJL = 1
+ NBUJH = 0
+ LBU_ICP = .TRUE.
+ LBU_JCP = .TRUE.
+!
+! 11.3 Variables for the mask
+!
+ NBUMASK = 1
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. SET DEFAULT VALUES FOR MODD_LES :
+! ---------------------------------
+!
+IF (KMI == 1) THEN
+ LLES_MEAN = .FALSE.
+ LLES_RESOLVED = .FALSE.
+ LLES_SUBGRID = .FALSE.
+ LLES_UPDRAFT = .FALSE.
+ LLES_DOWNDRAFT = .FALSE.
+ LLES_SPECTRA = .FALSE.
+!
+ NLES_LEVELS = NUNDEF
+ XLES_ALTITUDES = XUNDEF
+ NSPECTRA_LEVELS = NUNDEF
+ XSPECTRA_ALTITUDES = XUNDEF
+ NLES_TEMP_SERIE_I = NUNDEF
+ NLES_TEMP_SERIE_J = NUNDEF
+ NLES_TEMP_SERIE_Z = NUNDEF
+ CLES_NORM_TYPE = 'NONE'
+ CBL_HEIGHT_DEF = 'KE'
+ XLES_TEMP_SAMPLING = XUNDEF
+ XLES_TEMP_MEAN_START = XUNDEF
+ XLES_TEMP_MEAN_END = XUNDEF
+ XLES_TEMP_MEAN_STEP = 3600.
+ LLES_CART_MASK = .FALSE.
+ NLES_IINF = NUNDEF
+ NLES_ISUP = NUNDEF
+ NLES_JINF = NUNDEF
+ NLES_JSUP = NUNDEF
+ LLES_NEB_MASK = .FALSE.
+ LLES_CORE_MASK = .FALSE.
+ LLES_MY_MASK = .FALSE.
+ NLES_MASKS_USER = NUNDEF
+ LLES_CS_MASK = .FALSE.
+
+ LLES_PDF = .FALSE.
+ NPDF = 1
+ XTH_PDF_MIN = 270.
+ XTH_PDF_MAX = 350.
+ XW_PDF_MIN = -10.
+ XW_PDF_MAX = 10.
+ XTHV_PDF_MIN = 270.
+ XTHV_PDF_MAX = 350.
+ XRV_PDF_MIN = 0.
+ XRV_PDF_MAX = 20.
+ XRC_PDF_MIN = 0.
+ XRC_PDF_MAX = 1.
+ XRR_PDF_MIN = 0.
+ XRR_PDF_MAX = 1.
+ XRI_PDF_MIN = 0.
+ XRI_PDF_MAX = 1.
+ XRS_PDF_MIN = 0.
+ XRS_PDF_MAX = 1.
+ XRG_PDF_MIN = 0.
+ XRG_PDF_MAX = 1.
+ XRT_PDF_MIN = 0.
+ XRT_PDF_MAX = 20.
+ XTHL_PDF_MIN = 270.
+ XTHL_PDF_MAX = 350.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. SET DEFAULT VALUES FOR MODD_PARAM_RAD_n :
+! ---------------------------------------
+!
+XDTRAD = XTSTEP
+XDTRAD_CLONLY = XTSTEP
+LCLEAR_SKY =.FALSE.
+NRAD_COLNBR = 1000
+NRAD_DIAG = 0
+CLW ='RRTM'
+CAER='SURF'
+CAOP='CLIM'
+CEFRADL='MART'
+CEFRADI='LIOU'
+COPWSW = 'FOUQ'
+COPISW = 'EBCU'
+COPWLW = 'SMSH'
+COPILW = 'EBCU'
+XFUDG = 1.
+LAERO_FT=.FALSE.
+LFIX_DAT=.FALSE.
+!
+#ifdef MNH_ECRAD
+!* 13bis. SET DEFAULT VALUES FOR MODD_PARAM_ECRAD_n :
+! ---------------------------------------
+!
+#if ( VER_ECRAD == 101 )
+NSWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+NLWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
+#if ( VER_ECRAD == 140 )
+LSPEC_ALB = .FALSE.
+LSPEC_EMISS = .FALSE.
+
+
+!ALLOCATE(USER_ALB_DIFF(NSWB_MNH))
+!ALLOCATE(USER_ALB_DIR(NSWB_MNH))
+!ALLOCATE(USER_EMISS(NLWB_MNH))
+!PRINT*,USER_ALB_DIFF
+!USER_ALB_DIFF = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_ALB_DIR = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_EMISS = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+SURF_TYPE="SNOW"
+
+NLWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+NSWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
+! LEFF3D = .TRUE.
+! LSIDEM = .TRUE.
+NREG = 3 ! Number of cloudy regions (3=TripleClouds)
+! LLWCSCA = .TRUE. ! LW cloud scattering
+! LLWASCA = .TRUE. ! LW aerosols scattering
+NLWSCATTERING = 2
+NAERMACC = 0
+! CGAS = 'RRTMG-IFS' ! Gas optics model
+NOVLP = 1 ! overlap assumption ; 0= 'Max-Ran' ; 1= 'Exp-Ran'; 2 = 'Exp-Exp'
+NLIQOPT = 3 ! 1: 'Monochromatic', 2: 'HuStamnes', 3: 'SOCRATES', 4: 'Slingo'
+NICEOPT = 3 ! 1: 'Monochromatic', 2: 'Fu-PSRAD', 3: 'Fu-IFS', 4: 'Baran', 5: 'Baran2016', 6: 'Baran2017'
+! LSW_ML_E = .FALSE.
+! LLW_ML_E = .FALSE.
+! LPSRAD = .FALSE.
+!
+NRADLP = 1 ! 0: ERA-15, 1: Zhang and Rossow, 2: Martin (1994) et Woods (2000)
+NRADIP = 1 ! 0: 40 mum, 1: Liou and Ou (1994), 2: Liou and Ou (1994) improved, 3: Sun and Rikus (1999)
+XCLOUD_FRAC_STD = 1.0_JPRB ! change to 0.75 for more realistic distribution
+#endif
+!-------------------------------------------------------------------------------
+!
+!* 14. SET DEFAULT VALUES FOR MODD_BLANK_n :
+! -----------------------------------
+!
+XDUMMY1 = 0.
+XDUMMY2 = 0.
+XDUMMY3 = 0.
+XDUMMY4 = 0.
+XDUMMY5 = 0.
+XDUMMY6 = 0.
+XDUMMY7 = 0.
+XDUMMY8 = 0.
+!
+NDUMMY1 = 0
+NDUMMY2 = 0
+NDUMMY3 = 0
+NDUMMY4 = 0
+NDUMMY5 = 0
+NDUMMY6 = 0
+NDUMMY7 = 0
+NDUMMY8 = 0
+!
+LDUMMY1 = .TRUE.
+LDUMMY2 = .TRUE.
+LDUMMY3 = .TRUE.
+LDUMMY4 = .TRUE.
+LDUMMY5 = .TRUE.
+LDUMMY6 = .TRUE.
+LDUMMY7 = .TRUE.
+LDUMMY8 = .TRUE.
+!
+CDUMMY1 = ' '
+CDUMMY2 = ' '
+CDUMMY3 = ' '
+CDUMMY4 = ' '
+CDUMMY5 = ' '
+CDUMMY6 = ' '
+CDUMMY7 = ' '
+CDUMMY8 = ' '
+!
+!------------------------------------------------------------------------------
+!
+!* 15. SET DEFAULT VALUES FOR MODD_FRC :
+! ---------------------------------
+!
+IF (KMI == 1) THEN
+ LGEOST_UV_FRC = .FALSE.
+ LGEOST_TH_FRC = .FALSE.
+ LTEND_THRV_FRC = .FALSE.
+ LTEND_UV_FRC = .FALSE.
+ LVERT_MOTION_FRC = .FALSE.
+ LRELAX_THRV_FRC = .FALSE.
+ LRELAX_UV_FRC = .FALSE.
+ LRELAX_UVMEAN_FRC = .FALSE.
+ XRELAX_TIME_FRC = 10800.
+ XRELAX_HEIGHT_FRC = 0.
+ CRELAX_HEIGHT_TYPE = "FIXE"
+ LTRANS = .FALSE.
+ XUTRANS = 0.0
+ XVTRANS = 0.0
+ LPGROUND_FRC = .FALSE.
+ LDEEPOC = .FALSE.
+ XCENTX_OC = 16000.
+ XCENTY_OC = 16000.
+ XRADX_OC = 8000.
+ XRADY_OC = 8000.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 16. SET DEFAULT VALUES FOR MODD_PARAM_ICE :
+! ---------------------------------------
+!
+IF (KMI == 1) THEN
+ LRED = .TRUE.
+ LWARM = .TRUE.
+ CPRISTINE_ICE = 'PLAT'
+ LSEDIC = .TRUE.
+ LCONVHG = .FALSE.
+ CSEDIM = 'SPLI'
+ LFEEDBACKT = .TRUE.
+ LEVLIMIT = .TRUE.
+ LNULLWETG = .TRUE.
+ LWETGPOST = .TRUE.
+ LNULLWETH = .TRUE.
+ LWETHPOST = .TRUE.
+ CSNOWRIMING = 'M90 '
+ CSUBG_RC_RR_ACCR = 'NONE'
+ CSUBG_RR_EVAP = 'NONE'
+ CSUBG_PR_PDF = 'SIGM'
+ XFRACM90 = 0.1
+ LCRFLIMIT = .TRUE.
+ NMAXITER = 5
+ XMRSTEP = 0.00005
+ XTSTEP_TS = 0.
+ LADJ_BEFORE = .TRUE.
+ LADJ_AFTER = .TRUE.
+ CFRAC_ICE_ADJUST = 'S'
+ XSPLIT_MAXCFL = 0.8
+ CFRAC_ICE_SHALLOW_MF = 'S'
+ LSEDIM_AFTER = .FALSE.
+ LDEPOSC = .FALSE.
+ XVDEPOSC= 0.02 ! 2 cm/s
+ LSNOW_T=.FALSE.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 17. SET DEFAULT VALUES FOR MODD_PARAM_KAFR_n :
+! --------------------------------------------
+!
+XDTCONV = MAX( 300.0,XTSTEP )
+NICE = 1
+LREFRESH_ALL = .TRUE.
+LCHTRANS = .FALSE.
+LDOWN = .TRUE.
+LSETTADJ = .FALSE.
+XTADJD = 3600.
+XTADJS = 10800.
+LDIAGCONV = .FALSE.
+NENSM = 0
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 18. SET DEFAULT VALUES FOR MODD_PARAM_MFSHALL_n :
+! --------------------------------------------
+!
+XIMPL_MF = 1.
+CMF_UPDRAFT = 'EDKF'
+CMF_CLOUD = 'DIRE'
+LMIXUV = .TRUE.
+LMF_FLX = .FALSE.
+!
+XALP_PERT = 0.3
+XABUO = 1.
+XBENTR = 1.
+XBDETR = 0.
+XCMF = 0.065
+XENTR_MF = 0.035
+XCRAD_MF = 50.
+XENTR_DRY = 0.55
+XDETR_DRY = 10.
+XDETR_LUP = 1.
+XKCF_MF = 2.75
+XKRC_MF = 1.
+XTAUSIGMF = 600.
+XPRES_UV = 0.5
+XFRAC_UP_MAX= 0.33
+XALPHA_MF = 2.
+XSIGMA_MF = 20.
+!
+XA1 = 2./3.
+XB = 0.002
+XC = 0.012
+XBETA1 = 0.9
+XR = 2.
+XLAMBDA_MF= 0.
+LGZ = .FALSE.
+XGZ = 1.83 ! between 1.83 and 1.33
+!
+!-------------------------------------------------------------------------------
+!
+!* 19. SET DEFAULT VALUES FOR MODD_PARAM_C2R2 :
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ XNUC = 1.0
+ XALPHAC = 3.0
+ XNUR = 2.0
+ XALPHAR = 1.0
+!
+ LRAIN = .TRUE.
+ LSEDC = .TRUE.
+ LACTIT = .FALSE.
+ LSUPSAT = .FALSE.
+ LDEPOC = .FALSE.
+ XVDEPOC = 0.02 ! 2 cm/s
+ LACTTKE = .TRUE.
+!
+ HPARAM_CCN = 'XXX'
+ HINI_CCN = 'XXX'
+ HTYPE_CCN = 'X'
+!
+ XCHEN = 0.0
+ XKHEN = 0.0
+ XMUHEN = 0.0
+ XBETAHEN = 0.0
+!
+ XCONC_CCN = 0.0
+ XAERDIFF = 0.0
+ XAERHEIGHT = 2000
+ XR_MEAN_CCN = 0.0
+ XLOGSIG_CCN = 0.0
+ XFSOLUB_CCN = 1.0
+ XACTEMP_CCN = 280.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 19.BIS SET DEFAULT VALUES FOR MODD_PARAM_LIMA :
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ LPTSPLIT = .FALSE.
+ L_LFEEDBACKT = .TRUE.
+ L_NMAXITER = 1
+ L_XMRSTEP = 0.
+ L_XTSTEP_TS = 0.
+!
+ YNUC = 1.0
+ YALPHAC = 3.0
+ YNUR = 2.0
+ YALPHAR = 1.0
+!
+ OWARM = .TRUE.
+ LACTI = .TRUE.
+ ORAIN = .TRUE.
+ OSEDC = .TRUE.
+ OACTIT = .FALSE.
+ LADJ = .TRUE.
+ LSPRO = .FALSE.
+ LKHKO = .FALSE.
+ ODEPOC = .TRUE.
+ LBOUND = .FALSE.
+ OACTTKE = .TRUE.
+ LKESSLERAC = .FALSE.
+!
+ NMOM_C = 2
+ NMOM_R = 2
+!
+ OVDEPOC = 0.02 ! 2 cm/s
+!
+ CINI_CCN = 'AER'
+ CTYPE_CCN(:) = 'M'
+!
+ YAERDIFF = 0.0
+ YAERHEIGHT = 2000.
+! YR_MEAN_CCN = 0.0 ! In case of 'CCN' initialization
+! YLOGSIG_CCN = 0.0
+ YFSOLUB_CCN = 1.0
+ YACTEMP_CCN = 280.
+!
+ NMOD_CCN = 1
+!
+!* AP Scavenging
+!
+ LSCAV = .FALSE.
+ LAERO_MASS = .FALSE.
+!
+ LCCN_HOM = .TRUE.
+ CCCN_MODES = 'COPT'
+ XCCN_CONC(:)=300.
+!
+ LHHONI = .FALSE.
+ LCOLD = .TRUE.
+ LNUCL = .TRUE.
+ LSEDI = .TRUE.
+ LSNOW = .TRUE.
+ LHAIL = .FALSE.
+ YSNOW_T = .FALSE.
+ LMURAKAMI = .TRUE.
+ CPRISTINE_ICE_LIMA = 'PLAT'
+ CHEVRIMED_ICE_LIMA = 'GRAU'
+ XFACTNUC_DEP = 1.0
+ XFACTNUC_CON = 1.0
+ NMOM_I = 2
+ NMOM_S = 1
+ NMOM_G = 1
+ NMOM_H = 1
+ NMOD_IFN = 1
+ NIND_SPECIE = 1
+ LMEYERS = .FALSE.
+ LIFN_HOM = .TRUE.
+ CIFN_SPECIES = 'PHILLIPS'
+ CINT_MIXING = 'DM2'
+ XIFN_CONC(:) = 100.
+ NMOD_IMM = 0
+ NPHILLIPS=8
+ LCIBU = .FALSE.
+ XNDEBRIS_CIBU = 50.0
+ LRDSF = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 20. SET DEFAULT VALUES FOR MODD_CH_MNHC_n
+! -------------------------------------
+!
+LUSECHEM = .FALSE.
+LUSECHAQ = .FALSE.
+LUSECHIC = .FALSE.
+LCH_INIT_FIELD = .FALSE.
+LCH_CONV_SCAV = .FALSE.
+LCH_CONV_LINOX = .FALSE.
+LCH_PH = .FALSE.
+LCH_RET_ICE = .FALSE.
+XCH_PHINIT = 5.2
+XRTMIN_AQ = 5.e-8
+CCHEM_INPUT_FILE = 'EXSEG1.nam'
+CCH_TDISCRETIZATION = 'SPLIT'
+NCH_SUBSTEPS = 1
+LCH_TUV_ONLINE = .FALSE.
+CCH_TUV_LOOKUP = 'PHOTO.TUV39'
+CCH_TUV_CLOUDS = 'NONE'
+XCH_TUV_ALBNEW = -1.
+XCH_TUV_DOBNEW = -1.
+XCH_TUV_TUPDATE = 600.
+CCH_VEC_METHOD = 'MAX'
+NCH_VEC_LENGTH = 50
+XCH_TS1D_TSTEP = 600.
+CCH_TS1D_COMMENT = 'no comment'
+CCH_TS1D_FILENAME = 'IO1D'
+CSPEC_PRODLOSS = ''
+CSPEC_BUDGET = ''
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. SET DEFAULT VALUES FOR MODD_SERIES AND MODD_SERIE_n
+! ---------------------------------------------------
+!
+IF (KMI == 1) THEN
+ LSERIES = .FALSE.
+ LMASKLANDSEA = .FALSE.
+ LWMINMAX = .FALSE.
+ LSURF = .FALSE.
+ENDIF
+!
+NIBOXL = 1 !+ JPHEXT
+NIBOXH = 1 !+ 2*JPHEXT
+NJBOXL = 1 !+ JPHEXT
+NJBOXH = 1 !+ 2*JPHEXT
+NKCLS = 1 !+ JPVEXT
+NKLOW = 1 !+ JPVEXT
+NKMID = 1 !+ JPVEXT
+NKUP = 1 !+ JPVEXT
+NKCLA = 1 !+ JPVEXT
+NBJSLICE = 1
+NJSLICEL(:) = 1 !+ JPHEXT
+NJSLICEH(:) = 1 !+ 2*JPHEXT
+NFREQSERIES = INT(XSEGLEN /(100.*XTSTEP) )
+NFREQSERIES = MAX(NFREQSERIES,1)
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_TURB_CLOUD
+! --------------------------------------
+!
+IF (KMI == 1) THEN
+ NMODEL_CLOUD = NUNDEF
+ CTURBLEN_CLOUD = 'DELT'
+ XCOEF_AMPL_SAT = 5.
+ XCEI_MIN = 0.001E-06
+ XCEI_MAX = 0.01E-06
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_MEAN_FIELD
+! --------------------------------------
+!
+IF (KMI == 1) THEN
+ LMEAN_FIELD = .FALSE.
+ LCOV_FIELD = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_AEROSOL
+! -----------------------------------
+IF (KMI == 1) THEN ! other values are defined in modd_ch_aerosol
+!
+! aerosol lognormal parameterization
+
+LVARSIGI = .FALSE. ! switch to active pronostic dispersion for I mode
+LVARSIGJ = .FALSE. ! switch to active pronostic dispersion for J mode
+LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous
+ ! production
+LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation
+LAERINIT = .FALSE. ! switch to initialize aerosol in arome
+CMINERAL = "NONE" ! mineral equilibrium scheme
+CORGANIC = "NONE" ! mineral equilibrium scheme
+CNUCLEATION = "NONE" ! sulfates nucleation scheme
+LDEPOS_AER(:) = .FALSE.
+
+ENDIF
+
+!* 23. SET DEFAULT VALUES FOR MODD_DUST and MODD_SALT
+! ----------------------------------------------
+!
+IF (KMI == 1) THEN ! other values initialized in modd_dust
+ LDUST = .FALSE.
+ NMODE_DST = 3
+ LVARSIG = .FALSE.
+ LSEDIMDUST = .FALSE.
+ LDEPOS_DST(:) = .FALSE.
+
+ LSALT = .FALSE.
+ LVARSIG_SLT= .FALSE.
+ LSEDIMSALT = .FALSE.
+ LDEPOS_SLT(:) = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 24. SET DEFAULT VALUES FOR MODD_PASPOL
+! ----------------------------------
+!
+! other values initialized in modd_paspol
+!
+IF (KMI == 1) THEN
+ LPASPOL = .FALSE.
+ NRELEASE = 0
+ CPPINIT(:) ='1PT'
+ XPPLAT(:) = 0.
+ XPPLON (:) = 0.
+ XPPMASS(:) = 0.
+ XPPBOT(:) = 0.
+ XPPTOP(:) = 0.
+ CPPT1(:) = "20010921090000"
+ CPPT2(:) = "20010921090000"
+ CPPT3(:) = "20010921091500"
+ CPPT4(:) = "20010921091500"
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 25. SET DEFAULT VALUES FOR MODD_CONDSAMP
+! ----------------------------------
+!
+! other values initialized in modd_condsamp
+!
+IF (KMI == 1) THEN
+ LCONDSAMP = .FALSE.
+ NCONDSAMP = 3
+ XRADIO(:) = 900.
+ XSCAL(:) = 1.
+ XHEIGHT_BASE = 100.
+ XDEPTH_BASE = 100.
+ XHEIGHT_TOP = 100.
+ XDEPTH_TOP = 100.
+ NFINDTOP = 0
+ XTHVP = 0.25
+ LTPLUS = .TRUE.
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!
+!* 26. SET DEFAULT VALUES FOR MODD_LATZ_EDFLX
+! ----------------------------------
+!
+IF (KMI == 1) THEN
+ LUV_FLX=.FALSE.
+ XUV_FLX1=3.E+14
+ XUV_FLX2=0.
+ LTH_FLX=.FALSE.
+ XTH_FLX=0.75
+ENDIF
+#ifdef MNH_FOREFIRE
+!-------------------------------------------------------------------------------
+!
+!* 27. SET DEFAULT VALUES FOR MODD_FOREFIRE
+! ----------------------------------
+!
+! other values initialized in modd_forefire
+!
+IF (KMI == 1) THEN
+ LFOREFIRE = .FALSE.
+ LFFCHEM = .FALSE.
+ COUPLINGRES = 100.
+ NFFSCALARS = 0
+ENDIF
+#endif
+!-------------------------------------------------------------------------------
+!
+!* 28. SET DEFAULT VALUES FOR MODD_BLOWSNOW AND MODD_BLOWSNOW_n
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ LBLOWSNOW = .FALSE.
+ XALPHA_SNOW = 3.
+ XRSNOW = 4.
+ CSNOWSEDIM = 'TABC'
+END IF
+LSNOWSUBL = .FALSE.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 29. SET DEFAULT VALUES FOR MODD_VISC
+! ----------------------------------
+!
+! other values initialized in modd_VISC
+!
+IF (KMI == 1) THEN
+ LVISC = .FALSE.
+ LVISC_UVW = .FALSE.
+ LVISC_TH = .FALSE.
+ LVISC_SV = .FALSE.
+ LVISC_R = .FALSE.
+ XMU_V = 0.
+ XPRANDTL = 0.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 30. SET DEFAULT VALUES FOR MODD_DRAG
+! ----------------------------------
+!
+! other values initialized in modd_DRAG
+!
+IF (KMI == 1) THEN
+ LDRAG = .FALSE.
+ LMOUNT = .FALSE.
+ NSTART = 1
+ XHSTART = 0.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 31. SET DEFAULT VALUES FOR MODD_IBM_PARAMn
+! --------------------------------------
+!
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ XIBM_EPSI = 1.E-9
+ XIBM_IEPS = 1.E+9
+ NIBM_ITR = 8
+ XIBM_RUG = 0.01 ! (m^1.s^-0)
+ XIBM_VISC = 1.56e-5 ! (m^2.s^-1)
+ XIBM_CNU = 0.06 ! (m^0.s^-0)
+
+ NIBM_LAYER_P = 2
+ NIBM_LAYER_Q = 2
+ NIBM_LAYER_R = 2
+ NIBM_LAYER_S = 2
+ NIBM_LAYER_T = 2
+ NIBM_LAYER_E = 2
+ NIBM_LAYER_V = 2
+
+ XIBM_RADIUS_P = 2.
+ XIBM_RADIUS_Q = 2.
+ XIBM_RADIUS_R = 2.
+ XIBM_RADIUS_S = 2.
+ XIBM_RADIUS_T = 2.
+ XIBM_RADIUS_E = 2.
+ XIBM_RADIUS_V = 2.
+
+ XIBM_POWERS_P = 1.
+ XIBM_POWERS_Q = 1.
+ XIBM_POWERS_R = 1.
+ XIBM_POWERS_S = 1.
+ XIBM_POWERS_T = 1.
+ XIBM_POWERS_E = 1.
+ XIBM_POWERS_V = 1.
+
+ CIBM_MODE_INTE3_P = 'LAI'
+ CIBM_MODE_INTE3_Q = 'LAI'
+ CIBM_MODE_INTE3_R = 'LAI'
+ CIBM_MODE_INTE3_S = 'LAI'
+ CIBM_MODE_INTE3_T = 'LAI'
+ CIBM_MODE_INTE3_E = 'LAI'
+ CIBM_MODE_INTE3_V = 'LAI'
+
+ CIBM_MODE_INTE1_P = 'CL2'
+ CIBM_MODE_INTE1_Q = 'CL2'
+ CIBM_MODE_INTE1_R = 'CL2'
+ CIBM_MODE_INTE1_S = 'CL2'
+ CIBM_MODE_INTE1_T = 'CL2'
+ CIBM_MODE_INTE1_E = 'CL2'
+ CIBM_MODE_INTE1NV = 'CL2'
+ CIBM_MODE_INTE1TV = 'CL2'
+ CIBM_MODE_INTE1CV = 'CL2'
+
+ CIBM_MODE_BOUND_P = 'SYM'
+ CIBM_MODE_BOUND_Q = 'SYM'
+ CIBM_MODE_BOUND_R = 'SYM'
+ CIBM_MODE_BOUND_S = 'SYM'
+ CIBM_MODE_BOUND_T = 'SYM'
+ CIBM_MODE_BOUND_E = 'SYM'
+ CIBM_MODE_BOUNT_V = 'ASY'
+ CIBM_MODE_BOUNN_V = 'ASY'
+ CIBM_MODE_BOUNC_V = 'ASY'
+
+ XIBM_FORC_BOUND_P = 0.
+ XIBM_FORC_BOUND_Q = 0.
+ XIBM_FORC_BOUND_R = 0.
+ XIBM_FORC_BOUND_S = 0.
+ XIBM_FORC_BOUND_T = 0.
+ XIBM_FORC_BOUND_E = 0.
+ XIBM_FORC_BOUNN_V = 0.
+ XIBM_FORC_BOUNT_V = 0.
+ XIBM_FORC_BOUNC_V = 0.
+
+ CIBM_TYPE_BOUND_P = 'NEU'
+ CIBM_TYPE_BOUND_Q = 'NEU'
+ CIBM_TYPE_BOUND_R = 'NEU'
+ CIBM_TYPE_BOUND_S = 'NEU'
+ CIBM_TYPE_BOUND_T = 'NEU'
+ CIBM_TYPE_BOUND_E = 'NEU'
+ CIBM_TYPE_BOUNT_V = 'DIR'
+ CIBM_TYPE_BOUNN_V = 'DIR'
+ CIBM_TYPE_BOUNC_V = 'DIR'
+
+ CIBM_FORC_BOUND_P = 'CST'
+ CIBM_FORC_BOUND_Q = 'CST'
+ CIBM_FORC_BOUND_R = 'CST'
+ CIBM_FORC_BOUND_S = 'CST'
+ CIBM_FORC_BOUND_T = 'CST'
+ CIBM_FORC_BOUND_E = 'CST'
+ CIBM_FORC_BOUNN_V = 'CST'
+ CIBM_FORC_BOUNT_V = 'CST'
+ CIBM_FORC_BOUNC_V = 'CST'
+ CIBM_FORC_BOUNR_V = 'CST'
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn
+! --------------------------------------
+!
+ LRECYCL = .FALSE.
+ LRECYCLN = .FALSE.
+ LRECYCLW = .FALSE.
+ LRECYCLE = .FALSE.
+ LRECYCLS = .FALSE.
+ XDRECYCLN = 0.
+ XARECYCLN = 0.
+ XDRECYCLW = 0.
+ XARECYCLW = 0.
+ XDRECYCLS = 0.
+ XARECYCLS = 0.
+ XDRECYCLE = 0.
+ XARECYCLE = 0.
+ XTMOY = 0.
+ XTMOYCOUNT = 0.
+ XNUMBELT = 28.
+ XRCOEFF = 0.2
+ XTBVTOP = 500.
+ XTBVBOT = 300.
+!
+!-------------------------------------------------------------------------------
+!
+!* 33. SET DEFAULT VALUES FOR MODD_FIRE
+! --------------------------------
+!
+! Blaze fire model namelist
+!
+IF (KMI == 1) THEN
+ LBLAZE = .FALSE. ! Flag for Fire model use, default FALSE
+ !
+ CPROPAG_MODEL = 'SANTONI2011' ! Fire propagation model (default SANTONI2011)
+ !
+ CHEAT_FLUX_MODEL = 'EXS' ! Sensible heat flux injection model (default EXS)
+ CLATENT_FLUX_MODEL = 'EXP' ! latent heat flux injection model (default EXP)
+ XFERR = 0.8 ! Energy released in flamming stage (only for EXP)
+ !
+ CFIRE_CPL_MODE = '2WAYCPL' ! Coupling mode (default 2way coupled)
+ CBMAPFILE = CINIFILE ! File name of BMAP for FIR2ATM mode
+ LINTERPWIND = .TRUE. ! Horizontal interpolation of wind
+ LSGBAWEIGHT = .FALSE. ! Flag for use of weighted average method for SubGrid Burning Area computation
+ !
+ NFIRE_WENO_ORDER = 3 ! Weno order (1,3,5)
+ NFIRE_RK_ORDER = 3 ! Runge Kutta order (1,2,3,4)
+ !
+ NREFINX = 1 ! Refinement ratio X
+ NREFINY = 1 ! Refinement ratio Y
+ !
+ XCFLMAXFIRE = 0.8 ! Max CFL on fire mesh
+ XLSDIFFUSION = 0.1 ! Numerical diffusion of LevelSet
+ XROSDIFFUSION = 0.05 ! Numerical diffusion of ROS
+ !
+ XFLUXZEXT = 3. ! Flux distribution on vertical caracteristic length
+ XFLUXZMAX = 4. * XFLUXZEXT ! Flux distribution on vertical max injetion height
+ !
+ XFLXCOEFTMP = 1. ! Flux multiplicator. For testing
+ !
+ LWINDFILTER = .FALSE. ! Fire wind filtering flag
+ CWINDFILTER = 'EWAM' ! Wind filter method (EWAM or WLIM)
+ XEWAMTAU = 20. ! Time averaging constant for EWAM method (s)
+ XWLIMUTH = 8. ! Thresehold wind value for WLIM method (m/s)
+ XWLIMUTMAX = 9. ! Maximum wind value for WLIM method (m/s) (needs to be >= XWLIMUTH )
+ !
+ NNBSMOKETRACER = 1 ! Nb of smoke tracers
+ !
+ NWINDSLOPECPLMODE = 0 ! Flag for use of wind/slope in ROS (0 = wind + slope, 1 = wind only, 2 = slope only (U0=0))
+ !
+ !
+ !
+ !! DO NOT CHANGE BELOW PARAMETERS
+ XFIREMESHSIZE(:) = 0. ! Fire mesh size (dxf,dyf)
+ LRESTA_ASE = .FALSE. ! Flag for using ASE in RESTA file
+ LRESTA_AWC = .FALSE. ! Flag for using AWC in RESTA file
+ LRESTA_EWAM = .FALSE. ! Flag for using EWAM in RESTA file
+ LRESTA_WLIM = .FALSE. ! Flag for using WLIM in RESTA file
+ENDIF
+
+!-------------------------------------------------------------------------------
+END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/PHYEX/ext/diagnos_les_mf.f90 b/src/PHYEX/ext/diagnos_les_mf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..665d1ea7666f6047ab2a4d8e9343253fb2852446
--- /dev/null
+++ b/src/PHYEX/ext/diagnos_les_mf.f90
@@ -0,0 +1,244 @@
+!MNH_LIC Copyright 2009-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_DIAGNOS_LES_MF
+! ###########################
+!
+INTERFACE
+!
+! #################################################################
+ SUBROUTINE DIAGNOS_LES_MF(KIU,KJU,KKU,PTIME_LES, &
+ PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
+ PU_UP, PV_UP, PTHV_UP, PW_UP, &
+ PFRAC_UP,PEMF,PDETR,PENTR, &
+ PWTHMF,PWTHVMF,PWRTMF, &
+ PWUMF,PWVMF, &
+ KKLCL,KKETL,KKCTL)
+! #################################################################
+!
+!* 1.1 Declaration of Arguments
+!
+use modd_precision, only: MNHTIME
+!
+INTEGER, INTENT(IN) :: KIU, KJU, KKU ! 3D grid size
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(OUT) :: PTIME_LES
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL_UP,PRT_UP,PRV_UP,&
+ PRC_UP,PRI_UP ! updraft properties
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PU_UP, PV_UP
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHV_UP,PW_UP,&
+ PFRAC_UP,PEMF,PDETR,PENTR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHMF,PWTHVMF,PWRTMF, &
+ PWUMF,PWVMF
+INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL,KKETL,KKCTL
+
+
+END SUBROUTINE DIAGNOS_LES_MF
+
+END INTERFACE
+!
+END MODULE MODI_DIAGNOS_LES_MF
+!
+! #################################################################
+ SUBROUTINE DIAGNOS_LES_MF(KIU,KJU,KKU,PTIME_LES, &
+ PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
+ PU_UP, PV_UP, PTHV_UP, PW_UP, &
+ PFRAC_UP,PEMF,PDETR,PENTR, &
+ PWTHMF,PWTHVMF,PWRTMF, &
+ PWUMF,PWVMF, &
+ KKLCL,KKETL,KKCTL)
+! #################################################################
+!!
+!!**** *DIAGNOS_LES_MF* - Edit in File the updraft properties as
+!! LES diagnostics
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to write updraft variable as
+!! LES diagnostics
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.pergaud
+!
+! Modifications:
+! V. Masson 09/2010: Optimization
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_LES
+use modd_precision, only: MNHTIME
+!
+USE MODE_MNH_TIMING
+!
+USE MODI_LES_VER_INT
+USE MODI_LES_MEAN_ll
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+
+!* 0.1 Declaration of Arguments
+!
+!
+INTEGER, INTENT(IN) :: KIU, KJU, KKU ! 3D grid size
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(OUT) :: PTIME_LES
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL_UP,PRT_UP,PRV_UP,&
+ PRC_UP,PRI_UP ! updraft properties
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PU_UP, PV_UP
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHV_UP,PW_UP,&
+ PFRAC_UP,PEMF,PDETR,PENTR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHMF,PWTHVMF,PWRTMF, &
+ PWUMF,PWVMF
+INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL,KKETL,KKCTL
+
+!
+!
+! 0.2 Declaration of local variables
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHLMFFLX_LES,ZRTMFFLX_LES, &
+ ZTHVMFFLX_LES,ZUMFFLX_LES, &
+ ZVMFFLX_LES
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHLUP_MF_LES,ZRTUP_MF_LES, &
+ ZRCUP_MF_LES,ZEMF_MF_LES, &
+ ZDETR_MF_LES, ZENTR_MF_LES, &
+ ZWUP_MF_LES,ZFRACUP_MF_LES, &
+ ZTHVUP_MF_LES,ZRVUP_MF_LES, &
+ ZRIUP_MF_LES
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2
+!------------------------------------------------------------------------
+!
+
+CALL SECOND_MNH2(ZTIME1)
+
+ IF (LLES_CALL) THEN
+
+ ALLOCATE( ZTHLUP_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZRTUP_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZRVUP_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZRCUP_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZRIUP_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZEMF_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZDETR_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZENTR_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZWUP_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZFRACUP_MF_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZTHVUP_MF_LES(KIU,KJU,NLES_K) )
+
+ ALLOCATE( ZTHLMFFLX_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZRTMFFLX_LES (KIU,KJU,NLES_K) )
+ ALLOCATE( ZTHVMFFLX_LES(KIU,KJU,NLES_K) )
+ ALLOCATE( ZUMFFLX_LES (KIU,KJU,NLES_K) )
+ ALLOCATE( ZVMFFLX_LES (KIU,KJU,NLES_K) )
+
+
+ CALL LES_VER_INT(MZF(PWTHMF) ,ZTHLMFFLX_LES )
+ CALL LES_MEAN_ll(ZTHLMFFLX_LES,LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_WTHLMF(:,NLES_CURRENT_TCOUNT,1))
+
+ CALL LES_VER_INT( MZF(PWRTMF) ,ZRTMFFLX_LES )
+ CALL LES_MEAN_ll (ZRTMFFLX_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_WRTMF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PWUMF) ,ZUMFFLX_LES )
+ CALL LES_MEAN_ll (ZUMFFLX_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_WUMF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PWVMF) ,ZVMFFLX_LES )
+ CALL LES_MEAN_ll (ZVMFFLX_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_WVMF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PWTHVMF) ,ZTHVMFFLX_LES )
+ CALL LES_MEAN_ll (ZTHVMFFLX_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,1) )
+
+
+ CALL LES_VER_INT( MZF(PTHL_UP) ,ZTHLUP_MF_LES )
+ CALL LES_MEAN_ll (ZTHLUP_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_THLUP_MF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PRT_UP) ,ZRTUP_MF_LES )
+ CALL LES_MEAN_ll (ZRTUP_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_RTUP_MF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PRV_UP) ,ZRVUP_MF_LES )
+ CALL LES_MEAN_ll (ZRVUP_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_RVUP_MF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PRC_UP) ,ZRCUP_MF_LES )
+ CALL LES_MEAN_ll (ZRCUP_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_RCUP_MF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PRI_UP) ,ZRIUP_MF_LES )
+ CALL LES_MEAN_ll (ZRIUP_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_RIUP_MF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PEMF) ,ZEMF_MF_LES )
+ CALL LES_MEAN_ll (ZEMF_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_MASSFLUX(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PDETR) ,ZDETR_MF_LES )
+ CALL LES_MEAN_ll (ZDETR_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_DETR(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PENTR) ,ZENTR_MF_LES )
+ CALL LES_MEAN_ll (ZENTR_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_ENTR(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PW_UP) ,ZWUP_MF_LES )
+ CALL LES_MEAN_ll (ZWUP_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_WUP_MF(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PFRAC_UP) ,ZFRACUP_MF_LES )
+ CALL LES_MEAN_ll (ZFRACUP_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_FRACUP(:,NLES_CURRENT_TCOUNT,1) )
+
+ CALL LES_VER_INT( MZF(PTHV_UP) ,ZTHVUP_MF_LES )
+ CALL LES_MEAN_ll (ZTHVUP_MF_LES , LLES_CURRENT_CART_MASK, &
+ X_LES_SUBGRID_THVUP_MF(:,NLES_CURRENT_TCOUNT,1) )
+
+
+
+ DEALLOCATE( ZTHLMFFLX_LES )
+ DEALLOCATE( ZRTMFFLX_LES )
+ DEALLOCATE( ZTHVMFFLX_LES )
+ DEALLOCATE( ZUMFFLX_LES )
+ DEALLOCATE( ZVMFFLX_LES )
+
+
+ DEALLOCATE( ZTHLUP_MF_LES )
+ DEALLOCATE( ZRTUP_MF_LES )
+ DEALLOCATE( ZRVUP_MF_LES )
+ DEALLOCATE( ZRCUP_MF_LES )
+ DEALLOCATE( ZRIUP_MF_LES )
+ DEALLOCATE( ZENTR_MF_LES )
+ DEALLOCATE( ZDETR_MF_LES )
+ DEALLOCATE( ZEMF_MF_LES )
+ DEALLOCATE( ZWUP_MF_LES )
+ DEALLOCATE( ZFRACUP_MF_LES )
+ DEALLOCATE( ZTHVUP_MF_LES )
+
+ENDIF
+
+CALL SECOND_MNH2(ZTIME2)
+PTIME_LES = ZTIME2 - ZTIME1
+XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+
+END SUBROUTINE DIAGNOS_LES_MF
diff --git a/src/PHYEX/ext/ground_paramn.f90 b/src/PHYEX/ext/ground_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5d872413b3361b500da93f8a7671510c51adfdac
--- /dev/null
+++ b/src/PHYEX/ext/ground_paramn.f90
@@ -0,0 +1,1230 @@
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########
+MODULE MODI_GROUND_PARAM_n
+! ##########
+!
+INTERFACE
+!
+ SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!* surface fluxes
+! --------------
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
+ ! flux of chemical var. (ppp.m/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFU ! surface fluxes of horizontal
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFV ! momentum in x and y directions (m2/s2)
+!
+!* Radiative parameters
+! --------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-)
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-)
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K)
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
+END SUBROUTINE GROUND_PARAM_n
+!
+END INTERFACE
+!
+END MODULE MODI_GROUND_PARAM_n
+!
+! ######################################################################
+ SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
+! #######################################################################
+!
+!
+!!**** *GROUND_PARAM*
+!!
+!! PURPOSE
+!! -------
+! Monitor to call the externalized surface
+!
+!!** METHOD
+!! ------
+!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Noilhan and Planton (1989)
+!!
+!! AUTHOR
+!! ------
+!! S. Belair * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 10/03/95
+!! (J.Stein) 25/10/95 add the rain flux computation at the ground
+!! and the lbc
+!! (J.Stein) 15/11/95 include the strong slopes cases
+!! (J.Stein) 06/02/96 bug correction for the precipitation flux writing
+!! (J.Stein) 20/05/96 set the right IGRID value for the rain rate
+!! (J.Viviand) 04/02/97 add cold and convective precipitation rate
+!! (J.Stein) 22/06/97 use the absolute pressure
+!! (V.Masson) 09/07/97 add directional z0 computations and RESA correction
+!! (V.Masson) 13/02/98 merge the ISBA and TSZ0 routines,
+!! rename the routine as a monitor, called by PHYS_PARAMn
+!! add the town parameterization
+!! recomputes z0 where snow is.
+!! pack and unpack of 2D fields into 1D fields
+!! (V.Masson) 04/01/00 removes the TSZ0 case
+! (F.Solmon/V.Masson) adapatation for patch approach
+! modification of internal subroutine pack/ allocation in function
+! of patch indices
+! calling of isba for each defined patch
+! averaging of patch fluxes to get nat fluxes
+! (P. Tulet/G.Guenais) 04/02/01 separation of vegetatives class
+! for friction velocity and
+! aerodynamical resistance
+! (S Donnier) 09/12/02 add specific humidity at 2m for diagnostic
+! (V.Masson) 01/03/03 externalisation of the surface schemes!
+! (P.Tulet ) 01/11/03 externalisation of the surface chemistry!
+!! (D.Gazen) 01/12/03 change emissions handling for surf. externalization
+!! (J.escobar) 18/10/2012 missing USE MODI_COUPLING_SURF_ATM_n & MODI_DIAG_SURF_ATM_n
+! (J.escobar) 02/2014 add Forefire coupling
+!! (G.Delautier) 06/2016 phasage surfex 8
+!! (B.Vie) 2016 LIMA
+!! (J.Pianezze) 08/2016 add send/recv oasis functions
+!! (M.Leriche) 24/03/16 remove flag for chemical surface fluxes
+!! (M.Leriche) 01/07/2017 Add DIAG chimical surface fluxes
+!! 01/2018 (G.Delautier) SURFEX 8.1
+!! 02/2018 Q.Libois ECRAD
+!! (P.Wautelet) 28/03/2018 replace TEMPORAL_DIST by DATETIME_DISTANCE
+
+!! (V. Vionnet) 18/07/2017 add coupling for blowing snow module
+!! (Bielli S.) 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 09/02/2022: bugfix: add missing XCURRENT_LEI computation
+! A. Costes 12/2021: Blaze Fire model
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+#ifdef CPLOASIS
+USE MODI_GET_HALO
+USE MODI_MNH_OASIS_RECV
+USE MODI_MNH_OASIS_SEND
+USE MODD_SFX_OASIS, ONLY : LOASIS
+USE MODD_DYN, ONLY : XSEGLEN
+USE MODD_DYN_n, ONLY : DYN_MODEL
+#endif
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD, XAVOGADRO
+USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
+USE MODD_DYN_n, ONLY : XTSTEP
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM
+USE MODD_CH_M9_n, ONLY : CNAMES
+USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS,&
+XLSPHI, XBMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMIGNITION, XFMFUELTYPE,&
+XFIRETAU, XFLUXPARAMH, XFLUXPARAMW, XFIRERW, XFMASE, XFMAWC, XFMWALKIG,&
+XFMFLUXHDH, XFMFLUXHDW, XRTHS, XRRS, XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW, XGRADLSPHIX, &
+XGRADLSPHIY, XFIREWIND, XFMGRADOROX, XFMGRADOROY
+USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ
+USE MODD_DIM_n, ONLY : NKMAX
+USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE, XSINSLOPE, XZS
+USE MODD_REF_n, ONLY : XRHODREF,XRHODJ,XEXNREF
+USE MODD_CONF_n, ONLY : NRR
+USE MODD_PARAM_n, ONLY : CDCONV,CCLOUD, CRAD
+USE MODD_PRECIP_n, ONLY : XINPRC, XINPRR, XINPRS, XINPRG, XINPRH
+USE MODD_DEEP_CONVECTION_n, ONLY : XPRCONV, XPRSCONV
+USE MODD_CONF, ONLY : LCARTESIAN, CPROGRAM
+USE MODD_TIME_n, ONLY : TDTCUR
+USE MODD_RADIATIONS_n, ONLY : XFLALWD, XCCO2, XTSIDER, &
+ XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, &
+ XZENITH, XAZIM, XAER, XSWU, XLWU
+USE MODD_NSV
+USE MODD_GRID, ONLY : XLON0, XRPK, XBETA
+USE MODD_PARAM_ICE, ONLY : LSEDIC
+USE MODD_PARAM_C2R2, ONLY : LSEDC
+USE MODD_DIAG_IN_RUN
+USE MODD_DUST, ONLY : LDUST
+USE MODD_SALT, ONLY : LSALT
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+USE MODD_CH_AEROSOL, ONLY : LORILAM
+USE MODD_CSTS_DUST, ONLY : XMOLARWEIGHT_DUST
+USE MODD_CSTS_SALT, ONLY : XMOLARWEIGHT_SALT
+USE MODD_CH_FLX_n, ONLY : XCHFLX
+USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG
+!
+USE MODI_NORMAL_INTERPOL
+USE MODE_ROTATE_WIND, ONLY : ROTATE_WIND
+USE MODI_SHUMAN
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_COUPLING_SURF_ATM_n
+USE MODI_DIAG_SURF_ATM_n
+USE MODD_MNH_SURFEX_n
+!
+USE MODE_DATETIME
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+#ifdef MNH_FOREFIRE
+!** MODULES FOR FOREFIRE **!
+USE MODD_FOREFIRE
+USE MODD_FOREFIRE_n
+USE MODI_COUPLING_FOREFIRE_n
+#endif
+!
+USE MODD_TIME_n
+USE MODD_TIME
+!
+USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
+!
+USE MODD_FIRE
+USE MODD_FIELD
+USE MODI_FIRE_MODEL
+USE MODD_CONF, ONLY : NVERB, NHALO
+USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_MSG
+USE MODD_IO, ONLY: TFILEDATA
+!
+IMPLICIT NONE
+!
+!
+!
+!* 0.1 declarations of arguments
+!
+!* surface fluxes
+! --------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
+ ! flux of chemical var. (ppp.m/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFU ! surface fluxes of horizontal
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFV ! momentum in x and y directions (m2/s2)
+!
+!* Radiative parameters
+! --------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-)
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-)
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K)
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 0.2 declarations of local variables
+! -------------------------------
+!
+!
+!* Atmospheric variables
+! ---------------------
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! vapor mixing ratio
+!
+! suffix 'A' stands for atmospheric variable at first model level
+!
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF ! Forcing height
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTA ! Temperature
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRVA ! vapor mixing ratio
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZQA ! humidity (kg/m3)
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPA ! Pressure
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPS ! Pressure
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNA ! Exner function
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Exner function
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTHA ! potential temperature
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRAIN ! liquid precipitation (kg/m2/s)
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSNOW ! solid precipitation (kg/m2/s)
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTSUN ! solar time (s since midnight)
+!
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZUA ! u component of the wind
+! ! parallel to the orography
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZVA ! v component of the wind
+! ! parallel to the orography
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZU ! zonal wind
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZV ! meridian wind
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWIND ! wind parallel to the orography
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRHOA ! air density
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZDIR ! wind direction (rad from N clockwise)
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFU ! zonal momentum flux
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFV ! meridian momentum flux
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCO2 ! CO2 concentration (kg/kg)
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZALFA ! angle between the wind
+! ! and the x axis
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZU2D ! u and v component of the
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZV2D ! wind at mass point
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH ! Turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFCO2 ! Turbulent flux of CO2
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NSV):: ZSFTS! Turbulent flux of scalar
+!
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NBLOWSNOW_2D) :: ZBLOWSNOW_2D ! 2D blowing snow variables
+ ! after advection
+ ! They refer to the 2D fields advected by MNH including:
+ ! - total number concentration in Canopy
+ ! - total mass concentration in Canopy
+ ! - equivalent concentration in the saltation layer
+!
+!* Dimensions
+! ----------
+!
+INTEGER :: IIB ! physical boundary
+INTEGER :: IIE ! physical boundary
+INTEGER :: IJB ! physical boundary
+INTEGER :: IJE ! physical boundary
+INTEGER :: IKB ! physical boundary
+INTEGER :: IKE ! physical boundary
+INTEGER :: IKU ! vertical array sizes
+!
+INTEGER :: JLAYER ! loop counter
+INTEGER :: JSV ! loop counter
+INTEGER :: JI,JJ,JK ! loop index
+!
+INTEGER :: IDIM1 ! X physical dimension
+INTEGER :: IDIM2 ! Y physical dimension
+INTEGER :: IDIM1D! total physical dimension
+INTEGER :: IKRAD
+!
+INTEGER :: KSV_SURF ! Number of scalar variables sent to SURFEX
+!
+!* Arrays put in 1D vectors
+! ------------------------
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSUN ! solar time
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZREF ! forcing height
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZS ! orography
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_U ! zonal wind
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_V ! meridian wind
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_QA ! air humidity (kg/m3)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_TA ! air temperature
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_RHOA ! air density
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_RAIN ! liquid precipitation
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SNOW ! solid precipitation
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_LW ! incoming longwave
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_SW ! direct incoming shortwave
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_SW ! diffuse incoming shortwave
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZWS ! significant wave height (m)
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! potential temperature flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SFTS ! scalar flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFCO2 ! CO2 flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFU ! zonal momentum flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFV ! meridian momentum flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative surface temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_ALB ! direct albedo
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_ALB ! diffuse albedo
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSURF
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0H
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_QSURF
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_A_COEF ! coefficients for
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_B_COEF ! implicit coupling
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_A_COEF
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEQ_A_COEF
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_B_COEF
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEQ_B_COEF
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_RN ! net radiation (W/m2)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_H ! sensible heat flux (W/m2)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_LE ! Total latent heat flux (W/m2)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_LEI ! Solid Latent heat flux (W/m2)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_GFLUX ! ground flux (W/m2)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_T2M ! Air temperature at 2 meters (K)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_Q2M ! Air humidity at 2 meters (kg/kg)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_HU2M ! Air relative humidity at 2 meters (-)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZON10M ! zonal Wind at 10 meters (m/s)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_MER10M ! meridian Wind at 10 meters (m/s)
+TYPE(LIST_ll), POINTER :: TZFIELDSURF_ll ! list of fields to exchange
+INTEGER :: IINFO_ll ! return code of parallel routine
+!
+!
+CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: YSV_SURF ! name of the scalar variables
+ ! sent to SURFEX
+!
+REAL :: ZTIMEC
+INTEGER :: ILUOUT ! logical unit
+!
+! Fire model
+REAL, DIMENSION(2) :: ZFIRETIME1, ZFIRETIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(2) :: ZGRADTIME1, ZGRADTIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(2) :: ZPROPAGTIME1, ZPROPAGTIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(2) :: ZFLUXTIME1, ZFLUXTIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(2) :: ZROSWINDTIME1, ZROSWINDTIME2 ! CPU time for Blaze perf profiling
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFIREFUELMAP ! Fuel map
+CHARACTER(LEN=7) :: YFUELMAPFILE ! Fuel Map file name
+TYPE(LIST_ll), POINTER :: TZFIELDFIRE_ll ! list of fields to exchange
+
+!-------------------------------------------------------------------------------
+!
+!
+ILUOUT=TLUOUT%NLU
+IKB= 1+JPVEXT
+IKU=NKMAX + 2* JPVEXT
+IKE=IKU-JPVEXT
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+PSFTH = XUNDEF
+PSFRV = XUNDEF
+PSFSV = XUNDEF
+PSFCO2 = XUNDEF
+PSFU = XUNDEF
+PSFV = XUNDEF
+PDIR_ALB = XUNDEF
+PSCA_ALB = XUNDEF
+PEMIS = XUNDEF
+PTSRAD = XUNDEF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. CONVERSION OF THE ATMOSPHERIC VARIABLES
+! ---------------------------------------
+!
+! 1.1 water vapor
+! -----------
+
+!
+ALLOCATE(ZRV(SIZE(PSFTH,1),SIZE(PSFTH,2),IKU))
+!
+IF(NRR>0) THEN
+ ZRV(:,:,:)=XRT(:,:,:,1)
+ELSE
+ ZRV(:,:,:)=0.
+END IF
+!
+! 1.2 Horizontal wind direction (rad from N clockwise)
+! -------------------------
+!
+ZU2D(:,:,:)=MXF(XUT(:,:,IKB:IKB))
+ZV2D(:,:,:)=MYF(XVT(:,:,IKB:IKB))
+!
+!* angle between Y axis and wind (rad., clockwise)
+!
+ZALFA = 0.
+WHERE(ZU2D(:,:,1)/=0. .OR. ZV2D(:,:,1)/=0.)
+ ZALFA(:,:)=ATAN2(ZU2D(:,:,1),ZV2D(:,:,1))
+END WHERE
+WHERE(ZALFA(:,:)<0.) ZALFA(:,:) = ZALFA(:,:) + 2. * XPI
+!
+!* angle between North and wind (rad., clockwise)
+!
+IF (.NOT. LCARTESIAN) THEN
+ ZDIR = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA
+ELSE
+ ZDIR = - XBETA * XPI/180. + ZALFA
+END IF
+!
+!
+! 1.3 Rotate the wind
+! ---------------
+!
+CALL ROTATE_WIND(D,XUT,XVT,XWT, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE,XSINSLOPE, &
+ XDXX,XDYY,XDZZ, &
+ ZUA,ZVA )
+
+!
+! 1.4 zonal and meridian components of the wind parallel to the slope
+! ---------------------------------------------------------------
+!
+ZWIND(:,:) = SQRT( ZUA**2 + ZVA**2 )
+!
+ZU(:,:) = ZWIND(:,:) * SIN(ZDIR)
+ZV(:,:) = ZWIND(:,:) * COS(ZDIR)
+!
+! 1.5 Horizontal interpolation the thermodynamic fields
+! -------------------------------------------------
+!
+CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE,XSINSLOPE, &
+ XDXX,XDYY,XDZZ, &
+ ZTHA,ZRVA,ZEXNA )
+!
+DEALLOCATE(ZRV)
+!
+!
+! 1.6 Pressure and Exner function
+! ---------------------------
+!
+!
+ZPA(:,:) = XP00 * ZEXNA(:,:) **(XCPD/XRD)
+!
+ZEXNS(:,:) = 0.5 * ( (XPABST(:,:,IKB-1)/XP00)**(XRD/XCPD) &
+ +(XPABST(:,:,IKB )/XP00)**(XRD/XCPD) &
+ )
+ZPS(:,:) = XP00 * ZEXNS(:,:) **(XCPD/XRD)
+!
+! 1.7 humidity in kg/m3 from the mixing ratio
+! ---------------------------------------
+!
+!
+ZQA(:,:) = ZRVA(:,:) * XRHODREF(:,:,IKB)
+!
+!
+! 1.8 Temperature from the potential temperature
+! ------------------------------------------
+!
+!
+ZTA(:,:) = ZTHA(:,:) * ZEXNA(:,:)
+!
+!
+! 1.9 Air density
+! -----------
+!
+ZRHOA(:,:) = ZPA(:,:)/(XRD * ZTA(:,:) * ((1. + (XRD/XRV)*ZRVA(:,:))/ &
+ (1. + ZRVA(:,:))))
+!
+!
+! 1.10 Precipitations
+! --------------
+!
+ZRAIN=0.
+ZSNOW=0.
+IF (NRR>2 .AND. SIZE(XINPRR)>0 ) THEN
+ IF (( CCLOUD(1:3) == 'ICE' .AND. LSEDIC) .OR. &
+ ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') .AND. LSEDC) .OR. &
+ ( CCLOUD=='LIMA' .AND. MSEDC)) THEN
+ ZRAIN = ZRAIN + XINPRR * XRHOLW + XINPRC * XRHOLW
+ ELSE
+ ZRAIN = ZRAIN + XINPRR * XRHOLW
+ END IF
+END IF
+IF (CDCONV == 'KAFR') THEN
+ ZRAIN = ZRAIN + (XPRCONV - XPRSCONV) * XRHOLW
+ ZSNOW = ZSNOW + XPRSCONV * XRHOLW
+END IF
+IF( NRR >= 5 .AND. SIZE(XINPRS)>0 ) ZSNOW = ZSNOW + XINPRS * XRHOLW
+IF( NRR >= 6 .AND. SIZE(XINPRG)>0 ) ZSNOW = ZSNOW + XINPRG * XRHOLW
+IF( NRR >= 7 .AND. SIZE(XINPRH)>0 ) ZSNOW = ZSNOW + XINPRH * XRHOLW
+!
+!
+! 1.11 Solar time
+! ----------
+!
+IF (.NOT. LCARTESIAN) THEN
+ ZTSUN(:,:) = MOD(TDTCUR%xtime -XTSIDER*3600. +XLON(:,:)*240., XDAY)
+ELSE
+ ZTSUN(:,:) = MOD(TDTCUR%xtime -XTSIDER*3600. +XLON0 *240., XDAY)
+END IF
+!
+! 1.12 Forcing level
+! -------------
+!
+ZZREF(:,:) = 0.5*( XZZ(:,:,IKB+1)-XZZ(:,:,IKB) )*XDIRCOSZW(:,:)
+!
+!
+! 1.13 CO2 concentration (kg/m3)
+! -----------------
+!
+ZCO2(:,:) = XCCO2 * XRHODREF(:,:,IKB)
+!
+!
+!
+! 1.14 Blowing snow scheme (optional)
+! -----------------
+!
+ZBLOWSNOW_2D=0.
+
+IF(LBLOWSNOW) THEN
+ KSV_SURF = NSV+NBLOWSNOW_2D ! When blowing snow scheme is used
+ ! NBLOWSN0W_2D variables are sent to SURFEX through ZP_SV.
+ ! They refer to the 2D fields advected by MNH including:
+ ! - total number concentration in Canopy
+ ! - total mass concentration in Canopy
+ ! - equivalent concentration in the saltation layer
+ ! Initialize array of scalar to be sent to SURFEX including 2D blowing snow fields
+ ALLOCATE(YSV_SURF(KSV_SURF))
+ YSV_SURF(1:NSV) = CSV(:)
+ YSV_SURF(NSV+1:KSV_SURF) = YPBLOWSNOW_2D(:)
+
+
+ DO JSV=1,NBLOWSNOW_2D
+ ZBLOWSNOW_2D(:,:,JSV) = XRSNWCANOS(:,:,JSV)*XTSTEP/XRHODJ(:,:,IKB)
+ END DO
+
+ELSE
+ KSV_SURF = NSV
+ ALLOCATE(YSV_SURF(KSV_SURF))
+ YSV_SURF(:) = CSV(:)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Call to surface monitor with 2D variables
+! -----------------------------------------
+!
+!
+! initial values:
+!
+IDIM1 = IIE-IIB+1
+IDIM2 = IJE-IJB+1
+IDIM1D = IDIM1*IDIM2
+!
+!
+! Transform 2D input fields into 1D:
+!
+CALL RESHAPE_SURF(IDIM1D)
+!
+! call to have the cumulated time since beginning of simulation
+!
+CALL DATETIME_DISTANCE(TDTSEG,TDTCUR,ZTIMEC)
+
+#ifdef CPLOASIS
+IF (LOASIS) THEN
+ IF ( MOD(ZTIMEC,1.0) .LE. 1E-2 .OR. (1.0 - MOD(ZTIMEC,1.0)) .LE. 1E-2 ) THEN
+ IF ( NINT(ZTIMEC-(XSEGLEN-DYN_MODEL(1)%XTSTEP)) .LT. 0 ) THEN
+ WRITE(ILUOUT,*) '----------------------------'
+ WRITE(ILUOUT,*) ' Reception des champs avec OASIS'
+ WRITE(ILUOUT,*) 'NINT(ZTIMEC)=', NINT(ZTIMEC)
+ CALL MNH_OASIS_RECV(CPROGRAM,IDIM1D,SIZE(XSW_BANDS),ZTIMEC+XTSTEP,XTSTEP, &
+ ZP_ZENITH,XSW_BANDS , &
+ ZP_TSRAD,ZP_DIR_ALB,ZP_SCA_ALB,ZP_EMIS,ZP_TSURF)
+ WRITE(ILUOUT,*) '----------------------------'
+ END IF
+ END IF
+END IF
+#endif
+!
+! Call to surface schemes
+!
+CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, &
+ XTSTEP, TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
+ IDIM1D,KSV_SURF,SIZE(XSW_BANDS), &
+ ZP_TSUN, ZP_ZENITH,ZP_ZENITH, ZP_AZIM, &
+ ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, YSV_SURF, &
+ ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, ZP_PS, ZP_PA, &
+ ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
+ ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
+ ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
+ ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF,ZP_ZWS, &
+ 'OK' )
+!
+#ifdef CPLOASIS
+IF (LOASIS) THEN
+ IF ( MOD(ZTIMEC,1.0) .LE. 1E-2 .OR. (1.0 - MOD(ZTIMEC,1.0)) .LE. 1E-2 ) THEN
+ IF (NINT(ZTIMEC-(XSEGLEN-DYN_MODEL(1)%XTSTEP)) .LT. 0) THEN
+ WRITE(ILUOUT,*) '----------------------------'
+ WRITE(ILUOUT,*) ' Envoi des champs avec OASIS'
+ WRITE(ILUOUT,*) 'NINT(ZTIMEC)=', NINT(ZTIMEC)
+ CALL MNH_OASIS_SEND(CPROGRAM,IDIM1D,ZTIMEC+XTSTEP,XTSTEP)
+ WRITE(ILUOUT,*) '----------------------------'
+ END IF
+ END IF
+END IF
+#endif
+!
+IF (CPROGRAM=='DIAG ' .OR. LDIAG_IN_RUN) THEN
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
+ CALL MNHGET_SURF_PARAM_n( PRN = ZP_RN, PH = ZP_H, PLE = ZP_LE, PLEI = ZP_LEI, &
+ PGFLUX = ZP_GFLUX, PT2M = ZP_T2M, PQ2M = ZP_Q2M, PHU2M = ZP_HU2M, &
+ PZON10M = ZP_ZON10M, PMER10M = ZP_MER10M )
+END IF
+!
+! Transform 1D output fields into 2D:
+!
+CALL UNSHAPE_SURF(IDIM1,IDIM2)
+#ifdef MNH_FOREFIRE
+!------------------------!
+! COUPLING WITH FOREFIRE !
+!------------------------!
+
+IF ( LFOREFIRE ) THEN
+ CALL FOREFIRE_DUMP_FIELDS_n(XUT, XVT, XWT, XSVT&
+ , XTHT, XRT(:,:,:,1), XPABST, XTKET&
+ , IDIM1+2, IDIM2+2, NKMAX+2)
+END IF
+
+IF ( FFCOUPLING ) THEN
+
+ CALL SEND_GROUND_WIND_n(XUT, XVT, IKB, IINFO_ll)
+
+ CALL FOREFIRE_RECEIVE_PARAL_n()
+
+ CALL COUPLING_FOREFIRE_n(XTSTEP, ZSFTH, ZSFTQ, ZSFTS)
+
+ CALL FOREFIRE_SEND_PARAL_n(IINFO_ll)
+
+END IF
+
+FF_TIME = FF_TIME + XTSTEP
+#endif
+!
+! Friction of components along slope axes (U: largest local slope axis, V: zero slope axis)
+!
+!
+PSFU(:,:) = 0.
+PSFV(:,:) = 0.
+!
+WHERE (ZSFU(:,:)/=XUNDEF .AND. ZWIND(:,:)>0.)
+ PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
+ PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
+END WHERE
+!
+
+!* 2.1 Blaze Fire Model
+! ----------------
+!
+IF (LBLAZE) THEN
+ ! get start time
+ CALL SECOND_MNH2( ZFIRETIME1 )
+
+ !* 2.1.1 Local variables allocation
+ ! --------------------------
+ !
+
+ ! Parallel fuel
+ NULLIFY(TZFIELDFIRE_ll)
+ IF (KTCOUNT <= 1) THEN
+ ! fuelmap
+ SELECT CASE (CPROPAG_MODEL)
+ CASE('SANTONI2011')
+ !
+ ALLOCATE( ZFIREFUELMAP(SIZE(XLSPHI,1), SIZE(XLSPHI,2), SIZE(XLSPHI,3), 22) );
+ ! Parallel fuel
+ CALL ADD4DFIELD_ll( TZFIELDFIRE_ll, ZFIREFUELMAP(:,:,:,1::22), 'MODEL_n::ZFIREFUELMAP' )
+ ! Default value
+ ZFIREFUELMAP(:,:,:,:) = 0.
+ END SELECT
+
+ !* 2.1.2 Read fuel map file
+ ! ------------------
+ !
+ ! Fuel map file name
+ YFUELMAPFILE = 'FuelMap'
+ !
+ CALL FIRE_READFUEL( TPFILE, ZFIREFUELMAP, XFMIGNITION, XFMWALKIG )
+
+ !* 2.1.3 Ignition LS function with ignition map
+ ! --------------------------------------
+ !
+ SELECT CASE (CFIRE_CPL_MODE)
+ CASE('2WAYCPL', 'ATM2FIR')
+ ! force ignition
+ WHERE (XFMIGNITION <= TDTCUR%XTIME ) XLSPHI = 1.
+ ! walking ignition
+ CALL FIRE_LS_RECONSTRUCTION_FROM_BMAP( XLSPHI, XFMWALKIG, 0.)
+ !
+ !* 2.1.4 Update BMAP
+ ! -----------
+ !
+ WHERE (XLSPHI >= .5 .AND. XBMAP < 0) XBMAP = TDTCUR%XTIME
+ !
+ CASE('FIR2ATM')
+ CALL FIRE_READBMAP(TPFILE,XBMAP)
+
+ END SELECT
+ !
+ !* 2.1.5 Compute R0, A, Wf0, R00
+ ! -----------------------
+ !
+ SELECT CASE (CPROPAG_MODEL)
+ CASE('SANTONI2011')
+ CALL FIRE_NOWINDROS( ZFIREFUELMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMFUELTYPE, XFIRETAU, XFLUXPARAMH, &
+ XFLUXPARAMW, XFMASE, XFMAWC )
+ END SELECT
+ !
+ !* 2.1.6 Compute orographic gradient
+ ! ---------------------------
+ CALL FIRE_GRAD_OROGRAPHY( XZS, XFMGRADOROX, XFMGRADOROY )
+ !
+ !* 2.1.7 Test halo size
+ ! --------------
+ IF (NHALO < 2 .AND. NFIRE_WENO_ORDER == 3) THEN
+ WRITE(ILUOUT,'(A/A)') 'ERROR BLAZE-FIRE : WENO3 fire gradient calculation needs NHALO >= 2'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','GROUND_PARAM_n','')
+ ELSEIF (NHALO < 3 .AND. NFIRE_WENO_ORDER == 5) THEN
+ WRITE(ILUOUT,'(A/A)') 'ERROR : WENO5 fire gradient calculation needs NHALO >= 3'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','GROUND_PARAM_n','')
+ END IF
+ !
+ END IF
+ !
+ !* 2.1.6 Compute grad of level set function phi
+ ! --------------------------------------
+ !
+ SELECT CASE (CFIRE_CPL_MODE)
+ CASE('2WAYCPL', 'ATM2FIR')
+ ! get time 1
+ CALL SECOND_MNH2( ZGRADTIME1 )
+ CALL FIRE_GRADPHI( XLSPHI, XGRADLSPHIX, XGRADLSPHIY )
+
+ ! get time 2
+ CALL SECOND_MNH2( ZGRADTIME2 )
+ XGRADPERF = XGRADPERF + ZGRADTIME2 - ZGRADTIME1
+ !
+ !* 2.1.7 Get horizontal wind speed projected on LS gradient direction
+ ! ------------------------------------------------------------
+ !
+ CALL FIRE_GETWIND( XUT, XVT, XWT, XGRADLSPHIX, XGRADLSPHIY, XFIREWIND, KTCOUNT, XTSTEP, XFMGRADOROX, XFMGRADOROY )
+ !
+ !* 2.1.8 Compute ROS XFIRERW with wind
+ ! -----------------------------
+ !
+ !
+ SELECT CASE (CPROPAG_MODEL)
+ CASE('SANTONI2011')
+ CALL FIRE_RATEOFSPREAD( XFMFUELTYPE, XFMR0, XFMRFA, XFMWF0, XFMR00, XFIREWIND, XGRADLSPHIX, XGRADLSPHIY, &
+ XFMGRADOROX, XFMGRADOROY, XFIRERW )
+ END SELECT
+ CALL SECOND_MNH2( ZROSWINDTIME2 )
+ XROSWINDPERF = XROSWINDPERF + ZROSWINDTIME2 - ZGRADTIME2
+ !
+ !* 2.1.8 Integrate model on atm time step to propagate
+ ! ---------------------------------------------
+ !
+ SELECT CASE (CPROPAG_MODEL)
+ CASE('SANTONI2011')
+ CALL FIRE_PROPAGATE( XLSPHI, XBMAP, XFMIGNITION, XFMWALKIG, XGRADLSPHIX, XGRADLSPHIY, XTSTEP, XFIRERW )
+ END SELECT
+ CALL SECOND_MNH2( ZPROPAGTIME2 )
+ XPROPAGPERF = XPROPAGPERF + ZPROPAGTIME2 - ZROSWINDTIME2
+ !
+ CASE('FIR2ATM')
+ !
+ CALL SECOND_MNH2( ZPROPAGTIME1 )
+ CALL FIRE_LS_RECONSTRUCTION_FROM_BMAP( XLSPHI, XBMAP, XTSTEP )
+ CALL SECOND_MNH2( ZPROPAGTIME2 )
+ XPROPAGPERF = XPROPAGPERF + ZPROPAGTIME2 - ZPROPAGTIME1
+ XGRADPERF(:) = 0.
+ !
+ END SELECT
+ !
+ !* 2.1.8 Compute fluxes
+ ! --------------
+ !
+ SELECT CASE (CFIRE_CPL_MODE)
+ CASE('2WAYCPL','FIR2ATM')
+ CALL SECOND_MNH2( ZFLUXTIME1 )
+ ! 2 way coupling
+ CALL FIRE_HEATFLUXES( XLSPHI, XBMAP, XFIRETAU, XTSTEP, XFLUXPARAMH, XFLUXPARAMW, XFMFLUXHDH, XFMFLUXHDW, XFMASE, XFMAWC )
+ ! vertical distribution of fire heat fluxes
+ CALL FIRE_VERTICALFLUXDISTRIB( XFMFLUXHDH, XFMFLUXHDW, XRTHS, XRRS, ZSFTS, XEXNREF, XRHODJ, XRT, XRHODREF )
+ !
+ CALL SECOND_MNH2( ZFLUXTIME2 )
+ XFLUXPERF = XFLUXPERF + ZFLUXTIME2 - ZFLUXTIME1
+ CASE DEFAULT
+ XFLUXPERF(:) = 0.
+ END SELECT
+ ! get end time
+ CALL SECOND_MNH2( ZFIRETIME2 )
+ ! add to Blaze time
+ XFIREPERF = XFIREPERF + ZFIRETIME2 - ZFIRETIME1
+END IF
+!* conversion from H (W/m2) to w'Theta'
+!
+PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB)
+!
+!
+!* conversion from water flux (kg/m2/s) to w'rv'
+!
+PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB)
+!
+!
+!* conversion from scalar flux (kg/m2/s) to w'rsv'
+!
+IF(NSV .GT. 0) THEN
+ DO JSV=1,NSV
+ PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) / XRHODREF(:,:,IKB)
+ END DO
+END IF
+!
+!* conversion from chemistry flux (molec/m2/s) to (ppp.m.s-1)
+!
+IF (LUSECHEM) THEN
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB))
+ IF ((LCHEMDIAG).AND.(CPROGRAM == 'DIAG ')) XCHFLX(:,:,JSV-NSV_CHEMBEG+1) = PSFSV(:,:,JSV)
+ END DO
+ELSE
+ PSFSV(:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0.
+END IF
+!
+!* conversion from dust flux (kg/m2/s) to (ppp.m.s-1)
+!
+IF (LDUST) THEN
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / (XMOLARWEIGHT_DUST * XRHODREF(:,:,IKB))
+ END DO
+ELSE
+ PSFSV(:,:,NSV_DSTBEG:NSV_DSTEND) = 0.
+END IF
+!
+!* conversion from sea salt flux (kg/m2/s) to (ppp.m.s-1)
+!
+IF (LSALT) THEN
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / (XMOLARWEIGHT_SALT * XRHODREF(:,:,IKB))
+ END DO
+ELSE
+ PSFSV(:,:,NSV_SLTBEG:NSV_SLTEND) = 0.
+END IF
+!
+!* conversion from aerosol flux (molec/m2/s) to (ppp.m.s-1)
+!
+IF (LORILAM) THEN
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB))
+ END DO
+ELSE
+ PSFSV(:,:,NSV_AERBEG:NSV_AEREND) = 0.
+END IF
+!
+!* conversion from blowing snow flux (kg/m2/s) to [kg(snow)/kg(dry air).m.s-1]
+!
+IF (LBLOWSNOW) THEN
+ DO JSV=NSV_SNWBEG,NSV_SNWEND
+ PSFSV(:,:,JSV) = ZSFTS(:,:,JSV)/ (ZRHOA(:,:))
+ END DO
+ !* Update tendency for blowing snow 2D fields
+ DO JSV=1,(NBLOWSNOW_2D)
+ XRSNWCANOS(:,:,JSV) = ZBLOWSNOW_2D(:,:,JSV)*XRHODJ(:,:,IKB)/(XTSTEP*ZRHOA(:,:))
+ END DO
+
+ELSE
+ PSFSV(:,:,NSV_SNWBEG:NSV_SNWEND) = 0.
+END IF
+!
+!* conversion from CO2 flux (kg/m2/s) to w'CO2'
+!
+PSFCO2(:,:) = ZSFCO2(:,:) / XRHODREF(:,:,IKB)
+!
+!
+!* Diagnostics
+! -----------
+!
+!
+IF (LDIAG_IN_RUN) THEN
+ !
+ XCURRENT_SFCO2(:,:) = ZSFCO2(:,:)
+ XCURRENT_DSTAOD(:,:)=0.0
+ XCURRENT_SLTAOD(:,:)=0.0
+ IF (CRAD/='NONE') THEN
+ XCURRENT_LWD (:,:) = XFLALWD(:,:)
+ XCURRENT_SWD (:,:) = SUM(XDIRSRFSWD(:,:,:)+XSCAFLASWD(:,:,:),DIM=3)
+ XCURRENT_LWU (:,:) = XLWU(:,:,IKB)
+ XCURRENT_SWU (:,:) = XSWU(:,:,IKB)
+ XCURRENT_SWDIR(:,:) = SUM(XDIRSRFSWD,DIM=3)
+ XCURRENT_SWDIFF(:,:) = SUM(XSCAFLASWD(:,:,:),DIM=3)
+ DO JK=IKB,IKE
+ IKRAD = JK - 1
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ XCURRENT_DSTAOD(JI,JJ)=XCURRENT_DSTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,3)
+ XCURRENT_SLTAOD(JI,JJ)=XCURRENT_SLTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,2)
+ ENDDO
+ ENDDO
+ ENDDO
+ END IF
+!
+ NULLIFY(TZFIELDSURF_ll)
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_RN, 'GROUND_PARAM_n::XCURRENT_RN' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_H, 'GROUND_PARAM_n::XCURRENT_H' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LE, 'GROUND_PARAM_n::XCURRENT_LE' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_GFLUX, 'GROUND_PARAM_n::XCURRENT_GFLUX' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWD, 'GROUND_PARAM_n::XCURRENT_LWD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_T2M, 'GROUND_PARAM_n::XCURRENT_T2M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_Q2M, 'GROUND_PARAM_n::XCURRENT_Q2M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_HU2M, 'GROUND_PARAM_n::XCURRENT_HU2M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SLTAOD, 'GROUND_PARAM_n::XCURRENT_SLTAOD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZWS, 'GROUND_PARAM_n::XCURRENT_ZWS' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SFCO2, 'GROUND_PARAM_n::XCURRENT_SFCO2' )
+
+ CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDSURF_ll)
+END IF
+!
+IF (LBLAZE) THEN
+ IF (KTCOUNT <= 1) THEN
+ DEALLOCATE(ZFIREFUELMAP)
+ END IF
+ CALL CLEANLIST_ll(TZFIELDFIRE_ll)
+END IF
+!==================================================================================
+!
+CONTAINS
+!
+!==================================================================================
+!
+SUBROUTINE RESHAPE_SURF(KDIM1D)
+!
+INTEGER, INTENT(IN) :: KDIM1D
+INTEGER, DIMENSION(1) :: ISHAPE_1
+!
+ISHAPE_1 = (/KDIM1D/)
+!
+ALLOCATE(ZP_TSUN (KDIM1D))
+ALLOCATE(ZP_ZENITH (KDIM1D))
+ALLOCATE(ZP_AZIM (KDIM1D))
+ALLOCATE(ZP_ZREF (KDIM1D))
+ALLOCATE(ZP_ZS (KDIM1D))
+ALLOCATE(ZP_U (KDIM1D))
+ALLOCATE(ZP_V (KDIM1D))
+ALLOCATE(ZP_QA (KDIM1D))
+ALLOCATE(ZP_TA (KDIM1D))
+ALLOCATE(ZP_RHOA (KDIM1D))
+ALLOCATE(ZP_SV (KDIM1D,KSV_SURF))
+ALLOCATE(ZP_CO2 (KDIM1D))
+ALLOCATE(ZP_RAIN (KDIM1D))
+ALLOCATE(ZP_SNOW (KDIM1D))
+ALLOCATE(ZP_LW (KDIM1D))
+ALLOCATE(ZP_DIR_SW (KDIM1D,SIZE(XDIRSRFSWD,3)))
+ALLOCATE(ZP_SCA_SW (KDIM1D,SIZE(XSCAFLASWD,3)))
+ALLOCATE(ZP_PS (KDIM1D))
+ALLOCATE(ZP_PA (KDIM1D))
+ALLOCATE(ZP_ZWS (KDIM1D))
+
+ALLOCATE(ZP_SFTQ (KDIM1D))
+ALLOCATE(ZP_SFTH (KDIM1D))
+ALLOCATE(ZP_SFU (KDIM1D))
+ALLOCATE(ZP_SFV (KDIM1D))
+ALLOCATE(ZP_SFTS (KDIM1D,KSV_SURF))
+ALLOCATE(ZP_SFCO2 (KDIM1D))
+ALLOCATE(ZP_TSRAD (KDIM1D))
+ALLOCATE(ZP_DIR_ALB (KDIM1D,SIZE(PDIR_ALB,3)))
+ALLOCATE(ZP_SCA_ALB (KDIM1D,SIZE(PSCA_ALB,3)))
+ALLOCATE(ZP_EMIS (KDIM1D))
+ALLOCATE(ZP_TSURF (KDIM1D))
+ALLOCATE(ZP_Z0 (KDIM1D))
+ALLOCATE(ZP_Z0H (KDIM1D))
+ALLOCATE(ZP_QSURF (KDIM1D))
+ALLOCATE(ZP_RN (KDIM1D))
+ALLOCATE(ZP_H (KDIM1D))
+ALLOCATE(ZP_LE (KDIM1D))
+ALLOCATE(ZP_LEI (KDIM1D))
+ALLOCATE(ZP_GFLUX (KDIM1D))
+ALLOCATE(ZP_T2M (KDIM1D))
+ALLOCATE(ZP_Q2M (KDIM1D))
+ALLOCATE(ZP_HU2M (KDIM1D))
+ALLOCATE(ZP_ZON10M (KDIM1D))
+ALLOCATE(ZP_MER10M (KDIM1D))
+
+!* explicit coupling only
+ALLOCATE(ZP_PEW_A_COEF (KDIM1D))
+ALLOCATE(ZP_PEW_B_COEF (KDIM1D))
+ALLOCATE(ZP_PET_A_COEF (KDIM1D))
+ALLOCATE(ZP_PEQ_A_COEF (KDIM1D))
+ALLOCATE(ZP_PET_B_COEF (KDIM1D))
+ALLOCATE(ZP_PEQ_B_COEF (KDIM1D))
+
+ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_TA(:) = RESHAPE(ZTA(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_QA(:) = RESHAPE(ZQA(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_RHOA(:) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_U(:) = RESHAPE(ZU(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_V(:) = RESHAPE(ZV(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_PS(:) = RESHAPE(ZPS(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_PA(:) = RESHAPE(ZPA(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_ZS(:) = RESHAPE(XZS(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_ZREF(:) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1)
+
+DO JLAYER=1,NSV
+ ZP_SV(:,JLAYER) = RESHAPE(XSVT(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1)
+END DO
+!
+IF(LBLOWSNOW) THEN
+ DO JLAYER=1,NBLOWSNOW_2D
+ ZP_SV(:,NSV+JLAYER) = RESHAPE(ZBLOWSNOW_2D(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ END DO
+END IF
+!
+!chemical conversion : from part/part to molec./m3
+DO JLAYER=NSV_CHEMBEG,NSV_CHEMEND
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD
+END DO
+DO JLAYER=NSV_AERBEG,NSV_AEREND
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD
+END DO
+!dust conversion : from part/part to kg/m3
+DO JLAYER=NSV_DSTBEG,NSV_DSTEND
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_DUST* ZP_RHOA(:) / XMD
+END DO
+!sea salt conversion : from part/part to kg/m3
+DO JLAYER=NSV_SLTBEG,NSV_SLTEND
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_SALT* ZP_RHOA(:) / XMD
+END DO
+!
+!blowing snow conversion : from kg(snow)/kg(dry air) to kg(snow)/m3
+DO JLAYER=NSV_SNWBEG,NSV_SNWEND
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:)
+END DO
+
+IF(LBLOWSNOW) THEN ! Convert 2D blowing snow fields
+ ! from kg(snow)/kg(dry air) to kg(snow)/m3
+ DO JLAYER=(NSV+1),KSV_SURF
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:)
+ END DO
+END IF
+!
+ZP_ZENITH(:) = RESHAPE(XZENITH(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_AZIM (:) = RESHAPE(XAZIM (IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_LW(:) = RESHAPE(XFLALWD(IIB:IIE,IJB:IJE), ISHAPE_1)
+DO JLAYER=1,SIZE(XDIRSRFSWD,3)
+ ZP_DIR_SW(:,JLAYER) = RESHAPE(XDIRSRFSWD(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_SCA_SW(:,JLAYER) = RESHAPE(XSCAFLASWD(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+END DO
+!
+ZP_PEW_A_COEF = 0.
+ZP_PEW_B_COEF = 0.
+ZP_PET_A_COEF = 0.
+ZP_PEQ_A_COEF = 0.
+ZP_PET_B_COEF = 0.
+ZP_PEQ_B_COEF = 0.
+!
+END SUBROUTINE RESHAPE_SURF
+!================================================i=================================
+SUBROUTINE UNSHAPE_SURF(KDIM1,KDIM2)
+!
+INTEGER, INTENT(IN) :: KDIM1, KDIM2
+INTEGER, DIMENSION(2) :: ISHAPE_2
+!
+ISHAPE_2 = (/KDIM1,KDIM2/)
+!
+! Arguments in call to surface:
+!
+ZSFTH = XUNDEF
+ZSFTQ = XUNDEF
+IF (NSV>0) ZSFTS = XUNDEF
+ZSFCO2 = XUNDEF
+ZSFU = XUNDEF
+ZSFV = XUNDEF
+!
+ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2)
+ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2)
+DO JLAYER=1,SIZE(PSFSV,3)
+ ZSFTS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,JLAYER), ISHAPE_2)
+END DO
+ZSFCO2 (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFCO2(:), ISHAPE_2)
+ZSFU (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFU(:), ISHAPE_2)
+ZSFV (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFV(:), ISHAPE_2)
+DO JLAYER=1,SIZE(PEMIS,3)
+ PEMIS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_EMIS(:), ISHAPE_2)
+END DO
+PTSRAD (IIB:IIE,IJB:IJE) = RESHAPE(ZP_TSRAD(:), ISHAPE_2)
+IF(LBLOWSNOW) THEN
+ DO JLAYER=1,NBLOWSNOW_2D
+ ZBLOWSNOW_2D(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,NSV+JLAYER), ISHAPE_2)
+ END DO
+END IF
+!
+IF (LDIAG_IN_RUN) THEN
+ XCURRENT_RN (IIB:IIE,IJB:IJE) = RESHAPE(ZP_RN(:), ISHAPE_2)
+ XCURRENT_H (IIB:IIE,IJB:IJE) = RESHAPE(ZP_H (:), ISHAPE_2)
+ XCURRENT_LE (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LE(:), ISHAPE_2)
+ XCURRENT_LEI (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LEI(:), ISHAPE_2)
+ XCURRENT_GFLUX (IIB:IIE,IJB:IJE) = RESHAPE(ZP_GFLUX(:), ISHAPE_2)
+ XCURRENT_T2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_T2M(:), ISHAPE_2)
+ XCURRENT_Q2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_Q2M(:), ISHAPE_2)
+ XCURRENT_HU2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_HU2M(:), ISHAPE_2)
+ XCURRENT_ZON10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZON10M(:), ISHAPE_2)
+ XCURRENT_MER10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_MER10M(:), ISHAPE_2)
+ XCURRENT_ZWS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZWS(:), ISHAPE_2)
+ENDIF
+!
+DO JLAYER=1,SIZE(PDIR_ALB,3)
+ PDIR_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_DIR_ALB(:,JLAYER), ISHAPE_2)
+ PSCA_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SCA_ALB(:,JLAYER), ISHAPE_2)
+END DO
+!
+DEALLOCATE(ZP_TSUN )
+DEALLOCATE(ZP_ZENITH )
+DEALLOCATE(ZP_AZIM )
+DEALLOCATE(ZP_ZREF )
+DEALLOCATE(ZP_ZS )
+DEALLOCATE(ZP_U )
+DEALLOCATE(ZP_V )
+DEALLOCATE(ZP_QA )
+DEALLOCATE(ZP_TA )
+DEALLOCATE(ZP_RHOA )
+DEALLOCATE(ZP_SV )
+DEALLOCATE(ZP_CO2 )
+DEALLOCATE(ZP_RAIN )
+DEALLOCATE(ZP_SNOW )
+DEALLOCATE(ZP_LW )
+DEALLOCATE(ZP_DIR_SW )
+DEALLOCATE(ZP_SCA_SW )
+DEALLOCATE(ZP_PS )
+DEALLOCATE(ZP_PA )
+DEALLOCATE(ZP_ZWS )
+
+DEALLOCATE(ZP_SFTQ )
+DEALLOCATE(ZP_SFTH )
+DEALLOCATE(ZP_SFTS )
+DEALLOCATE(ZP_SFCO2 )
+DEALLOCATE(ZP_SFU )
+DEALLOCATE(ZP_SFV )
+DEALLOCATE(ZP_TSRAD )
+DEALLOCATE(ZP_DIR_ALB )
+DEALLOCATE(ZP_SCA_ALB )
+DEALLOCATE(ZP_EMIS )
+DEALLOCATE(ZP_RN )
+DEALLOCATE(ZP_H )
+DEALLOCATE(ZP_LE )
+DEALLOCATE(ZP_LEI )
+DEALLOCATE(ZP_GFLUX )
+DEALLOCATE(ZP_T2M )
+DEALLOCATE(ZP_Q2M )
+DEALLOCATE(ZP_HU2M )
+DEALLOCATE(ZP_ZON10M )
+DEALLOCATE(ZP_MER10M )
+
+DEALLOCATE(ZP_PEW_A_COEF )
+DEALLOCATE(ZP_PEW_B_COEF )
+DEALLOCATE(ZP_PET_A_COEF )
+DEALLOCATE(ZP_PEQ_A_COEF )
+DEALLOCATE(ZP_PET_B_COEF )
+DEALLOCATE(ZP_PEQ_B_COEF )
+!
+END SUBROUTINE UNSHAPE_SURF
+!==================================================================================
+!
+END SUBROUTINE GROUND_PARAM_n
diff --git a/src/PHYEX/ext/ibm_affectv.f90 b/src/PHYEX/ext/ibm_affectv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..74df9a13dcc052c86357bf674ab178fff8dcfae7
--- /dev/null
+++ b/src/PHYEX/ext/ibm_affectv.f90
@@ -0,0 +1,402 @@
+!MNH_LIC Copyright 2019-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_IBM_AFFECTV
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
+ HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
+ HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
+ HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
+ HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
+ CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
+ INTEGER ,INTENT(IN) :: KIBM_LAYER
+ REAL ,INTENT(IN) :: PRADIUS
+ REAL ,INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
+ !
+ END SUBROUTINE IBM_AFFECTV
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_AFFECTV
+!
+! ########################################################
+SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
+ HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
+ HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
+ HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
+ HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
+ ! ########################################################
+ !
+ !
+ !**** IBM_AFFECTV computes the variable PVAR on desired ghost points :
+ ! - the V type of the ghost/image
+ ! - the 3D interpolation mode (HIBM_MODE_INTE3)
+ ! - the 1D interpolation mode (HIBM_MODE_INTE1)
+ ! - the boundary condition (HIBM_TYPE_BOUND)
+ ! - the symmetry character (HIBM_MODE_BOUND)
+ ! - the forcing type (HIBM_FORC_BOUND)
+ ! - the forcing term (HIBM_FORC_BOUND)
+ ! Choice of forcing type is depending on
+ ! the normal, binormal, tangent vectors (N,C,T)
+ !
+ !
+ ! PURPOSE
+ ! -------
+ !**** Ghosts (resp. Images) locations are stored in KIBM_STOR_GHOST (resp. KIBM_STOR_IMAGE).
+ ! Solutions are computed in regard of the symmetry character of the solution:
+ ! HIBM_MODE_BOUND = 'SYM' (Symmetrical)
+ ! HIBM_MODE_BOUND = 'ASY' (Anti-symmetrical)
+ ! The ghost value is depending on the variable value at the interface:
+ ! HIBM_TYPE_BOUND = "CST" (constant value)
+ ! HIBM_TYPE_BOUND = "LAW" (wall models)
+ ! HIBM_TYPE_BOUND = "LIN" (linear evolution, only IMAGE2 type)
+ ! HIBM_TYPE_BOUND = "LOG" (logarithmic evol, only IMAGE2 type)
+ ! Three 3D interpolations exists HIBM_MODE_INTE3 = "IDW" (Inverse Distance Weighting)
+ ! HIBM_MODE_INTE3 = "MDW" (Modified Distance Weighting)
+ ! HIBM_MODE_INTE3 = "LAG" (Trilinear Lagrange interp. )
+ ! Three 1D interpolations exists HIBM_MODE_INTE1 = "CL0" (Lagrange Polynomials - 1 points - MIRROR)
+ ! HIBM_MODE_INTE1 = "CL1" (Lagrange Polynomials - 2 points - IMAGE1)
+ ! HIBM_MODE_INTE1 = "CL2" (Lagrange Polynomials - 3 points - IMAGE2)
+ ! METHOD
+ ! ------
+ ! - loop on ghosts
+ ! - functions storage
+ ! - computations of the location of the corners cell containing MIRROR/IMAGE1/IMAGE2
+ ! - 3D interpolation (IDW, MDW, CLI) to obtain the MIRROR/IMAGE1/IMAGE2 values
+ ! - computation of the value at the interface
+ ! - 1D interpolation (CLI1,CLI2,CLI3) to obtain the GHOSTS values
+ ! - Affectation
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_FIELD_n
+ USE MODD_PARAM_n, ONLY: CTURB
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_LBC_n
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ !
+ ! interface
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_3DINT
+ USE MODI_IBM_1DINT
+ USE MODI_IBM_0DINT
+ USE MODI_IBM_VALUEMAT1
+ USE MODI_IBM_VALUEMAT2
+ USE MODI_SHUMAN
+ USE MODD_DYN_n
+ USE MODD_FIELD_n
+ USE MODD_CST
+ USE MODD_CTURB
+ USE MODD_RADIATIONS_n
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
+ CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
+ INTEGER ,INTENT(IN) :: KIBM_LAYER
+ REAL ,INTENT(IN) :: PRADIUS
+ REAL ,INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JM,JMM,JN,JNN,JH,JLL ! loop index
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDEX_CORN ! reference corner index
+ INTEGER :: I_GHOST_NUMB ! ghost number per layer
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_LOCAT_CORN,Z_LOCAT_IMAG ! corners coordinates
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_TESTS_CORN ! interface distance dependence
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_CORN ! value variables at corners
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_IMAG,Z_VALUE_TEMP,Z_VALUE_ZLKE ! value at mirror/image1/image2
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_LOCAT_BOUN,Z_LOCAT_GHOS,Z_TEMP_ZLKE ! location of bound and ghost
+ REAL :: Z_DELTA_IMAG,ZIBM_VISC,ZIBM_DIVK
+ CHARACTER(LEN=3),DIMENSION(:), ALLOCATABLE :: Y_TYPE_BOUND,Y_FORC_BOUND,Y_MODE_BOUND,Y_MODE_INTE1
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_FORC_BOUND,Z_VALUE_GHOS
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_MAT1,Z_VALUE_MAT2
+ REAL :: ZIBM_HALO
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ ALLOCATE(I_INDEX_CORN(3))
+ ALLOCATE(Z_LOCAT_CORN(8,3))
+ ALLOCATE(Z_VALUE_CORN(8))
+ ALLOCATE(Z_TESTS_CORN(8))
+ ALLOCATE(Z_LOCAT_IMAG(3,3))
+ ALLOCATE(Z_VALUE_IMAG(4,3))
+ ALLOCATE(Z_VALUE_TEMP(4,3))
+ ALLOCATE(Z_LOCAT_BOUN(3))
+ ALLOCATE(Z_LOCAT_GHOS(3))
+ ALLOCATE(Z_VALUE_GHOS(3))
+ ALLOCATE(Y_TYPE_BOUND(3),Y_FORC_BOUND(3))
+ ALLOCATE(Y_MODE_BOUND(3),Y_MODE_INTE1(3))
+ ALLOCATE(Z_FORC_BOUND(3))
+ ALLOCATE(Z_VALUE_MAT1(3,3))
+ ALLOCATE(Z_VALUE_MAT2(3,3))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ I_INDEX_CORN(:) = 0
+ Z_LOCAT_CORN(:,:) = 0.
+ Z_VALUE_CORN(:) = 0.
+ Z_TESTS_CORN(:) = 0.
+ Z_LOCAT_IMAG(:,:) = 0.
+ Z_VALUE_IMAG(:,:) = 0.
+ Z_VALUE_TEMP(:,:) = 0.
+ Z_LOCAT_GHOS(:) = 0.
+ Z_LOCAT_BOUN(:) = 0.
+ Z_VALUE_GHOS(:) = 0.
+ Z_VALUE_MAT1(:,:) = 0.
+ Z_VALUE_MAT2(:,:) = 0.
+ IF (HVAR=='U') JH = 1
+ IF (HVAR=='V') JH = 2
+ IF (HVAR=='W') JH = 3
+ Y_TYPE_BOUND(1) = HIBM_TYPE_BOUNN
+ Y_TYPE_BOUND(2) = HIBM_TYPE_BOUNT
+ Y_TYPE_BOUND(3) = HIBM_TYPE_BOUNC
+ Y_FORC_BOUND(1) = HIBM_FORC_BOUNN
+ Y_FORC_BOUND(2) = HIBM_FORC_BOUNT
+ Y_FORC_BOUND(3) = HIBM_FORC_BOUNC
+ Y_MODE_BOUND(1) = HIBM_MODE_BOUNN
+ Y_MODE_BOUND(2) = HIBM_MODE_BOUNT
+ Y_MODE_BOUND(3) = HIBM_MODE_BOUNC
+ Y_MODE_INTE1(1) = HIBM_MODE_INT1N
+ Y_MODE_INTE1(2) = HIBM_MODE_INT1T
+ Y_MODE_INTE1(3) = HIBM_MODE_INT1C
+ Z_FORC_BOUND(1) = PIBM_FORC_BOUNN
+ Z_FORC_BOUND(2) = PIBM_FORC_BOUNT
+ Z_FORC_BOUND(3) = PIBM_FORC_BOUNC
+ !
+ ALLOCATE(Z_VALUE_ZLKE(4,3))
+ ALLOCATE(Z_TEMP_ZLKE(3))
+ Z_VALUE_ZLKE(:,:) = 0.
+ Z_TEMP_ZLKE(:) = 0.
+ !
+ DO JMM=1,KIBM_LAYER
+ !
+ ! searching number of ghosts
+ JM = size(NIBM_GHOST_V,1)
+ JI = 0
+ JJ = 0
+ JK = 0
+ DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0)
+ JI = NIBM_GHOST_V(JM,JMM,JH,1)
+ JJ = NIBM_GHOST_V(JM,JMM,JH,2)
+ JK = NIBM_GHOST_V(JM,JMM,JH,3)
+ IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1
+ ENDDO
+ I_GHOST_NUMB = JM
+ !
+ ! Loop on each P Ghosts
+ IF (I_GHOST_NUMB<=0) GO TO 666
+ DO JM = 1,I_GHOST_NUMB
+ !
+ ! ghost index/ls
+ JI = NIBM_GHOST_V(JM,JMM,JH,1)
+ JJ = NIBM_GHOST_V(JM,JMM,JH,2)
+ JK = NIBM_GHOST_V(JM,JMM,JH,3)
+ IF (JI==0.or.JJ==0.or.JK==0) GO TO 777
+ Z_LOCAT_GHOS(:) = XIBM_GHOST_V(JM,JMM,JH,:)
+ Z_LOCAT_BOUN(:) = 2.0*XIBM_IMAGE_V(JM,JMM,JH,1,:)-1.0*XIBM_IMAGE_V(JM,JMM,JH,2,:)
+ ZIBM_HALO = 1.
+ !
+ DO JN = 1,3
+ !
+ Z_LOCAT_IMAG(JN,:)= XIBM_IMAGE_V(JM,JMM,JH ,JN,:)
+ Z_DELTA_IMAG = ((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))**0.5
+ !
+ DO JLL=1,3
+ I_INDEX_CORN(:) = NIBM_IMAGE_V(JM,JMM,JH,JLL,JN,:)
+ IF (I_INDEX_CORN(1)==0.AND.JN==2) ZIBM_HALO=0.
+ IF (I_INDEX_CORN(2)==0.AND.JN==2) ZIBM_HALO=0.
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,JLL+1)
+ Z_TESTS_CORN(:) = XIBM_TESTI_V(JM,JMM,JH,JLL,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(PVAR2(:,:,:,JLL),I_INDEX_CORN)
+ Z_VALUE_IMAG(JN,JLL) = IBM_3DINT(JN,Z_VALUE_IMAG(:,JLL),Z_LOCAT_BOUN,Z_TESTS_CORN,&
+ Z_LOCAT_CORN,Z_VALUE_CORN,Z_LOCAT_IMAG(JN,:),&
+ HIBM_MODE_INTE3,PRADIUS,PPOWERS)
+ ENDDO
+ !
+ ENDDO
+ ZIBM_VISC = PXMU(JI,JJ,JK)
+ ZIBM_DIVK = PDIV(JI,JJ,JK)
+ !
+ ! projection step
+ Z_VALUE_MAT1(:,:) = IBM_VALUEMAT1(Z_LOCAT_IMAG(1,:),Z_LOCAT_BOUN,Z_VALUE_IMAG,HIBM_FORC_BOUNR)
+ DO JN=1,3
+ Z_VALUE_TEMP(JN,:)= Z_VALUE_MAT1(:,1)*Z_VALUE_IMAG(JN,1) +&
+ Z_VALUE_MAT1(:,2)*Z_VALUE_IMAG(JN,2) +&
+ Z_VALUE_MAT1(:,3)*Z_VALUE_IMAG(JN,3)
+ ENDDO
+ !
+ ! === BOUND computation ===
+ !
+ JN=4
+ DO JLL=1,3
+ Z_VALUE_TEMP(JN,JLL) = IBM_0DINT(Z_DELTA_IMAG,Z_VALUE_TEMP(:,JLL),Y_TYPE_BOUND(JLL),Y_FORC_BOUND(JLL), &
+ Z_FORC_BOUND(JLL),ZIBM_VISC,ZIBM_DIVK)
+ ENDDO
+ !
+ ! inverse projection step
+ Z_VALUE_MAT2(:,:) = IBM_VALUEMAT2(Z_VALUE_MAT1)
+ Z_VALUE_IMAG(JN,:)= Z_VALUE_MAT2(:,1)*Z_VALUE_TEMP(JN,1) +&
+ Z_VALUE_MAT2(:,2)*Z_VALUE_TEMP(JN,2) +&
+ Z_VALUE_MAT2(:,3)*Z_VALUE_TEMP(JN,3)
+ !
+ ! === GHOST computation ===
+ !
+ ! functions storage
+ Z_LOCAT_IMAG(1,3) = ((XIBM_GHOST_V(JM,JMM,JH,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_GHOST_V(JM,JMM,JH,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_GHOST_V(JM,JMM,JH,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ IF (Z_LOCAT_IMAG(1,3)>Z_DELTA_IMAG.AND.ZIBM_HALO>0.5) THEN
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,2,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,2,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,2,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ ELSE
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,3,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,3,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,3,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_VALUE_TEMP(2,:) = Z_VALUE_TEMP(1,:)
+ Z_VALUE_TEMP(1,:) = Z_VALUE_TEMP(3,:)
+ ENDIF
+ !
+ DO JLL=1,3
+ Z_VALUE_GHOS(JLL) = IBM_1DINT(Z_LOCAT_IMAG(1,:),Z_VALUE_TEMP(:,JLL),Y_MODE_INTE1(JLL))
+ IF (Y_MODE_BOUND(JLL)=='SYM') Z_VALUE_GHOS(JLL) = +Z_VALUE_GHOS(JLL)
+ IF (Y_MODE_BOUND(JLL)=='ASY') Z_VALUE_GHOS(JLL) = -Z_VALUE_GHOS(JLL) + 2.*Z_VALUE_TEMP(4,JLL)
+ IF (Y_MODE_BOUND(JLL)=='CST') Z_VALUE_GHOS(JLL) = Z_VALUE_TEMP(4,JLL)
+ ENDDO
+ !
+ PVAR(JI,JJ,JK) = Z_VALUE_MAT2(JH,1)*Z_VALUE_GHOS(1) +&
+ Z_VALUE_MAT2(JH,2)*Z_VALUE_GHOS(2) +&
+ Z_VALUE_MAT2(JH,3)*Z_VALUE_GHOS(3)
+ !
+ IF ((JH==3).AND.(JK==2)) THEN
+ PVAR(JI,JJ,JK) = 0.
+ ENDIF
+ !
+777 CONTINUE
+ !
+ ENDDO
+ ENDDO
+ !
+666 CONTINUE
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDEX_CORN)
+ DEALLOCATE(Z_LOCAT_CORN)
+ DEALLOCATE(Z_VALUE_CORN)
+ DEALLOCATE(Z_LOCAT_IMAG)
+ DEALLOCATE(Z_VALUE_IMAG)
+ DEALLOCATE(Z_VALUE_TEMP)
+ DEALLOCATE(Z_LOCAT_BOUN)
+ DEALLOCATE(Z_LOCAT_GHOS)
+ DEALLOCATE(Z_VALUE_GHOS)
+ DEALLOCATE(Z_TESTS_CORN)
+ DEALLOCATE(Y_TYPE_BOUND,Y_FORC_BOUND)
+ DEALLOCATE(Y_MODE_BOUND,Y_MODE_INTE1)
+ DEALLOCATE(Z_FORC_BOUND)
+ DEALLOCATE(Z_VALUE_MAT1)
+ DEALLOCATE(Z_VALUE_MAT2)
+ DEALLOCATE(Z_VALUE_ZLKE)
+ DEALLOCATE(Z_TEMP_ZLKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_AFFECTV
diff --git a/src/PHYEX/ext/ice_adjust_bis.f90 b/src/PHYEX/ext/ice_adjust_bis.f90
new file mode 100644
index 0000000000000000000000000000000000000000..44ab0c680b6d689ab050c53ddd39ec799bf0b100
--- /dev/null
+++ b/src/PHYEX/ext/ice_adjust_bis.f90
@@ -0,0 +1,160 @@
+!MNH_LIC Copyright 2012-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_ICE_ADJUST_BIS
+! ###############################
+!
+INTERFACE
+!
+! #################################################################
+ SUBROUTINE ICE_ADJUST_BIS(PP,PTH,PR)
+! #################################################################
+!
+!!
+!* 1.1 Declaration of Arguments
+!!
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTH ! thetal to transform into th
+REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PR ! Total mixing ratios to transform into rv,rc and ri
+!
+END SUBROUTINE ICE_ADJUST_BIS
+
+END INTERFACE
+!
+END MODULE MODI_ICE_ADJUST_BIS
+! ######spl
+ SUBROUTINE ICE_ADJUST_BIS(PP,PTH,PR)
+! #################################################################
+!
+!
+!!**** *ICE_ADJUST_BIS* - computes an adjusted state of thermodynamical variables
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Valery Masson & C. Lac * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/2012
+!! M.Moge 08/2015 UPDATE_HALO_ll on PTH, ZRV, ZRC, ZRI
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XCPD, XRD, XP00, CST
+USE MODD_NEB, ONLY : NEB
+!
+USE MODI_COMPUTE_FUNCTION_THERMO
+USE MODI_THLRT_FROM_THRVRCRI
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTH ! thetal to transform into th
+REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PR ! Total mixing ratios to transform into rv,rc and ri
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZTHL, ZRW, ZRV, ZRC, &
+ ZRI, ZWORK
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZFRAC_ICE, ZRSATW, ZRSATI
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZT, ZEXN, ZLVOCPEXN,ZLSOCPEXN
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3), 16) :: ZBUF
+INTEGER :: IRR
+CHARACTER(LEN=1) :: YFRAC_ICE
+!
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
+!----------------------------------------------------------------------------
+!
+!* 1 Initialisation
+! --------------
+!
+IRR = SIZE(PR,4)
+!
+ZRV(:,:,:)=0.
+IF (IRR>=1) &
+ZRV(:,:,:)=PR(:,:,:,1)
+ZRC(:,:,:)=0.
+IF (IRR>=2) &
+ZRC(:,:,:)=PR(:,:,:,2)
+ZRI(:,:,:)=0.
+IF (IRR>=4) &
+ZRI(:,:,:)=PR(:,:,:,4)
+!
+YFRAC_ICE='T'
+ZFRAC_ICE(:,:,:) = 0.
+!
+!* 2 Computation
+! -----------
+!
+ZEXN(:,:,:)=(PP(:,:,:)/XP00)**(XRD/XCPD)
+!
+CALL COMPUTE_FUNCTION_THERMO( IRR, &
+ PTH, PR, ZEXN, PP, &
+ ZT,ZLVOCPEXN,ZLSOCPEXN )
+
+!
+CALL THLRT_FROM_THRVRCRI( IRR, PTH, PR, ZLVOCPEXN, ZLSOCPEXN,&
+ ZTHL, ZRW )
+!
+CALL TH_R_FROM_THL_RT(CST, NEB, SIZE(ZFRAC_ICE), YFRAC_ICE,ZFRAC_ICE(:,:,:),PP(:,:,:), &
+ ZTHL(:,:,:), ZRW(:,:,:), PTH(:,:,:), &
+ ZRV(:,:,:), ZRC(:,:,:), ZRI(:,:,:), &
+ ZRSATW(:,:,:), ZRSATI(:,:,:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF)
+CALL ADD3DFIELD_ll( TZFIELDS_ll, PTH, 'ICE_ADJUST_BIS::PTH')
+IF (IRR>=1) THEN
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRV, 'ICE_ADJUST_BIS::ZRV' )
+ENDIF
+IF (IRR>=2) THEN
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRC, 'ICE_ADJUST_BIS::ZRC' )
+ENDIF
+IF (IRR>=4) THEN
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRI, 'ICE_ADJUST_BIS::ZRI' )
+ENDIF
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+
+IF (IRR>=1) &
+PR(:,:,:,1) = ZRV(:,:,:)
+IF (IRR>=2) &
+PR(:,:,:,2) = ZRC(:,:,:)
+IF (IRR>=4) &
+PR(:,:,:,4) = ZRI(:,:,:)
+!
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
+END SUBROUTINE ICE_ADJUST_BIS
diff --git a/src/PHYEX/ext/ini_lesn.f90 b/src/PHYEX/ext/ini_lesn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..378e43f533ddc33eac977c0cc9a82b5b9e72e6be
--- /dev/null
+++ b/src/PHYEX/ext/ini_lesn.f90
@@ -0,0 +1,2007 @@
+!MNH_LIC Copyright 2000-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ SUBROUTINE INI_LES_n
+! ####################
+!
+!
+!!**** *INI_LES_n* initializes the LES variables for model _n
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!! Modification 01/02/01 (D.Gazen) add module MODD_NSV for NSV variable
+!! 06/11/02 (V. Masson) add LES budgets
+!! 10/2016 (C.Lac) Add droplet deposition
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 12/08/2020: bugfix: use NUNDEF instead of XUNDEF for integer variables
+! P. Wautelet 04/01/2021: bugfix: nles_k was used instead of nspectra_k for a loop index
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
+! P. Wautelet 09/07/2021: bugfix: altitude levels are on the correct grid position (mass point)
+! P. Wautelet 22/03/2022: LES averaging periods are more reliable (compute with integers instead of reals)
+! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+USE MODE_GATHER_ll
+USE MODE_MSG
+USE MODE_MODELN_HANDLER
+!
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_LES_n
+!
+USE MODD_CONF
+USE MODD_PARAMETERS
+USE MODD_NESTING
+!
+USE MODD_LUNIT_n
+USE MODD_GRID_n
+USE MODD_DYN_n
+USE MODD_TIME_n
+USE MODD_DIM_n
+USE MODD_TURB_n
+USE MODD_CONF_n
+USE MODD_LBC_n
+USE MODD_PARAM_n
+USE MODD_DYN
+USE MODD_NSV, ONLY: NSV ! update_nsv is done in INI_MODEL
+USE MODD_CONDSAMP, ONLY : LCONDSAMP
+!
+USE MODI_INI_LES_CART_MASKn
+USE MODI_COEF_VER_INTERP_LIN
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+!
+! 0.2 declaration of local variables
+!
+!
+!
+INTEGER :: ILUOUT, IRESP
+INTEGER :: JI,JJ, JK ! loop counters
+INTEGER :: IIU_ll ! total domain I size
+INTEGER :: IJU_ll ! total domain J size
+INTEGER :: IIMAX_ll ! total physical domain I size
+INTEGER :: IJMAX_ll ! total physical domain J size
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZ_LES ! LES altitudes 3D array
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZ_SPEC! " for spectra
+!
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! father model coordinates
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll !
+INTEGER :: IMI
+!
+!-------------------------------------------------------------------------------
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
+IIU_ll = IIMAX_ll+2*JPHEXT
+IJU_ll = IJMAX_ll+2*JPHEXT
+!
+ILUOUT = TLUOUT%NLU
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Does LES computations are used?
+! ------------------------------
+!
+LLES = LLES_MEAN .OR. LLES_RESOLVED .OR. LLES_SUBGRID .OR. LLES_UPDRAFT &
+ .OR. LLES_DOWNDRAFT .OR. LLES_SPECTRA
+!
+!
+IF (.NOT. LLES) RETURN
+!
+IF (L1D) THEN
+ LLES_RESOLVED = .FALSE.
+ LLES_UPDRAFT = .FALSE.
+ LLES_DOWNDRAFT = .FALSE.
+ LLES_SPECTRA = .FALSE.
+ LLES_NEB_MASK = .FALSE.
+ LLES_CORE_MASK = .FALSE.
+ LLES_CS_MASK = .FALSE.
+ LLES_MY_MASK = .FALSE.
+END IF
+!
+IF (LLES_RESOLVED ) LLES_MEAN = .TRUE.
+IF (LLES_SUBGRID ) LLES_MEAN = .TRUE.
+IF (LLES_UPDRAFT ) LLES_MEAN = .TRUE.
+IF (LLES_DOWNDRAFT) LLES_MEAN = .TRUE.
+IF (LLES_SPECTRA ) LLES_MEAN = .TRUE.
+!
+IF (CTURB=='NONE') THEN
+ WRITE(ILUOUT,FMT=*) 'LES diagnostics cannot be done without subgrid turbulence.'
+ WRITE(ILUOUT,FMT=*) 'You have chosen CTURB="NONE". You must choose a turbulence scheme.'
+ call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_LB_n', 'LES diagnostics cannot be done without subgrid turbulence' )
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 2. Number and definition of masks
+! ------------------------------
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.1 Cartesian (sub-)domain
+! ----------------------
+!
+!* updates number of masks
+! -----------------------
+!
+NLES_MASKS = 1
+!
+!* For model 1, set default values of cartesian mask, and defines cartesian mask
+! -----------------------------------------------------------------------------
+!
+IF (IMI==1) THEN
+ IF ( LLES_CART_MASK ) THEN
+ !Compute LES diagnostics inside a cartesian mask
+
+ !Set default values to physical domain boundaries
+ IF ( NLES_IINF == NUNDEF ) NLES_IINF = 1
+ IF ( NLES_JINF == NUNDEF ) NLES_JINF = 1
+ IF ( NLES_ISUP == NUNDEF ) NLES_ISUP = NIMAX_ll
+ IF ( NLES_JSUP == NUNDEF ) NLES_JSUP = NJMAX_ll
+
+ !Check that selected indices are in physical domain
+ IF ( NLES_IINF < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_IINF too small (<1)' )
+ IF ( NLES_IINF > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_IINF too large (>NIMAX)' )
+ IF ( NLES_ISUP < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_ISUP too small (<1)' )
+ IF ( NLES_ISUP > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_ISUP too large (>NIMAX)' )
+ IF ( NLES_ISUP < NLES_IINF ) CALL Print_msg( NVERB_ERROR, 'BUD', 'INI_LES_n', 'NLES_ISUP < NLES_IINF' )
+
+ IF ( NLES_JINF < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JINF too small (<1)' )
+ IF ( NLES_JINF > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JINF too large (>NJMAX)' )
+ IF ( NLES_JSUP < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JSUP too small (<1)' )
+ IF ( NLES_JSUP > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JSUP too large (>NJMAX)' )
+ IF ( NLES_JSUP < NLES_JINF ) CALL Print_msg( NVERB_ERROR, 'BUD', 'INI_LES_n', 'NLES_JSUP < NLES_JINF' )
+
+ !Set LLES_CART_MASK to false if whole domain is selected
+ IF ( NLES_IINF == 1 .AND. NLES_JINF == 1 &
+ .AND. NLES_ISUP == NIMAX_ll .AND. NLES_ISUP == NJMAX_ll ) THEN
+ LLES_CART_MASK = .FALSE.
+ END IF
+ ELSE
+ !Compute LES diagnostics on whole physical domain
+ NLES_IINF = 1
+ NLES_JINF = 1
+ NLES_ISUP = NIMAX_ll
+ NLES_JSUP = NJMAX_ll
+ END IF
+ !
+ NLESn_IINF(1)= NLES_IINF
+ NLESn_ISUP(1)= NLES_ISUP
+ NLESn_JINF(1)= NLES_JINF
+ NLESn_JSUP(1)= NLES_JSUP
+!
+!* For other models, fits cartesian mask on model 1 mask
+! -----------------------------------------------------
+!
+ELSE
+ ALLOCATE(ZXHAT_ll(IIU_ll))
+ ALLOCATE(ZYHAT_ll(IJU_ll))
+ CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP)
+ CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP)
+!
+ CALL GOTO_MODEL(NDAD(IMI))
+ CALL INI_LES_CART_MASK_n(IMI,ZXHAT_ll,ZYHAT_ll, &
+ NLESn_IINF(IMI),NLESn_JINF(IMI), &
+ NLESn_ISUP(IMI),NLESn_JSUP(IMI) )
+ CALL GOTO_MODEL(IMI)
+!
+ DEALLOCATE(ZXHAT_ll)
+ DEALLOCATE(ZYHAT_ll)
+END IF
+!
+!* in non cyclic boundary conditions, limitiation of masks due to u and v grids
+! ----------------------------------------------------------------------------
+!
+IF ( (.NOT. L1D) .AND. CLBCX(1)/='CYCL') THEN
+ NLESn_IINF(IMI) = MAX(NLESn_IINF(IMI),2)
+END IF
+IF ( (.NOT. L1D) .AND. (.NOT. L2D) .AND. CLBCY(1)/='CYCL') THEN
+ NLESn_JINF(IMI) = MAX(NLESn_JINF(IMI),2)
+END IF
+!
+!* X boundary conditions for 2points correlations computations
+! -----------------------------------------------------------
+!
+IF ( CLBCX(1) == 'CYCL' .AND. NLESn_IINF(IMI) == 1 .AND. NLESn_ISUP(IMI) == NIMAX_ll ) THEN
+ CLES_LBCX(:,IMI) = 'CYCL'
+ELSE
+ CLES_LBCX(:,IMI) = 'OPEN'
+END IF
+!
+!* Y boundary conditions for 2points correlations computations
+! -----------------------------------------------------------
+!
+IF ( CLBCY(1) == 'CYCL' .AND. NLESn_JINF(IMI) == 1 .AND. NLESn_JSUP(IMI) == NJMAX_ll ) THEN
+ CLES_LBCY(:,IMI) = 'CYCL'
+ELSE
+ CLES_LBCY(:,IMI) = 'OPEN'
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.2 Nebulosity mask
+! ---------------
+!
+IF (.NOT. LUSERC .AND. .NOT. LUSERI) LLES_NEB_MASK = .FALSE.
+!
+IF (LLES_NEB_MASK) NLES_MASKS = NLES_MASKS + 2
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.3 Cloud core mask
+! ---------------
+!
+IF (.NOT. LUSERC .AND. .NOT. LUSERI) LLES_CORE_MASK = .FALSE.
+!
+IF (LLES_CORE_MASK) NLES_MASKS = NLES_MASKS + 2
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.4 Conditional sampling mask
+! -------------------------
+!
+IF (.NOT. LUSERC .AND. .NOT. LCONDSAMP) LLES_CS_MASK = .FALSE.
+!
+IF (LLES_CS_MASK) NLES_MASKS = NLES_MASKS + 3
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.5 User mask
+! ---------
+!
+IF (LLES_MY_MASK) NLES_MASKS = NLES_MASKS + NLES_MASKS_USER
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Number of temporal LES samplings
+! --------------------------------
+!
+!* 3.1 Default value
+! -------------
+!
+IF (XLES_TEMP_SAMPLING == XUNDEF) THEN
+ IF (CTURBDIM=='3DIM') THEN
+ XLES_TEMP_SAMPLING = 60.
+ ELSE
+ XLES_TEMP_SAMPLING = 300.
+ END IF
+END IF
+!
+!* 3.2 Number of time steps between two calls
+! --------------------------------------
+!
+NLES_DTCOUNT = MAX( NINT( XLES_TEMP_SAMPLING / XTSTEP ) , 1)
+
+!
+!* 3.3 Redefinition of the LES sampling time coherent with model time-step
+! -------------------------------------------------------------------
+!
+! Note that this modifies XLES_TEMP_SAMPLING only for father model (model number 1)
+! For nested models (for which integration time step is an integer part of father model)
+! the following operation does not change XLES_TEMP_SAMPLING. This way, LEs
+! sampling is done at the same instants for all models.
+!
+XLES_TEMP_SAMPLING = XTSTEP * NLES_DTCOUNT
+!
+!
+!* 3.4 number of temporal calls to LES routines
+! ----------------------------------------
+!
+!
+NLES_TIMES = ( NINT( ( XSEGLEN - DYN_MODEL(1)%XTSTEP ) / XTSTEP ) ) / NLES_DTCOUNT
+!
+!* 3.5 current LES time counter
+! ------------------------
+!
+NLES_TCOUNT = 0
+!
+!* 3.6 dates array for diachro
+! ----------------------
+!
+allocate( tles_dates( nles_times ) )
+allocate( xles_times( nles_times ) )
+!
+!* 3.7 No data
+! -------
+!
+IF (NLES_TIMES==0) THEN
+ LLES=.FALSE.
+ RETURN
+END IF
+!
+!* 3.8 Averaging
+! ---------
+IF ( XLES_TEMP_MEAN_END == XUNDEF &
+ .OR. XLES_TEMP_MEAN_START == XUNDEF &
+ .OR. XLES_TEMP_MEAN_STEP == XUNDEF ) THEN
+ !No LES temporal averaging
+ NLES_MEAN_TIMES = 0
+ NLES_MEAN_STEP = NNEGUNDEF
+ NLES_MEAN_START = NNEGUNDEF
+ NLES_MEAN_END = NNEGUNDEF
+ELSE
+ !LES temporal averaging is enabled
+ !Ensure that XLES_TEMP_MEAN_END is not after segment end
+ XLES_TEMP_MEAN_END = MIN( XLES_TEMP_MEAN_END, XSEGLEN - DYN_MODEL(1)%XTSTEP )
+
+ NLES_MEAN_START = NINT( XLES_TEMP_MEAN_START / XTSTEP )
+
+ IF ( MODULO( NLES_MEAN_START, NLES_DTCOUNT ) /= 0 ) THEN
+ CMNHMSG(1) = 'XLES_TEMP_MEAN_START is not a multiple of XLES_TEMP_SAMPLING'
+ CMNHMSG(2) = 'LES averaging periods could be wrong'
+ CALL Print_msg( NVERB_WARNING, 'IO', 'INI_LES_n' )
+ END IF
+
+ NLES_MEAN_END = NINT( XLES_TEMP_MEAN_END / XTSTEP )
+
+ NLES_MEAN_STEP = NINT( XLES_TEMP_MEAN_STEP / XTSTEP )
+
+ IF ( NLES_MEAN_STEP < NLES_DTCOUNT ) &
+ CALL Print_msg( NVERB_ERROR, 'IO', 'INI_LES_n', 'XLES_TEMP_MEAN_STEP < XLES_TEMP_SAMPLING not allowed' )
+
+ IF ( MODULO( NLES_MEAN_STEP, NLES_DTCOUNT ) /= 0 ) THEN
+ CMNHMSG(1) = 'XLES_TEMP_MEAN_STEP is not a multiple of XLES_TEMP_SAMPLING'
+ CMNHMSG(2) = 'LES averaging periods could be wrong'
+ CALL Print_msg( NVERB_WARNING, 'IO', 'INI_LES_n' )
+ END IF
+
+ NLES_MEAN_TIMES = ( NLES_MEAN_END - NLES_MEAN_START ) / NLES_MEAN_STEP
+ !Add 1 averaging period if the last one is incomplete (for example: start=0., end=10., step=3.)
+ IF ( MODULO( NLES_MEAN_END - NLES_MEAN_START, NLES_MEAN_STEP ) > 0 ) NLES_MEAN_TIMES = NLES_MEAN_TIMES + 1
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 4. Number of vertical levels for local diagnostics
+! -----------------------------------------------
+!
+NLES_K = 0
+!
+!* 4.1 Case of altitude levels (lowest priority)
+! -----------------------
+!
+IF (ANY(XLES_ALTITUDES(:)/=XUNDEF)) THEN
+ NLES_K = COUNT (XLES_ALTITUDES(:)/=XUNDEF)
+ CLES_LEVEL_TYPE='Z'
+ !
+ ALLOCATE(XCOEFLIN_LES(SIZE(XZZ,1),SIZE(XZZ,2),NLES_K))
+ ALLOCATE(NKLIN_LES (SIZE(XZZ,1),SIZE(XZZ,2),NLES_K))
+ !
+ ALLOCATE(ZZ_LES (SIZE(XZZ,1),SIZE(XZZ,2),NLES_K))
+ DO JK=1,NLES_K
+ DO JJ=1,SIZE(XZZ,2)
+ DO JI=1,SIZE(XZZ,1)
+ ZZ_LES(JI,JJ,JK) = XLES_ALTITUDES(JK)
+ END DO
+ END DO
+ END DO
+ CALL COEF_VER_INTERP_LIN(MZF(XZZ),ZZ_LES,NKLIN_LES,XCOEFLIN_LES)
+ !
+ DEALLOCATE(ZZ_LES)
+END IF
+!
+!
+!* 4.2 Case of model levels (highest priority)
+! --------------------
+!
+IF (ANY(NLES_LEVELS(:)/=NUNDEF)) THEN
+ DO JK = 1, SIZE( NLES_LEVELS )
+ IF ( NLES_LEVELS(JK) /= NUNDEF ) THEN
+ IF ( NLES_LEVELS(JK) < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_LEVELS too small (<1)' )
+ IF ( NLES_LEVELS(JK) > NKMAX ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_LEVELS too large (>NKMAX)' )
+ END IF
+ END DO
+
+ NLES_K = COUNT (NLES_LEVELS(:)/=NUNDEF)
+ CLES_LEVEL_TYPE='K'
+ELSE
+ IF (NLES_K==0) THEN
+ NLES_K = MIN(SIZE(NLES_LEVELS),NKMAX)
+ CLES_LEVEL_TYPE='K'
+ DO JK=1,NLES_K
+ NLES_LEVELS(JK) = JK
+ END DO
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Number of vertical levels for non-local diagnostics
+! ---------------------------------------------------
+!
+NSPECTRA_K = 0
+CSPECTRA_LEVEL_TYPE='N'
+!
+!
+!* 5.1 Case of altitude levels (medium priority)
+! -----------------------
+!
+IF (ANY(XSPECTRA_ALTITUDES(:)/=XUNDEF)) THEN
+ NSPECTRA_K = COUNT (XSPECTRA_ALTITUDES(:)/=XUNDEF)
+ CSPECTRA_LEVEL_TYPE='Z'
+ !
+ ALLOCATE(XCOEFLIN_SPEC(SIZE(XZZ,1),SIZE(XZZ,2),NSPECTRA_K))
+ ALLOCATE(NKLIN_SPEC (SIZE(XZZ,1),SIZE(XZZ,2),NSPECTRA_K))
+ !
+ ALLOCATE(ZZ_SPEC (SIZE(XZZ,1),SIZE(XZZ,2),NSPECTRA_K))
+ DO JK=1,NSPECTRA_K
+ DO JJ=1,SIZE(XZZ,2)
+ DO JI=1,SIZE(XZZ,1)
+ ZZ_SPEC(JI,JJ,JK) = XSPECTRA_ALTITUDES(JK)
+ END DO
+ END DO
+ END DO
+ CALL COEF_VER_INTERP_LIN(XZZ,ZZ_SPEC,NKLIN_SPEC,XCOEFLIN_SPEC)
+ !
+ DEALLOCATE(ZZ_SPEC)
+END IF
+!
+!
+!* 5.2 Case of model levels (highest priority)
+! --------------------
+!
+IF (ANY(NSPECTRA_LEVELS(:)/=NUNDEF)) THEN
+ DO JK = 1, SIZE( NSPECTRA_LEVELS )
+ IF ( NSPECTRA_LEVELS(JK) /= NUNDEF ) THEN
+ IF ( NSPECTRA_LEVELS(JK) < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NSPECTRA_LEVELS too small (<1)' )
+ IF ( NSPECTRA_LEVELS(JK) > NKMAX ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NSPECTRA_LEVELS too large (>NKMAX)' )
+ END IF
+ END DO
+
+ NSPECTRA_K = COUNT (NSPECTRA_LEVELS(:)/=NUNDEF)
+ CSPECTRA_LEVEL_TYPE='K'
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. Number of horizontal wavelengths for non-local diagnostics
+! ----------------------------------------------------------
+!
+NSPECTRA_NI = NLESn_ISUP(IMI) - NLESn_IINF(IMI) + 1
+NSPECTRA_NJ = NLESn_JSUP(IMI) - NLESn_JINF(IMI) + 1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. Allocations of temporal series of local diagnostics
+! ---------------------------------------------------
+!
+!* 7.0 Altitude levels
+! ---------------
+!
+ALLOCATE(XLES_Z (NLES_K))
+!
+!* 7.1 Averaging control variables
+! ---------------------------
+!
+ALLOCATE(NLES_AVG_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(NLES_UND_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
+!
+NLES_AVG_PTS_ll = NUNDEF
+NLES_UND_PTS_ll = NUNDEF
+!
+!
+!* 7.2 Horizontally mean variables
+! ---------------------------
+!
+ALLOCATE(XLES_MEAN_U (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_V (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_W (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_P (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_DP (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_TP (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_TR (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_DISS(NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_LM (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_RHO(NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_Th (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_Mf (NLES_K,NLES_TIMES,NLES_MASKS))
+IF (LUSERC ) THEN
+ ALLOCATE(XLES_MEAN_Thl(NLES_K,NLES_TIMES,NLES_MASKS))
+ ALLOCATE(XLES_MEAN_Rt (NLES_K,NLES_TIMES,NLES_MASKS))
+ ALLOCATE(XLES_MEAN_KHt(NLES_K,NLES_TIMES,NLES_MASKS))
+ ALLOCATE(XLES_MEAN_KHr(NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Thl(0,0,0))
+ ALLOCATE(XLES_MEAN_Rt (0,0,0))
+ ALLOCATE(XLES_MEAN_KHt(0,0,0))
+ ALLOCATE(XLES_MEAN_KHr(0,0,0))
+END IF
+IF (LUSERV) THEN
+ ALLOCATE(XLES_MEAN_Thv(NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Thv(0,0,0))
+END IF
+!
+IF (LUSERV ) THEN
+ ALLOCATE(XLES_MEAN_Rv (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Rv (0,0,0))
+END IF
+IF (LUSERV ) THEN
+ ALLOCATE(XLES_MEAN_Rehu (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Rehu (0,0,0))
+ENDIF
+IF (LUSERV ) THEN
+ ALLOCATE(XLES_MEAN_Qs (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Qs (0,0,0))
+END IF
+IF (LUSERC ) THEN
+ ALLOCATE(XLES_MEAN_Rc (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Rc (0,0,0))
+END IF
+IF (LUSERC ) THEN
+ ALLOCATE(XLES_MEAN_Cf (NLES_K,NLES_TIMES,NLES_MASKS))
+ ALLOCATE(XLES_MEAN_INDCf (NLES_K,NLES_TIMES,NLES_MASKS))
+ ALLOCATE(XLES_MEAN_INDCf2 (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Cf (0,0,0))
+ ALLOCATE(XLES_MEAN_INDCf (0,0,0))
+ ALLOCATE(XLES_MEAN_INDCf2(0,0,0))
+END IF
+IF (LUSERR ) THEN
+ ALLOCATE(XLES_MEAN_Rr (NLES_K,NLES_TIMES,NLES_MASKS))
+ ALLOCATE(XLES_MEAN_RF (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Rr (0,0,0))
+ ALLOCATE(XLES_MEAN_RF (0,0,0))
+END IF
+IF (LUSERI ) THEN
+ ALLOCATE(XLES_MEAN_Ri (NLES_K,NLES_TIMES,NLES_MASKS))
+ ALLOCATE(XLES_MEAN_If (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Ri (0,0,0))
+ ALLOCATE(XLES_MEAN_If (0,0,0))
+END IF
+IF (LUSERS ) THEN
+ ALLOCATE(XLES_MEAN_Rs (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Rs (0,0,0))
+END IF
+IF (LUSERG ) THEN
+ ALLOCATE(XLES_MEAN_Rg (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Rg (0,0,0))
+END IF
+IF (LUSERH ) THEN
+ ALLOCATE(XLES_MEAN_Rh (NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_Rh (0,0,0))
+END IF
+IF (NSV>0 ) THEN
+ ALLOCATE(XLES_MEAN_Sv (NLES_K,NLES_TIMES,NLES_MASKS,NSV))
+ELSE
+ ALLOCATE(XLES_MEAN_Sv (0,0,0,0))
+END IF
+ALLOCATE(XLES_MEAN_WIND (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_dUdz (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_dVdz (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_dWdz (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(XLES_MEAN_dThldz(NLES_K,NLES_TIMES,NLES_MASKS))
+IF (LUSERV) THEN
+ ALLOCATE(XLES_MEAN_dRtdz(NLES_K,NLES_TIMES,NLES_MASKS))
+ELSE
+ ALLOCATE(XLES_MEAN_dRtdz(0,0,0))
+END IF
+IF (NSV>0) THEN
+ ALLOCATE(XLES_MEAN_dSvdz(NLES_K,NLES_TIMES,NLES_MASKS,NSV))
+ELSE
+ ALLOCATE(XLES_MEAN_dSvdz(0,0,0,0))
+END IF
+!
+IF (LLES_PDF) THEN
+!pdf distributions and jpdf distributions
+ CALL LES_ALLOCATE('XLES_PDF_TH ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ CALL LES_ALLOCATE('XLES_PDF_W ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ CALL LES_ALLOCATE('XLES_PDF_THV ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ IF (LUSERV) THEN
+ CALL LES_ALLOCATE('XLES_PDF_RV ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ ELSE
+ CALL LES_ALLOCATE('XLES_PDF_RV ',(/0,0,0,0/))
+ END IF
+ IF (LUSERC) THEN
+ CALL LES_ALLOCATE('XLES_PDF_RC ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ CALL LES_ALLOCATE('XLES_PDF_RT ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ CALL LES_ALLOCATE('XLES_PDF_THL',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ ELSE
+ CALL LES_ALLOCATE('XLES_PDF_RC ',(/0,0,0,0/))
+ CALL LES_ALLOCATE('XLES_PDF_RT ',(/0,0,0,0/))
+ CALL LES_ALLOCATE('XLES_PDF_THL',(/0,0,0,0/))
+ ENDIF
+ IF (LUSERR) THEN
+ CALL LES_ALLOCATE('XLES_PDF_RR ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ ELSE
+ CALL LES_ALLOCATE('XLES_PDF_RR ',(/0,0,0,0/))
+ ENDIF
+ IF (LUSERI) THEN
+ CALL LES_ALLOCATE('XLES_PDF_RI ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ ELSE
+ CALL LES_ALLOCATE('XLES_PDF_RI ',(/0,0,0,0/))
+ END IF
+ IF (LUSERS) THEN
+ CALL LES_ALLOCATE('XLES_PDF_RS ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ ELSE
+ CALL LES_ALLOCATE('XLES_PDF_RS ',(/0,0,0,0/))
+ END IF
+ IF (LUSERG) THEN
+ CALL LES_ALLOCATE('XLES_PDF_RG ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
+ ELSE
+ CALL LES_ALLOCATE('XLES_PDF_RG ',(/0,0,0,0/))
+ END IF
+ENDIF
+!
+XLES_MEAN_U = XUNDEF
+XLES_MEAN_V = XUNDEF
+XLES_MEAN_W = XUNDEF
+XLES_MEAN_P = XUNDEF
+XLES_MEAN_DP = XUNDEF
+XLES_MEAN_TP = XUNDEF
+XLES_MEAN_TR = XUNDEF
+XLES_MEAN_DISS= XUNDEF
+XLES_MEAN_LM = XUNDEF
+XLES_MEAN_RHO= XUNDEF
+XLES_MEAN_Th = XUNDEF
+XLES_MEAN_Mf = XUNDEF
+IF (LUSERC ) XLES_MEAN_Thl= XUNDEF
+IF (LUSERV ) XLES_MEAN_Thv= XUNDEF
+IF (LUSERV ) XLES_MEAN_Rv = XUNDEF
+IF (LUSERV ) XLES_MEAN_Rehu = XUNDEF
+IF (LUSERV ) XLES_MEAN_Qs = XUNDEF
+IF (LUSERC ) XLES_MEAN_KHr = XUNDEF
+IF (LUSERC ) XLES_MEAN_KHt = XUNDEF
+IF (LUSERC ) XLES_MEAN_Rt = XUNDEF
+IF (LUSERC ) XLES_MEAN_Rc = XUNDEF
+IF (LUSERC ) XLES_MEAN_Cf = XUNDEF
+IF (LUSERC ) XLES_MEAN_RF = XUNDEF
+IF (LUSERC ) XLES_MEAN_INDCf = XUNDEF
+IF (LUSERC ) XLES_MEAN_INDCf2 = XUNDEF
+IF (LUSERR ) XLES_MEAN_Rr = XUNDEF
+IF (LUSERI ) XLES_MEAN_Ri = XUNDEF
+IF (LUSERI ) XLES_MEAN_If = XUNDEF
+IF (LUSERS ) XLES_MEAN_Rs = XUNDEF
+IF (LUSERG ) XLES_MEAN_Rg = XUNDEF
+IF (LUSERH ) XLES_MEAN_Rh = XUNDEF
+IF (NSV>0 ) XLES_MEAN_Sv = XUNDEF
+XLES_MEAN_WIND = XUNDEF
+XLES_MEAN_WIND = XUNDEF
+XLES_MEAN_dUdz = XUNDEF
+XLES_MEAN_dVdz = XUNDEF
+XLES_MEAN_dWdz = XUNDEF
+XLES_MEAN_dThldz= XUNDEF
+IF (LUSERV) XLES_MEAN_dRtdz = XUNDEF
+IF (NSV>0) XLES_MEAN_dSvdz = XUNDEF
+!
+IF (LLES_PDF) THEN
+ XLES_PDF_TH = XUNDEF
+ XLES_PDF_W = XUNDEF
+ XLES_PDF_THV = XUNDEF
+ IF (LUSERV) THEN
+ XLES_PDF_RV = XUNDEF
+ END IF
+ IF (LUSERC) THEN
+ XLES_PDF_RC = XUNDEF
+ XLES_PDF_RT = XUNDEF
+ XLES_PDF_THL = XUNDEF
+ END IF
+ IF (LUSERR) THEN
+ XLES_PDF_RR = XUNDEF
+ END IF
+ IF (LUSERI) THEN
+ XLES_PDF_RI = XUNDEF
+ END IF
+ IF (LUSERS) THEN
+ XLES_PDF_RS = XUNDEF
+ END IF
+ IF (LUSERG) THEN
+ XLES_PDF_RG = XUNDEF
+ END IF
+END IF
+!
+!
+!
+!* 7.3 Resolved quantities
+! -------------------
+!
+ALLOCATE(XLES_RESOLVED_U2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'2>
+ALLOCATE(XLES_RESOLVED_V2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'2>
+ALLOCATE(XLES_RESOLVED_W2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2>
+ALLOCATE(XLES_RESOLVED_P2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <p'2>
+ALLOCATE(XLES_RESOLVED_Th2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'2>
+IF (LUSERV) THEN
+ ALLOCATE(XLES_RESOLVED_ThThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'Thv'>
+ELSE
+ ALLOCATE(XLES_RESOLVED_ThThv (0,0,0))
+END IF
+IF (LUSERC) THEN
+ ALLOCATE(XLES_RESOLVED_Thl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'2>
+ ALLOCATE(XLES_RESOLVED_ThlThv(NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Thv'>
+ELSE
+ ALLOCATE(XLES_RESOLVED_Thl2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThlThv(0,0,0))
+END IF
+ALLOCATE(XLES_RESOLVED_Ke (NLES_K,NLES_TIMES,NLES_MASKS)) ! 0.5 <u'2+v'2+w'2>
+ALLOCATE(XLES_RESOLVED_UV (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'v'>
+ALLOCATE(XLES_RESOLVED_WU (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'u'>
+ALLOCATE(XLES_RESOLVED_WV (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'v'>
+ALLOCATE(XLES_RESOLVED_UP (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'p'>
+ALLOCATE(XLES_RESOLVED_VP (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'p'>
+ALLOCATE(XLES_RESOLVED_WP (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'p'>
+ALLOCATE(XLES_RESOLVED_UTh (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Th'>
+ALLOCATE(XLES_RESOLVED_VTh (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Th'>
+ALLOCATE(XLES_RESOLVED_WTh (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Th'>
+IF (LUSERC) THEN
+ ALLOCATE(XLES_RESOLVED_UThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Thl'>
+ ALLOCATE(XLES_RESOLVED_VThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Thl'>
+ ALLOCATE(XLES_RESOLVED_WThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'>
+ELSE
+ ALLOCATE(XLES_RESOLVED_UThl(0,0,0))
+ ALLOCATE(XLES_RESOLVED_VThl(0,0,0))
+ ALLOCATE(XLES_RESOLVED_WThl(0,0,0))
+END IF
+IF (LUSERV) THEN
+ ALLOCATE(XLES_RESOLVED_UThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Thv'>
+ ALLOCATE(XLES_RESOLVED_VThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Thv'>
+ ALLOCATE(XLES_RESOLVED_WThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thv'>
+ELSE
+ ALLOCATE(XLES_RESOLVED_UThv(0,0,0))
+ ALLOCATE(XLES_RESOLVED_VThv(0,0,0))
+ ALLOCATE(XLES_RESOLVED_WThv(0,0,0))
+END IF
+ALLOCATE(XLES_RESOLVED_U3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'3>
+ALLOCATE(XLES_RESOLVED_V3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'3>
+ALLOCATE(XLES_RESOLVED_W3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'3>
+ALLOCATE(XLES_RESOLVED_U4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'4>
+ALLOCATE(XLES_RESOLVED_V4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'4>
+ALLOCATE(XLES_RESOLVED_W4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'4>
+ALLOCATE(XLES_RESOLVED_ThlPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'dp'/dz>
+ALLOCATE(XLES_RESOLVED_WThl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'2>
+ALLOCATE(XLES_RESOLVED_W2Thl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Thl'>
+ALLOCATE(XLES_RESOLVED_MASSFX(NLES_K,NLES_TIMES,NLES_MASKS)) ! <upward mass flux>
+ALLOCATE(XLES_RESOLVED_UKe (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'(u'2+v'2+w'2)>
+ALLOCATE(XLES_RESOLVED_VKe (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'(u'2+v'2+w'2)>
+ALLOCATE(XLES_RESOLVED_WKe (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'(u'2+v'2+w'2)>
+
+IF (LUSERV ) THEN
+ ALLOCATE(XLES_RESOLVED_Rv2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rv'2>
+ ALLOCATE(XLES_RESOLVED_ThRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'Rv'>
+ ALLOCATE(XLES_RESOLVED_ThvRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'Rv'>
+ ALLOCATE(XLES_RESOLVED_URv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Rv'>
+ ALLOCATE(XLES_RESOLVED_VRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Rv'>
+ ALLOCATE(XLES_RESOLVED_WRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rv'>
+ ALLOCATE(XLES_RESOLVED_WRv2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rv'2>
+ ALLOCATE(XLES_RESOLVED_W2Rv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Rv'>
+ ALLOCATE(XLES_RESOLVED_W2Rt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Rt'>
+ ALLOCATE(XLES_RESOLVED_WRt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rt2'>
+ ALLOCATE(XLES_RESOLVED_RvPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rv'dp'/dz>
+ ALLOCATE(XLES_RESOLVED_WThlRv(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Rv'>
+ ALLOCATE(XLES_RESOLVED_WThlRt(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Rt'>
+ELSE
+ ALLOCATE(XLES_RESOLVED_Rv2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThRv (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThvRv (0,0,0))
+ ALLOCATE(XLES_RESOLVED_URv (0,0,0))
+ ALLOCATE(XLES_RESOLVED_VRv (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRv (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRv2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_W2Rv (0,0,0))
+ ALLOCATE(XLES_RESOLVED_W2Rt (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRt2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_RvPz (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WThlRv(0,0,0))
+ ALLOCATE(XLES_RESOLVED_WThlRt(0,0,0))
+END IF
+IF (LUSERC ) THEN
+ ALLOCATE(XLES_RESOLVED_ThlRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Rv'>
+ !
+ ALLOCATE(XLES_RESOLVED_Rc2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rc'2>
+ ALLOCATE(XLES_RESOLVED_ThRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'Rc'>
+ ALLOCATE(XLES_RESOLVED_ThlRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Rc'>
+ ALLOCATE(XLES_RESOLVED_ThvRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'Rc'>
+ ALLOCATE(XLES_RESOLVED_URc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Rc'>
+ ALLOCATE(XLES_RESOLVED_VRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Rc'>
+ ALLOCATE(XLES_RESOLVED_WRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rc'>
+ ALLOCATE(XLES_RESOLVED_WRc2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rc'2>
+ ALLOCATE(XLES_RESOLVED_W2Rc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Rc'>
+ ALLOCATE(XLES_RESOLVED_RcPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rc'dp'/dz>
+ ALLOCATE(XLES_RESOLVED_WThlRc(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Rc'>
+ ALLOCATE(XLES_RESOLVED_WRvRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rv'Rc'>
+ ALLOCATE(XLES_RESOLVED_WRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rt'>
+ ALLOCATE(XLES_RESOLVED_Rt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rt'2>
+ ALLOCATE(XLES_RESOLVED_RtPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rv'dp'/dz>
+ELSE
+ ALLOCATE(XLES_RESOLVED_ThlRv (0,0,0))
+ !
+ ALLOCATE(XLES_RESOLVED_Rc2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThRc (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThlRc (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThvRc (0,0,0))
+ ALLOCATE(XLES_RESOLVED_URc (0,0,0))
+ ALLOCATE(XLES_RESOLVED_VRc (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRc (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRc2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_W2Rc (0,0,0))
+ ALLOCATE(XLES_RESOLVED_RcPz (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WThlRc(0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRvRc (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRt (0,0,0))
+ ALLOCATE(XLES_RESOLVED_Rt2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_RtPz (0,0,0))
+END IF
+IF (LUSERI ) THEN
+ ALLOCATE(XLES_RESOLVED_Ri2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Ri'2>
+ ALLOCATE(XLES_RESOLVED_ThRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'Ri'>
+ ALLOCATE(XLES_RESOLVED_ThlRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Ri'>
+ ALLOCATE(XLES_RESOLVED_ThvRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'Ri'>
+ ALLOCATE(XLES_RESOLVED_URi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Ri'>
+ ALLOCATE(XLES_RESOLVED_VRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Ri'>
+ ALLOCATE(XLES_RESOLVED_WRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Ri'>
+ ALLOCATE(XLES_RESOLVED_WRi2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Ri'2>
+ ALLOCATE(XLES_RESOLVED_W2Ri (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Ri'>
+ ALLOCATE(XLES_RESOLVED_RiPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Ri'dp'/dz>
+ ALLOCATE(XLES_RESOLVED_WThlRi(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Ri'>
+ ALLOCATE(XLES_RESOLVED_WRvRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rv'Ri'>
+ELSE
+ ALLOCATE(XLES_RESOLVED_Ri2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThRi (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThlRi (0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThvRi (0,0,0))
+ ALLOCATE(XLES_RESOLVED_URi (0,0,0))
+ ALLOCATE(XLES_RESOLVED_VRi (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRi (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRi2 (0,0,0))
+ ALLOCATE(XLES_RESOLVED_W2Ri (0,0,0))
+ ALLOCATE(XLES_RESOLVED_RiPz (0,0,0))
+ ALLOCATE(XLES_RESOLVED_WThlRi(0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRvRi (0,0,0))
+END IF
+!
+IF (LUSERR) THEN
+ ALLOCATE(XLES_RESOLVED_WRr (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rr'>
+ ALLOCATE(XLES_INPRR3D (NLES_K,NLES_TIMES,NLES_MASKS)) !precip flux
+ ALLOCATE(XLES_MAX_INPRR3D (NLES_K,NLES_TIMES,NLES_MASKS)) !precip flux
+ ALLOCATE(XLES_EVAP3D (NLES_K,NLES_TIMES,NLES_MASKS)) ! evap
+ELSE
+ ALLOCATE(XLES_RESOLVED_WRr (0,0,0))
+ ALLOCATE(XLES_INPRR3D (0,0,0))
+ ALLOCATE(XLES_MAX_INPRR3D (0,0,0))
+ ALLOCATE(XLES_EVAP3D (0,0,0))
+END IF
+IF (NSV>0 ) THEN
+ ALLOCATE(XLES_RESOLVED_Sv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'2>
+ ALLOCATE(XLES_RESOLVED_ThSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Th'Sv>
+ ALLOCATE(XLES_RESOLVED_USv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <u'Sv'>
+ ALLOCATE(XLES_RESOLVED_VSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <v'Sv'>
+ ALLOCATE(XLES_RESOLVED_WSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'>
+ ALLOCATE(XLES_RESOLVED_WSv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'2>
+ ALLOCATE(XLES_RESOLVED_W2Sv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'2Sv'>
+ ALLOCATE(XLES_RESOLVED_SvPz (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'dp'/dz>
+ ALLOCATE(XLES_RESOLVED_WThlSv(NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Thl'Sv'>
+ IF (LUSERV) THEN
+ ALLOCATE(XLES_RESOLVED_ThvSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Thv'Sv>
+ ALLOCATE(XLES_RESOLVED_WRvSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Rv'Sv'>
+ ELSE
+ ALLOCATE(XLES_RESOLVED_ThvSv (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRvSv (0,0,0,0))
+ END IF
+ IF (LUSERC) THEN
+ ALLOCATE(XLES_RESOLVED_ThlSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Thl'Sv>
+ ELSE
+ ALLOCATE(XLES_RESOLVED_ThlSv (0,0,0,0))
+ END IF
+ELSE
+ ALLOCATE(XLES_RESOLVED_Sv2 (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThSv (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_USv (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_VSv (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_WSv (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_WSv2 (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_W2Sv (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_SvPz (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThvSv (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_ThlSv (0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_WThlSv(0,0,0,0))
+ ALLOCATE(XLES_RESOLVED_WRvSv (0,0,0,0))
+END IF
+!
+!
+XLES_RESOLVED_U2 = XUNDEF
+XLES_RESOLVED_V2 = XUNDEF
+XLES_RESOLVED_W2 = XUNDEF
+XLES_RESOLVED_P2 = XUNDEF
+XLES_RESOLVED_Th2 = XUNDEF
+IF( LUSERC) THEN
+ XLES_RESOLVED_Thl2= XUNDEF
+ XLES_RESOLVED_ThlThv= XUNDEF
+END IF
+IF (LUSERV) THEN
+ XLES_RESOLVED_ThThv = XUNDEF
+END IF
+XLES_RESOLVED_Ke = XUNDEF
+XLES_RESOLVED_UV = XUNDEF
+XLES_RESOLVED_WU = XUNDEF
+XLES_RESOLVED_WV = XUNDEF
+XLES_RESOLVED_UP = XUNDEF
+XLES_RESOLVED_VP = XUNDEF
+XLES_RESOLVED_WP = XUNDEF
+XLES_RESOLVED_UTh = XUNDEF
+XLES_RESOLVED_VTh = XUNDEF
+XLES_RESOLVED_WTh = XUNDEF
+IF (LUSERC) THEN
+ XLES_RESOLVED_UThl= XUNDEF
+ XLES_RESOLVED_VThl= XUNDEF
+ XLES_RESOLVED_WThl= XUNDEF
+END IF
+IF (LUSERV) THEN
+ XLES_RESOLVED_UThv= XUNDEF
+ XLES_RESOLVED_VThv= XUNDEF
+ XLES_RESOLVED_WThv= XUNDEF
+END IF
+XLES_RESOLVED_U3 = XUNDEF
+XLES_RESOLVED_V3 = XUNDEF
+XLES_RESOLVED_W3 = XUNDEF
+XLES_RESOLVED_U4 = XUNDEF
+XLES_RESOLVED_V4 = XUNDEF
+XLES_RESOLVED_W4 = XUNDEF
+XLES_RESOLVED_WThl2 = XUNDEF
+XLES_RESOLVED_W2Thl = XUNDEF
+XLES_RESOLVED_ThlPz = XUNDEF
+!
+XLES_RESOLVED_MASSFX = XUNDEF
+XLES_RESOLVED_UKe = XUNDEF
+XLES_RESOLVED_VKe = XUNDEF
+XLES_RESOLVED_WKe = XUNDEF
+IF (LUSERV ) THEN
+ XLES_RESOLVED_Rv2 = XUNDEF
+ XLES_RESOLVED_ThRv = XUNDEF
+ IF (LUSERC) XLES_RESOLVED_ThlRv= XUNDEF
+ XLES_RESOLVED_ThvRv= XUNDEF
+ XLES_RESOLVED_URv = XUNDEF
+ XLES_RESOLVED_VRv = XUNDEF
+ XLES_RESOLVED_WRv = XUNDEF
+ XLES_RESOLVED_WRv2 = XUNDEF
+ XLES_RESOLVED_W2Rv = XUNDEF
+ XLES_RESOLVED_WRt2 = XUNDEF
+ XLES_RESOLVED_W2Rt = XUNDEF
+ XLES_RESOLVED_WThlRv= XUNDEF
+ XLES_RESOLVED_WThlRt= XUNDEF
+ XLES_RESOLVED_RvPz = XUNDEF
+END IF
+IF (LUSERC ) THEN
+ XLES_RESOLVED_Rc2 = XUNDEF
+ XLES_RESOLVED_ThRc = XUNDEF
+ XLES_RESOLVED_ThlRc= XUNDEF
+ XLES_RESOLVED_ThvRc= XUNDEF
+ XLES_RESOLVED_URc = XUNDEF
+ XLES_RESOLVED_VRc = XUNDEF
+ XLES_RESOLVED_WRc = XUNDEF
+ XLES_RESOLVED_WRc2 = XUNDEF
+ XLES_RESOLVED_W2Rc = XUNDEF
+ XLES_RESOLVED_WThlRc= XUNDEF
+ XLES_RESOLVED_WRvRc = XUNDEF
+ XLES_RESOLVED_RcPz = XUNDEF
+ XLES_RESOLVED_RtPz = XUNDEF
+ XLES_RESOLVED_WRt = XUNDEF
+ XLES_RESOLVED_Rt2 = XUNDEF
+END IF
+IF (LUSERI ) THEN
+ XLES_RESOLVED_Ri2 = XUNDEF
+ XLES_RESOLVED_ThRi = XUNDEF
+ XLES_RESOLVED_ThlRi= XUNDEF
+ XLES_RESOLVED_ThvRi= XUNDEF
+ XLES_RESOLVED_URi = XUNDEF
+ XLES_RESOLVED_VRi = XUNDEF
+ XLES_RESOLVED_WRi = XUNDEF
+ XLES_RESOLVED_WRi2 = XUNDEF
+ XLES_RESOLVED_W2Ri = XUNDEF
+ XLES_RESOLVED_WThlRi= XUNDEF
+ XLES_RESOLVED_WRvRi = XUNDEF
+ XLES_RESOLVED_RiPz = XUNDEF
+END IF
+!
+IF (LUSERR) XLES_RESOLVED_WRr = XUNDEF
+IF (LUSERR) XLES_MAX_INPRR3D = XUNDEF
+IF (LUSERR) XLES_INPRR3D = XUNDEF
+IF (LUSERR) XLES_EVAP3D = XUNDEF
+IF (NSV>0 ) THEN
+ XLES_RESOLVED_Sv2 = XUNDEF
+ XLES_RESOLVED_ThSv = XUNDEF
+ IF (LUSERC) XLES_RESOLVED_ThlSv= XUNDEF
+ IF (LUSERV) XLES_RESOLVED_ThvSv= XUNDEF
+ XLES_RESOLVED_USv = XUNDEF
+ XLES_RESOLVED_VSv = XUNDEF
+ XLES_RESOLVED_WSv = XUNDEF
+ XLES_RESOLVED_WSv2 = XUNDEF
+ XLES_RESOLVED_W2Sv = XUNDEF
+ XLES_RESOLVED_WThlSv= XUNDEF
+ IF (LUSERV) XLES_RESOLVED_WRvSv = XUNDEF
+ XLES_RESOLVED_SvPz = XUNDEF
+END IF
+!
+!
+!* 7.4 interactions of resolved and subgrid quantities
+! -----------------------------------------------
+!
+ALLOCATE(XLES_RES_U_SBG_Tke (NLES_K,NLES_TIMES,NLES_MASKS))! <u'Tke>
+ALLOCATE(XLES_RES_V_SBG_Tke (NLES_K,NLES_TIMES,NLES_MASKS))! <v'Tke>
+ALLOCATE(XLES_RES_W_SBG_Tke (NLES_K,NLES_TIMES,NLES_MASKS))! <w'Tke>
+! ______
+ALLOCATE(XLES_RES_W_SBG_WThl (NLES_K,NLES_TIMES,NLES_MASKS))! <w'w'Thl'>
+! _____
+ALLOCATE(XLES_RES_W_SBG_Thl2 (NLES_K,NLES_TIMES,NLES_MASKS))! <w'Thl'2>
+! _____
+ALLOCATE(XLES_RES_ddxa_U_SBG_UaU (NLES_K,NLES_TIMES,NLES_MASKS))! <du'/dxa ua'u'>
+! _____
+ALLOCATE(XLES_RES_ddxa_V_SBG_UaV (NLES_K,NLES_TIMES,NLES_MASKS))! <dv'/dxa ua'v'>
+! _____
+ALLOCATE(XLES_RES_ddxa_W_SBG_UaW (NLES_K,NLES_TIMES,NLES_MASKS))! <dw'/dxa ua'w'>
+! _______
+ALLOCATE(XLES_RES_ddxa_W_SBG_UaThl (NLES_K,NLES_TIMES,NLES_MASKS))! <dw'/dxa ua'Thl'>
+! _____
+ALLOCATE(XLES_RES_ddxa_Thl_SBG_UaW (NLES_K,NLES_TIMES,NLES_MASKS))! <dThl'/dxa ua'w'>
+! ___
+ALLOCATE(XLES_RES_ddz_Thl_SBG_W2 (NLES_K,NLES_TIMES,NLES_MASKS))! <dThl'/dz w'2>
+! _______
+ALLOCATE(XLES_RES_ddxa_Thl_SBG_UaThl(NLES_K,NLES_TIMES,NLES_MASKS))! <dThl'/dxa ua'Thl'>
+!
+IF (LUSERV) THEN
+! _____
+ ALLOCATE(XLES_RES_W_SBG_WRt (NLES_K,NLES_TIMES,NLES_MASKS))! <w'w'Rt'>
+! ____
+ ALLOCATE(XLES_RES_W_SBG_Rt2 (NLES_K,NLES_TIMES,NLES_MASKS))! <w'Rt'2>
+! _______
+ ALLOCATE(XLES_RES_W_SBG_ThlRt (NLES_K,NLES_TIMES,NLES_MASKS))! <w'Thl'Rt'>
+! ______
+ ALLOCATE(XLES_RES_ddxa_W_SBG_UaRt (NLES_K,NLES_TIMES,NLES_MASKS))! <dw'/dxa ua'Rt'>
+! _____
+ ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaW (NLES_K,NLES_TIMES,NLES_MASKS))! <dRt'/dxa ua'w'>
+! ___
+ ALLOCATE(XLES_RES_ddz_Rt_SBG_W2 (NLES_K,NLES_TIMES,NLES_MASKS))! <dRt'/dz w'2>
+! ______
+ ALLOCATE(XLES_RES_ddxa_Thl_SBG_UaRt (NLES_K,NLES_TIMES,NLES_MASKS))! <dThl'/dxa ua'Rt'>
+! _______
+ ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaThl (NLES_K,NLES_TIMES,NLES_MASKS))! <dRt'/dxa ua'Thl'>
+! ______
+ ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <dRt'/dxa ua'Rt'>
+ELSE
+ ALLOCATE(XLES_RES_W_SBG_WRt (0,0,0))
+ ALLOCATE(XLES_RES_W_SBG_Rt2 (0,0,0))
+ ALLOCATE(XLES_RES_W_SBG_ThlRt (0,0,0))
+ ALLOCATE(XLES_RES_ddxa_W_SBG_UaRt (0,0,0))
+ ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaW (0,0,0))
+ ALLOCATE(XLES_RES_ddz_Rt_SBG_W2 (0,0,0))
+ ALLOCATE(XLES_RES_ddxa_Thl_SBG_UaRt (0,0,0))
+ ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaThl (0,0,0))
+ ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaRt (0,0,0))
+END IF
+!
+! ______
+ALLOCATE(XLES_RES_ddxa_W_SBG_UaSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <dw'/dxa ua'Sv'>
+! _____
+ALLOCATE(XLES_RES_ddxa_Sv_SBG_UaW (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <dSv'/dxa ua'w'>
+! ___
+ALLOCATE(XLES_RES_ddz_Sv_SBG_W2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <dSv'/dz w'2>
+! ______
+ALLOCATE(XLES_RES_ddxa_Sv_SBG_UaSv(NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <dSv'/dxa ua'Sv'>
+! _____
+ALLOCATE(XLES_RES_W_SBG_WSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'w'Sv'>
+! ____
+ALLOCATE(XLES_RES_W_SBG_Sv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'2>
+!
+XLES_RES_U_SBG_Tke= XUNDEF
+XLES_RES_V_SBG_Tke= XUNDEF
+XLES_RES_W_SBG_Tke= XUNDEF
+XLES_RES_W_SBG_WThl = XUNDEF
+XLES_RES_W_SBG_Thl2 = XUNDEF
+XLES_RES_ddxa_U_SBG_UaU = XUNDEF
+XLES_RES_ddxa_V_SBG_UaV = XUNDEF
+XLES_RES_ddxa_W_SBG_UaW = XUNDEF
+XLES_RES_ddxa_W_SBG_UaThl = XUNDEF
+XLES_RES_ddxa_Thl_SBG_UaW = XUNDEF
+XLES_RES_ddz_Thl_SBG_W2 = XUNDEF
+XLES_RES_ddxa_Thl_SBG_UaThl = XUNDEF
+IF (LUSERV) THEN
+ XLES_RES_W_SBG_WRt = XUNDEF
+ XLES_RES_W_SBG_Rt2 = XUNDEF
+ XLES_RES_W_SBG_ThlRt = XUNDEF
+ XLES_RES_ddxa_W_SBG_UaRt = XUNDEF
+ XLES_RES_ddxa_Rt_SBG_UaW = XUNDEF
+ XLES_RES_ddz_Rt_SBG_W2 = XUNDEF
+ XLES_RES_ddxa_Thl_SBG_UaRt= XUNDEF
+ XLES_RES_ddxa_Rt_SBG_UaThl= XUNDEF
+ XLES_RES_ddxa_Rt_SBG_UaRt = XUNDEF
+END IF
+IF (NSV>0) THEN
+ XLES_RES_ddxa_W_SBG_UaSv = XUNDEF
+ XLES_RES_ddxa_Sv_SBG_UaW = XUNDEF
+ XLES_RES_ddz_Sv_SBG_W2 = XUNDEF
+ XLES_RES_ddxa_Sv_SBG_UaSv= XUNDEF
+ XLES_RES_W_SBG_WSv = XUNDEF
+ XLES_RES_W_SBG_Sv2 = XUNDEF
+END IF
+!
+!
+!* 7.5 subgrid quantities
+! ------------------
+!
+ALLOCATE(XLES_SUBGRID_U2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'2>
+ALLOCATE(XLES_SUBGRID_V2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'2>
+ALLOCATE(XLES_SUBGRID_W2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2>
+ALLOCATE(XLES_SUBGRID_Tke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <e>
+ALLOCATE(XLES_SUBGRID_Thl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'2>
+ALLOCATE(XLES_SUBGRID_UV (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'v'>
+ALLOCATE(XLES_SUBGRID_WU (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'u'>
+ALLOCATE(XLES_SUBGRID_WV (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'v'>
+ALLOCATE(XLES_SUBGRID_UThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Thl'>
+ALLOCATE(XLES_SUBGRID_VThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Thl'>
+ALLOCATE(XLES_SUBGRID_WThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'>
+ALLOCATE(XLES_SUBGRID_WThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thv'>
+ALLOCATE(XLES_SUBGRID_ThlThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Thv'>
+ALLOCATE(XLES_SUBGRID_W2Thl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Thl>
+ALLOCATE(XLES_SUBGRID_WThl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'2>
+ALLOCATE(XLES_SUBGRID_DISS_Tke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <epsilon>
+ALLOCATE(XLES_SUBGRID_DISS_Thl2(NLES_K,NLES_TIMES,NLES_MASKS)) ! <epsilon_Thl2>
+ALLOCATE(XLES_SUBGRID_WP (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'p'>
+ALLOCATE(XLES_SUBGRID_PHI3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! phi3
+ALLOCATE(XLES_SUBGRID_LMix (NLES_K,NLES_TIMES,NLES_MASKS)) ! mixing length
+ALLOCATE(XLES_SUBGRID_LDiss (NLES_K,NLES_TIMES,NLES_MASKS)) ! dissipative length
+ALLOCATE(XLES_SUBGRID_Km (NLES_K,NLES_TIMES,NLES_MASKS)) ! Km
+ALLOCATE(XLES_SUBGRID_Kh (NLES_K,NLES_TIMES,NLES_MASKS)) ! Kh
+ALLOCATE(XLES_SUBGRID_ThlPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'dp'/dz>
+ALLOCATE(XLES_SUBGRID_UTke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Tke>
+ALLOCATE(XLES_SUBGRID_VTke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Tke>
+ALLOCATE(XLES_SUBGRID_WTke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Tke>
+ALLOCATE(XLES_SUBGRID_ddz_WTke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <dw'Tke/dz>
+
+ALLOCATE(XLES_SUBGRID_THLUP_MF(NLES_K,NLES_TIMES,NLES_MASKS)) ! Thl of the Updraft
+ALLOCATE(XLES_SUBGRID_RTUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Rt of the Updraft
+ALLOCATE(XLES_SUBGRID_RVUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Rv of the Updraft
+ALLOCATE(XLES_SUBGRID_RCUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Rc of the Updraft
+ALLOCATE(XLES_SUBGRID_RIUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Ri of the Updraft
+ALLOCATE(XLES_SUBGRID_WUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Thl of the Updraft
+ALLOCATE(XLES_SUBGRID_MASSFLUX(NLES_K,NLES_TIMES,NLES_MASKS)) ! Mass Flux
+ALLOCATE(XLES_SUBGRID_DETR (NLES_K,NLES_TIMES,NLES_MASKS)) ! Detrainment
+ALLOCATE(XLES_SUBGRID_ENTR (NLES_K,NLES_TIMES,NLES_MASKS)) ! Entrainment
+ALLOCATE(XLES_SUBGRID_FRACUP (NLES_K,NLES_TIMES,NLES_MASKS)) ! Updraft Fraction
+ALLOCATE(XLES_SUBGRID_THVUP_MF(NLES_K,NLES_TIMES,NLES_MASKS)) ! Thv of the Updraft
+ALLOCATE(XLES_SUBGRID_WTHLMF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Flux of thl
+ALLOCATE(XLES_SUBGRID_WRTMF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Flux of rt
+ALLOCATE(XLES_SUBGRID_WTHVMF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Flux of thv
+ALLOCATE(XLES_SUBGRID_WUMF (NLES_K,NLES_TIMES,NLES_MASKS))! Flux of u
+ALLOCATE(XLES_SUBGRID_WVMF (NLES_K,NLES_TIMES,NLES_MASKS))! Flux of v
+
+IF (LUSERV ) THEN
+ ALLOCATE(XLES_SUBGRID_Rt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rt'2>
+ ALLOCATE(XLES_SUBGRID_ThlRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Rt'>
+ ALLOCATE(XLES_SUBGRID_URt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Rt'>
+ ALLOCATE(XLES_SUBGRID_VRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Rt'>
+ ALLOCATE(XLES_SUBGRID_WRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rt'>
+ ALLOCATE(XLES_SUBGRID_RtThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rt'Thv'>
+ ALLOCATE(XLES_SUBGRID_W2Rt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Rt'>
+ ALLOCATE(XLES_SUBGRID_WThlRt(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Rt'>
+ ALLOCATE(XLES_SUBGRID_WRt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rt'2>
+ ALLOCATE(XLES_SUBGRID_DISS_Rt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <epsilon_Rt2>
+ ALLOCATE(XLES_SUBGRID_DISS_ThlRt(NLES_K,NLES_TIMES,NLES_MASKS)) ! <epsilon_ThlRt>
+ ALLOCATE(XLES_SUBGRID_RtPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rt'dp'/dz>
+ ALLOCATE(XLES_SUBGRID_PSI3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! psi3
+ELSE
+ ALLOCATE(XLES_SUBGRID_Rt2 (0,0,0))
+ ALLOCATE(XLES_SUBGRID_ThlRt (0,0,0))
+ ALLOCATE(XLES_SUBGRID_URt (0,0,0))
+ ALLOCATE(XLES_SUBGRID_VRt (0,0,0))
+ ALLOCATE(XLES_SUBGRID_WRt (0,0,0))
+ ALLOCATE(XLES_SUBGRID_RtThv (0,0,0))
+ ALLOCATE(XLES_SUBGRID_W2Rt (0,0,0))
+ ALLOCATE(XLES_SUBGRID_WThlRt(0,0,0))
+ ALLOCATE(XLES_SUBGRID_WRt2 (0,0,0))
+ ALLOCATE(XLES_SUBGRID_DISS_Rt2 (0,0,0))
+ ALLOCATE(XLES_SUBGRID_DISS_ThlRt(0,0,0))
+ ALLOCATE(XLES_SUBGRID_RtPz (0,0,0))
+ ALLOCATE(XLES_SUBGRID_PSI3 (0,0,0))
+END IF
+IF (LUSERC ) THEN
+ ALLOCATE(XLES_SUBGRID_Rc2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rc'2>
+ ALLOCATE(XLES_SUBGRID_URc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Rc'>
+ ALLOCATE(XLES_SUBGRID_VRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Rc'>
+ ALLOCATE(XLES_SUBGRID_WRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rc'>
+ELSE
+ ALLOCATE(XLES_SUBGRID_Rc2 (0,0,0))
+ ALLOCATE(XLES_SUBGRID_URc (0,0,0))
+ ALLOCATE(XLES_SUBGRID_VRc (0,0,0))
+ ALLOCATE(XLES_SUBGRID_WRc (0,0,0))
+END IF
+IF (LUSERI ) THEN
+ ALLOCATE(XLES_SUBGRID_Ri2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Ri'2>
+ELSE
+ ALLOCATE(XLES_SUBGRID_Ri2 (0,0,0))
+END IF
+IF (NSV>0 ) THEN
+ ALLOCATE(XLES_SUBGRID_USv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <u'Sv'>
+ ALLOCATE(XLES_SUBGRID_VSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <v'Sv'>
+ ALLOCATE(XLES_SUBGRID_WSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'>
+ ALLOCATE(XLES_SUBGRID_Sv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'2>
+ ALLOCATE(XLES_SUBGRID_SvThv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'Thv'>
+ ALLOCATE(XLES_SUBGRID_W2Sv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'2Sv'>
+ ALLOCATE(XLES_SUBGRID_WSv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'2>
+ ALLOCATE(XLES_SUBGRID_DISS_Sv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <epsilon_Sv2>
+ ALLOCATE(XLES_SUBGRID_SvPz (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'dp'/dz>
+ELSE
+ ALLOCATE(XLES_SUBGRID_USv (0,0,0,0))
+ ALLOCATE(XLES_SUBGRID_VSv (0,0,0,0))
+ ALLOCATE(XLES_SUBGRID_WSv (0,0,0,0))
+ ALLOCATE(XLES_SUBGRID_Sv2 (0,0,0,0))
+ ALLOCATE(XLES_SUBGRID_SvThv (0,0,0,0))
+ ALLOCATE(XLES_SUBGRID_W2Sv (0,0,0,0))
+ ALLOCATE(XLES_SUBGRID_WSv2 (0,0,0,0))
+ ALLOCATE(XLES_SUBGRID_DISS_Sv2(0,0,0,0))
+ ALLOCATE(XLES_SUBGRID_SvPz (0,0,0,0))
+END IF
+!
+XLES_SUBGRID_U2 = XUNDEF
+XLES_SUBGRID_V2 = XUNDEF
+XLES_SUBGRID_W2 = XUNDEF
+XLES_SUBGRID_Tke = XUNDEF
+XLES_SUBGRID_Thl2= XUNDEF
+XLES_SUBGRID_UV = XUNDEF
+XLES_SUBGRID_WU = XUNDEF
+XLES_SUBGRID_WV = XUNDEF
+XLES_SUBGRID_UThl= XUNDEF
+XLES_SUBGRID_VThl= XUNDEF
+XLES_SUBGRID_WThl= XUNDEF
+XLES_SUBGRID_WThv= XUNDEF
+XLES_SUBGRID_ThlThv= XUNDEF
+XLES_SUBGRID_W2Thl= XUNDEF
+XLES_SUBGRID_WThl2 = XUNDEF
+XLES_SUBGRID_DISS_Tke = XUNDEF
+XLES_SUBGRID_DISS_Thl2= XUNDEF
+XLES_SUBGRID_WP = XUNDEF
+XLES_SUBGRID_PHI3 = XUNDEF
+XLES_SUBGRID_LMix = XUNDEF
+XLES_SUBGRID_LDiss = XUNDEF
+XLES_SUBGRID_Km = XUNDEF
+XLES_SUBGRID_Kh = XUNDEF
+XLES_SUBGRID_ThlPz = XUNDEF
+XLES_SUBGRID_UTke= XUNDEF
+XLES_SUBGRID_VTke= XUNDEF
+XLES_SUBGRID_WTke= XUNDEF
+XLES_SUBGRID_ddz_WTke = XUNDEF
+
+XLES_SUBGRID_THLUP_MF = XUNDEF
+XLES_SUBGRID_RTUP_MF = XUNDEF
+XLES_SUBGRID_RVUP_MF = XUNDEF
+XLES_SUBGRID_RCUP_MF = XUNDEF
+XLES_SUBGRID_RIUP_MF = XUNDEF
+XLES_SUBGRID_WUP_MF = XUNDEF
+XLES_SUBGRID_MASSFLUX = XUNDEF
+XLES_SUBGRID_DETR = XUNDEF
+XLES_SUBGRID_ENTR = XUNDEF
+XLES_SUBGRID_FRACUP = XUNDEF
+XLES_SUBGRID_THVUP_MF = XUNDEF
+XLES_SUBGRID_WTHLMF = XUNDEF
+XLES_SUBGRID_WRTMF = XUNDEF
+XLES_SUBGRID_WTHVMF = XUNDEF
+XLES_SUBGRID_WUMF = XUNDEF
+XLES_SUBGRID_WVMF = XUNDEF
+
+IF (LUSERV ) THEN
+ XLES_SUBGRID_Rt2 = XUNDEF
+ XLES_SUBGRID_ThlRt= XUNDEF
+ XLES_SUBGRID_URt = XUNDEF
+ XLES_SUBGRID_VRt = XUNDEF
+ XLES_SUBGRID_WRt = XUNDEF
+ XLES_SUBGRID_RtThv = XUNDEF
+ XLES_SUBGRID_W2Rt = XUNDEF
+ XLES_SUBGRID_WThlRt = XUNDEF
+ XLES_SUBGRID_WRt2 = XUNDEF
+ XLES_SUBGRID_DISS_Rt2= XUNDEF
+ XLES_SUBGRID_DISS_ThlRt= XUNDEF
+ XLES_SUBGRID_RtPz = XUNDEF
+ XLES_SUBGRID_PSI3 = XUNDEF
+END IF
+IF (LUSERC ) THEN
+ XLES_SUBGRID_Rc2 = XUNDEF
+ XLES_SUBGRID_URc = XUNDEF
+ XLES_SUBGRID_VRc = XUNDEF
+ XLES_SUBGRID_WRc = XUNDEF
+END IF
+IF (LUSERI ) THEN
+ XLES_SUBGRID_Ri2 = XUNDEF
+END IF
+IF (NSV>0 ) THEN
+ XLES_SUBGRID_USv = XUNDEF
+ XLES_SUBGRID_VSv = XUNDEF
+ XLES_SUBGRID_WSv = XUNDEF
+ XLES_SUBGRID_Sv2 = XUNDEF
+ XLES_SUBGRID_SvThv = XUNDEF
+ XLES_SUBGRID_W2Sv = XUNDEF
+ XLES_SUBGRID_WSv2 = XUNDEF
+ XLES_SUBGRID_DISS_Sv2= XUNDEF
+ XLES_SUBGRID_SvPz = XUNDEF
+END IF
+!
+!
+!* 7.6 updraft quantities (only on the cartesian mask)
+! ------------------
+!
+ALLOCATE(XLES_UPDRAFT (NLES_K,NLES_TIMES)) ! updraft fraction
+ALLOCATE(XLES_UPDRAFT_W (NLES_K,NLES_TIMES)) ! <w>
+ALLOCATE(XLES_UPDRAFT_Th (NLES_K,NLES_TIMES)) ! <theta>
+ALLOCATE(XLES_UPDRAFT_Ke (NLES_K,NLES_TIMES)) ! <E>
+ALLOCATE(XLES_UPDRAFT_WTh (NLES_K,NLES_TIMES)) ! <w'theta'>
+ALLOCATE(XLES_UPDRAFT_Th2 (NLES_K,NLES_TIMES)) ! <th'2>
+ALLOCATE(XLES_UPDRAFT_Tke (NLES_K,NLES_TIMES)) ! <e>
+
+IF (LUSERV) THEN
+ ALLOCATE(XLES_UPDRAFT_Thv (NLES_K,NLES_TIMES)) ! <thetav>
+ ALLOCATE(XLES_UPDRAFT_WThv (NLES_K,NLES_TIMES)) ! <w'thv'>
+ ALLOCATE(XLES_UPDRAFT_ThThv (NLES_K,NLES_TIMES)) ! <th'thv'>
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Thv (0,0))
+ ALLOCATE(XLES_UPDRAFT_WThv (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThThv (0,0))
+END IF
+!
+IF (LUSERC) THEN
+ ALLOCATE(XLES_UPDRAFT_Thl (NLES_K,NLES_TIMES)) ! <thetal>
+ ALLOCATE(XLES_UPDRAFT_WThl (NLES_K,NLES_TIMES)) ! <w'thetal'>
+ ALLOCATE(XLES_UPDRAFT_Thl2 (NLES_K,NLES_TIMES)) ! <thl'2>
+ ALLOCATE(XLES_UPDRAFT_ThlThv(NLES_K,NLES_TIMES)) ! <thl'thv'>
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Thl (0,0))
+ ALLOCATE(XLES_UPDRAFT_WThl (0,0))
+ ALLOCATE(XLES_UPDRAFT_Thl2 (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThlThv(0,0))
+END IF
+
+IF (LUSERV ) THEN
+ ALLOCATE(XLES_UPDRAFT_Rv (NLES_K,NLES_TIMES)) ! <Rv>
+ ALLOCATE(XLES_UPDRAFT_WRv (NLES_K,NLES_TIMES)) ! <w'Rv'>
+ ALLOCATE(XLES_UPDRAFT_Rv2 (NLES_K,NLES_TIMES)) ! <Rv'2>
+ ALLOCATE(XLES_UPDRAFT_ThRv (NLES_K,NLES_TIMES)) ! <Th'Rv'>
+ ALLOCATE(XLES_UPDRAFT_ThvRv (NLES_K,NLES_TIMES)) ! <Thv'Rv'>
+ IF (LUSERC) THEN
+ ALLOCATE(XLES_UPDRAFT_ThlRv (NLES_K,NLES_TIMES)) ! <Thl'Rv'>
+ ELSE
+ ALLOCATE(XLES_UPDRAFT_ThlRv (0,0))
+ END IF
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Rv (0,0))
+ ALLOCATE(XLES_UPDRAFT_WRv (0,0))
+ ALLOCATE(XLES_UPDRAFT_Rv2 (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThRv (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThvRv (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThlRv (0,0))
+END IF
+IF (LUSERC ) THEN
+ ALLOCATE(XLES_UPDRAFT_Rc (NLES_K,NLES_TIMES)) ! <Rc>
+ ALLOCATE(XLES_UPDRAFT_WRc (NLES_K,NLES_TIMES)) ! <w'Rc'>
+ ALLOCATE(XLES_UPDRAFT_Rc2 (NLES_K,NLES_TIMES)) ! <Rc'2>
+ ALLOCATE(XLES_UPDRAFT_ThRc (NLES_K,NLES_TIMES)) ! <Th'Rc'>
+ ALLOCATE(XLES_UPDRAFT_ThvRc (NLES_K,NLES_TIMES)) ! <Thv'Rc'>
+ ALLOCATE(XLES_UPDRAFT_ThlRc (NLES_K,NLES_TIMES)) ! <Thl'Rc'>
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Rc (0,0))
+ ALLOCATE(XLES_UPDRAFT_WRc (0,0))
+ ALLOCATE(XLES_UPDRAFT_Rc2 (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThRc (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThvRc (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThlRc (0,0))
+END IF
+IF (LUSERR ) THEN
+ ALLOCATE(XLES_UPDRAFT_Rr (NLES_K,NLES_TIMES)) ! <Rr>
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Rr (0,0))
+END IF
+IF (LUSERI ) THEN
+ ALLOCATE(XLES_UPDRAFT_Ri (NLES_K,NLES_TIMES)) ! <Ri>
+ ALLOCATE(XLES_UPDRAFT_WRi (NLES_K,NLES_TIMES)) ! <w'Ri'>
+ ALLOCATE(XLES_UPDRAFT_Ri2 (NLES_K,NLES_TIMES)) ! <Ri'2>
+ ALLOCATE(XLES_UPDRAFT_ThRi (NLES_K,NLES_TIMES)) ! <Th'Ri'>
+ ALLOCATE(XLES_UPDRAFT_ThvRi (NLES_K,NLES_TIMES)) ! <Thv'Ri'>
+ ALLOCATE(XLES_UPDRAFT_ThlRi (NLES_K,NLES_TIMES)) ! <Thl'Ri'>
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Ri (0,0))
+ ALLOCATE(XLES_UPDRAFT_WRi (0,0))
+ ALLOCATE(XLES_UPDRAFT_Ri2 (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThRi (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThvRi (0,0))
+ ALLOCATE(XLES_UPDRAFT_ThlRi (0,0))
+END IF
+IF (LUSERS ) THEN
+ ALLOCATE(XLES_UPDRAFT_Rs (NLES_K,NLES_TIMES)) ! <Rs>
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Rs (0,0))
+END IF
+IF (LUSERG ) THEN
+ ALLOCATE(XLES_UPDRAFT_Rg (NLES_K,NLES_TIMES)) ! <Rg>
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Rg (0,0))
+END IF
+IF (LUSERH ) THEN
+ ALLOCATE(XLES_UPDRAFT_Rh (NLES_K,NLES_TIMES)) ! <Rh>
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Rh (0,0))
+END IF
+IF (NSV>0 ) THEN
+ ALLOCATE(XLES_UPDRAFT_Sv (NLES_K,NLES_TIMES,NSV))! <Sv>
+ ALLOCATE(XLES_UPDRAFT_WSv (NLES_K,NLES_TIMES,NSV))! <w'Sv'>
+ ALLOCATE(XLES_UPDRAFT_Sv2 (NLES_K,NLES_TIMES,NSV))! <Sv'2>
+ ALLOCATE(XLES_UPDRAFT_ThSv (NLES_K,NLES_TIMES,NSV))! <Th'Sv'>
+ IF (LUSERV) THEN
+ ALLOCATE(XLES_UPDRAFT_ThvSv (NLES_K,NLES_TIMES,NSV))! <Thv'Sv'>
+ ELSE
+ ALLOCATE(XLES_UPDRAFT_ThvSv (0,0,0))
+ END IF
+ IF (LUSERC) THEN
+ ALLOCATE(XLES_UPDRAFT_ThlSv (NLES_K,NLES_TIMES,NSV))! <Thl'Sv'>
+ ELSE
+ ALLOCATE(XLES_UPDRAFT_ThlSv (0,0,0))
+ END IF
+ELSE
+ ALLOCATE(XLES_UPDRAFT_Sv (0,0,0))
+ ALLOCATE(XLES_UPDRAFT_WSv (0,0,0))
+ ALLOCATE(XLES_UPDRAFT_Sv2 (0,0,0))
+ ALLOCATE(XLES_UPDRAFT_ThSv (0,0,0))
+ ALLOCATE(XLES_UPDRAFT_ThvSv (0,0,0))
+ ALLOCATE(XLES_UPDRAFT_ThlSv (0,0,0))
+END IF
+!
+!
+XLES_UPDRAFT = XUNDEF
+XLES_UPDRAFT_W = XUNDEF
+XLES_UPDRAFT_Th = XUNDEF
+XLES_UPDRAFT_Thl = XUNDEF
+XLES_UPDRAFT_Tke = XUNDEF
+IF (LUSERV ) XLES_UPDRAFT_Thv = XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_Thl = XUNDEF
+IF (LUSERV ) XLES_UPDRAFT_Rv = XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_Rc = XUNDEF
+IF (LUSERR ) XLES_UPDRAFT_Rr = XUNDEF
+IF (LUSERI ) XLES_UPDRAFT_Ri = XUNDEF
+IF (LUSERS ) XLES_UPDRAFT_Rs = XUNDEF
+IF (LUSERG ) XLES_UPDRAFT_Rg = XUNDEF
+IF (LUSERH ) XLES_UPDRAFT_Rh = XUNDEF
+IF (NSV>0 ) XLES_UPDRAFT_Sv = XUNDEF
+XLES_UPDRAFT_Ke = XUNDEF
+XLES_UPDRAFT_WTh = XUNDEF
+IF (LUSERV ) XLES_UPDRAFT_WThv = XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_WThl = XUNDEF
+IF (LUSERV ) XLES_UPDRAFT_WRv = XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_WRc = XUNDEF
+IF (LUSERI ) XLES_UPDRAFT_WRi = XUNDEF
+IF (NSV>0 ) XLES_UPDRAFT_WSv = XUNDEF
+XLES_UPDRAFT_Th2 = XUNDEF
+IF (LUSERV ) THEN
+ XLES_UPDRAFT_ThThv = XUNDEF
+END IF
+IF (LUSERC ) THEN
+ XLES_UPDRAFT_Thl2 = XUNDEF
+ XLES_UPDRAFT_ThlThv = XUNDEF
+END IF
+IF (LUSERV ) XLES_UPDRAFT_Rv2 = XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_Rc2 = XUNDEF
+IF (LUSERI ) XLES_UPDRAFT_Ri2 = XUNDEF
+IF (NSV>0 ) XLES_UPDRAFT_Sv2 = XUNDEF
+IF (LUSERV ) XLES_UPDRAFT_ThRv = XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_ThRc = XUNDEF
+IF (LUSERI ) XLES_UPDRAFT_ThRi = XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_ThlRv= XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_ThlRc= XUNDEF
+IF (LUSERI ) XLES_UPDRAFT_ThlRi= XUNDEF
+IF (NSV>0 ) XLES_UPDRAFT_ThSv = XUNDEF
+IF (LUSERV ) XLES_UPDRAFT_ThvRv= XUNDEF
+IF (LUSERC ) XLES_UPDRAFT_ThvRc= XUNDEF
+IF (LUSERI ) XLES_UPDRAFT_ThvRi= XUNDEF
+IF (NSV>0 .AND. LUSERV) XLES_UPDRAFT_ThvSv = XUNDEF
+IF (NSV>0 .AND. LUSERC) XLES_UPDRAFT_ThlSv = XUNDEF
+!
+!
+!* 7.7 downdraft quantities (only on the cartesian mask)
+! --------------------
+!
+ALLOCATE(XLES_DOWNDRAFT (NLES_K,NLES_TIMES)) ! updraft fraction
+ALLOCATE(XLES_DOWNDRAFT_W (NLES_K,NLES_TIMES)) ! <w>
+ALLOCATE(XLES_DOWNDRAFT_Th (NLES_K,NLES_TIMES)) ! <theta>
+ALLOCATE(XLES_DOWNDRAFT_Ke (NLES_K,NLES_TIMES)) ! <E>
+ALLOCATE(XLES_DOWNDRAFT_WTh (NLES_K,NLES_TIMES)) ! <w'theta'>
+ALLOCATE(XLES_DOWNDRAFT_Th2 (NLES_K,NLES_TIMES)) ! <th'2>
+ALLOCATE(XLES_DOWNDRAFT_Tke (NLES_K,NLES_TIMES)) ! <e>
+
+IF (LUSERV) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Thv (NLES_K,NLES_TIMES)) ! <thetav>
+ ALLOCATE(XLES_DOWNDRAFT_WThv (NLES_K,NLES_TIMES)) ! <w'thv'>
+ ALLOCATE(XLES_DOWNDRAFT_ThThv (NLES_K,NLES_TIMES)) ! <th'thv'>
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Thv (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_WThv (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThThv (0,0))
+END IF
+!
+IF (LUSERC) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Thl (NLES_K,NLES_TIMES)) ! <thetal>
+ ALLOCATE(XLES_DOWNDRAFT_WThl (NLES_K,NLES_TIMES)) ! <w'thetal'>
+ ALLOCATE(XLES_DOWNDRAFT_Thl2 (NLES_K,NLES_TIMES)) ! <thl'2>
+ ALLOCATE(XLES_DOWNDRAFT_ThlThv(NLES_K,NLES_TIMES)) ! <thl'thv'>
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Thl (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_WThl (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_Thl2 (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThlThv(0,0))
+END IF
+
+IF (LUSERV ) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Rv (NLES_K,NLES_TIMES)) ! <Rv>
+ ALLOCATE(XLES_DOWNDRAFT_WRv (NLES_K,NLES_TIMES)) ! <w'Rv'>
+ ALLOCATE(XLES_DOWNDRAFT_Rv2 (NLES_K,NLES_TIMES)) ! <Rv'2>
+ ALLOCATE(XLES_DOWNDRAFT_ThRv (NLES_K,NLES_TIMES)) ! <Th'Rv'>
+ ALLOCATE(XLES_DOWNDRAFT_ThvRv (NLES_K,NLES_TIMES)) ! <Thv'Rv'>
+ IF (LUSERC) THEN
+ ALLOCATE(XLES_DOWNDRAFT_ThlRv (NLES_K,NLES_TIMES)) ! <Thl'Rv'>
+ ELSE
+ ALLOCATE(XLES_DOWNDRAFT_ThlRv (0,0))
+ END IF
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Rv (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_WRv (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_Rv2 (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThRv (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThvRv (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThlRv (0,0))
+END IF
+IF (LUSERC ) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Rc (NLES_K,NLES_TIMES)) ! <Rc>
+ ALLOCATE(XLES_DOWNDRAFT_WRc (NLES_K,NLES_TIMES)) ! <w'Rc'>
+ ALLOCATE(XLES_DOWNDRAFT_Rc2 (NLES_K,NLES_TIMES)) ! <Rc'2>
+ ALLOCATE(XLES_DOWNDRAFT_ThRc (NLES_K,NLES_TIMES)) ! <Th'Rc'>
+ ALLOCATE(XLES_DOWNDRAFT_ThvRc (NLES_K,NLES_TIMES)) ! <Thv'Rc'>
+ ALLOCATE(XLES_DOWNDRAFT_ThlRc (NLES_K,NLES_TIMES)) ! <Thl'Rc'>
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Rc (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_WRc (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_Rc2 (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThRc (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThvRc (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThlRc (0,0))
+END IF
+IF (LUSERR ) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Rr (NLES_K,NLES_TIMES)) ! <Rr>
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Rr (0,0))
+END IF
+IF (LUSERI ) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Ri (NLES_K,NLES_TIMES)) ! <Ri>
+ ALLOCATE(XLES_DOWNDRAFT_WRi (NLES_K,NLES_TIMES)) ! <w'Ri'>
+ ALLOCATE(XLES_DOWNDRAFT_Ri2 (NLES_K,NLES_TIMES)) ! <Ri'2>
+ ALLOCATE(XLES_DOWNDRAFT_ThRi (NLES_K,NLES_TIMES)) ! <Th'Ri'>
+ ALLOCATE(XLES_DOWNDRAFT_ThvRi (NLES_K,NLES_TIMES)) ! <Thv'Ri'>
+ ALLOCATE(XLES_DOWNDRAFT_ThlRi (NLES_K,NLES_TIMES)) ! <Thl'Ri'>
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Ri (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_WRi (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_Ri2 (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThRi (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThvRi (0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThlRi (0,0))
+END IF
+IF (LUSERS ) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Rs (NLES_K,NLES_TIMES)) ! <Rs>
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Rs (0,0))
+END IF
+IF (LUSERG ) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Rg (NLES_K,NLES_TIMES)) ! <Rg>
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Rg (0,0))
+END IF
+IF (LUSERH ) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Rh (NLES_K,NLES_TIMES)) ! <Rh>
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Rh (0,0))
+END IF
+IF (NSV>0 ) THEN
+ ALLOCATE(XLES_DOWNDRAFT_Sv (NLES_K,NLES_TIMES,NSV))! <Sv>
+ ALLOCATE(XLES_DOWNDRAFT_WSv (NLES_K,NLES_TIMES,NSV))! <w'Sv'>
+ ALLOCATE(XLES_DOWNDRAFT_Sv2 (NLES_K,NLES_TIMES,NSV))! <Sv'2>
+ ALLOCATE(XLES_DOWNDRAFT_ThSv (NLES_K,NLES_TIMES,NSV))! <Th'Sv'>
+ IF (LUSERV) THEN
+ ALLOCATE(XLES_DOWNDRAFT_ThvSv (NLES_K,NLES_TIMES,NSV))! <Thv'Sv'>
+ ELSE
+ ALLOCATE(XLES_DOWNDRAFT_ThvSv (0,0,0))
+ END IF
+ IF (LUSERC) THEN
+ ALLOCATE(XLES_DOWNDRAFT_ThlSv (NLES_K,NLES_TIMES,NSV))! <Thl'Sv'>
+ ELSE
+ ALLOCATE(XLES_DOWNDRAFT_ThlSv (0,0,0))
+ END IF
+ELSE
+ ALLOCATE(XLES_DOWNDRAFT_Sv (0,0,0))
+ ALLOCATE(XLES_DOWNDRAFT_WSv (0,0,0))
+ ALLOCATE(XLES_DOWNDRAFT_Sv2 (0,0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThSv (0,0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThvSv (0,0,0))
+ ALLOCATE(XLES_DOWNDRAFT_ThlSv (0,0,0))
+END IF
+!
+!
+XLES_DOWNDRAFT = XUNDEF
+XLES_DOWNDRAFT_W = XUNDEF
+XLES_DOWNDRAFT_Th = XUNDEF
+XLES_DOWNDRAFT_Thl = XUNDEF
+XLES_DOWNDRAFT_Tke = XUNDEF
+IF (LUSERV ) XLES_DOWNDRAFT_Thv = XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_Thl = XUNDEF
+IF (LUSERV ) XLES_DOWNDRAFT_Rv = XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_Rc = XUNDEF
+IF (LUSERR ) XLES_DOWNDRAFT_Rr = XUNDEF
+IF (LUSERI ) XLES_DOWNDRAFT_Ri = XUNDEF
+IF (LUSERS ) XLES_DOWNDRAFT_Rs = XUNDEF
+IF (LUSERG ) XLES_DOWNDRAFT_Rg = XUNDEF
+IF (LUSERH ) XLES_DOWNDRAFT_Rh = XUNDEF
+IF (NSV>0 ) XLES_DOWNDRAFT_Sv = XUNDEF
+XLES_DOWNDRAFT_Ke = XUNDEF
+XLES_DOWNDRAFT_WTh = XUNDEF
+IF (LUSERV ) XLES_DOWNDRAFT_WThv = XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_WThl = XUNDEF
+IF (LUSERV ) XLES_DOWNDRAFT_WRv = XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_WRc = XUNDEF
+IF (LUSERI ) XLES_DOWNDRAFT_WRi = XUNDEF
+IF (NSV>0 ) XLES_DOWNDRAFT_WSv = XUNDEF
+XLES_DOWNDRAFT_Th2 = XUNDEF
+IF (LUSERV ) THEN
+ XLES_DOWNDRAFT_ThThv = XUNDEF
+END IF
+IF (LUSERC ) THEN
+ XLES_DOWNDRAFT_Thl2 = XUNDEF
+ XLES_DOWNDRAFT_ThlThv = XUNDEF
+END IF
+IF (LUSERV ) XLES_DOWNDRAFT_Rv2 = XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_Rc2 = XUNDEF
+IF (LUSERI ) XLES_DOWNDRAFT_Ri2 = XUNDEF
+IF (NSV>0 ) XLES_DOWNDRAFT_Sv2 = XUNDEF
+IF (LUSERV ) XLES_DOWNDRAFT_ThRv = XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_ThRc = XUNDEF
+IF (LUSERI ) XLES_DOWNDRAFT_ThRi = XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_ThlRv= XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_ThlRc= XUNDEF
+IF (LUSERI ) XLES_DOWNDRAFT_ThlRi= XUNDEF
+IF (NSV>0 ) XLES_DOWNDRAFT_ThSv = XUNDEF
+IF (LUSERV ) XLES_DOWNDRAFT_ThvRv= XUNDEF
+IF (LUSERC ) XLES_DOWNDRAFT_ThvRc= XUNDEF
+IF (LUSERI ) XLES_DOWNDRAFT_ThvRi= XUNDEF
+IF (NSV>0 .AND. LUSERV) XLES_DOWNDRAFT_ThvSv = XUNDEF
+IF (NSV>0 .AND. LUSERC) XLES_DOWNDRAFT_ThlSv = XUNDEF
+!
+!* 7.8 production terms
+! ----------------
+!
+ALLOCATE(XLES_BU_RES_KE (NLES_K,NLES_TIMES,NLES_TOT))
+ALLOCATE(XLES_BU_RES_WThl (NLES_K,NLES_TIMES,NLES_TOT))
+ALLOCATE(XLES_BU_RES_Thl2 (NLES_K,NLES_TIMES,NLES_TOT))
+ALLOCATE(XLES_BU_SBG_TKE (NLES_K,NLES_TIMES,NLES_TOT))
+XLES_BU_RES_KE = 0.
+XLES_BU_RES_WThl = 0.
+XLES_BU_RES_Thl2 = 0.
+XLES_BU_SBG_TKE = 0.
+IF (LUSERV) THEN
+ ALLOCATE(XLES_BU_RES_WRt (NLES_K,NLES_TIMES,NLES_TOT))
+ ALLOCATE(XLES_BU_RES_Rt2 (NLES_K,NLES_TIMES,NLES_TOT))
+ ALLOCATE(XLES_BU_RES_ThlRt(NLES_K,NLES_TIMES,NLES_TOT))
+ XLES_BU_RES_WRt = 0.
+ XLES_BU_RES_Rt2 = 0.
+ XLES_BU_RES_ThlRt = 0.
+END IF
+ALLOCATE(XLES_BU_RES_WSv (NLES_K,NLES_TIMES,NLES_TOT,NSV))
+ALLOCATE(XLES_BU_RES_Sv2 (NLES_K,NLES_TIMES,NLES_TOT,NSV))
+IF (NSV>0) THEN
+ XLES_BU_RES_WSv = 0.
+ XLES_BU_RES_Sv2 = 0.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. Allocations of the normalization variables temporal series
+! ----------------------------------------------------------
+!
+ALLOCATE(XLES_UW0 (NLES_TIMES))
+ALLOCATE(XLES_VW0 (NLES_TIMES))
+ALLOCATE(XLES_USTAR (NLES_TIMES))
+ALLOCATE(XLES_WSTAR (NLES_TIMES))
+ALLOCATE(XLES_Q0 (NLES_TIMES))
+ALLOCATE(XLES_E0 (NLES_TIMES))
+ALLOCATE(XLES_SV0 (NLES_TIMES,NSV))
+ALLOCATE(XLES_BL_HEIGHT (NLES_TIMES))
+ALLOCATE(XLES_MO_LENGTH (NLES_TIMES))
+ALLOCATE(XLES_ZCB (NLES_TIMES))
+ALLOCATE(XLES_CFtot (NLES_TIMES))
+ALLOCATE(XLES_CF2tot (NLES_TIMES))
+ALLOCATE(XLES_LWP (NLES_TIMES))
+ALLOCATE(XLES_LWPVAR (NLES_TIMES))
+ALLOCATE(XLES_RWP (NLES_TIMES))
+ALLOCATE(XLES_IWP (NLES_TIMES))
+ALLOCATE(XLES_SWP (NLES_TIMES))
+ALLOCATE(XLES_GWP (NLES_TIMES))
+ALLOCATE(XLES_HWP (NLES_TIMES))
+ALLOCATE(XLES_INT_TKE (NLES_TIMES))
+ALLOCATE(XLES_ZMAXCF (NLES_TIMES))
+ALLOCATE(XLES_ZMAXCF2 (NLES_TIMES))
+ALLOCATE(XLES_INPRR (NLES_TIMES))
+ALLOCATE(XLES_INPRC (NLES_TIMES))
+ALLOCATE(XLES_INDEP (NLES_TIMES))
+ALLOCATE(XLES_RAIN_INPRR(NLES_TIMES))
+ALLOCATE(XLES_ACPRR (NLES_TIMES))
+ALLOCATE(XLES_PRECFR (NLES_TIMES))
+ALLOCATE(XLES_SWU (NLES_K,NLES_TIMES))
+ALLOCATE(XLES_SWD (NLES_K,NLES_TIMES))
+ALLOCATE(XLES_LWU (NLES_K,NLES_TIMES))
+ALLOCATE(XLES_LWD (NLES_K,NLES_TIMES))
+ALLOCATE(XLES_DTHRADSW (NLES_K,NLES_TIMES))
+ALLOCATE(XLES_DTHRADLW (NLES_K,NLES_TIMES))
+ALLOCATE(XLES_RADEFF (NLES_K,NLES_TIMES))
+!
+XLES_UW0 = XUNDEF
+XLES_VW0 = XUNDEF
+XLES_USTAR = XUNDEF
+XLES_WSTAR = XUNDEF
+XLES_Q0 = XUNDEF
+XLES_E0 = XUNDEF
+XLES_SV0 = XUNDEF
+XLES_BL_HEIGHT = XUNDEF
+XLES_MO_LENGTH = XUNDEF
+XLES_ZCB = XUNDEF
+XLES_CFtot = XUNDEF
+XLES_CF2tot = XUNDEF
+XLES_LWP = XUNDEF
+XLES_LWPVAR = XUNDEF
+XLES_RWP = XUNDEF
+XLES_IWP = XUNDEF
+XLES_SWP = XUNDEF
+XLES_GWP = XUNDEF
+XLES_HWP = XUNDEF
+XLES_INT_TKE = XUNDEF
+XLES_ZMAXCF = XUNDEF
+XLES_ZMAXCF2 = XUNDEF
+XLES_PRECFR = XUNDEF
+XLES_ACPRR = XUNDEF
+XLES_INPRR = XUNDEF
+XLES_INPRC = XUNDEF
+XLES_INDEP = XUNDEF
+XLES_RAIN_INPRR = XUNDEF
+XLES_SWU = XUNDEF
+XLES_SWD = XUNDEF
+XLES_LWU = XUNDEF
+XLES_LWD = XUNDEF
+XLES_DTHRADSW = XUNDEF
+XLES_DTHRADLW = XUNDEF
+XLES_RADEFF = XUNDEF
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. Allocations of the normalization variables temporal series
+! ----------------------------------------------------------
+!
+! 9.1 Two-points correlations in I direction
+! --------------------------------------
+!
+ALLOCATE(XCORRi_UU (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between u and u
+ALLOCATE(XCORRi_VV (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between v and v
+ALLOCATE(XCORRi_UV (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between u and v
+ALLOCATE(XCORRi_WU (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and u
+ALLOCATE(XCORRi_WV (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and v
+ALLOCATE(XCORRi_WW (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and w
+ALLOCATE(XCORRi_WTh (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and theta
+ALLOCATE(XCORRi_ThTh (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between theta and theta
+IF (LUSERC) THEN
+ ALLOCATE(XCORRi_WThl (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and thetal
+ ALLOCATE(XCORRi_ThlThl(NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between thetal and thetal
+ELSE
+ ALLOCATE(XCORRi_WThl (0,0,0))
+ ALLOCATE(XCORRi_ThlThl(0,0,0))
+END IF
+
+
+IF (LUSERV ) THEN
+ ALLOCATE(XCORRi_WRv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and Rv
+ ALLOCATE(XCORRi_ThRv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between theta and Rv
+ IF (LUSERC) THEN
+ ALLOCATE(XCORRi_ThlRv(NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rv
+ ELSE
+ ALLOCATE(XCORRi_ThlRv(0,0,0))
+ END IF
+ ALLOCATE(XCORRi_RvRv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between Rv and Rv
+ELSE
+ ALLOCATE(XCORRi_WRv (0,0,0))
+ ALLOCATE(XCORRi_ThRv (0,0,0))
+ ALLOCATE(XCORRi_ThlRv(0,0,0))
+ ALLOCATE(XCORRi_RvRv (0,0,0))
+END IF
+
+IF (LUSERC ) THEN
+ ALLOCATE(XCORRi_WRc (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and Rc
+ ALLOCATE(XCORRi_ThRc (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between theta and Rc
+ ALLOCATE(XCORRi_ThlRc(NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rc
+ ALLOCATE(XCORRi_RcRc (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between Rc and Rc
+ELSE
+ ALLOCATE(XCORRi_WRc (0,0,0))
+ ALLOCATE(XCORRi_ThRc (0,0,0))
+ ALLOCATE(XCORRi_ThlRc(0,0,0))
+ ALLOCATE(XCORRi_RcRc (0,0,0))
+END IF
+
+IF (LUSERI ) THEN
+ ALLOCATE(XCORRi_WRi (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and Ri
+ ALLOCATE(XCORRi_ThRi (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between theta and Rc
+ ALLOCATE(XCORRi_ThlRi(NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rc
+ ALLOCATE(XCORRi_RiRi (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between Rc and Rc
+ELSE
+ ALLOCATE(XCORRi_WRi (0,0,0))
+ ALLOCATE(XCORRi_ThRi (0,0,0))
+ ALLOCATE(XCORRi_ThlRi(0,0,0))
+ ALLOCATE(XCORRi_RiRi (0,0,0))
+END IF
+
+IF (NSV>0 ) THEN
+ ALLOCATE(XCORRi_WSv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES,NSV)) ! between w and Sv
+ ALLOCATE(XCORRi_SvSv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES,NSV)) ! between Sv and Sv
+ELSE
+ ALLOCATE(XCORRi_WSv (0,0,0,0))
+ ALLOCATE(XCORRi_SvSv (0,0,0,0))
+END IF
+!
+!
+XCORRi_UU = XUNDEF
+XCORRi_VV = XUNDEF
+XCORRi_UV = XUNDEF
+XCORRi_WU = XUNDEF
+XCORRi_WV = XUNDEF
+XCORRi_WW = XUNDEF
+XCORRi_WTh = XUNDEF
+IF (LUSERC ) XCORRi_WThl= XUNDEF
+IF (LUSERV ) XCORRi_WRv = XUNDEF
+IF (LUSERC ) XCORRi_WRc = XUNDEF
+IF (LUSERI ) XCORRi_WRi = XUNDEF
+IF (NSV>0 ) XCORRi_WSv = XUNDEF
+XCORRi_ThTh = XUNDEF
+IF (LUSERC ) XCORRi_ThlThl= XUNDEF
+IF (LUSERV ) XCORRi_ThRv = XUNDEF
+IF (LUSERC ) XCORRi_ThRc = XUNDEF
+IF (LUSERI ) XCORRi_ThRi = XUNDEF
+IF (LUSERC ) XCORRi_ThlRv= XUNDEF
+IF (LUSERC ) XCORRi_ThlRc= XUNDEF
+IF (LUSERI ) XCORRi_ThlRi= XUNDEF
+IF (LUSERV ) XCORRi_RvRv = XUNDEF
+IF (LUSERC ) XCORRi_RcRc = XUNDEF
+IF (LUSERI ) XCORRi_RiRi = XUNDEF
+IF (NSV>0 ) XCORRi_SvSv = XUNDEF
+!
+!
+! 9.2 Two-points correlations in J direction
+! --------------------------------------
+!
+ALLOCATE(XCORRj_UU (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between u and u
+ALLOCATE(XCORRj_VV (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between v and v
+ALLOCATE(XCORRj_UV (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between u and v
+ALLOCATE(XCORRj_WU (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and u
+ALLOCATE(XCORRj_WV (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and v
+ALLOCATE(XCORRj_WW (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and w
+ALLOCATE(XCORRj_WTh (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and theta
+ALLOCATE(XCORRj_ThTh (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between theta and theta
+IF (LUSERC) THEN
+ ALLOCATE(XCORRj_WThl (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and thetal
+ ALLOCATE(XCORRj_ThlThl(NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between thetal and thetal
+ELSE
+ ALLOCATE(XCORRj_WThl (0,0,0))
+ ALLOCATE(XCORRj_ThlThl(0,0,0))
+END IF
+
+IF (LUSERV ) THEN
+ ALLOCATE(XCORRj_WRv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and Rv
+ ALLOCATE(XCORRj_ThRv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between theta and Rv
+ IF (LUSERC) THEN
+ ALLOCATE(XCORRj_ThlRv(NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rv
+ ELSE
+ ALLOCATE(XCORRj_ThlRv(0,0,0))
+ END IF
+ ALLOCATE(XCORRj_RvRv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between Rv and Rv
+ELSE
+ ALLOCATE(XCORRj_WRv (0,0,0))
+ ALLOCATE(XCORRj_ThRv (0,0,0))
+ ALLOCATE(XCORRj_ThlRv(0,0,0))
+ ALLOCATE(XCORRj_RvRv (0,0,0))
+END IF
+
+IF (LUSERC ) THEN
+ ALLOCATE(XCORRj_WRc (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and Rc
+ ALLOCATE(XCORRj_ThRc (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between theta and Rc
+ ALLOCATE(XCORRj_ThlRc(NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rc
+ ALLOCATE(XCORRj_RcRc (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between Rc and Rc
+ELSE
+ ALLOCATE(XCORRj_WRc (0,0,0))
+ ALLOCATE(XCORRj_ThRc (0,0,0))
+ ALLOCATE(XCORRj_ThlRc(0,0,0))
+ ALLOCATE(XCORRj_RcRc (0,0,0))
+END IF
+
+IF (LUSERI ) THEN
+ ALLOCATE(XCORRj_WRi (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and Ri
+ ALLOCATE(XCORRj_ThRi (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between theta and Rc
+ ALLOCATE(XCORRj_ThlRi(NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rc
+ ALLOCATE(XCORRj_RiRi (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between Rc and Rc
+ELSE
+ ALLOCATE(XCORRj_WRi (0,0,0))
+ ALLOCATE(XCORRj_ThRi (0,0,0))
+ ALLOCATE(XCORRj_ThlRi(0,0,0))
+ ALLOCATE(XCORRj_RiRi (0,0,0))
+END IF
+
+IF (NSV>0 ) THEN
+ ALLOCATE(XCORRj_WSv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES,NSV)) ! between w and Sv
+ ALLOCATE(XCORRj_SvSv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES,NSV)) ! between Sv and Sv
+ELSE
+ ALLOCATE(XCORRj_WSv (0,0,0,0))
+ ALLOCATE(XCORRj_SvSv (0,0,0,0))
+END IF
+!
+!
+XCORRj_UU = XUNDEF
+XCORRj_VV = XUNDEF
+XCORRj_UV = XUNDEF
+XCORRj_WU = XUNDEF
+XCORRj_WV = XUNDEF
+XCORRj_WW = XUNDEF
+XCORRj_WTh = XUNDEF
+IF (LUSERC ) XCORRj_WThl= XUNDEF
+IF (LUSERV ) XCORRj_WRv = XUNDEF
+IF (LUSERC ) XCORRj_WRc = XUNDEF
+IF (LUSERI ) XCORRj_WRi = XUNDEF
+IF (NSV>0 ) XCORRj_WSv = XUNDEF
+XCORRj_ThTh = XUNDEF
+IF (LUSERC ) XCORRj_ThlThl= XUNDEF
+IF (LUSERV ) XCORRj_ThRv = XUNDEF
+IF (LUSERC ) XCORRj_ThRc = XUNDEF
+IF (LUSERI ) XCORRj_ThRi = XUNDEF
+IF (LUSERC ) XCORRj_ThlRv= XUNDEF
+IF (LUSERC ) XCORRj_ThlRc= XUNDEF
+IF (LUSERI ) XCORRj_ThlRi= XUNDEF
+IF (LUSERV ) XCORRj_RvRv = XUNDEF
+IF (LUSERC ) XCORRj_RcRc = XUNDEF
+IF (LUSERI ) XCORRj_RiRi = XUNDEF
+IF (NSV>0 ) XCORRj_SvSv = XUNDEF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_LES_n
diff --git a/src/PHYEX/ext/ini_radar.f90 b/src/PHYEX/ext/ini_radar.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dbc94a72621630ef82491f6541fd803553260fef
--- /dev/null
+++ b/src/PHYEX/ext/ini_radar.f90
@@ -0,0 +1,234 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! masdev4_7 BUG1 2007/06/15 17:47:18
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_INI_RADAR
+! ########################
+!
+INTERFACE
+ SUBROUTINE INI_RADAR (HPRISTINE_ICE )
+!
+CHARACTER (LEN=4), INTENT(IN) :: HPRISTINE_ICE ! Indicator of ice crystal characteristics
+!
+!
+END SUBROUTINE INI_RADAR
+!
+END INTERFACE
+!
+END MODULE MODI_INI_RADAR
+! ###########################################################
+ SUBROUTINE INI_RADAR ( HPRISTINE_ICE )
+! ###########################################################
+!
+!!**** *INI_RADAR *
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used to
+!! compute radar reflectivity (radar_rain_ice.f90 or radar_simulator.f90)
+!! for DIAG after PREP_REAL_CASE with AROME file (CCLOUD=NONE)
+!!
+!!** METHOD
+!! ------
+!! The constants useful to radar are initialized to their
+!! numerical values as in ini_rain_ice.f90 for ICE3
+!!
+!! EXTERNAL
+!! --------
+!! GAMMA : gamma function
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XPI !
+!! XP00 ! Reference pressure
+!! XRD ! Gaz constant for dry air
+!! XRHOLW ! Liquid water density
+!! Module MODD_RAIN_ICE_DESCR
+!!
+!!
+!! AUTHOR
+!! ------
+!! G. TANGUY * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/10/2009
+!! P.Scheffknecht 22/04/2015: test missing on already allocated XRTMIN
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_RAIN_ICE_DESCR
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+CHARACTER (LEN=4), INTENT(IN) :: HPRISTINE_ICE ! Indicator of ice crystal caracteristics
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 1.1 Raindrop characteristics
+!
+!
+!
+XAR = (XPI/6.0)*XRHOLW
+XBR = 3.0
+XCR = 842.
+XDR = 0.8
+XCCR = 8.E6
+!
+!* 1.2 Ice crystal characteristics
+!
+!
+SELECT CASE (HPRISTINE_ICE)
+ CASE('PLAT')
+ XAI = 0.82 ! Plates
+ XBI = 2.5 ! Plates
+ XC_I = 800. ! Plates
+ XDI = 1.0 ! Plates
+ CASE('COLU')
+ XAI = 2.14E-3 ! Columns
+ XBI = 1.7 ! Columns
+ XC_I = 2.1E5 ! Columns
+ XDI = 1.585 ! Columns
+ CASE('BURO')
+ XAI = 44.0 ! Bullet rosettes
+ XBI = 3.0 ! Bullet rosettes
+ XC_I = 4.3E5 ! Bullet rosettes
+ XDI = 1.663 ! Bullet rosettes
+END SELECT
+!
+!
+!* 1.3 Snowflakes/aggregates characteristics
+!
+!
+XAS = 0.02
+XBS = 1.9
+XCS = 5.1
+XDS = 0.27
+XCCS = 5.0
+XCXS = 1.0
+!
+!* 1.4 Graupel/Frozen drop characteristics
+!
+!
+XAG = 19.6
+XBG = 2.8
+XCG = 124.
+XDG = 0.66
+XCCG = 5.E5
+XCXG = -0.5
+!
+!* 1.5 Hailstone characteristics
+!
+!
+XAH = 470.
+XBH = 3.0
+XCH = 207.
+XDH = 0.64
+XCCH = 4.E4
+XCXH = -1.0
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+!* 2.1 Raindrops distribution
+!
+XALPHAR = 1.0 ! Exponential law
+XNUR = 1.0 ! Exponential law
+!
+!* 2.2 Ice crystal distribution
+!
+XALPHAI = 3.0 ! Gamma law for the ice crystal volume
+XNUI = 3.0 ! Gamma law with little dispersion
+!
+XALPHAS = 1.0 ! Exponential law
+XNUS = 1.0 ! Exponential law
+!
+XALPHAG = 1.0 ! Exponential law
+XNUG = 1.0 ! Exponential law
+!
+XALPHAH = 1.0 ! Gamma law
+XNUH = 8.0 ! Gamma law with little dispersion
+!
+!* 2.3 Constants for shape parameter
+!
+XLBEXR = 1.0/(-1.0-XBR)
+XLBR = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR)
+!
+XLBEXI = 1.0/(-XBI)
+XLBI = ( XAI*MOMG(XALPHAI,XNUI,XBI) )**(-XLBEXI)
+!
+XNS = 1.0/(XAS*MOMG(XALPHAS,XNUS,XBS))
+XLBEXS = 1.0/(XCXS-XBS)
+XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
+!
+XLBEXG = 1.0/(XCXG-XBG)
+XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG) )**(-XLBEXG)
+!
+XLBEXH = 1.0/(XCXH-XBH)
+XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH)
+!
+!* 2.4 Minimal values allowed for the mixing ratios
+! ICE3
+IF(.NOT.ASSOCIATED(XRTMIN)) THEN
+ CALL RAIN_ICE_DESCR_ALLOCATE(6)
+END IF
+!
+XRTMIN(1) = 1.0E-20
+XRTMIN(2) = 1.0E-20
+XRTMIN(3) = 1.0E-20
+XRTMIN(4) = 1.0E-20
+XRTMIN(5) = 1.0E-15
+XRTMIN(6) = 1.0E-15
+
+!
+CONTAINS
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+!
+! auxiliary routine used to compute the Pth moment order of the generalized
+! gamma law
+!
+ USE MODI_GAMMA
+
+ IMPLICIT NONE
+
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+
+!------------------------------------------------------------------------------
+
+
+ PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
+
+ END FUNCTION MOMG
+
+!-------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE INI_RADAR
+
+
diff --git a/src/PHYEX/ext/ini_segn.f90 b/src/PHYEX/ext/ini_segn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c581f7c0140586a06e2e0309fff7d0e1ceedd4ca
--- /dev/null
+++ b/src/PHYEX/ext/ini_segn.f90
@@ -0,0 +1,494 @@
+!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_INI_SEG_n
+! ###################
+!
+INTERFACE
+!
+SUBROUTINE INI_SEG_n(KMI,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
+!
+USE MODD_IO, ONLY : TFILEDATA
+!
+INTEGER, INTENT(IN) :: KMI !Model index
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPINIFILE !Initial file
+CHARACTER (LEN=28), INTENT(OUT) :: HINIFILEPGD
+REAL,DIMENSION(:), INTENT(INOUT) :: PTSTEP_ALL ! Time STEP of ALL models
+!
+END SUBROUTINE INI_SEG_n
+!
+END INTERFACE
+!
+END MODULE MODI_INI_SEG_n
+!
+!
+!
+!
+! #############################################################
+ SUBROUTINE INI_SEG_n(KMI,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
+! #############################################################
+!
+!!**** *INI_SEG_n * - routine to read and update the descriptor files for
+!! model KMI
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to read the descriptor files in the
+! following order :
+! - DESFM file which gives informations about the initial file
+! (i.e. the description of the segment that produced the initial file
+! or the description of the preinitialisation that created the initial file)
+! - EXSEG file which gives informations about the segment to perform.
+!
+! Informations in EXSEG file are completed by DESFM file informations
+! and if the informations are not in DESFM file, they are set
+! to default values.
+!
+! The descriptor file EXSEG corresponding to the segment of simulation
+! to be performed, is then updated with the combined informations.
+! We also store in the updated EXSEG file, the informations on the status
+! of the different variables ( skip, init, read) in the namelist NAM_GETn,
+! which will be read in the INI_MODELn routine to properly initiliaze the
+! model n. Except this last namelist, the informations written in this
+! EXSEG file, will be identical to the NAMELIST section of the descriptive
+! part of the FM files containing the model outputs.
+!
+! In order not to duplicate the routines called by ini_seg, we use the
+! modules modd, corresponding to the first model to store the informations
+! read on the different files ( DESFM and EXSEG ). The final filling of
+! the modules modd (MODD_CONFn ....) will be realized in the subroutine
+! INI_MODELn. The goal of the INI_SEG_n part of the initialization is to
+! built the final EXSEG, which will be associated to the LFI files
+! generated during the segment ( and therefore not to fill the modd).
+!
+!
+!!** METHOD
+!! ------
+!! For a nested model of index KMI :
+!! - Logical unit numbers are associated to output-listing file and
+!! descriptor EXSEG file by FMATTR. Then these files are opened.
+!! The name of the initial file is read in EXSEG file.
+!! - Default values are supplied for variables in descriptor files
+!! (by DEFAULT_DESFM).
+!! - The Initial file (LFIFM + DESFM) is opened by IO_File_open.
+!! - The descriptor DESFM file is read (by READ_DESFM_n).
+!! - The descriptor file EXSEG is read (by READ_EXSEG_n) and coherence
+!! between the initial file and the description of segment is also checked
+!! in this routine.
+!! - If there is more than one model the EXSEG file is updated
+!! (by WRITE_DESFM$n). This routine prints also EXSEG content on
+!! output-listing.
+!! - If there is only one model (i.e. no grid-nesting),
+!! EXSEG file is also closed (logical unit number associated with this
+!! file is also released by FMFREE).
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FMATTR : to associate a logical unit number to a file
+!! IO_File_open : to open descriptor file or LFI file
+!! DEFAULT_DESFM1: to set default values
+!! READ_DESFM_n : to read a DESFM file
+!! READ_EXSEG_n : to read a EXSEG file
+!! WRITE_DESFM1 : to write the DESFM part of the future outputs
+!! FMFREE : to release a logical unit number linked to a file
+!!
+!! Module MODI_DEFAULT_DESFM : Interface for routine DEFAULT_DESFM
+!! Module MODI_READ_DESFM_n : Interface for routine READ_DESFM_n
+!! Module MODI_READ_EXSEG_n : Interface for routine READ_EXSEG_n
+!! Module MODI_WRITE_DESFM1 : Interface for routine WRITE_DESFM1
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_LUNIT : contains names and logical unit numbers
+!!
+!! Module MODD_CONF : contains configuration variables
+!! CCONF : Configuration of models
+!! NMODEL : Number of nested models
+!! NVERB : Level of informations on output-listing
+!! 0 for minimum of prints
+!! 5 for intermediate level of prints
+!! 10 for maximum of prints
+!!
+!! Module MODN_LUNIT1 : contains declarations of namelist NAMLUNITMN
+!! and module MODD_LUNIT1
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine INI_SEG)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/06/94
+!! Modification 26/10/94 remove the NAM_GETn from the namelist present
+!! in the EXSEG file (J.Stein)
+!! 11/01/95 change the read_exseg and desfm CALLS to add
+!! the G1D switch
+!! 15/02/95 add the HTURBLEN information (J. Cuxart)
+!! 18/08/95 Time STEP change (J. P. Lafore)
+!! 02/10/95 add the radiation control (J. Stein)
+!! 18/03/96 remove the no write option for WRITE_DESFM
+!! (J. Stein)
+!! 11/04/96 add the ice conc. control (J.-P. Pinty)
+!! 11/01/97 add the deep convection control (J.-P. Pinty)
+!! 17/07/96 correction for WRITE_DESFM1 call (J. P. Lafore)
+!! 22/07/96 PTSTEP_ALL introduction for nesting (J. P. Lafore)
+!! 7/08/98 // (V. Ducrocq)
+!! 02/08/99 remove unused argument for read_desfm (J. Stein)
+!! 15/03/99 test on execution program (V. Masson)
+!! 15/11/00 Add YCLOUD (J.-P. Pinty)
+!! 01/03/01 Add GUSECHEM (D. Gazen)
+!! 15/10/01 namelists in different orders (I.Mallet)
+!! 25/11/02 Add YELEC (P. Jabouille)
+!! 01/2004 externalization of surface (V. Masson)
+!! 01/2005 add GDUST, GSALT, and GORILAM (P. Tulet)
+!! 04/2010 add GUSECHAQ, GCH_PH (M. Leriche)
+!! 09/2010 add GUSECHIC (M. Leriche)
+!! 02/2012 add GFOREFIRE (Pialat/Tulet)
+!! 05/2014 missing reading of IMASDEV before COUPLING
+!! test (Escobar)
+!! 10/02/15 remove ABORT in parallel case for SPAWNING
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 01/2015 add GLNOX_EXPLICIT (C. Barthe)
+!! 04/2016 add ABORT if CINIFILEPGD is not specified (G.Delautier)
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 07/2017 add GBLOWSNOW (V. Vionnet)
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 19/06/2019: add Fieldlist_nmodel_resize subroutine + provide KMODEL to INI_FIELD_LIST when known
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CONF
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODN_CONFZ
+USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_DYN
+USE MODD_IO, ONLY: NVERB_FATAL, NVERB_WARNING, TFILE_OUTPUTLISTING, TFILEDATA
+USE MODD_LES, ONLY: LES_ASSOCIATE
+USE MODD_LUNIT
+USE MODD_LUNIT_n, ONLY: CINIFILE_n=> CINIFILE, TINIFILE_n => TINIFILE, CINIFILEPGD_n=> CINIFILEPGD, TLUOUT, LUNIT_MODEL
+USE MODD_PARAM_n, ONLY: CSURF
+USE MODD_PARAM_ICE
+USE MODD_PARAMETERS
+USE MODD_REF, ONLY: LBOUSS
+!
+use mode_field, only: Fieldlist_nmodel_resize, Ini_field_list, Ini_field_scalars
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
+USE MODE_IO, only: IO_Config_set
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
+USE MODE_MSG
+USE MODE_POS
+!
+USE MODI_DEFAULT_DESFM_n
+USE MODI_READ_DESFM_n
+USE MODI_READ_EXSEG_n
+USE MODI_WRITE_DESFM_n
+!
+USE MODN_CONFIO, ONLY: NAM_CONFIO
+USE MODN_LUNIT_n
+USE MODN_FIRE
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI !Model index
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPINIFILE !Initial file
+CHARACTER (LEN=28), INTENT(OUT) :: HINIFILEPGD
+REAL,DIMENSION(:), INTENT(INOUT) :: PTSTEP_ALL ! Time STEP of ALL models
+!
+!* 0.1 declarations of local variables
+!
+LOGICAL :: GFOUND ! Return code when searching namelist
+CHARACTER (LEN=28) :: YINIFILE ! name of initial file
+CHARACTER (LEN=2) :: YMI ! string for model index
+INTEGER :: ILUOUT ! Logical unit number
+ ! associated with TLUOUT
+ !
+INTEGER :: IRESP,ILUSEG ! File management variables
+CHARACTER (LEN=5) :: YCONF ! Local variables which have
+LOGICAL :: GFLAT ! the same definition as the
+LOGICAL :: GUSERV,GUSERC,GUSERR,GUSERI ! variables in module MODD_CONF,
+LOGICAL :: GUSERS,GUSERG,GUSERH,GUSECI ! MODD_CONFn, MODD_PARAMn,
+LOGICAL :: GUSECHEM ! flag for chemistry
+LOGICAL :: GUSECHAQ ! flag for aq. phase chemistry
+LOGICAL :: GUSECHIC ! flag for ice phase chemistry
+LOGICAL :: GCH_PH ! flag for pH
+LOGICAL :: GCH_CONV_LINOX
+LOGICAL :: GDUST
+LOGICAL,DIMENSION(JPMODELMAX) :: GDEPOS_DST, GDEPOS_SLT, GDEPOS_AER
+LOGICAL :: GSALT
+LOGICAL :: GORILAM
+LOGICAL :: GLG
+LOGICAL :: GPASPOL
+LOGICAL :: GFIRE
+#ifdef MNH_FOREFIRE
+LOGICAL :: GFOREFIRE
+#endif
+LOGICAL :: GCONDSAMP
+LOGICAL :: GBLOWSNOW
+LOGICAL :: GCHTRANS
+LOGICAL :: GLNOX_EXPLICIT ! flag for LNOx
+ ! These variables
+ ! are used to locally store
+INTEGER :: ISV ! the value read in DESFM
+INTEGER :: IRIMX,IRIMY ! number of points for the
+ ! horizontal relaxation
+CHARACTER (LEN=4) :: YTURB ! file in order to check the
+CHARACTER (LEN=4) :: YRAD ! corresponding informations
+CHARACTER (LEN=4) :: YTOM ! read in EXSEG file.
+LOGICAL :: GRMC01
+CHARACTER (LEN=4) :: YDCONV
+CHARACTER (LEN=4) :: YSCONV
+CHARACTER (LEN=4) :: YCLOUD
+CHARACTER (LEN=4) :: YELEC
+CHARACTER (LEN=3) :: YEQNSYS
+TYPE(TFILEDATA),POINTER :: TZFILE_DES
+!
+TPINIFILE => NULL()
+TZFILE_DES => NULL()
+!-------------------------------------------------------------------------------
+!
+!* 1. OPEN OUPTUT-LISTING FILE AND EXSEG FILE
+! ---------------------------------------
+!
+WRITE(YMI,'(I2.0)') KMI
+CALL IO_File_add2list(LUNIT_MODEL(KMI)%TLUOUT,'OUTPUT_LISTING'//ADJUSTL(YMI),'OUTPUTLISTING','WRITE')
+TLUOUT => LUNIT_MODEL(KMI)%TLUOUT !Necessary because TLUOUT was initially pointing to NULL
+CALL IO_File_open(TLUOUT)
+!
+!Set output file for PRINT_MSG
+TFILE_OUTPUTLISTING => TLUOUT
+!
+ILUOUT=TLUOUT%NLU
+!
+WRITE(UNIT=ILUOUT,FMT='(50("*"),/,"*",17X,"MODEL ",I1," LISTING",16X,"*",/, &
+ & 50("*"))') KMI
+!
+IF (CPROGRAM=='MESONH') THEN
+ CALL IO_File_add2list(TZFILE_DES,'EXSEG'//TRIM(ADJUSTL(YMI))//'.nam','NML','READ')
+ CALL IO_File_open(TZFILE_DES)
+!
+!* 1.3 SPAWNING or SPEC or REAL program case
+! ---------------------
+!
+ELSE IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL '.OR. CPROGRAM=='SPEC ') THEN
+ YINIFILE = CINIFILE_n
+ HINIFILEPGD = CINIFILEPGD_n
+ CALL IO_File_add2list(TPINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TPINIFILE)
+ TZFILE_DES => TPINIFILE%TDESFILE
+!
+!* 1.3bis DIAG program case
+!
+ELSE IF (CPROGRAM=='DIAG ') THEN
+ YINIFILE = CINIFILE_n
+ HINIFILEPGD = CINIFILEPGD_n
+ CALL IO_File_add2list(TINIFILE_n,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TINIFILE_n)
+ TPINIFILE => TINIFILE_n
+ TZFILE_DES => TPINIFILE%TDESFILE
+!
+!* 1.4 Other program cases
+! -------------------
+!
+ELSE
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','should not be called for CPROGRAM='//TRIM(CPROGRAM))
+ENDIF
+!
+ILUSEG = TZFILE_DES%NLU
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. SET DEFAULT VALUES
+! ------------------
+!
+CALL PARAM_ICE_ASSOCIATE()
+CALL LES_ASSOCIATE()
+CALL DEFAULT_DESFM_n(KMI)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. READ INITIAL FILE NAME AND OPEN INITIAL FILE
+! --------------------------------------------
+!
+CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND)
+IF (GFOUND) THEN
+ CALL INIT_NAM_LUNITn
+ READ(UNIT=ILUSEG,NML=NAM_LUNITn)
+ CALL UPDATE_NAM_LUNITn
+ IF (LEN_TRIM(CINIFILEPGD)==0 .AND. CSURF=='EXTE') THEN
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','error in namelist NAM_LUNITn: you need to specify CINIFILEPGD')
+ ENDIF
+END IF
+
+IF (CPROGRAM=='MESONH') THEN
+ IF (KMI.EQ.1) THEN
+ CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
+ CALL POSNAM(ILUSEG,'NAM_CONFIO',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFIO)
+ CALL IO_Config_set()
+ ! read Blaze namelist to get NREFINX and NREFINY before INI_FIELD_LIST
+ CALL POSNAM(ILUSEG,'NAM_FIRE',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FIRE)
+ END IF
+ HINIFILEPGD=CINIFILEPGD_n
+ YINIFILE=CINIFILE_n
+
+ CALL IO_File_add2list(TPINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ TINIFILE_n => TPINIFILE !Necessary because TINIFILE was initially pointing to NULL
+ CALL IO_File_open(TPINIFILE)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. READ DESFM FILE
+! ---------------
+!
+CALL READ_DESFM_n(KMI,TPINIFILE,YCONF,GFLAT,GUSERV,GUSERC, &
+ GUSERR,GUSERI,GUSECI,GUSERS,GUSERG,GUSERH,GUSECHEM,GUSECHAQ,&
+ GUSECHIC,GCH_PH,GCH_CONV_LINOX,GSALT,GDEPOS_SLT,GDUST, &
+ GDEPOS_DST, GCHTRANS, GORILAM, &
+ GDEPOS_AER, GLG, GPASPOL,GFIRE, &
+#ifdef MNH_FOREFIRE
+ GFOREFIRE, &
+#endif
+ GLNOX_EXPLICIT, &
+ GCONDSAMP,GBLOWSNOW, IRIMX,IRIMY,ISV, &
+ YTURB,YTOM,GRMC01,YRAD,YDCONV,YSCONV,YCLOUD,YELEC,YEQNSYS )
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Initialize fieldlist
+! --------------------
+!
+IF (KMI==1) THEN !Do this only 1 time
+ IF (CPROGRAM=='SPAWN ') THEN
+ CALL INI_FIELD_LIST(2)
+ ELSE IF (CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ') THEN
+ CALL INI_FIELD_LIST(1)
+ ELSE IF (CPROGRAM/='REAL ' .AND. CPROGRAM/='IDEAL ' ) THEN
+ CALL INI_FIELD_LIST()
+ END IF
+ IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' .OR. CPROGRAM=='MESONH') THEN
+ CALL INI_FIELD_SCALARS()
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. READ in the LFI file SOME VARIABLES of MODD_CONF
+! ------------------------------------------------
+!
+IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='SPAWN ') THEN
+ IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>9) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
+ CALL IO_Field_read(TPINIFILE,'COUPLING',LCOUPLING)
+ IF (LCOUPLING) THEN
+ WRITE(ILUOUT,*) 'Error with the initial file'
+ WRITE(ILUOUT,*) 'The file',YINIFILE,' was created with LCOUPLING=.TRUE.'
+ WRITE(ILUOUT,*) 'You can not use it as initial file, only as coupling file'
+ WRITE(ILUOUT,*) 'Run PREP_REAL_CASE with LCOUPLING=.FALSE.'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','')
+ ENDIF
+ ENDIF
+END IF
+!
+! Read the storage type
+ CALL IO_Field_read(TPINIFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP)
+ IF (IRESP /= 0) THEN
+ WRITE(ILUOUT,FMT=9002) 'STORAGE_TYPE',IRESP
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','')
+ END IF
+IF (KMI == 1) THEN
+! Read the geometry kind
+ CALL IO_Field_read(TPINIFILE,'CARTESIAN',LCARTESIAN)
+! Read the thinshell approximation
+ CALL IO_Field_read(TPINIFILE,'THINSHELL',LTHINSHELL)
+!
+ IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
+ CALL IO_Field_read(TPINIFILE,'L1D',L1D,IRESP)
+ IF (IRESP/=0) L1D=.FALSE.
+!
+ CALL IO_Field_read(TPINIFILE,'L2D',L2D,IRESP)
+ IF (IRESP/=0) L2D=.FALSE.
+!
+ CALL IO_Field_read(TPINIFILE,'PACK',LPACK,IRESP)
+ IF (IRESP/=0) LPACK=.TRUE.
+ ELSE
+ L1D=.FALSE.
+ L2D=.FALSE.
+ LPACK=.TRUE.
+ END IF
+ IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=10) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
+ CALL IO_Field_read(TPINIFILE,'LBOUSS',LBOUSS)
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. READ EXSEG FILE
+! ---------------
+! We pass by arguments the informations read in DESFM descriptor to the
+! routine which read related informations in the EXSEG descriptor in order to
+! check coherence between both informations.
+!
+CALL IO_Field_read(TPINIFILE,'LOCEAN',LOCEAN,IRESP)
+IF ( IRESP /= 0 ) LOCEAN = .FALSE.
+!
+CALL READ_EXSEG_n(KMI,TZFILE_DES,YCONF,GFLAT,GUSERV,GUSERC, &
+ GUSERR,GUSERI,GUSECI,GUSERS,GUSERG,GUSERH,GUSECHEM, &
+ GUSECHAQ,GUSECHIC,GCH_PH, &
+ GCH_CONV_LINOX,GSALT,GDEPOS_SLT,GDUST,GDEPOS_DST,GCHTRANS, &
+ GORILAM,GDEPOS_AER,GLG,GPASPOL,GFIRE, &
+#ifdef MNH_FOREFIRE
+ GFOREFIRE, &
+#endif
+ GLNOX_EXPLICIT, &
+ GCONDSAMP,GBLOWSNOW, IRIMX,IRIMY,ISV, &
+ YTURB,YTOM,GRMC01,YRAD,YDCONV,YSCONV,YCLOUD,YELEC,YEQNSYS, &
+ PTSTEP_ALL,CSTORAGE_TYPE,CINIFILEPGD_n )
+!
+if ( cprogram == 'MESONH' .and. kmi == 1 ) then !Do this only once
+ call Fieldlist_nmodel_resize(NMODEL)
+end if
+!
+IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' &
+ .OR. CPROGRAM=='REAL ') THEN
+ CINIFILE_n = YINIFILE
+ CCPLFILE(:) = ' '
+ NMODEL=1
+ LSTEADYLS=.TRUE.
+END IF
+!
+IF (CPROGRAM=='MESONH') THEN
+ HINIFILEPGD=CINIFILEPGD_n
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 7. CLOSE FILES
+! ------------
+!
+IF (CPROGRAM=='MESONH') CALL IO_File_close(TZFILE_DES)
+!
+!-------------------------------------------------------------------------------
+9002 FORMAT(/,'FATAL ERROR IN INI_SEG_n: pb to read ',A16,' IRESP=',I3)
+!
+END SUBROUTINE INI_SEG_n
diff --git a/src/PHYEX/ext/les_cloud_masksn.f90 b/src/PHYEX/ext/les_cloud_masksn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..10e9e4093fc35cf7e5d3ba3c0ebcce0047611694
--- /dev/null
+++ b/src/PHYEX/ext/les_cloud_masksn.f90
@@ -0,0 +1,419 @@
+!MNH_LIC Copyright 2006-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.
+!-----------------------------------------------------------------
+! #######################
+ SUBROUTINE LES_CLOUD_MASKS_n
+! #######################
+!
+!
+!!**** *LES_MASKS_n* initializes the masks for clouds
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/2006
+!! P. Aumond 10/2009 Add possibility of user maskS
+!! F.Couvreux 06/2011 : Conditional sampling
+!! C.Lac 10/2014 : Correction on user masks
+!! Q.Rodier 05/2019 : Missing parallelization
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_LES
+USE MODD_LES_n
+USE MODD_FIELD_n
+USE MODD_CONF_n
+USE MODD_CST , ONLY : XRD, XRV
+USE MODD_NSV , ONLY : NSV_CSBEG, NSV_CSEND, NSV_CS
+USE MODD_GRID_n , ONLY : XZHAT
+USE MODD_CONDSAMP
+!
+USE MODE_ll
+!
+USE MODI_LES_VER_INT
+USE MODI_LES_MEAN_ll
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: JK ! vertical loop counter
+INTEGER :: JI ! loop index on masks
+INTEGER :: IIU, IJU,IIB,IJB,IIE,IJE ! hor. indices
+INTEGER :: IKU, KBASE, KTOP ! ver. index
+INTEGER :: IRR, IRRC, IRRR, IRRI, IRRS, IRRG ! moist variables indices
+INTEGER :: JSV ! ind of scalars
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT ! total water
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV ! Virtual potential temperature
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW_LES ! W on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_LES ! Rc on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_LES ! Ri on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT_LES ! Rt on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LES ! thv on LES vertical grid
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_LES ! thv on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_ANOM ! thv-thv_mean on LES vertical grid
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_ANOM ! sv-sv_mean
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTD_SV
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTD_SVTRES ! threshold of sv
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D,ZWORK3DB
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1D
+REAL, DIMENSION(:), ALLOCATABLE :: ZMEANRC
+!
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+IKU = SIZE(XTHT,3)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.0 Thermodynamical computations
+! ----------------------------
+!
+ALLOCATE(ZRT (IIU,IJU,IKU))
+ALLOCATE(ZMEANRC (IKU))
+ZRT = 0.
+!
+IRR=0
+IF (LUSERV) THEN
+ IRR=IRR+1
+ ZRT = ZRT + XRT(:,:,:,1)
+END IF
+IF (LUSERC) THEN
+ IRR=IRR+1
+ IRRC=IRR
+ ZRT = ZRT + XRT(:,:,:,IRRC)
+END IF
+IF (LUSERR) THEN
+ IRR=IRR+1
+ IRRR=IRR
+ ZRT = ZRT + XRT(:,:,:,IRRR)
+END IF
+IF (LUSERI) THEN
+ IRR=IRR+1
+ IRRI=IRR
+ ZRT = ZRT + XRT(:,:,:,IRRI)
+END IF
+IF (LUSERS) THEN
+ IRR=IRR+1
+ IRRS=IRR
+ ZRT = ZRT + XRT(:,:,:,IRRS)
+END IF
+IF (LUSERG) THEN
+ IRR=IRR+1
+ IRRG=IRR
+ ZRT = ZRT + XRT(:,:,:,IRRG)
+END IF
+!
+!
+!* computes fields on the LES grid in order to compute masks
+!
+ALLOCATE(ZTHV (IIU,IJU,IKU))
+ZTHV = XTHT
+IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRT(:,:,:,1))/(1.+ZRT(:,:,:))
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.0 Fields on LES grid
+! ------------------
+!
+!* allocates fields on the LES grid
+!
+!
+ALLOCATE(ZW_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZRC_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZRI_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZRT_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZTHV_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZTHV_ANOM(IIU,IJU,NLES_K))
+ALLOCATE(ZSV_LES (IIU,IJU,NLES_K,NSV_CS))
+ALLOCATE(ZSV_ANOM(IIU,IJU,NLES_K,NSV_CS))
+ALLOCATE(ZSTD_SV(NLES_K,NSV_CS))
+ALLOCATE(ZSTD_SVTRES(NLES_K,NSV_CS))
+ALLOCATE(ZWORK1D(NLES_K))
+ALLOCATE(ZWORK3D(IIU,IJU,IKU))
+ALLOCATE(ZWORK3DB(IIU,IJU,NLES_K))
+!
+ZWORK1D=0.
+ZWORK3D=0.
+ZWORK3DB=0.
+!
+CALL LES_VER_INT(MZF(XWT), ZW_LES)
+IF (NSV_CS>0) THEN
+ DO JSV=NSV_CSBEG, NSV_CSEND
+ CALL LES_VER_INT( XSVT(:,:,:,JSV), &
+ ZSV_LES(:,:,:,JSV-NSV_CSBEG+1) )
+ END DO
+END IF
+IF (LUSERC) THEN
+ CALL LES_VER_INT(XRT(:,:,:,IRRC), ZRC_LES)
+ELSE
+ ZRC_LES = 0.
+END IF
+IF (LUSERI) THEN
+ CALL LES_VER_INT(XRT(:,:,:,IRRI), ZRI_LES)
+ELSE
+ ZRI_LES = 0.
+END IF
+CALL LES_VER_INT(ZRT, ZRT_LES)
+CALL LES_VER_INT(ZTHV, ZTHV_LES)
+CALL LES_ANOMALY_FIELD(ZTHV,ZTHV_ANOM)
+!
+IF (NSV_CS>0) THEN
+ DO JSV=NSV_CSBEG, NSV_CSEND
+ ZWORK3D(:,:,:)=XSVT(:,:,:,JSV)
+ CALL LES_ANOMALY_FIELD(ZWORK3D,ZWORK3DB)
+ ZSV_ANOM(:,:,:,JSV-NSV_CSBEG+1)=ZWORK3DB(:,:,:)
+ CALL LES_STDEV(ZWORK3DB,ZWORK1D)
+ ZSTD_SV(:,JSV-NSV_CSBEG+1)=ZWORK1D(:)
+ DO JK=1,NLES_K
+ ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)=SUM(ZSTD_SV(1:JK,JSV-NSV_CSBEG+1))/(1.*JK)
+ END DO
+ END DO
+END IF
+!
+DEALLOCATE(ZTHV )
+DEALLOCATE(ZWORK3D)
+DEALLOCATE(ZWORK3DB)
+DEALLOCATE(ZWORK1D)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3.0 Cloud mask
+! ----------
+!
+IF (LLES_NEB_MASK) THEN
+ CALL LES_ALLOCATE('LLES_CURRENT_NEB_MASK',(/IIU,IJU,NLES_K/))
+ LLES_CURRENT_NEB_MASK (:,:,:) = .FALSE.
+ WHERE ((ZRC_LES(IIB:IIE,IJB:IJE,:)>1.E-6 .OR. ZRI_LES(IIB:IIE,IJB:IJE,:)>1.E-6) .AND. ZW_LES(IIB:IIE,IJB:IJE,:)>0.)
+ LLES_CURRENT_NEB_MASK (IIB:IIE,IJB:IJE,:) = .TRUE.
+ END WHERE
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.0 Cloud core mask
+! ---------------
+!
+IF (LLES_CORE_MASK) THEN
+ CALL LES_ALLOCATE('LLES_CURRENT_CORE_MASK',(/IIU,IJU,NLES_K/))
+ LLES_CURRENT_CORE_MASK (:,:,:) = .FALSE.
+ WHERE ((ZRC_LES(IIB:IIE,IJB:IJE,:)>1.E-6 .OR. ZRI_LES(IIB:IIE,IJB:IJE,:)>1.E-6) &
+ .AND. ZW_LES(IIB:IIE,IJB:IJE,:)>0. .AND. ZTHV_ANOM(IIB:IIE,IJB:IJE,:)>0.)
+ LLES_CURRENT_CORE_MASK (IIB:IIE,IJB:IJE,:) = .TRUE.
+ END WHERE
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.0 Conditional sampling mask
+! -------------------------
+!
+IF (LLES_CS_MASK) THEN
+!
+ CALL LES_MEAN_ll(ZRC_LES, LLES_CURRENT_CART_MASK, ZMEANRC )
+ CALL LES_ALLOCATE('LLES_CURRENT_CS1_MASK',(/IIU,IJU,NLES_K/))
+ LLES_CURRENT_CS1_MASK(:,:,:) = .FALSE.
+ IF (NSV_CS >= 2) THEN
+ CALL LES_ALLOCATE('LLES_CURRENT_CS2_MASK',(/IIU,IJU,NLES_K/))
+ LLES_CURRENT_CS2_MASK(:,:,:) = .FALSE.
+ IF (NSV_CS == 3) THEN
+ CALL LES_ALLOCATE('LLES_CURRENT_CS3_MASK',(/IIU,IJU,NLES_K/))
+ LLES_CURRENT_CS3_MASK (:,:,:) = .FALSE.
+ END IF
+ END IF
+
+!
+! Cloud top and base computation
+!
+ KBASE=2
+ KTOP=NLES_K
+ DO JK=2,NLES_K
+ IF ((ZMEANRC(JK) > 1.E-7) .AND. (KBASE == 2)) KBASE=JK
+ IF ((ZMEANRC(JK) < 1.E-7) .AND. (KBASE > 2) .AND. (KTOP == NLES_K)) &
+ KTOP=JK-1
+ END DO
+!
+ DO JSV=NSV_CSBEG, NSV_CSEND
+ DO JK=2,NLES_K
+ IF (ZSTD_SV(JK,JSV-NSV_CSBEG+1) < 0.05*ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)) &
+ ZSTD_SV(JK,JSV-NSV_CSBEG+1)=0.05*ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)
+! case no cloud top and base
+ IF (JSV == NSV_CSBEG) THEN
+ IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
+ WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
+ LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+!
+! case cloud top and base defined
+!
+ IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
+ WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
+ LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+!
+ IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
+ WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1) .AND. &
+ ZRC_LES(IIB:IIE,IJB:IJE,JK)>1.E-6)
+ LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+ ELSE IF ( JSV == NSV_CSBEG + 1 ) THEN
+ IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
+ WHERE ( ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
+ LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+!
+! case cloud top and base defined
+!
+ IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
+ WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
+ LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+!
+ IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
+ WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
+ LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+!
+ ELSE
+ IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
+ WHERE ( ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
+ LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+!
+! case cloud top and base defined
+!
+ IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
+ WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
+ LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+!
+ IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
+ WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
+ XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
+ LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
+ END WHERE
+ END IF
+ END IF
+ END DO
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5.0 User mask
+! ---------
+!
+IF (LLES_MY_MASK) THEN
+ CALL LES_ALLOCATE('LLES_CURRENT_MY_MASKS',(/IIU,IJU,NLES_K,NLES_MASKS_USER/))
+ DO JI=1,NLES_MASKS_USER
+ LLES_CURRENT_MY_MASKS (IIB:IIE,IJB:IJE,:,JI) = .FALSE.
+ END DO
+! WHERE ((ZRC_LES + ZRI_LES) > 1.E-06)
+! LLES_CURRENT_MY_MASKS (:,:,:,1) = .TRUE.
+! END WHERE
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+DEALLOCATE(ZW_LES )
+DEALLOCATE(ZRC_LES )
+DEALLOCATE(ZRI_LES )
+DEALLOCATE(ZRT_LES )
+DEALLOCATE(ZTHV_LES )
+DEALLOCATE(ZSV_LES )
+DEALLOCATE(ZTHV_ANOM)
+DEALLOCATE(ZSV_ANOM)
+DEALLOCATE(ZSTD_SV)
+DEALLOCATE(ZSTD_SVTRES)
+!-------------------------------------------------------------------------------
+DEALLOCATE(ZRT )
+DEALLOCATE(ZMEANRC)
+!--------------------------------------------------------------------------------
+!
+CONTAINS
+!
+!--------------------------------------------------------------------------------
+!
+SUBROUTINE LES_ANOMALY_FIELD(PF,PF_ANOM)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PF
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_ANOM
+
+REAL, DIMENSION(SIZE(PF_ANOM,3)) :: ZMEAN
+INTEGER :: JI, JJ
+
+CALL LES_VER_INT(PF, PF_ANOM)
+CALL LES_MEAN_ll(PF_ANOM, LLES_CURRENT_CART_MASK, ZMEAN )
+DO JJ=1,SIZE(PF_ANOM,2)
+ DO JI=1,SIZE(PF_ANOM,1)
+ PF_ANOM(JI,JJ,:) = PF_ANOM(JI,JJ,:) - ZMEAN(:)
+ END DO
+END DO
+
+END SUBROUTINE LES_ANOMALY_FIELD
+!--------------------------------------------------------------------------------
+!
+!--------------------------------------------------------------------------------
+!
+SUBROUTINE LES_STDEV(PF_ANOM,PF_STD)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PF_ANOM
+REAL, DIMENSION(:), INTENT(OUT) :: PF_STD
+
+REAL, DIMENSION(SIZE(PF_ANOM,1),SIZE(PF_ANOM,2),SIZE(PF_ANOM,3)) :: Z2
+INTEGER :: JK
+
+Z2(:,:,:)=PF_ANOM(:,:,:)*PF_ANOM(:,:,:)
+CALL LES_MEAN_ll(Z2, LLES_CURRENT_CART_MASK, PF_STD )
+DO JK=1,SIZE(PF_ANOM,3)
+ PF_STD(JK)=SQRT(PF_STD(JK))
+END DO
+
+END SUBROUTINE LES_STDEV
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LES_CLOUD_MASKS_n
diff --git a/src/PHYEX/ext/les_ini_timestepn.f90 b/src/PHYEX/ext/les_ini_timestepn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..98c5cd306456bf19b2839c9ee608448392c07078
--- /dev/null
+++ b/src/PHYEX/ext/les_ini_timestepn.f90
@@ -0,0 +1,407 @@
+!MNH_LIC Copyright 2002-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_LES_INI_TIMESTEP_n
+! #######################
+!
+!
+INTERFACE LES_INI_TIMESTEP_n
+!
+ SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT)
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
+!
+END SUBROUTINE LES_INI_TIMESTEP_n
+!
+END INTERFACE
+!
+END MODULE MODI_LES_INI_TIMESTEP_n
+
+! ##############################
+ SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT)
+! ##############################
+!
+!
+!!**** *LES_INI_TIMESTEP_n* initializes the LES variables for
+!! the current time-step of model _n
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/11/02
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
+! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_NSV
+USE MODD_LES
+USE MODD_LES_n
+USE MODD_FIELD_n
+USE MODD_METRICS_n
+USE MODD_REF_n
+USE MODD_CONF_n
+USE MODD_TIME_n
+USE MODD_DYN_n
+USE MODD_TIME
+USE MODD_CONF
+USE MODD_LES_BUDGET
+!
+use mode_datetime, only: Datetime_distance
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+!
+USE MODI_LES_VER_INT
+USE MODI_THL_RT_FROM_TH_R
+USE MODI_LES_MEAN_ll
+USE MODI_SHUMAN
+!
+USE MODI_SECOND_MNH
+USE MODI_LES_CLOUD_MASKS_N
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
+!
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: IXOR_ll, IYOR_ll ! origine point coordinates
+! ! of current processor domain
+! ! on model domain on all
+! ! processors
+INTEGER :: IIB_ll, IJB_ll ! SO point coordinates of
+! ! current processor phys. domain
+! ! on model domain on all
+! ! processors
+INTEGER :: IIE_ll, IJE_ll ! NE point coordinates of
+! ! current processor phys. domain
+! ! on model domain on all
+! ! processors
+INTEGER :: IIINF_MASK, IISUP_MASK ! cart. mask local proc. limits
+INTEGER :: IJINF_MASK, IJSUP_MASK ! cart. mask local proc. limits
+!
+INTEGER :: JK ! vertical loop counter
+INTEGER :: IIB, IJB, IIE, IJE ! hor. indices
+INTEGER :: IIU, IJU ! hor. indices
+INTEGER :: IKU ! ver. index
+INTEGER :: IRR, IRRC, IRRR, IRRI, IRRS, IRRG ! moist variables indices
+!
+INTEGER :: JSV ! scalar variables counter
+!
+REAL :: ZTIME1, ZTIME2 ! CPU time counters
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL ! theta_l
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT ! total water
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZL ! Latent heat of vaporization
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCP ! Cp
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN ! Exner function
+INTEGER :: IMI ! current model index
+!-------------------------------------------------------------------------------
+!
+!* 1. Does current time-step is a LES time-step?
+! -----------------------------------------
+!
+LLES_CALL= .FALSE.
+!
+CALL SECOND_MNH(ZTIME1)
+!
+IF (NLES_TCOUNT==NLES_TIMES) LLES_CALL=.FALSE.
+!
+IF ( KTCOUNT>1 .AND. MOD (KTCOUNT-1,NLES_DTCOUNT)==0) LLES_CALL=.TRUE.
+!
+IF (.NOT. LLES_CALL) RETURN
+!
+CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH )
+!
+NLES_TCOUNT = NLES_TCOUNT + 1
+!
+NLES_CURRENT_TCOUNT = NLES_TCOUNT
+!
+tles_dates(nles_tcount) = tdtcur
+call Datetime_distance( tdtseg, tdtcur, xles_times(nles_tcount) )
+!
+!* forward-in-time time-step
+!
+XCURRENT_TSTEP = XTSTEP
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_OR_ll ('B',IXOR_ll,IYOR_ll)
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+IIB_ll=IXOR_ll+IIB-1
+IJB_ll=IYOR_ll+IJB-1
+IIE_ll=IXOR_ll+IIE-1
+IJE_ll=IYOR_ll+IJE-1
+!
+IKU = SIZE(XTHT,3)
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Definition of masks
+! -------------------
+!
+!* 2.1 Cartesian (sub-)domain (on local processor)
+! ----------------------
+!
+CALL LES_ALLOCATE('LLES_CURRENT_CART_MASK',(/IIU,IJU,NLES_K/))
+!
+IIINF_MASK = MAX(IIB, NLESn_IINF(IMI)+JPHEXT-(IIB_ll-1-JPHEXT))
+IJINF_MASK = MAX(IJB, NLESn_JINF(IMI)+JPHEXT-(IJB_ll-1-JPHEXT))
+IISUP_MASK = MIN(IIE, NLESn_ISUP(IMI)+JPHEXT-(IIB_ll-1-JPHEXT))
+IJSUP_MASK = MIN(IJE, NLESn_JSUP(IMI)+JPHEXT-(IJB_ll-1-JPHEXT))
+!
+!
+LLES_CURRENT_CART_MASK(:,:,:) = .FALSE.
+LLES_CURRENT_CART_MASK(IIINF_MASK:IISUP_MASK,IJINF_MASK:IJSUP_MASK,:) = .TRUE.
+!
+CLES_CURRENT_LBCX(:) = CLES_LBCX(:,IMI)
+CLES_CURRENT_LBCY(:) = CLES_LBCY(:,IMI)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Definition of LES vertical grid for this model
+! ----------------------------------------------
+!
+IF (CLES_LEVEL_TYPE=='Z') THEN
+ IF (ASSOCIATED(XCOEFLIN_CURRENT_LES)) CALL LES_DEALLOCATE('XCOEFLIN_CURRENT_LES')
+ IF (ASSOCIATED(NKLIN_CURRENT_LES )) CALL LES_DEALLOCATE('NKLIN_CURRENT_LES')
+ !
+ CALL LES_ALLOCATE('XCOEFLIN_CURRENT_LES',(/IIU,IJU,NLES_K/))
+ CALL LES_ALLOCATE('NKLIN_CURRENT_LES',(/IIU,IJU,NLES_K/))
+ !
+ XCOEFLIN_CURRENT_LES(:,:,:) = XCOEFLIN_LES(:,:,:)
+ NKLIN_CURRENT_LES (:,:,:) = NKLIN_LES (:,:,:)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Definition of variables used in budgets for current model
+! ---------------------------------------------------------
+!
+IF (LUSERC) THEN
+ ALLOCATE(XCURRENT_L_O_EXN_CP (IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XCURRENT_L_O_EXN_CP (0,0,0))
+END IF
+ALLOCATE(XCURRENT_RHODJ (IIU,IJU,IKU))
+!
+!* coefficients for Th to Thl conversion
+!
+IF (LUSERC) THEN
+ ALLOCATE(ZL (IIU,IJU,IKU))
+ ALLOCATE(ZEXN(IIU,IJU,IKU))
+ ALLOCATE(ZCP (IIU,IJU,IKU))
+ !
+ !* Exner function
+ !
+ ZEXN(:,:,:) = (XPABST/XP00)**(XRD/XCPD)
+ !
+ !* Latent heat of vaporization
+ !
+ ZL(:,:,:) = XLVTT + (XCPD-XCL) * (XTHT(:,:,:)*ZEXN(:,:,:)-XTT)
+ !
+ !* heat capacity at constant pressure of the humid air
+ !
+ ZCP(:,:,:) = XCPD
+ IRR=2
+ ZCP(:,:,:) = ZCP(:,:,:) + XCPV * XRT(:,:,:,1)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRT(:,:,:,2)
+ IF (LUSERR) THEN
+ IRR=IRR+1
+ ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRT(:,:,:,IRR)
+ END IF
+ IF (LUSERI) THEN
+ IRR=IRR+1
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
+ END IF
+ IF (LUSERS) THEN
+ IRR=IRR+1
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
+ END IF
+ IF (LUSERG) THEN
+ IRR=IRR+1
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
+ END IF
+ IF (LUSERH) THEN
+ IRR=IRR+1
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
+ END IF
+ !
+ !* L / (Exn * Cp)
+ !
+ XCURRENT_L_O_EXN_CP(:,:,:) = ZL(:,:,:) / ZEXN(:,:,:) / ZCP(:,:,:)
+ !
+ DEALLOCATE(ZL )
+ DEALLOCATE(ZEXN)
+ DEALLOCATE(ZCP )
+END IF
+!
+!* other initializations
+!
+XCURRENT_RHODJ=XRHODJ
+!
+LCURRENT_USERV=LUSERV
+LCURRENT_USERC=LUSERC
+LCURRENT_USERR=LUSERR
+LCURRENT_USERI=LUSERI
+LCURRENT_USERS=LUSERS
+LCURRENT_USERG=LUSERG
+LCURRENT_USERH=LUSERH
+!
+NCURRENT_RR = NRR
+!
+ALLOCATE(XCURRENT_RUS (IIU,IJU,IKU))
+ALLOCATE(XCURRENT_RVS (IIU,IJU,IKU))
+ALLOCATE(XCURRENT_RWS (IIU,IJU,IKU))
+ALLOCATE(XCURRENT_RTHS (IIU,IJU,IKU))
+ALLOCATE(XCURRENT_RTKES(IIU,IJU,IKU))
+ALLOCATE(XCURRENT_RRS (IIU,IJU,IKU,NRR))
+ALLOCATE(XCURRENT_RSVS (IIU,IJU,IKU,NSV))
+ALLOCATE(XCURRENT_RTHLS(IIU,IJU,IKU))
+ALLOCATE(XCURRENT_RRTS (IIU,IJU,IKU))
+!
+XCURRENT_RUS =XRUS
+XCURRENT_RVS =XRVS
+XCURRENT_RWS =XRWS
+XCURRENT_RTHS =XRTHS
+XCURRENT_RTKES=XRTKES
+XCURRENT_RRS =XRRS
+XCURRENT_RSVS =XRSVS
+CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH, &
+ XCURRENT_L_O_EXN_CP, &
+ XCURRENT_RTHS, XCURRENT_RRS, &
+ XCURRENT_RTHLS, XCURRENT_RRTS )
+
+ALLOCATE(X_LES_BU_RES_KE (NLES_K,NLES_TOT))
+ALLOCATE(X_LES_BU_RES_WThl (NLES_K,NLES_TOT))
+ALLOCATE(X_LES_BU_RES_Thl2 (NLES_K,NLES_TOT))
+ALLOCATE(X_LES_BU_SBG_Tke (NLES_K,NLES_TOT))
+ALLOCATE(X_LES_BU_RES_WRt (NLES_K,NLES_TOT))
+ALLOCATE(X_LES_BU_RES_Rt2 (NLES_K,NLES_TOT))
+ALLOCATE(X_LES_BU_RES_ThlRt(NLES_K,NLES_TOT))
+ALLOCATE(X_LES_BU_RES_Sv2 (NLES_K,NLES_TOT,NSV))
+ALLOCATE(X_LES_BU_RES_WSv (NLES_K,NLES_TOT,NSV))
+
+X_LES_BU_RES_KE = 0.
+X_LES_BU_RES_WThl = 0.
+X_LES_BU_RES_Thl2 = 0.
+X_LES_BU_SBG_Tke = 0.
+X_LES_BU_RES_WRt = 0.
+X_LES_BU_RES_Rt2 = 0.
+X_LES_BU_RES_ThlRt= 0.
+X_LES_BU_RES_Sv2 = 0.
+X_LES_BU_RES_WSv = 0.
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Definition of anomaly fields
+! ----------------------------
+!
+ALLOCATE (XU_ANOM (IIU,IJU,NLES_K))
+ALLOCATE (XV_ANOM (IIU,IJU,NLES_K))
+ALLOCATE (XW_ANOM (IIU,IJU,NLES_K))
+ALLOCATE (XTHL_ANOM(IIU,IJU,NLES_K))
+IF (LUSERV) THEN
+ ALLOCATE (XRT_ANOM (IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE (XRT_ANOM (0,0,0))
+END IF
+ALLOCATE (XSV_ANOM (IIU,IJU,NLES_K,NSV))
+!
+!* 4.1 conservative variables
+! ----------------------
+!
+ALLOCATE(ZTHL(IIU,IJU,IKU))
+ALLOCATE(ZRT (IIU,IJU,IKU))
+CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH, &
+ XCURRENT_L_O_EXN_CP, &
+ XTHT, XRT, &
+ ZTHL, ZRT )
+!
+!* 4.2 anomaly fields on the LES grid
+! ------------------------------
+!
+CALL LES_ANOMALY_FIELD(MXF(XUT),XU_ANOM)
+CALL LES_ANOMALY_FIELD(MYF(XVT),XV_ANOM)
+CALL LES_ANOMALY_FIELD(MZF(XWT),XW_ANOM)
+CALL LES_ANOMALY_FIELD(ZTHL,XTHL_ANOM)
+IF (LUSERV) CALL LES_ANOMALY_FIELD(ZRT,XRT_ANOM)
+DO JSV=1,NSV
+ CALL LES_ANOMALY_FIELD(XSVT(:,:,:,JSV),XSV_ANOM(:,:,:,JSV))
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+DEALLOCATE(ZTHL)
+DEALLOCATE(ZRT )
+!-------------------------------------------------------------------------------
+!
+!* 6.0 Nebulosity masks
+! ----------------
+!
+CALL LES_CLOUD_MASKS_n
+!
+!-------------------------------------------------------------------------------
+CALL SECOND_MNH(ZTIME2)
+XTIME_LES_BU = XTIME_LES_BU + ZTIME2 - ZTIME1
+!--------------------------------------------------------------------------------
+!
+CONTAINS
+!
+!--------------------------------------------------------------------------------
+!
+SUBROUTINE LES_ANOMALY_FIELD(PF,PF_ANOM)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PF
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_ANOM
+
+REAL, DIMENSION(SIZE(PF_ANOM,3)) :: ZMEAN
+INTEGER :: JI, JJ
+
+CALL LES_VER_INT(PF, PF_ANOM)
+CALL LES_MEAN_ll(PF_ANOM, LLES_CURRENT_CART_MASK, ZMEAN )
+DO JJ=1,SIZE(PF_ANOM,2)
+ DO JI=1,SIZE(PF_ANOM,1)
+ PF_ANOM(JI,JJ,:) = PF_ANOM(JI,JJ,:) - ZMEAN(:)
+ END DO
+END DO
+
+END SUBROUTINE LES_ANOMALY_FIELD
+!--------------------------------------------------------------------------------
+!
+END SUBROUTINE LES_INI_TIMESTEP_n
+
diff --git a/src/PHYEX/ext/lesn.f90 b/src/PHYEX/ext/lesn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f66f89eae81a2f226ff87fd494f3982cc065fc61
--- /dev/null
+++ b/src/PHYEX/ext/lesn.f90
@@ -0,0 +1,3580 @@
+!MNH_LIC Copyright 2000-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.
+!-----------------------------------------------------------------
+! #################
+ SUBROUTINE LES_n
+! #################
+!
+!
+!!**** *LES_n* computes the current time-step LES diagnostics for model _n
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!! 01/02/01 (D. Gazen) add module MODD_NSV for NSV variable
+!! 06/11/02 (V. Masson) add LES budgets and use of anomalies
+!! in LES quantities computations
+!! 01/04/03 (V. Masson and F. Couvreux) bug in BL height loop
+!! 10/07 (J.Pergaud) Add mass flux diagnostics
+!! 06/08 (O.Thouron) Add radiative diagnostics
+!! 12/10 (R.Honnert) Add EDKF mass flux in BL height
+!! 10/09 (P. Aumond) Add possibility of user maskS
+!! 10/14 (C.Lac) Correction on user masks
+!! 10/16 (C.Lac) Add ground droplet deposition amount
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB, ONLY : XFTOP_O_FSURF
+!
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_CONF
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_LES_n
+USE MODD_RADIATIONS_n
+USE MODD_GRID_n
+USE MODD_REF_n
+USE MODD_FIELD_n
+USE MODD_CONF_n
+USE MODD_PARAM_n
+USE MODD_TURB_n
+USE MODD_METRICS_n
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_PRECIP_n, ONLY: XINPRR,XACPRR,XINPRR3D,XEVAP3D,XINPRC,XINDEP
+USE MODD_NSV, ONLY : NSV, NSV_CS
+USE MODD_PARAM_ICE, ONLY: LDEPOSC,LSEDIC
+USE MODD_PARAM_C2R2, ONLY: LDEPOC,LSEDC
+USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
+!
+USE MODI_SHUMAN
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_LES_VER_INT
+USE MODI_SPEC_VER_INT
+USE MODI_LES_MEAN_ll
+USE MODI_THL_RT_FROM_TH_R
+USE MODI_LES_RES_TR
+USE MODI_BUDGET_FLAGS
+USE MODI_LES_BUDGET_TEND_n
+USE MODE_BL_DEPTH_DIAG
+!
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+! 0.2 declaration of local variables
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN ! Exner function
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL ! liquid potential temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV ! virtual potential temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO ! air density
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: CHAMPXY1 !tableau intermediaire
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! Temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEW
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINDCLD !indice cloud si rc>0
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINDCLD2 !indice cloud rc>1E-5
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCLDFR_LES! CLDFR on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZICEFR_LES! ICEFR on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRAINFR_LES! RAINFR on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMASSF ! massflux=rho*w
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZREHU ! relative humidity
+
+
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZ_LES ! alt. on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZZZ_LES
+REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZINPRR3D_LES ! precipitation flux 3D
+REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZEVAP3D_LES !evaporation 3D
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZP_LES ! pres. on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDP_LES ! dynamical production TKE
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTP_LES ! thermal production TKE
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTR_LES ! transport production TKE
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDISS_LES ! dissipation TKE
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLM_LES ! mixing length
+
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDPDZ_LES ! dp/dz on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDTHLDZ_LES ! dThl/dz on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDTHDZ_LES ! dTh/dz on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDRTDZ_LES ! dRt/dz on LES vertical grid
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZDSvDZ_LES ! dSv/dz on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDUDZ_LES ! du/dz on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDVDZ_LES ! dv/dz on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDWDZ_LES ! dw/dz on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN_LES ! Exner on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO_LES ! rho on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU_LES ! U on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV_LES ! V on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW_LES ! W on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMF_LES ! mass flux on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTH_LES ! Theta on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LES ! thv on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL_LES ! thl on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTKE_LES ! tke on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZKE_LES ! ke on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_LES ! Rv on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZREHU_LES ! Rehu on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_LES ! Rc on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRR_LES ! Rr on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_LES ! Ri on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRS_LES ! Rs on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRG_LES ! Rg on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRH_LES ! Rh on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT_LES ! Rt on LES vertical grid
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_LES ! Sv on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTH_ANOM ! Theta anomaly on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_ANOM ! thv anomaly on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_ANOM ! Rv anomaly on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_ANOM ! Rc anomaly on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_ANOM ! Ri anomaly on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRR_ANOM ! Rr anomaly on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZP_ANOM ! p anomaly on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO_ANOM ! rho anomaly on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDPDZ_ANOM! dp/dz anomaly on LES vertical grid
+REAL, DIMENSION(:), ALLOCATABLE :: ZMEAN_DPDZ! dp/dz mean on LES vertical grid
+REAL, DIMENSION(:), ALLOCATABLE :: ZLES_MEAN_DRtDZ! drt/dz mean on LES vertical grid
+REAL, DIMENSION(:), ALLOCATABLE :: ZLES_MEAN_DTHDZ! dth/dz mean on LES vertical grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLES_MEAN_DSVDZ! drt/dz mean on LES vertical grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLWP_LES, ZRWP_LES, ZTKET_LES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZIWP_LES, ZSWP_LES, ZGWP_LES, ZHWP_LES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINDCLD2D !
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINDCLD2D2 !
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLWP_ANOM ! lwp anomaly
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZMAXWRR2D ! maxwrr2D
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU_SPEC ! U on SPEC vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV_SPEC ! V on SPEC vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW_SPEC ! W on SPEC vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTH_SPEC ! Theta on SPEC vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL_SPEC ! thl on SPEC vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_SPEC ! Rv on SPEC vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_SPEC ! Rc on SPEC vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_SPEC ! Ri on SPEC vertical grid
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_SPEC ! Sv on SPEC vertical grid
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT ! rv+rc+rr+ri+rs+rg+rh
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1D,ZWORK1DT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
+REAL :: ZINPRRm,ZCOUNT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRADEFF_LES ! Re on LES vertical grid
+!!fl sw, lw, dthrad on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSWU_LES ! SWU on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSWD_LES ! SWD on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLWU_LES ! LWU on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLWD_LES ! LWD on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDTHRADSW_LES ! DTHRADSW on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDTHRADLW_LES ! DTHRADLW on LES vertical grid
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK !
+!
+INTEGER :: IRR ! moist variables counter
+INTEGER :: JSV ! scalar variables counter
+INTEGER :: IIU, IJU ! array sizes
+INTEGER :: IKE,IKB
+INTEGER :: JI, JJ, JK ! loop counters
+INTEGER :: IIU_ll, IJU_ll ! total domain I size (fin)
+INTEGER :: IIA_ll, IJA_ll ! total domain I size (debut)
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: IIMAX_ll, IJMAX_ll ! total physical domain I size
+INTEGER :: JLOOP
+!
+INTEGER :: IMASK ! mask counter
+INTEGER :: IMASKUSER! mask user number
+!
+INTEGER :: IRESP, ILUOUT
+INTEGER :: IMI ! Current model index
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
+!-------------------------------------------------------------------------------
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+IF (.NOT. LLES_CALL) RETURN
+!
+CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
+IIU_ll = IIMAX_ll+JPHEXT
+IJU_ll = IJMAX_ll+JPHEXT
+IIA_ll=JPHEXT+1
+IJA_ll=JPHEXT+1
+IKE=SIZE(XVT,3)-JPVEXT
+IKB=1+JPVEXT
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3),.TRUE.)
+!
+ILUOUT = TLUOUT%NLU
+!
+!-------------------------------------------------------------------------------
+!
+!* interpolation coefficients for Z type grid
+!
+IF (CSPECTRA_LEVEL_TYPE=='Z') THEN
+ IF (ASSOCIATED(XCOEFLIN_CURRENT_SPEC)) CALL LES_DEALLOCATE('XCOEFLIN_CURRENT_SPEC')
+ IF (ASSOCIATED(NKLIN_CURRENT_SPEC )) CALL LES_DEALLOCATE('NKLIN_CURRENT_SPEC')
+ !
+ CALL LES_ALLOCATE('XCOEFLIN_CURRENT_SPEC',(/IIU,IJU,NSPECTRA_K/))
+ CALL LES_ALLOCATE('NKLIN_CURRENT_SPEC',(/IIU,IJU,NSPECTRA_K/))
+ !
+ XCOEFLIN_CURRENT_SPEC(:,:,:) = XCOEFLIN_SPEC(:,:,:)
+ NKLIN_CURRENT_SPEC (:,:,:) = NKLIN_SPEC (:,:,:)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Allocations
+! -----------
+!
+ALLOCATE(ZP_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZDP_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZTP_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZTR_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZDISS_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZLM_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZDTHLDZ_LES(IIU,IJU,NLES_K))
+ALLOCATE(ZDTHDZ_LES(IIU,IJU,NLES_K))
+ALLOCATE(ZDRTDZ_LES(IIU,IJU,NLES_K))
+ALLOCATE(ZDUDZ_LES(IIU,IJU,NLES_K))
+ALLOCATE(ZDVDZ_LES(IIU,IJU,NLES_K))
+ALLOCATE(ZDWDZ_LES(IIU,IJU,NLES_K))
+ALLOCATE(ZDSVDZ_LES(IIU,IJU,NLES_K,NSV))
+
+ALLOCATE(ZDPDZ_LES(IIU,IJU,NLES_K))
+ALLOCATE(ZEXN_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZRHO_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZU_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZV_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZW_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZMF_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZTH_LES (IIU,IJU,NLES_K))
+IF (CRAD /= 'NONE') THEN
+ ALLOCATE(ZRADEFF_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZSWU_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZSWD_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZLWU_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZLWD_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZDTHRADSW_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZDTHRADLW_LES (IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZRADEFF_LES (0,0,0))
+ ALLOCATE(ZSWU_LES (0,0,0))
+ ALLOCATE(ZSWD_LES (0,0,0))
+ ALLOCATE(ZLWU_LES (0,0,0))
+ ALLOCATE(ZLWD_LES (0,0,0))
+ ALLOCATE(ZDTHRADSW_LES (0,0,0))
+ ALLOCATE(ZDTHRADLW_LES (0,0,0))
+END IF
+IF (LUSERV) THEN
+ ALLOCATE(ZTHV_LES (IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZTHV_LES (0,0,0))
+END IF
+ALLOCATE(ZTHL_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZTKE_LES (IIU,IJU,NLES_K))
+ALLOCATE(ZKE_LES(IIU,IJU,NLES_K))
+ALLOCATE(ZTKET_LES(IIU,IJU))
+ALLOCATE(ZWORK1D (NLES_K))
+ALLOCATE(ZWORK1DT (NLES_K))
+ALLOCATE(ZZZ_LES(IIU,IJU,NLES_K))
+IF (LUSERV) THEN
+ ALLOCATE(ZRV_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZRT_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZREHU_LES (IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZRV_LES (0,0,0))
+ ALLOCATE(ZRT_LES (0,0,0))
+ ALLOCATE(ZREHU_LES (0,0,0))
+END IF
+IF (LUSERC) THEN
+ ALLOCATE(ZRC_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZLWP_LES(IIU,IJU))
+ ALLOCATE(ZINDCLD2D(IIU,IJU))
+ ALLOCATE(ZINDCLD2D2(IIU,IJU))
+ ALLOCATE(ZCLDFR_LES(IIU,IJU,NLES_K))
+ ALLOCATE(ZWORK2D(IIU,IJU))
+ ALLOCATE(ZLWP_ANOM(IIU,IJU))
+ELSE
+ ALLOCATE(ZRC_LES (0,0,0))
+ ALLOCATE(ZLWP_LES(0,0))
+ ALLOCATE(ZINDCLD2D(0,0))
+ ALLOCATE(ZINDCLD2D2(0,0))
+ ALLOCATE(ZCLDFR_LES(0,0,0))
+ ALLOCATE(ZWORK2D(0,0))
+ ALLOCATE(ZLWP_ANOM(0,0))
+END IF
+IF (LUSERR) THEN
+ ALLOCATE(ZRR_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZMAXWRR2D(IIU,IJU))
+ ALLOCATE(ZRWP_LES(IIU,IJU))
+ ALLOCATE(ZINPRR3D_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZEVAP3D_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZRAINFR_LES(IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZRR_LES (0,0,0))
+ ALLOCATE(ZMAXWRR2D(0,0))
+ ALLOCATE(ZRWP_LES(0,0))
+ ALLOCATE(ZINPRR3D_LES(0,0,0))
+ ALLOCATE(ZEVAP3D_LES(0,0,0))
+ ALLOCATE(ZRAINFR_LES(0,0,0))
+END IF
+IF (LUSERI) THEN
+ ALLOCATE(ZRI_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZIWP_LES(IIU,IJU))
+ ALLOCATE(ZICEFR_LES(IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZRI_LES (0,0,0))
+ ALLOCATE(ZIWP_LES(0,0))
+ ALLOCATE(ZICEFR_LES(0,0,0))
+END IF
+IF (LUSERS) THEN
+ ALLOCATE(ZRS_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZSWP_LES(IIU,IJU))
+ELSE
+ ALLOCATE(ZRS_LES (0,0,0))
+ ALLOCATE(ZSWP_LES(0,0))
+END IF
+IF (LUSERG) THEN
+ ALLOCATE(ZRG_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZGWP_LES(IIU,IJU))
+ELSE
+ ALLOCATE(ZRG_LES (0,0,0))
+ ALLOCATE(ZGWP_LES(0,0))
+END IF
+IF (LUSERH) THEN
+ ALLOCATE(ZRH_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZHWP_LES(IIU,IJU))
+ELSE
+ ALLOCATE(ZRH_LES (0,0,0))
+ ALLOCATE(ZHWP_LES(0,0))
+END IF
+IF (NSV>0) THEN
+ ALLOCATE(ZSV_LES (IIU,IJU,NLES_K,NSV))
+ELSE
+ ALLOCATE(ZSV_LES (0,0,0,0))
+END IF
+!
+ALLOCATE(ZP_ANOM (IIU,IJU,NLES_K))
+ALLOCATE(ZRHO_ANOM (IIU,IJU,NLES_K))
+ALLOCATE(ZTH_ANOM (IIU,IJU,NLES_K))
+ALLOCATE(ZDPDZ_ANOM(IIU,IJU,NLES_K))
+IF (LUSERV) THEN
+ ALLOCATE(ZTHV_ANOM(IIU,IJU,NLES_K))
+ ALLOCATE(ZRV_ANOM (IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZTHV_ANOM(0,0,0))
+ ALLOCATE(ZRV_ANOM (0,0,0))
+END IF
+IF (LUSERC) THEN
+ ALLOCATE(ZRC_ANOM (IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZRC_ANOM (0,0,0))
+END IF
+IF (LUSERI) THEN
+ ALLOCATE(ZRI_ANOM (IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZRI_ANOM (0,0,0))
+END IF
+IF (LUSERR) THEN
+ ALLOCATE(ZRR_ANOM (IIU,IJU,NLES_K))
+ELSE
+ ALLOCATE(ZRR_ANOM (0,0,0))
+END IF
+ALLOCATE(ZMEAN_DPDZ(NLES_K))
+ALLOCATE(ZLES_MEAN_DTHDZ(NLES_K))
+!
+!
+ALLOCATE(ZU_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
+ALLOCATE(ZV_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
+ALLOCATE(ZW_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
+ALLOCATE(ZTH_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
+IF (LUSERC) THEN
+ ALLOCATE(ZTHL_SPEC(NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
+ELSE
+ ALLOCATE(ZTHL_SPEC(0,0,0))
+END IF
+IF (LUSERV) THEN
+ ALLOCATE(ZRV_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
+ELSE
+ ALLOCATE(ZRV_SPEC (0,0,0))
+END IF
+IF (LUSERC) THEN
+ ALLOCATE(ZRC_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
+ELSE
+ ALLOCATE(ZRC_SPEC (0,0,0))
+END IF
+IF (LUSERI) THEN
+ ALLOCATE(ZRI_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
+ELSE
+ ALLOCATE(ZRI_SPEC (0,0,0))
+END IF
+IF (NSV>0) THEN
+ ALLOCATE(ZSV_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K,NSV))
+ELSE
+ ALLOCATE(ZSV_SPEC (0,0,0,0))
+END IF
+!
+!
+ALLOCATE(ZEXN (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZRHO (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZRT (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZTHV (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZTHL (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZEW (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZMASSF (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZTEMP (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZREHU (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(CHAMPXY1 (IIU,IJU,1))
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.2 preliminary calculations
+! ------------------------
+!
+ZEXN(:,:,:) = (XPABST/XP00)**(XRD/XCPD)
+!
+!
+!* computation of relative humidity
+ZTEMP=XTHT*ZEXN
+ZEW=EXP (XALPW -XBETAW/ZTEMP-XGAMW*ALOG(ZTEMP))
+IF (LUSERV) THEN
+ ZREHU(:,:,:)=100.*XRT(:,:,:,1)*XPABST(:,:,:)/((XRD/XRV+XRT(:,:,:,1))*ZEW(:,:,:))
+ELSE
+ ZREHU(:,:,:)=0.
+END IF
+!
+CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH, &
+ XCURRENT_L_O_EXN_CP, &
+ XTHT, XRT, &
+ ZTHL, ZRT )
+!
+!* computation of density and virtual potential temperature
+!
+ZTHV=XTHT
+IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRT(:,:,:,1))/(1.+ZRT(:,:,:))
+!
+IF (CEQNSYS=='DUR') THEN
+ ZRHO=XPABST/(XRD*ZTHV*ZEXN)
+ELSE
+ ZRHO=XRHODREF*( 1. + (XCPD-XRD)/XRD*(ZEXN/XEXNREF - 1.) - (ZTHV/XTHVREF - 1.) )
+END IF
+!
+! computation of mass flux
+ZMASSF=MZM(ZRHO)*XWT
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Vertical interpolations to LES vertical grid
+! --------------------------------------------
+!
+!* note that velocity fields are first localized on the MASS points
+!
+!
+IF (CRAD /= 'NONE') THEN
+ CALL LES_VER_INT( XRADEFF, ZRADEFF_LES)
+ CALL LES_VER_INT( XSWU, ZSWU_LES)
+ CALL LES_VER_INT( XSWD, ZSWD_LES)
+ CALL LES_VER_INT( XLWU, ZLWU_LES)
+ CALL LES_VER_INT( XLWD, ZLWD_LES)
+ CALL LES_VER_INT( XDTHRADSW, ZDTHRADSW_LES)
+ CALL LES_VER_INT( XDTHRADLW, ZDTHRADLW_LES)
+END IF
+!
+CALL LES_VER_INT( XZZ , ZZZ_LES)
+CALL LES_VER_INT( XPABST, ZP_LES )
+CALL LES_VER_INT( XDYP, ZDP_LES )
+CALL LES_VER_INT( XTHP, ZTP_LES )
+CALL LES_VER_INT( XTR, ZTR_LES )
+CALL LES_VER_INT( XDISS, ZDISS_LES )
+CALL LES_VER_INT( XLEM, ZLM_LES )
+CALL LES_VER_INT( GZ_M_M(XPABST,XDZZ), ZDPDZ_LES )
+!
+CALL LES_VER_INT( MXF(XUT) ,ZU_LES )
+CALL LES_VER_INT( MYF(XVT) ,ZV_LES )
+CALL LES_VER_INT( MZF(XWT) ,ZW_LES )
+CALL LES_VER_INT( MZF(ZMASSF) ,ZMF_LES)
+CALL LES_VER_INT( XTHT ,ZTH_LES )
+CALL LES_VER_INT( MXF(MZF(GZ_U_UW(XUT,XDZZ))), ZDUDZ_LES )
+CALL LES_VER_INT( MYF(MZF(GZ_V_VW(XVT,XDZZ))), ZDVDZ_LES )
+CALL LES_VER_INT( GZ_W_M(XWT,XDZZ), ZDWDZ_LES )
+CALL LES_VER_INT( ZEXN, ZEXN_LES)
+!
+CALL LES_VER_INT( GZ_M_M(XTHT,XDZZ), ZDTHDZ_LES )
+!
+CALL LES_VER_INT(ZRHO, ZRHO_LES)
+!
+IF (LUSERV) CALL LES_VER_INT(ZTHV, ZTHV_LES)
+CALL LES_VER_INT(ZTHL, ZTHL_LES)
+CALL LES_VER_INT( GZ_M_M(ZTHL,XDZZ), ZDTHLDZ_LES )
+!
+CALL LES_VER_INT( XTKET ,ZTKE_LES)
+IRR = 0
+IF (LUSERV) THEN
+ IRR = IRR + 1
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRV_LES )
+ CALL LES_VER_INT( ZRT(:,:,:) ,ZRT_LES )
+ CALL LES_VER_INT( GZ_M_M(ZRT,XDZZ), ZDRTDZ_LES )
+ CALL LES_VER_INT( ZREHU(:,:,:) ,ZREHU_LES)
+END IF
+IF (LUSERC) THEN
+ IRR = IRR + 1
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRC_LES )
+ ALLOCATE(ZINDCLD (IIU,IJU,NLES_K))
+ ALLOCATE(ZINDCLD2(IIU,IJU,NLES_K))
+ ZINDCLD = CEILING(ZRC_LES-1.E-6)
+ ZINDCLD2 = CEILING(ZRC_LES-1.E-5)
+ CALL LES_VER_INT( XCLDFR(:,:,:) ,ZCLDFR_LES )
+ELSE
+ ALLOCATE(ZINDCLD (0,0,0))
+ ALLOCATE(ZINDCLD2(0,0,0))
+END IF
+IF (LUSERR) THEN
+ IRR = IRR + 1
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRR_LES )
+ CALL LES_VER_INT( XINPRR3D(:,:,:), ZINPRR3D_LES)
+ CALL LES_VER_INT( XEVAP3D(:,:,:), ZEVAP3D_LES)
+ CALL LES_VER_INT( XRAINFR(:,:,:) ,ZRAINFR_LES )
+END IF
+IF (LUSERC) THEN
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ ZINDCLD2D(JI,JJ) = maxval(ZINDCLD(JI,JJ,:))
+ ZINDCLD2D2(JI,JJ)= maxval(ZINDCLD2(JI,JJ,:))
+ END DO
+ END DO
+ !* integration of rho rc
+ !!!ZLWP_LES only for cloud water
+ ZLWP_LES(:,:) = 0.
+ DO JK=1,NLES_K-1
+ ZLWP_LES(:,:) = ZLWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
+ * (ZRC_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
+ END DO
+ CALL LES_MEAN_ll ( ZLWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_LWP(NLES_CURRENT_TCOUNT) )
+!
+END IF
+
+ !!!ZRWP_LES only for rain water
+IF (LUSERR) THEN
+ ZRWP_LES(:,:)=0.
+ DO JK=1,NLES_K-1
+ ZRWP_LES(:,:) = ZRWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
+ * (ZRR_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
+ END DO
+ CALL LES_MEAN_ll ( ZRWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_RWP(NLES_CURRENT_TCOUNT) )
+ENDIF
+!
+IF (LUSERI) THEN
+ IRR = IRR + 1
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRI_LES )
+ ZIWP_LES(:,:)=0.
+ DO JK=1,NLES_K-1
+ ZIWP_LES(:,:) = ZIWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
+ * (ZRI_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
+ END DO
+ CALL LES_MEAN_ll ( ZIWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_IWP(NLES_CURRENT_TCOUNT) )
+ CALL LES_VER_INT( XICEFR(:,:,:) ,ZICEFR_LES )
+END IF
+IF (LUSERS) THEN
+ IRR = IRR + 1
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRS_LES )
+ ZSWP_LES(:,:)=0.
+ DO JK=1,NLES_K-1
+ ZSWP_LES(:,:) = ZSWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
+ * (ZRS_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
+ END DO
+ CALL LES_MEAN_ll ( ZSWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_SWP(NLES_CURRENT_TCOUNT) )
+END IF
+IF (LUSERG) THEN
+ IRR = IRR + 1
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRG_LES )
+ ZGWP_LES(:,:)=0.
+ DO JK=1,NLES_K-1
+ ZGWP_LES(:,:) = ZGWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
+ * (ZRG_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
+ END DO
+ CALL LES_MEAN_ll ( ZGWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_GWP(NLES_CURRENT_TCOUNT) )
+END IF
+IF (LUSERH) THEN
+ IRR = IRR + 1
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRH_LES )
+ ZHWP_LES(:,:)=0.
+ DO JK=1,NLES_K-1
+ ZHWP_LES(:,:) = ZHWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
+ * (ZRH_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
+ END DO
+ CALL LES_MEAN_ll ( ZHWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_HWP(NLES_CURRENT_TCOUNT) )
+END IF
+IF (NSV>0) THEN
+ DO JSV=1,NSV
+ CALL LES_VER_INT( XSVT(:,:,:,JSV), ZSV_LES(:,:,:,JSV) )
+ CALL LES_VER_INT( GZ_M_M(XSVT(:,:,:,JSV),XDZZ), ZDSVDZ_LES(:,:,:,JSV) )
+ END DO
+END IF
+!
+!*mean sw and lw fluxes
+ CALL LES_MEAN_ll ( ZSWU_LES, LLES_CURRENT_CART_MASK, &
+ XLES_SWU(:,NLES_CURRENT_TCOUNT) )
+ CALL LES_MEAN_ll ( ZSWD_LES, LLES_CURRENT_CART_MASK, &
+ XLES_SWD(:,NLES_CURRENT_TCOUNT) )
+ CALL LES_MEAN_ll ( ZLWU_LES, LLES_CURRENT_CART_MASK, &
+ XLES_LWU(:,NLES_CURRENT_TCOUNT) )
+ CALL LES_MEAN_ll ( ZLWD_LES, LLES_CURRENT_CART_MASK, &
+ XLES_LWD(:,NLES_CURRENT_TCOUNT) )
+ CALL LES_MEAN_ll ( ZDTHRADSW_LES, LLES_CURRENT_CART_MASK, &
+ XLES_DTHRADSW(:,NLES_CURRENT_TCOUNT) )
+ CALL LES_MEAN_ll ( ZDTHRADLW_LES, LLES_CURRENT_CART_MASK, &
+ XLES_DTHRADLW(:,NLES_CURRENT_TCOUNT) )
+ CALL LES_MEAN_ll ( ZRADEFF_LES, LLES_CURRENT_CART_MASK, &
+ XLES_RADEFF(:,NLES_CURRENT_TCOUNT) )
+!* mean vertical profiles on the LES grid
+!
+ CALL LES_MEAN_ll ( ZU_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_U(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZV_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_V(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZW_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_W(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZP_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZDP_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_DP(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZTP_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_TP(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZTR_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_TR(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZDISS_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_DISS(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZLM_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_LM(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZRHO_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_RHO(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZMF_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Mf(:,NLES_CURRENT_TCOUNT,1) )
+!
+ CALL LES_MEAN_ll ( ZTH_LES*ZEXN_LES, LLES_CURRENT_CART_MASK, &
+ ZWORK1DT(:) )
+!
+!computation of es
+ ZWORK1D(:)=EXP(XALPW - &
+ XBETAW/ZWORK1DT(:) &
+ -XGAMW*ALOG(ZWORK1DT(:)))
+!computation of qs
+
+ IF (LUSERV) &
+ XLES_MEAN_Qs(:,NLES_CURRENT_TCOUNT,1)=XRD/XRV*ZWORK1D(:)/ &
+ (XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,1)-ZWORK1D(:)*(1-XRD/XRV))
+! qs is determined from the temperature average over the current_mask
+!
+ CALL LES_MEAN_ll ( ZTH_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Th(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERV) &
+ CALL LES_MEAN_ll ( ZTHV_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Thv(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERC) &
+ CALL LES_MEAN_ll ( ZTHL_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Thl(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERC) &
+ CALL LES_MEAN_ll ( ZRT_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rt(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERV) &
+ CALL LES_MEAN_ll ( ZRV_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rv(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERV) &
+ CALL LES_MEAN_ll ( ZREHU_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rehu(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERC) &
+ CALL LES_MEAN_ll ( ZRC_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rc(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERC) THEN
+ CALL LES_MEAN_ll ( ZINDCLD, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_INDCf(:,NLES_CURRENT_TCOUNT,1) )
+ CALL LES_MEAN_ll ( ZINDCLD2, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_INDCf2(:,NLES_CURRENT_TCOUNT,1) )
+ CALL LES_MEAN_ll ( ZCLDFR_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Cf(:,NLES_CURRENT_TCOUNT,1) )
+!
+!* cf total
+ CALL LES_MEAN_ll( ZINDCLD2D, LLES_CURRENT_CART_MASK(:,:,1) , &
+ XLES_CFtot(NLES_CURRENT_TCOUNT) )
+ CALL LES_MEAN_ll( ZINDCLD2D2, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_CF2tot(NLES_CURRENT_TCOUNT) )
+ ENDIF
+!
+ IF (LUSERR) THEN
+
+ CALL LES_MEAN_ll ( XINPRR, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_INPRR(NLES_CURRENT_TCOUNT) )
+ ZINPRRm=0.
+ ZCOUNT=0.
+ ZINDCLD2D(:,:)=0.
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ IF (ZRR_LES(JI,JJ,1) .GT. 1.E-6) ZINPRRm = ZINPRRm+XINPRR(JI,JJ)
+ IF (ZRR_LES(JI,JJ,1) .GT. 1.E-6) ZINDCLD2D(JI,JJ)=1.
+ IF (ZRR_LES(JI,JJ,1) .GT. 1.E-6) ZCOUNT=ZCOUNT+1.
+ END DO
+ END DO
+ IF (ZCOUNT .GE. 1) ZINPRRm=ZINPRRm/ZCOUNT
+ XLES_RAIN_INPRR(NLES_CURRENT_TCOUNT)=ZINPRRm
+ CALL LES_MEAN_ll ( ZINDCLD2D, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_PRECFR(NLES_CURRENT_TCOUNT) )
+ CALL LES_MEAN_ll ( ZINPRR3D_LES, LLES_CURRENT_CART_MASK, &
+ XLES_INPRR3D(:,NLES_CURRENT_TCOUNT,1) )
+ CALL LES_MEAN_ll ( ZEVAP3D_LES, LLES_CURRENT_CART_MASK, &
+ XLES_EVAP3D(:,NLES_CURRENT_TCOUNT,1) )
+ DO JK=1,NLES_K
+ CHAMPXY1(:,:,1)=ZINPRR3D_LES(:,:,JK)
+ XLES_MAX_INPRR3D(JK,NLES_CURRENT_TCOUNT,1)=MAX_ll (CHAMPXY1,IINFO_ll, &
+ IIA_ll,IJA_ll,1,IIU_ll,IJU_ll,1)
+ END DO
+!
+
+! conversion de m/s en mm/day
+ XLES_RAIN_INPRR(NLES_CURRENT_TCOUNT)=XLES_RAIN_INPRR(NLES_CURRENT_TCOUNT)*3.6E6*24.
+ XLES_INPRR(NLES_CURRENT_TCOUNT)=XLES_INPRR(NLES_CURRENT_TCOUNT)*3.6E6*24.
+
+ CALL LES_MEAN_ll ( XACPRR, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_ACPRR(NLES_CURRENT_TCOUNT) )
+! conversion de m en mm
+ XLES_ACPRR(NLES_CURRENT_TCOUNT)=XLES_ACPRR(NLES_CURRENT_TCOUNT)*1000.
+ CALL LES_MEAN_ll ( ZRAINFR_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_RF(:,NLES_CURRENT_TCOUNT,1) )
+
+ ENDIF
+!
+ IF (LUSERC ) THEN
+ IF (( CCLOUD(1:3) == 'ICE' .AND.LSEDIC) .OR. &
+ ((CCLOUD=='C2R2' .OR. CCLOUD=='C3R5' .OR. CCLOUD=='KHKO').AND.LSEDC) .OR. &
+ ( CCLOUD=='LIMA' .AND.MSEDC)) THEN
+ CALL LES_MEAN_ll ( XINPRC, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_INPRC(NLES_CURRENT_TCOUNT) )
+! conversion from m/s to mm/day
+ XLES_INPRC(NLES_CURRENT_TCOUNT)=XLES_INPRC(NLES_CURRENT_TCOUNT)*3.6E6*24.
+ ENDIF
+ IF ( (((CCLOUD == 'KHKO') .OR.(CCLOUD == 'C2R2')) .AND. LDEPOC) &
+ .OR. ( (CCLOUD(1:3) == 'ICE') .AND. LDEPOSC) ) THEN
+ CALL LES_MEAN_ll ( XINDEP, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_INDEP(NLES_CURRENT_TCOUNT) )
+! conversion from m/s to mm/day
+ XLES_INDEP(NLES_CURRENT_TCOUNT)=XLES_INDEP(NLES_CURRENT_TCOUNT)*3.6E6*24.
+ ENDIF
+ ENDIF
+!
+ IF (LUSERR) &
+ CALL LES_MEAN_ll ( ZRR_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rr(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERI) &
+ CALL LES_MEAN_ll ( ZRI_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Ri(:,NLES_CURRENT_TCOUNT,1) )
+ CALL LES_MEAN_ll ( ZICEFR_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_If(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERS) &
+ CALL LES_MEAN_ll ( ZRS_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rs(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERG) &
+ CALL LES_MEAN_ll ( ZRG_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rg(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERH) &
+ CALL LES_MEAN_ll ( ZRH_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rh(:,NLES_CURRENT_TCOUNT,1) )
+!
+ DO JSV=1,NSV
+ CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Sv(:,NLES_CURRENT_TCOUNT,1,JSV) )
+ END DO
+!
+ CALL LES_MEAN_ll ( ZDPDZ_LES, LLES_CURRENT_CART_MASK, &
+ ZMEAN_DPDZ(:) )
+ CALL LES_MEAN_ll ( ZDTHDZ_LES, LLES_CURRENT_CART_MASK, &
+ ZLES_MEAN_DTHDZ(:) )
+
+!
+!* build the 3D resolved turbulent fields by removing the mean field
+!
+DO JJ=1,IJU
+ DO JI=1,IIU
+ ZP_ANOM(JI,JJ,:) = ZP_LES(JI,JJ,:) - XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,1)
+ ZDPDZ_ANOM(JI,JJ,:) = ZDPDZ_LES(JI,JJ,:) - ZMEAN_DPDZ(:)
+ ZTH_ANOM(JI,JJ,:) = ZTH_LES(JI,JJ,:) - XLES_MEAN_Th(:,NLES_CURRENT_TCOUNT,1)
+ ZRHO_ANOM(JI,JJ,:) = ZRHO_LES(JI,JJ,:) - XLES_MEAN_Rho(:,NLES_CURRENT_TCOUNT,1)
+ IF (LUSERV) THEN
+ ZTHV_ANOM(JI,JJ,:) = ZTHV_LES(JI,JJ,:) - XLES_MEAN_Thv(:,NLES_CURRENT_TCOUNT,1)
+ ZRV_ANOM(JI,JJ,:) = ZRV_LES(JI,JJ,:) - XLES_MEAN_Rv(:,NLES_CURRENT_TCOUNT,1)
+ END IF
+ IF (LUSERC) THEN
+ ZRC_ANOM(JI,JJ,:) = ZRC_LES(JI,JJ,:) - XLES_MEAN_Rc(:,NLES_CURRENT_TCOUNT,1)
+ ZLWP_ANOM(JI,JJ) =ZLWP_LES(JI,JJ)-XLES_LWP(NLES_CURRENT_TCOUNT)
+ END IF
+ IF (LUSERI) THEN
+ ZRI_ANOM(JI,JJ,:) = ZRI_LES(JI,JJ,:) - XLES_MEAN_Ri(:,NLES_CURRENT_TCOUNT,1)
+ END IF
+ IF (LUSERR) THEN
+ ZRR_ANOM(JI,JJ,:) = ZRR_LES(JI,JJ,:) - XLES_MEAN_Rr(:,NLES_CURRENT_TCOUNT,1)
+ END IF
+ END DO
+END DO
+!
+!
+!--------------------------------------------------------------------------------
+!
+!* vertical grid computed at first LES call for this model
+!
+IF (NLES_CURRENT_TCOUNT==1) THEN
+ ALLOCATE(ZZ_LES (IIU,IJU,NLES_K))
+ CALL LES_VER_INT( MZF(XZZ) ,ZZ_LES )
+ CALL LES_MEAN_ll ( ZZ_LES, LLES_CURRENT_CART_MASK, XLES_Z )
+ DEALLOCATE(ZZ_LES)
+ CALL LES_MEAN_ll ( XZS, LLES_CURRENT_CART_MASK(:,:,1), XLES_ZS )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Vertical interpolations to SECTRA computations vertical grid
+! ------------------------------------------------------------
+!
+!* note that velocity fields are previously localized on the MASS points
+!
+CALL SPEC_VER_INT(IMI, MXF(XUT) ,ZU_SPEC )
+CALL SPEC_VER_INT(IMI, MYF(XVT) ,ZV_SPEC )
+CALL SPEC_VER_INT(IMI, MZF(XWT) ,ZW_SPEC )
+CALL SPEC_VER_INT(IMI, XTHT ,ZTH_SPEC )
+IF (LUSERC) CALL SPEC_VER_INT(IMI, ZTHL ,ZTHL_SPEC)
+IRR = 0
+IF (LUSERV) THEN
+ IRR = IRR + 1
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRV_SPEC )
+END IF
+IF (LUSERC) THEN
+ IRR = IRR + 1
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRC_SPEC )
+END IF
+IF (LUSERR) THEN
+ IRR = IRR + 1
+END IF
+IF (LUSERI) THEN
+ IRR = IRR + 1
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRI_SPEC )
+END IF
+IF (NSV>0) THEN
+ DO JSV=1,NSV
+ CALL SPEC_VER_INT(IMI, XSVT(:,:,:,JSV), ZSV_SPEC(:,:,:,JSV) )
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Call to LES computations on cartesian (sub-)domain
+! --------------------------------------------------
+!
+IMASK=1
+!
+CALL LES(LLES_CURRENT_CART_MASK)
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Call to LES computations on nebulosity mask
+! -------------------------------------------
+!
+IF (LLES_NEB_MASK) THEN
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_NEB_MASK .AND. LLES_CURRENT_CART_MASK)
+!
+ IMASK=IMASK+1
+ CALL LES((.NOT. LLES_CURRENT_NEB_MASK) .AND. LLES_CURRENT_CART_MASK)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. Call to LES computations on cloud core mask
+! -------------------------------------------
+!
+IF (LLES_CORE_MASK) THEN
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_CORE_MASK .AND. LLES_CURRENT_CART_MASK)
+!
+ IMASK=IMASK+1
+ CALL LES((.NOT. LLES_CURRENT_CORE_MASK) .AND. LLES_CURRENT_CART_MASK)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. Call to LES computations on user mask
+! -------------------------------------
+!
+IF (LLES_MY_MASK) THEN
+ DO JI=1,NLES_MASKS_USER
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_MY_MASKS(:,:,:,JI))
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7b. Call to LES computations on conditional sampling mask
+! -----------------------------------------------------
+!
+IF (LLES_CS_MASK) THEN
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_CS1_MASK)
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_CS2_MASK)
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_CS3_MASK)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. budgets
+! -------
+!
+!* 8.1 tendencies
+! ----------
+!
+!
+!* 8.2 dynamical production, transport and mean advection
+! --------------------------------------------------
+!
+ALLOCATE(ZLES_MEAN_DRtDZ(NLES_K))
+ALLOCATE(ZLES_MEAN_DSVDZ(NLES_K,NSV))
+!
+IF (LUSERV) THEN
+ ZLES_MEAN_DRtDZ(:) = XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,1)
+ELSE
+ ZLES_MEAN_DRtDZ(:) = XUNDEF
+END IF
+!
+ZLES_MEAN_DSVDZ = 0.
+DO JSV=1,NSV
+ ZLES_MEAN_DSvDZ(:,JSV) = XLES_MEAN_DSvDZ(:,NLES_CURRENT_TCOUNT,1,JSV)
+END DO
+!
+CALL LES_RES_TR(LUSERV, &
+ XLES_MEAN_DUDZ(:,NLES_CURRENT_TCOUNT,1), &
+ XLES_MEAN_DVDZ(:,NLES_CURRENT_TCOUNT,1), &
+ XLES_MEAN_DWDZ(:,NLES_CURRENT_TCOUNT,1), &
+ XLES_MEAN_DThlDZ(:,NLES_CURRENT_TCOUNT,1), &
+ ZLES_MEAN_DRtDZ(:), &
+ ZLES_MEAN_DSvDZ(:,:) )
+!
+DEALLOCATE(ZLES_MEAN_DRtDZ)
+DEALLOCATE(ZLES_MEAN_DSVDZ)
+!
+CALL LES_BUDGET_TEND_n
+!* 8.3 end of LES budgets computations
+! -------------------------------
+!
+DO JLOOP=1,NLES_TOT
+ XLES_BU_RES_KE (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_KE (:,JLOOP)
+ XLES_BU_RES_WThl (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_WThl (:,JLOOP)
+ XLES_BU_RES_Thl2 (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_Thl2 (:,JLOOP)
+ XLES_BU_SBG_Tke (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_SBG_Tke (:,JLOOP)
+ IF (LUSERV) THEN
+ XLES_BU_RES_WRt (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_WRt (:,JLOOP)
+ XLES_BU_RES_Rt2 (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_Rt2 (:,JLOOP)
+ XLES_BU_RES_ThlRt(:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_ThlRt(:,JLOOP)
+ END IF
+ DO JSV=1,NSV
+ XLES_BU_RES_Sv2 (:,NLES_CURRENT_TCOUNT,JLOOP,JSV) = X_LES_BU_RES_Sv2 (:,JLOOP,JSV)
+ XLES_BU_RES_WSv (:,NLES_CURRENT_TCOUNT,JLOOP,JSV) = X_LES_BU_RES_WSv (:,JLOOP,JSV)
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. Deallocations
+! -------------
+!
+!* 9.1 local variables
+! ---------------
+!
+DEALLOCATE(ZEXN )
+DEALLOCATE(ZTHL)
+DEALLOCATE(ZRT )
+DEALLOCATE(ZTHV )
+DEALLOCATE(ZRHO )
+DEALLOCATE(ZEW )
+
+DEALLOCATE(ZINDCLD )
+DEALLOCATE(ZINDCLD2 )
+DEALLOCATE(ZINDCLD2D )
+DEALLOCATE(ZINDCLD2D2)
+DEALLOCATE(ZCLDFR_LES)
+DEALLOCATE(ZICEFR_LES)
+DEALLOCATE(ZRAINFR_LES)
+DEALLOCATE(ZMASSF )
+DEALLOCATE(ZTEMP )
+DEALLOCATE(ZREHU )
+DEALLOCATE(CHAMPXY1 )
+!
+DEALLOCATE(ZU_LES)
+DEALLOCATE(ZV_LES)
+DEALLOCATE(ZW_LES)
+DEALLOCATE(ZTHL_LES)
+DEALLOCATE(ZRT_LES)
+DEALLOCATE(ZSV_LES)
+DEALLOCATE(ZP_LES )
+DEALLOCATE(ZDP_LES )
+DEALLOCATE(ZTP_LES )
+DEALLOCATE(ZTR_LES )
+DEALLOCATE(ZDISS_LES )
+DEALLOCATE(ZLM_LES )
+DEALLOCATE(ZDPDZ_LES)
+DEALLOCATE(ZLWP_ANOM)
+DEALLOCATE(ZWORK2D)
+DEALLOCATE(ZWORK1D)
+DEALLOCATE(ZWORK1DT)
+DEALLOCATE(ZMAXWRR2D)
+DEALLOCATE(ZDTHLDZ_LES)
+DEALLOCATE(ZDTHDZ_LES)
+DEALLOCATE(ZDRTDZ_LES)
+DEALLOCATE(ZDSVDZ_LES)
+DEALLOCATE(ZDUDZ_LES)
+DEALLOCATE(ZDVDZ_LES)
+DEALLOCATE(ZDWDZ_LES)
+DEALLOCATE(ZRHO_LES )
+DEALLOCATE(ZEXN_LES )
+DEALLOCATE(ZTH_LES )
+DEALLOCATE(ZMF_LES )
+DEALLOCATE(ZTHV_LES )
+DEALLOCATE(ZTKE_LES )
+DEALLOCATE(ZKE_LES )
+DEALLOCATE(ZTKET_LES)
+DEALLOCATE(ZRV_LES )
+DEALLOCATE(ZREHU_LES )
+DEALLOCATE(ZRC_LES )
+DEALLOCATE(ZRR_LES )
+DEALLOCATE(ZZZ_LES)
+DEALLOCATE(ZLWP_LES )
+DEALLOCATE(ZRWP_LES )
+DEALLOCATE(ZIWP_LES )
+DEALLOCATE(ZSWP_LES )
+DEALLOCATE(ZGWP_LES )
+DEALLOCATE(ZHWP_LES )
+DEALLOCATE(ZINPRR3D_LES)
+DEALLOCATE(ZEVAP3D_LES)
+DEALLOCATE(ZRI_LES )
+DEALLOCATE(ZRS_LES )
+DEALLOCATE(ZRG_LES )
+DEALLOCATE(ZRH_LES )
+DEALLOCATE(ZP_ANOM )
+DEALLOCATE(ZRHO_ANOM)
+DEALLOCATE(ZTH_ANOM )
+DEALLOCATE(ZTHV_ANOM)
+DEALLOCATE(ZRV_ANOM )
+DEALLOCATE(ZRC_ANOM )
+DEALLOCATE(ZRI_ANOM )
+DEALLOCATE(ZRR_ANOM )
+DEALLOCATE(ZDPDZ_ANOM)
+DEALLOCATE(ZMEAN_DPDZ)
+DEALLOCATE(ZLES_MEAN_DTHDZ)
+!
+DEALLOCATE(ZU_SPEC )
+DEALLOCATE(ZV_SPEC )
+DEALLOCATE(ZW_SPEC )
+DEALLOCATE(ZTH_SPEC )
+DEALLOCATE(ZTHL_SPEC )
+DEALLOCATE(ZRV_SPEC )
+DEALLOCATE(ZRC_SPEC )
+DEALLOCATE(ZRI_SPEC )
+DEALLOCATE(ZSV_SPEC )
+!
+DEALLOCATE(ZRADEFF_LES )
+DEALLOCATE(ZSWU_LES )
+DEALLOCATE(ZSWD_LES )
+DEALLOCATE(ZLWD_LES )
+DEALLOCATE(ZLWU_LES )
+DEALLOCATE(ZDTHRADSW_LES )
+DEALLOCATE(ZDTHRADLW_LES )
+!
+!* 9.2 current time-step LES masks (in MODD_LES)
+! ---------------------------
+!
+CALL LES_DEALLOCATE('LLES_CURRENT_CART_MASK')
+IF (LLES_NEB_MASK) CALL LES_DEALLOCATE('LLES_CURRENT_NEB_MASK')
+IF (LLES_CORE_MASK) CALL LES_DEALLOCATE('LLES_CURRENT_CORE_MASK')
+IF (LLES_MY_MASK) THEN
+ CALL LES_DEALLOCATE('LLES_CURRENT_MY_MASKS')
+END IF
+IF (LLES_CS_MASK) THEN
+ CALL LES_DEALLOCATE('LLES_CURRENT_CS1_MASK')
+ IF (NSV_CS >= 2) CALL LES_DEALLOCATE('LLES_CURRENT_CS2_MASK')
+ IF (NSV_CS == 3) CALL LES_DEALLOCATE('LLES_CURRENT_CS3_MASK')
+END IF
+!
+!
+!* 9.3 variables in MODD_LES_BUDGET
+! ----------------------------
+!
+
+DEALLOCATE(XU_ANOM )
+DEALLOCATE(XV_ANOM )
+DEALLOCATE(XW_ANOM )
+DEALLOCATE(XTHL_ANOM)
+DEALLOCATE(XRT_ANOM )
+DEALLOCATE(XSV_ANOM )
+!
+DEALLOCATE(XCURRENT_L_O_EXN_CP)
+DEALLOCATE(XCURRENT_RHODJ )
+!
+DEALLOCATE(XCURRENT_RUS )
+DEALLOCATE(XCURRENT_RVS )
+DEALLOCATE(XCURRENT_RWS )
+DEALLOCATE(XCURRENT_RTHS )
+DEALLOCATE(XCURRENT_RTKES)
+DEALLOCATE(XCURRENT_RRS )
+DEALLOCATE(XCURRENT_RSVS )
+DEALLOCATE(XCURRENT_RTHLS)
+DEALLOCATE(XCURRENT_RRTS )
+
+DEALLOCATE(X_LES_BU_RES_KE )
+DEALLOCATE(X_LES_BU_RES_WThl )
+DEALLOCATE(X_LES_BU_RES_Thl2 )
+DEALLOCATE(X_LES_BU_RES_WRt )
+DEALLOCATE(X_LES_BU_RES_Rt2 )
+DEALLOCATE(X_LES_BU_RES_ThlRt)
+DEALLOCATE(X_LES_BU_RES_Sv2 )
+DEALLOCATE(X_LES_BU_RES_WSv )
+DEALLOCATE(X_LES_BU_SBG_TKE )
+!-------------------------------------------------------------------------------
+!
+!* 10. end of LES computations for this time-step
+! ------------------------------------------
+!
+LLES_CALL=.FALSE.
+CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH )
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+!
+! ##########################################################################
+ SUBROUTINE LES(OMASK)
+! ##########################################################################
+!
+!
+!!**** *LES* computes the current time-step LES diagnostics for one mask.
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+USE MODI_LES_FLUX_ll
+USE MODI_LES_3RD_MOMENT_ll
+USE MODI_LES_4TH_MOMENT_ll
+USE MODI_LES_MEAN_1PROC
+USE MODI_LES_MEAN_MPROC
+USE MODI_LES_PDF_ll
+!
+USE MODI_LES_HOR_CORR
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: OMASK ! 2D mask for computations
+!
+!
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: JSV ! scalar variables counter
+INTEGER :: JI
+INTEGER :: JK ! vertical loop counter
+INTEGER :: JPDF ! pdf counter
+!
+LOGICAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: GUPDRAFT_MASK
+LOGICAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: GDOWNDRAFT_MASK
+REAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: ZUPDRAFT
+REAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: ZDOWNDRAFT
+REAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: ZW_UP
+REAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: ZWORK_LES
+!
+INTEGER, DIMENSION(SIZE(ZW_LES,3)) :: IAVG_PTS
+INTEGER, DIMENSION(SIZE(ZW_LES,3)) :: IUND_PTS
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZAVG
+!
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_U3
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_UV2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_UW2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_VU2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_V3
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_VW2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_WU2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_WV2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_UPDRAFT_U2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_UPDRAFT_V2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_UPDRAFT_W2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_DOWNDRAFT_U2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_DOWNDRAFT_V2
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_DOWNDRAFT_W2
+REAL, DIMENSION(SIZE(ZW_LES,3),NPDF) :: ZPDF
+!
+INTEGER, DIMENSION(1) :: IKMIN_FLUX ! vertical index of min. W'thl'
+INTEGER, DIMENSION(1) :: IKMAX_TH !vertical index maxdth
+INTEGER, DIMENSION(1) :: IKMAX_CF ! vertical index of max. Cf
+!
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZKE_TOT ! total turbulent kinetic energy
+REAL :: ZINT_KE_TOT! integral of KE_TOT
+REAL :: ZINT_RHOKE! integral of RHO*KE
+REAL :: ZFRIC_SURF ! surface friction
+REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZFRIC_LES ! friction at all LES levels
+!
+!-------------------------------------------------------------------------------
+!
+! 1. local diagnostics (for any mask type)
+! -----------------
+!
+!
+! 1.2 Number of points used for averaging on current processor
+! --------------------------------------------------------
+!
+!* to be sure to be coherent with other computations,
+! a field on LES vertical grid (and horizontal mass point grid) is used.
+! This information is necessary for the subgrid fluxes computations, because
+! half of the work is already done, but the number of averaging points was
+! not kept.
+!
+CALL LES_MEAN_1PROC ( XW_ANOM, OMASK, &
+ ZAVG(:), &
+ IAVG_PTS(:), &
+ IUND_PTS(:) )
+!
+!
+! 1.3 Number of points used for averaging on all processor
+! ----------------------------------------------------
+!
+CALL LES_MEAN_ll ( XW_ANOM, OMASK, &
+ ZAVG(:), &
+ NLES_AVG_PTS_ll(:,NLES_CURRENT_TCOUNT,IMASK), &
+ NLES_UND_PTS_ll(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!
+! 1.4 Mean quantities
+! ---------------
+!
+IF (LLES_MEAN .AND. IMASK > 1) THEN
+!
+!* horizontal wind velocities
+!
+ CALL LES_MEAN_ll ( ZU_LES, OMASK, &
+ XLES_MEAN_U(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_MEAN_ll ( ZV_LES, OMASK, &
+ XLES_MEAN_V(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* vertical wind velocity
+!
+ CALL LES_MEAN_ll ( ZW_LES, OMASK, &
+ XLES_MEAN_W(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* pressure
+!
+ CALL LES_MEAN_ll ( ZP_LES, OMASK, &
+ XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* dynamical production TKE
+!
+ CALL LES_MEAN_ll ( ZDP_LES, OMASK, &
+ XLES_MEAN_DP(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* thermal production TKE
+!
+ CALL LES_MEAN_ll ( ZTP_LES, OMASK, &
+ XLES_MEAN_TP(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* transport TKE
+!
+ CALL LES_MEAN_ll ( ZTR_LES, OMASK, &
+ XLES_MEAN_TR(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* dissipation TKE
+!
+ CALL LES_MEAN_ll ( ZDISS_LES, OMASK, &
+ XLES_MEAN_DISS(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* mixing length
+!
+ CALL LES_MEAN_ll ( ZLM_LES, OMASK, &
+ XLES_MEAN_LM(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* density
+!
+ CALL LES_MEAN_ll ( ZRHO_LES, OMASK, &
+ XLES_MEAN_RHO(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!
+!* potential temperature
+!
+ CALL LES_MEAN_ll ( ZTH_LES, OMASK, &
+ XLES_MEAN_Th(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* mass flux
+ CALL LES_MEAN_ll ( ZMF_LES, OMASK, &
+ XLES_MEAN_Mf(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!
+!* virtual potential temperature
+!
+ IF (LUSERV) &
+ CALL LES_MEAN_ll ( ZTHV_LES, OMASK, &
+ XLES_MEAN_Thv(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* liquid potential temperature
+!
+ IF (LUSERC) THEN
+ CALL LES_MEAN_ll ( ZTHL_LES, OMASK, &
+ XLES_MEAN_Thl(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* vapor mixing ratio
+!
+ IF (LUSERV) THEN
+ CALL LES_MEAN_ll ( ZRV_LES, OMASK, &
+ XLES_MEAN_Rv(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!*relative humidity
+!
+ IF (LUSERV) THEN
+ CALL LES_MEAN_ll ( ZREHU_LES, OMASK, &
+ XLES_MEAN_Rehu(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* cloud mixing ratio
+!
+ IF (LUSERC) THEN
+ CALL LES_MEAN_ll ( ZRC_LES, OMASK, &
+ XLES_MEAN_Rc(:,NLES_CURRENT_TCOUNT,IMASK) )
+ CALL LES_MEAN_ll ( ZRT_LES, OMASK, &
+ XLES_MEAN_Rt(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* rain mixing ratio
+!
+ IF (LUSERR) THEN
+ CALL LES_MEAN_ll ( ZRR_LES, OMASK, &
+ XLES_MEAN_Rr(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* ice mixing ratio
+!
+ IF (LUSERI) THEN
+ CALL LES_MEAN_ll ( ZRI_LES, OMASK, &
+ XLES_MEAN_Ri(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* snow mixing ratio
+!
+ IF (LUSERS) THEN
+ CALL LES_MEAN_ll ( ZRS_LES, OMASK, &
+ XLES_MEAN_Rs(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* graupel mixing ratio
+!
+ IF (LUSERG) THEN
+ CALL LES_MEAN_ll ( ZRG_LES, OMASK, &
+ XLES_MEAN_Rg(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* hail mixing ratio
+!
+ IF (LUSERH) THEN
+ CALL LES_MEAN_ll ( ZRH_LES, OMASK, &
+ XLES_MEAN_Rh(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* scalar variables mixing ratio
+!
+ DO JSV=1,NSV
+ CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), OMASK, &
+ XLES_MEAN_Sv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ END DO
+END IF
+!
+!* wind modulus
+!
+IF (LLES_MEAN) THEN
+!
+ ZWORK_LES =SQRT( ZU_LES**2 +ZV_LES**2 )
+ CALL LES_MEAN_ll ( ZWORK_LES, OMASK, &
+ XLES_MEAN_WIND(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* vertical speed larger than mean vertical speed (updraft)
+!
+ DO JK=1,NLES_K
+ ZW_UP(:,:,JK) = MAX(ZW_LES(:,:,JK), XLES_MEAN_W(JK,NLES_CURRENT_TCOUNT,IMASK))
+ END DO
+!
+!* upward mass flux
+!
+ ZWORK_LES = ZW_UP * ZRHO_LES
+ CALL LES_MEAN_ll ( ZWORK_LES, OMASK, &
+ XLES_RESOLVED_MASSFX(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* pdf calculation
+!
+ IF (LLES_PDF) THEN
+ CALL LES_PDF_ll ( ZTH_LES,OMASK,XTH_PDF_MIN,XTH_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_TH(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+
+ CALL LES_PDF_ll ( ZW_LES,OMASK,XW_PDF_MIN,XW_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_W(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ CALL LES_PDF_ll ( ZTHV_LES,OMASK,XTHV_PDF_MIN,XTHV_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_THV(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ IF (LUSERV) THEN
+ CALL LES_PDF_ll ( ZRV_LES,OMASK,XRV_PDF_MIN,XRV_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_RV(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ END IF
+ IF (LUSERC) THEN
+ CALL LES_PDF_ll ( ZRC_LES,OMASK,XRC_PDF_MIN,XRC_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_RC(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ CALL LES_PDF_ll ( ZRT_LES,OMASK,XRT_PDF_MIN,XRT_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_RT(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ CALL LES_PDF_ll ( ZTHL_LES,OMASK,XTHL_PDF_MIN,XTHL_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_THL(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ END IF
+ IF (LUSERR) THEN
+ CALL LES_PDF_ll ( ZRR_LES,OMASK,XRR_PDF_MIN,XRR_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_RR(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ END IF
+ IF (LUSERI) THEN
+ CALL LES_PDF_ll ( ZRI_LES,OMASK,XRI_PDF_MIN,XRI_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_RI(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ END IF
+ IF (LUSERS) THEN
+ CALL LES_PDF_ll ( ZRS_LES,OMASK,XRS_PDF_MIN,XRS_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_RS(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ END IF
+ IF (LUSERG) THEN
+ CALL LES_PDF_ll ( ZRG_LES,OMASK,XRG_PDF_MIN,XRG_PDF_MAX, &
+ ZPDF(:,:) )
+ DO JSV=1,NPDF
+ XLES_PDF_RG(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
+ END DO
+ END IF
+ END IF
+!
+!* mean vertical gradients
+!
+ CALL LES_MEAN_ll ( ZDTHLDZ_LES, OMASK, XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
+ CALL LES_MEAN_ll ( ZDUDZ_LES, OMASK, XLES_MEAN_DUDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
+ CALL LES_MEAN_ll ( ZDVDZ_LES, OMASK, XLES_MEAN_DVDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
+ CALL LES_MEAN_ll ( ZDWDZ_LES, OMASK, XLES_MEAN_DWDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
+ IF (LUSERV) CALL LES_MEAN_ll ( ZDRtDZ_LES, OMASK, XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
+ DO JSV=1,NSV
+ CALL LES_MEAN_ll ( ZDSVDZ_LES(:,:,:,JSV), OMASK, XLES_MEAN_DSVDZ(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ END DO
+
+END IF
+!-------------------------------------------------------------------------------
+!
+! 1.5 Resolved quantities
+! -------------------
+!
+!* horizontal wind variances
+!
+ CALL LES_FLUX_ll ( XU_ANOM, XU_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_U2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, XV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_V2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* vertical wind variance
+!
+ CALL LES_FLUX_ll ( XW_ANOM, XW_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* pressure variance
+!
+ CALL LES_FLUX_ll ( ZP_ANOM, ZP_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_P2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* potential temperature variance
+!
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZTH_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_TH2(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+!
+!* resolved turbulent kinetic energy
+!
+ XLES_RESOLVED_Ke(:,NLES_CURRENT_TCOUNT,IMASK) = XUNDEF
+!
+ WHERE(XLES_RESOLVED_U2 (:,NLES_CURRENT_TCOUNT,IMASK) /= XUNDEF) &
+ XLES_RESOLVED_Ke(:,NLES_CURRENT_TCOUNT,IMASK) = 0.5*( &
+ XLES_RESOLVED_U2 (:,NLES_CURRENT_TCOUNT,IMASK) &
+ + XLES_RESOLVED_V2 (:,NLES_CURRENT_TCOUNT,IMASK) &
+ + XLES_RESOLVED_W2 (:,NLES_CURRENT_TCOUNT,IMASK))
+!
+!* potential temperature - virtual potential temperature covariance
+!
+ IF (LUSERV) THEN
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZTHV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_THTHV(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+!
+!* vapor mixing ratio variance
+!
+ CALL LES_FLUX_ll ( ZRV_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_Rv2(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!
+!* potential temperature - vapor mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThRv(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* virtual potential temperature - vapor mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThvRv(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!
+!* liquid potential temperature - virtual potential temperature covariance
+!
+ IF (LUSERC) THEN
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZTHV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_THLTHV(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* liquid potential temperature variance
+!
+ CALL LES_FLUX_ll ( XTHL_ANOM, XTHL_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_THL2(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* total water mixing ratio variance
+!
+ CALL LES_FLUX_ll ( XRT_ANOM, XRT_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_Rt2(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* cloud mixing ratio variance
+!
+ CALL LES_FLUX_ll ( ZRC_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_Rc2(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* potential temperature - cloud mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThRc(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* liquid potential temperature - vapor mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThlRv(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* liquid potential temperature - cloud mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThlRc(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* virtual potential temperature - cloud mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThvRc(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+! variance of lwp
+!
+ IF (IMASK .EQ. 1) THEN
+ CALL LES_FLUX_ll (ZLWP_ANOM, ZLWP_ANOM, &
+ OMASK(:,:,1), &
+ XLES_LWPVAR(NLES_CURRENT_TCOUNT) )
+ END IF
+ END IF
+!
+!* ice mixing ratio variance
+!
+ IF (LUSERI) THEN
+ CALL LES_FLUX_ll ( ZRI_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_Ri2(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* potential temperature - ice mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThRi(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* liquid potential temperature - ice mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThlRi(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* virtual potential temperature - ice mixing ratio correlation
+!
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThvRi(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* scalar variable mixing ratio variances
+!
+ DO JSV=1,NSV
+ CALL LES_FLUX_ll ( XSV_ANOM(:,:,:,JSV), XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_Sv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+!
+!* potential temperature - scalar variables ratio correlation
+!
+ CALL LES_FLUX_ll ( ZTH_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_ThSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+!
+!* liquid potential temperature - scalar variables ratio correlation
+!
+ IF (LUSERC) THEN
+ CALL LES_FLUX_ll ( XTHL_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_ThlSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ END IF
+!
+!* virtual potential temperature - scalar variables ratio correlation
+!
+ IF (LUSERV) THEN
+ CALL LES_FLUX_ll ( ZTHV_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_ThvSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ END IF
+ END DO
+!
+!
+!* wind fluxes
+!
+ CALL LES_FLUX_ll ( XU_ANOM, XV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_UV (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, XU_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WU (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, XV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WV (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* pressure fluxes
+!
+ CALL LES_FLUX_ll ( XU_ANOM, ZDPDZ_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_UP (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, ZDPDZ_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_VP (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZDPDZ_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WP (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* theta fluxes
+!
+ CALL LES_FLUX_ll ( XU_ANOM, ZTH_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_UTh (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_FLUX_ll ( XV_ANOM, ZTH_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_VTh (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZTH_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WTh (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* virtual theta fluxes
+!
+ IF (LUSERV) THEN
+ CALL LES_FLUX_ll ( XU_ANOM, ZTHV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_UThv (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, ZTHV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_VThv (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZTHV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThv (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* vapor mixing ratio fluxes
+!
+ CALL LES_FLUX_ll ( XU_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_URv (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_VRv (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRv (:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* cloud water mixing ratio fluxes
+!
+ IF (LUSERC) THEN
+ CALL LES_FLUX_ll ( XU_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_URc (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_VRc (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRc (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* liquid theta fluxes
+!
+ CALL LES_FLUX_ll ( XU_ANOM, XTHL_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_UThl (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, XTHL_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_VThl (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, XTHL_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThl (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* total water mixing ratio fluxes
+!
+ CALL LES_FLUX_ll ( XW_ANOM, XRT_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRt (:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* cloud ice mixing ratio fluxes
+!
+ IF (LUSERI) THEN
+ CALL LES_FLUX_ll ( XU_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_URi (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_VRi (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRi (:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+ IF (LUSERR) THEN
+ CALL LES_FLUX_ll ( XW_ANOM, ZRR_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRr (:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+
+!
+!* scalar variables fluxes
+!
+ DO JSV=1,NSV
+ CALL LES_FLUX_ll ( XU_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_USv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_VSv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_WSv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ END DO
+!
+!* skewness
+!
+ CALL LES_3RD_MOMENT_ll ( XU_ANOM, XU_ANOM, XU_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_U3 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XV_ANOM, XV_ANOM, XV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_V3 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, XW_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W3 (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* kurtosis
+!
+ CALL LES_4TH_MOMENT_ll ( XU_ANOM, XU_ANOM, XU_ANOM, XU_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_U4 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_4TH_MOMENT_ll ( XV_ANOM, XV_ANOM, XV_ANOM, XV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_V4 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_4TH_MOMENT_ll ( XW_ANOM, XW_ANOM, XW_ANOM, XW_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W4 (:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+!* third moments of liquid potential temperature
+!
+ IF (LUSERC) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, XTHL_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThl2(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, XTHL_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W2Thl(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ ELSE
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZTH_ANOM, ZTH_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThl2(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZTH_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W2Thl(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* third moments of water vapor
+!
+ IF (LUSERV) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRv2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W2Rv (:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+
+ IF (LUSERC) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThlRv(:,NLES_CURRENT_TCOUNT,IMASK) )
+ ELSE IF (LUSERV) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZTH_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThlRv(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* third moments of total water
+!
+ IF (LUSERC) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XRT_ANOM, XRT_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRt2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, XRT_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W2Rt (:,NLES_CURRENT_TCOUNT,IMASK) )
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, XRT_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThlRt (:,NLES_CURRENT_TCOUNT,IMASK) )
+ ELSE IF (LUSERV) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRt2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W2Rt (:,NLES_CURRENT_TCOUNT,IMASK) )
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZTH_ANOM, ZRV_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThlRt (:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* third moments of cloud water
+!
+ IF (LUSERC) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRC_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRc2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W2Rc (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThlRc(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, ZRC_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRvRc (:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* third moments of cloud ice
+!
+ IF (LUSERI) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRI_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRi2 (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_W2Ri (:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WThlRi(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, ZRI_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_WRvRi (:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+!
+!* third moments of scalar variables
+!
+ DO JSV=1,NSV
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XSV_ANOM(:,:,:,JSV), XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_WSv2 (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_W2Sv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ IF (LUSERC) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_WThlSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ ELSE
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZTH_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_WThlSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ END IF
+
+ IF (LUSERV) THEN
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, XSV_ANOM(:,:,:,JSV), &
+ OMASK, &
+ XLES_RESOLVED_WRvSv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
+ END IF
+ END DO
+!
+!* presso-correlations
+!
+!
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZDPDZ_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_ThlPz(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ IF (LUSERV) &
+ CALL LES_FLUX_ll ( ZRV_ANOM, ZDPDZ_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_RvPz(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ IF (LUSERC) THEN
+ CALL LES_FLUX_ll ( XRT_ANOM, ZDPDZ_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_RtPz(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_FLUX_ll ( ZRC_ANOM, ZDPDZ_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_RcPz(:,NLES_CURRENT_TCOUNT,IMASK) )
+ END IF
+
+ IF (LUSERI) &
+ CALL LES_FLUX_ll ( ZRI_ANOM, ZDPDZ_ANOM, &
+ OMASK, &
+ XLES_RESOLVED_RiPz(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+!
+!
+!* resolved turbulent kinetic energy fluxes
+!
+
+ CALL LES_3RD_MOMENT_ll ( XU_ANOM, XU_ANOM, XU_ANOM, &
+ OMASK, &
+ ZLES_RESOLVED_U3 (:) )
+
+ CALL LES_3RD_MOMENT_ll ( XU_ANOM, XV_ANOM, XV_ANOM, &
+ OMASK, &
+ ZLES_RESOLVED_UV2 (:) )
+
+ CALL LES_3RD_MOMENT_ll ( XU_ANOM, XW_ANOM, XW_ANOM, &
+ OMASK, &
+ ZLES_RESOLVED_UW2 (:) )
+
+ XLES_RESOLVED_UKe(:,NLES_CURRENT_TCOUNT,IMASK) = 0.5*( ZLES_RESOLVED_U3 &
+ + ZLES_RESOLVED_UV2 &
+ + ZLES_RESOLVED_UW2 )
+
+
+
+ CALL LES_3RD_MOMENT_ll ( XV_ANOM, XU_ANOM, XU_ANOM, &
+ OMASK, &
+ ZLES_RESOLVED_VU2 (:) )
+
+ CALL LES_3RD_MOMENT_ll ( XV_ANOM, XV_ANOM, XV_ANOM, &
+ OMASK, &
+ ZLES_RESOLVED_V3 (:) )
+
+ CALL LES_3RD_MOMENT_ll ( XV_ANOM, XW_ANOM, XW_ANOM, &
+ OMASK, &
+ ZLES_RESOLVED_VW2 (:) )
+
+ XLES_RESOLVED_VKe(:,NLES_CURRENT_TCOUNT,IMASK) = 0.5*( ZLES_RESOLVED_VU2 &
+ + ZLES_RESOLVED_V3 &
+ + ZLES_RESOLVED_VW2 )
+
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XU_ANOM, XU_ANOM, &
+ OMASK, &
+ ZLES_RESOLVED_WU2 (:) )
+
+ CALL LES_3RD_MOMENT_ll ( XW_ANOM, XV_ANOM, XV_ANOM, &
+ OMASK, &
+ ZLES_RESOLVED_WV2 (:) )
+
+ XLES_RESOLVED_WKe(:,NLES_CURRENT_TCOUNT,IMASK) = 0.5*( ZLES_RESOLVED_WU2 &
+ + ZLES_RESOLVED_WV2 &
+ + XLES_RESOLVED_W3(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 1.6 Subgrid quantities
+! ------------------
+!
+IF (LLES_SUBGRID) THEN
+!
+!* wind fluxes and variances
+!
+ CALL LES_MEAN_ll ( ZTKE_LES, OMASK, &
+ XLES_SUBGRID_Tke(:,NLES_CURRENT_TCOUNT,IMASK) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_UV(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WU(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WV(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_U2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_V2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_W2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+!
+!* liquid potential temperature fluxes
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_UThl(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_VThl(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WThl(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+
+!* liquid potential temperature variance
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_Thl2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+!* Mass flux scheme of shallow convection
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_THLUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_RTUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_RVUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_RCUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_RIUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_MASSFLUX(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_DETR(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_ENTR(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_FRACUP(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_THVUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WTHLMF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WRTMF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WUMF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WVMF(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+
+!* total water mixing ratio fluxes, correlation and variance
+!
+ IF (LUSERV) THEN
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_URt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_VRt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WRt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_ThlRt(:,NLES_CURRENT_TCOUNT,IMASK),&
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_Rt2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END IF
+!
+!* scalar variances
+!
+ DO JSV=1,NSV
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_Sv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END DO
+!
+!* cloud water mixing ratio fluxes
+!
+ IF (LUSERC) THEN
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_URc(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_VRc(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WRc(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END IF
+!
+!* scalar variables fluxes
+!
+ DO JSV=1,NSV
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_USv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_VSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END DO
+!
+!* subgrid turbulent kinetic energy fluxes
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_UTke(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_VTke(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ !
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WTke(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_ddz_WTke(:,NLES_CURRENT_TCOUNT,IMASK),&
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+!* fluxes and correlations with virtual potential temperature
+!
+ IF (LUSERV) THEN
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WThv(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_ThlThv(:,NLES_CURRENT_TCOUNT,IMASK),&
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_RtThv(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ DO JSV=1,NSV
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_SvThv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END DO
+ END IF
+!
+!* third order fluxes
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_W2Thl(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WThl2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ IF (LUSERV) THEN
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_W2Rt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WThlRt(:,NLES_CURRENT_TCOUNT,IMASK),&
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WRt2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ END IF
+ DO JSV=1,NSV
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_W2Sv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WSv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END DO
+!
+!* dissipative terms
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_Tke(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_Thl2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ IF (LUSERV) THEN
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_Rt2(:,NLES_CURRENT_TCOUNT,IMASK),&
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_ThlRt(:,NLES_CURRENT_TCOUNT,IMASK),&
+ IAVG_PTS(:), IUND_PTS(:) )
+ END IF
+
+ DO JSV=1,NSV
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_Sv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END DO
+!
+!* presso-correlation terms
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_WP(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_ThlPz(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ IF (LUSERV) THEN
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_RtPz(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ END IF
+
+ DO JSV=1,NSV
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_SvPz(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END DO
+
+!* phi3 and psi3 terms
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_PHI3(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ IF (LUSERV) THEN
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_PSI3(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END IF
+!
+!* subgrid mixing length
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_LMix(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+!* subgrid dissipative length
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_LDiss(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+!
+!* eddy diffusivities
+!
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_Km(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_SUBGRID_Kh(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+END IF
+!
+! computation of KHT and KHR depending on LLES
+ IF (LUSERC) THEN
+ IF (LLES_RESOLVED) THEN
+ XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=0.
+ WHERE(XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
+ XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=-1. &
+ *XLES_RESOLVED_WThl (:,NLES_CURRENT_TCOUNT,IMASK)/ &
+ XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)
+ XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=0.
+ WHERE(XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
+ XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=-1.* &
+ XLES_RESOLVED_WRt (:,NLES_CURRENT_TCOUNT,IMASK)/ &
+ XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)
+ END IF
+ IF (LLES_SUBGRID) THEN
+ XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=0.
+ WHERE(XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
+ XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=-1. &
+ *XLES_SUBGRID_WThl (:,NLES_CURRENT_TCOUNT,IMASK) / &
+ XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)
+ XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=0.
+ WHERE(XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
+ XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=-1.* &
+ XLES_SUBGRID_WRt (:,NLES_CURRENT_TCOUNT,IMASK) / &
+ XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)
+ END IF
+ IF (LLES_RESOLVED .AND. LLES_SUBGRID) THEN
+ XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=0.
+ WHERE(XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
+ XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=-1. &
+ *(XLES_RESOLVED_WThl (:,NLES_CURRENT_TCOUNT,IMASK)+ &
+ XLES_SUBGRID_WThl (:,NLES_CURRENT_TCOUNT,IMASK))/ &
+ XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)
+ XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=0.
+ WHERE(XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
+ XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=-1.* &
+ (XLES_RESOLVED_WRt (:,NLES_CURRENT_TCOUNT,IMASK)+ &
+ XLES_SUBGRID_WRt (:,NLES_CURRENT_TCOUNT,IMASK)) / &
+ XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)
+ END IF
+ END IF
+!-------------------------------------------------------------------------------
+!
+! 1.7 Interaction of subgrid and resolved quantities
+! ----------------------------------------------
+!
+!* WARNING: these terms also contain the term due to the mean flow.
+! this mean flow contribution will be removed from them
+! when treated in write_les_budgetn.f90
+!
+!
+!* subgrid turbulent kinetic energy fluxes
+!
+IF (LLES_RESOLVED) THEN
+ CALL LES_FLUX_ll ( XU_ANOM, ZTKE_LES, &
+ OMASK, &
+ XLES_RES_U_SBG_Tke(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XV_ANOM, ZTKE_LES, &
+ OMASK, &
+ XLES_RES_V_SBG_Tke(:,NLES_CURRENT_TCOUNT,IMASK) )
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZTKE_LES, &
+ OMASK, &
+ XLES_RES_W_SBG_Tke(:,NLES_CURRENT_TCOUNT,IMASK) )
+END IF
+!
+!* WARNING: these terms also contain the term due to the mean flow.
+! this mean flow contribution will be removed from them
+! when treated in write_les_budgetn.f90
+!
+!* production terms for subgrid quantities
+!
+IF (LLES_RESOLVED .AND. LLES_SUBGRID) THEN
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_U_SBG_UaU(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_V_SBG_UaV(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_W_SBG_UaW(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_W_SBG_UaThl(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Thl_SBG_UaW(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddz_Thl_SBG_W2 (:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Thl_SBG_UaThl(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ IF (LUSERV) THEN
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_W_SBG_UaRt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Rt_SBG_UaW(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddz_Rt_SBG_W2 (:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Thl_SBG_UaRt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Rt_SBG_UaThl(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Rt_SBG_UaRt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ END IF
+!
+!* WARNING: these terms also contain the term due to the mean flow.
+! this mean flow contribution will be removed from them
+! when treated in write_les_budgetn.f90
+!
+!* turbulent transport and advection terms for subgrid quantities
+!
+ CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_WThl(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_Thl2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ IF (LUSERV) THEN
+ CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_WRt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_Rt2(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_ThlRt(:,NLES_CURRENT_TCOUNT,IMASK), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ END IF
+
+ DO JSV=1,NSV
+ CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_WSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+
+ CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_Sv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
+ IAVG_PTS(:), IUND_PTS(:) )
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+! 2. The following is for cartesian mask only
+! ----------------------------------------
+!
+IF (IMASK>1) RETURN
+!
+!-------------------------------------------------------------------------------
+!
+! 3. Updraft diagnostics
+! -------------------
+!
+IF (LLES_UPDRAFT) THEN
+!
+ DO JK=1,NLES_K
+ GUPDRAFT_MASK(:,:,JK) = (XW_ANOM(:,:,JK) > 0.) .AND. LLES_CURRENT_CART_MASK(:,:,JK)
+ END DO
+!
+!
+! 3.1 Updraft fraction
+! ----------------
+!
+ ZUPDRAFT(:,:,:) = 0.
+ WHERE (GUPDRAFT_MASK(:,:,:))
+ ZUPDRAFT(:,:,:) = 1.
+ END WHERE
+!
+ CALL LES_MEAN_ll ( ZUPDRAFT, OMASK, &
+ XLES_UPDRAFT(:,NLES_CURRENT_TCOUNT) )
+!
+!
+! 3.2 Updraft mean quantities
+! -----------------------
+!
+!* vertical wind velocity
+!
+ CALL LES_MEAN_ll ( ZW_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_W(:,NLES_CURRENT_TCOUNT) )
+!
+!* potential temperature
+!
+ CALL LES_MEAN_ll ( ZTH_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Th(:,NLES_CURRENT_TCOUNT) )
+!
+!* liquid potential temperature
+!
+ IF (LUSERC) &
+ CALL LES_MEAN_ll ( ZTHL_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Thl(:,NLES_CURRENT_TCOUNT) )
+!
+!* virtual potential temperature
+!
+ IF (LUSERV) &
+ CALL LES_MEAN_ll ( ZTHV_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Thv(:,NLES_CURRENT_TCOUNT) )
+!
+!* vapor mixing ratio
+!
+ IF (LUSERV) &
+ CALL LES_MEAN_ll ( ZRV_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Rv(:,NLES_CURRENT_TCOUNT) )
+!
+!* cloud water mixing ratio
+!
+ IF (LUSERC) &
+ CALL LES_MEAN_ll ( ZRC_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Rc(:,NLES_CURRENT_TCOUNT) )
+!
+!* rain mixing ratio
+!
+ IF (LUSERR) &
+ CALL LES_MEAN_ll ( ZRR_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Rr(:,NLES_CURRENT_TCOUNT) )
+!
+!* cloud ice mixing ratio
+!
+ IF (LUSERI) &
+ CALL LES_MEAN_ll ( ZRI_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Ri(:,NLES_CURRENT_TCOUNT) )
+!
+!* snow mixing ratio
+!
+ IF (LUSERS) &
+ CALL LES_MEAN_ll ( ZRS_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Rs(:,NLES_CURRENT_TCOUNT) )
+!
+!* graupel mixing ratio
+!
+ IF (LUSERG) &
+ CALL LES_MEAN_ll ( ZRG_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Rg(:,NLES_CURRENT_TCOUNT) )
+!
+!* hail mixing ratio
+!
+ IF (LUSERH) &
+ CALL LES_MEAN_ll ( ZRG_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Rh(:,NLES_CURRENT_TCOUNT) )
+!
+!* scalar variables
+!
+ DO JSV=1,NSV
+ CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Sv(:,NLES_CURRENT_TCOUNT,JSV) )
+ END DO
+!
+!* subgrid turbulent kinetic energy
+!
+ CALL LES_MEAN_ll ( ZTKE_LES, GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Tke(:,NLES_CURRENT_TCOUNT) )
+!
+!
+! 3.3 Updraft resolved quantities
+! ---------------------------
+!
+!
+!* resolved turbulent kinetic energy
+!
+ CALL LES_FLUX_ll ( XU_ANOM, XU_ANOM, &
+ GUPDRAFT_MASK, &
+ ZLES_UPDRAFT_U2(:) )
+
+ CALL LES_FLUX_ll ( XV_ANOM, XV_ANOM, &
+ GUPDRAFT_MASK, &
+ ZLES_UPDRAFT_V2(:) )
+
+ CALL LES_FLUX_ll ( XW_ANOM, XW_ANOM, &
+ GUPDRAFT_MASK, &
+ ZLES_UPDRAFT_W2(:) )
+
+ XLES_UPDRAFT_Ke(:,NLES_CURRENT_TCOUNT) = 0.5 * ( ZLES_UPDRAFT_U2(:) &
+ + ZLES_UPDRAFT_V2(:) &
+ + ZLES_UPDRAFT_W2(:) )
+!
+!* vertical potential temperature flux
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZTH_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_WTh(:,NLES_CURRENT_TCOUNT) )
+!
+!* vertical liquid potential temperature flux
+!
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XW_ANOM, XTHL_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_WThl(:,NLES_CURRENT_TCOUNT) )
+!
+!* vertical virtual potential temperature flux
+!
+ IF (LUSERV) &
+ CALL LES_FLUX_ll ( XW_ANOM, ZTHV_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_WThv(:,NLES_CURRENT_TCOUNT) )
+!
+!* potential temperature variance
+!
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZTH_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Th2(:,NLES_CURRENT_TCOUNT) )
+!
+!* liquid potential temperature variance
+!
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XTHL_ANOM, XTHL_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Thl2(:,NLES_CURRENT_TCOUNT) )
+!
+!* potential temperature - virtual potential temperature covariance
+!
+ IF (LUSERV) &
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZTHV_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThThv (:,NLES_CURRENT_TCOUNT) )
+!
+!* liquid potential temperature - virtual potential temperature covariance
+!
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZTHV_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThlThv(:,NLES_CURRENT_TCOUNT) )
+!
+!* water vapor mixing ratio flux, variance and correlations
+!
+ IF (LUSERV) THEN
+ CALL LES_FLUX_ll ( XW_ANOM, ZRV_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_WRv(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZRV_ANOM, ZRV_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Rv2(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRV_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThRv (:,NLES_CURRENT_TCOUNT) )
+ !
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRV_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThlRv(:,NLES_CURRENT_TCOUNT) )
+
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRV_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThvRv(:,NLES_CURRENT_TCOUNT) )
+ END IF
+!
+!* cloud water mixing ratio flux
+!
+ IF (LUSERC) THEN
+ CALL LES_FLUX_ll ( XW_ANOM, ZRC_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_WRc(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZRC_ANOM, ZRC_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Rc2(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRC_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThRc (:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRC_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThlRc(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRC_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThvRc(:,NLES_CURRENT_TCOUNT) )
+ END IF
+!
+!* cloud ice mixing ratio flux
+!
+ IF (LUSERI) THEN
+ CALL LES_FLUX_ll ( XW_ANOM, ZRI_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_WRi(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZRI_ANOM, ZRI_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Ri2(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRI_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThRi (:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRI_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThlRi(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRI_ANOM, &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThvRi(:,NLES_CURRENT_TCOUNT) )
+ END IF
+!
+!* scalar variables flux
+!
+ DO JSV=1,NSV
+ CALL LES_FLUX_ll ( XW_ANOM, XSV_ANOM(:,:,:,JSV), &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_WSv(:,NLES_CURRENT_TCOUNT,JSV) )
+ !
+ CALL LES_FLUX_ll ( XSV_ANOM(:,:,:,JSV), XSV_ANOM(:,:,:,JSV), &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_Sv2(:,NLES_CURRENT_TCOUNT,JSV) )
+ !
+ CALL LES_FLUX_ll ( ZTH_ANOM, XSV_ANOM(:,:,:,JSV), &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThSv(:,NLES_CURRENT_TCOUNT,JSV) )
+ !
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XTHL_ANOM, XSV_ANOM(:,:,:,JSV), &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThlSv(:,NLES_CURRENT_TCOUNT,JSV) )
+ !
+ IF (LUSERV) &
+ CALL LES_FLUX_ll ( ZTHV_ANOM, XSV_ANOM(:,:,:,JSV), &
+ GUPDRAFT_MASK, &
+ XLES_UPDRAFT_ThvSv(:,NLES_CURRENT_TCOUNT,JSV) )
+ END DO
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+! 4. Downdraft diagnostics
+! ---------------------
+!
+IF (LLES_DOWNDRAFT) THEN
+!
+ DO JK=1,NLES_K
+ GDOWNDRAFT_MASK(:,:,JK) = (XW_ANOM(:,:,JK) <= 0.) .AND. LLES_CURRENT_CART_MASK(:,:,JK)
+ END DO
+!
+!
+! 4.1 Downdraft fraction
+! ------------------
+!
+ ZDOWNDRAFT(:,:,:) = 0.
+ WHERE (GDOWNDRAFT_MASK(:,:,:))
+ ZDOWNDRAFT(:,:,:) = 1.
+ END WHERE
+!
+ CALL LES_MEAN_ll ( ZDOWNDRAFT, OMASK, &
+ XLES_DOWNDRAFT(:,NLES_CURRENT_TCOUNT) )
+!
+!
+! 4.2 Downdraft mean quantities
+! -------------------------
+!
+!* vertical wind velocity
+!
+ CALL LES_MEAN_ll ( ZW_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_W(:,NLES_CURRENT_TCOUNT) )
+!
+!* potential temperature
+!
+ CALL LES_MEAN_ll ( ZTH_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Th(:,NLES_CURRENT_TCOUNT) )
+!
+!* liquid potential temperature
+!
+ IF (LUSERC) &
+ CALL LES_MEAN_ll ( ZTHL_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Thl(:,NLES_CURRENT_TCOUNT) )
+!
+!* virtual potential temperature
+!
+ IF (LUSERV) &
+ CALL LES_MEAN_ll ( ZTHV_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Thv(:,NLES_CURRENT_TCOUNT) )
+!
+!* vapor mixing ratio
+!
+ IF (LUSERV) &
+ CALL LES_MEAN_ll ( ZRV_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Rv(:,NLES_CURRENT_TCOUNT) )
+!
+!* cloud water mixing ratio
+!
+ IF (LUSERC) &
+ CALL LES_MEAN_ll ( ZRC_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Rc(:,NLES_CURRENT_TCOUNT) )
+!
+!* rain mixing ratio
+!
+ IF (LUSERR) &
+ CALL LES_MEAN_ll ( ZRR_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Rr(:,NLES_CURRENT_TCOUNT) )
+!
+!* cloud ice mixing ratio
+!
+ IF (LUSERI) &
+ CALL LES_MEAN_ll ( ZRI_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Ri(:,NLES_CURRENT_TCOUNT) )
+!
+!* snow mixing ratio
+!
+ IF (LUSERS) &
+ CALL LES_MEAN_ll ( ZRS_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Rs(:,NLES_CURRENT_TCOUNT) )
+!
+!* graupel mixing ratio
+!
+ IF (LUSERG) &
+ CALL LES_MEAN_ll ( ZRG_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Rg(:,NLES_CURRENT_TCOUNT) )
+!
+!* hail mixing ratio
+!
+ IF (LUSERH) &
+ CALL LES_MEAN_ll ( ZRG_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Rh(:,NLES_CURRENT_TCOUNT) )
+!
+!* scalar variables
+!
+ DO JSV=1,NSV
+ CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Sv(:,NLES_CURRENT_TCOUNT,JSV) )
+ END DO
+!
+!* subgrid turbulent kinetic energy
+!
+ CALL LES_MEAN_ll ( ZTKE_LES, GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Tke(:,NLES_CURRENT_TCOUNT) )
+!
+!
+! 4.3 Downdraft resolved quantities
+! -----------------------------
+!
+!* resolved turbulent kinetic energy
+!
+ CALL LES_FLUX_ll ( XU_ANOM, XU_ANOM, &
+ GDOWNDRAFT_MASK, &
+ ZLES_DOWNDRAFT_U2(:) )
+
+ CALL LES_FLUX_ll ( XV_ANOM, XV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ ZLES_DOWNDRAFT_V2(:) )
+
+ CALL LES_FLUX_ll ( XW_ANOM, XW_ANOM, &
+ GDOWNDRAFT_MASK, &
+ ZLES_DOWNDRAFT_W2(:) )
+
+ XLES_DOWNDRAFT_Ke(:,NLES_CURRENT_TCOUNT) = 0.5 * ( ZLES_DOWNDRAFT_U2(:) &
+ + ZLES_DOWNDRAFT_V2(:) &
+ + ZLES_DOWNDRAFT_W2(:) )
+!
+!* vertical potential temperature flux
+!
+ CALL LES_FLUX_ll ( XW_ANOM, ZTH_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_WTh(:,NLES_CURRENT_TCOUNT) )
+!
+!* vertical liquid potential temperature flux
+!
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XW_ANOM, XTHL_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_WThl(:,NLES_CURRENT_TCOUNT) )
+!
+!* vertical virtual potential temperature flux
+!
+ IF (LUSERV) &
+ CALL LES_FLUX_ll ( XW_ANOM, ZTHV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_WThv(:,NLES_CURRENT_TCOUNT) )
+!
+!* potential temperature variance
+!
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZTH_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Th2(:,NLES_CURRENT_TCOUNT) )
+!
+!* liquid potential temperature variance
+!
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XTHL_ANOM, XTHL_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Thl2(:,NLES_CURRENT_TCOUNT) )
+!
+!* potential temperature - virtual potential temperature covariance
+!
+ IF (LUSERV) &
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZTHV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThThv (:,NLES_CURRENT_TCOUNT) )
+!
+!* liquid potential temperature - virtual potential temperature covariance
+!
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZTHV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThlThv(:,NLES_CURRENT_TCOUNT) )
+!
+!
+!* water vapor mixing ratio flux, variance and correlations
+!
+ IF (LUSERV) THEN
+ CALL LES_FLUX_ll ( XW_ANOM, ZRV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_WRv(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZRV_ANOM, ZRV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Rv2(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThRv (:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThvRv(:,NLES_CURRENT_TCOUNT) )
+ !
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRV_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThlRv(:,NLES_CURRENT_TCOUNT) )
+ END IF
+!
+!* cloud water mixing ratio flux
+!
+ IF (LUSERC) THEN
+ CALL LES_FLUX_ll ( XW_ANOM, ZRC_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_WRc(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZRC_ANOM, ZRC_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Rc2(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRC_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThRc (:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRC_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThvRc(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRC_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThlRc(:,NLES_CURRENT_TCOUNT) )
+ END IF
+!
+!* cloud ice mixing ratio flux
+!
+ IF (LUSERI) THEN
+ CALL LES_FLUX_ll ( XW_ANOM, ZRI_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_WRi(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZRI_ANOM, ZRI_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Ri2(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTH_ANOM, ZRI_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThRi (:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( ZTHV_ANOM, ZRI_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThvRi(:,NLES_CURRENT_TCOUNT) )
+ !
+ CALL LES_FLUX_ll ( XTHL_ANOM, ZRI_ANOM, &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThlRi(:,NLES_CURRENT_TCOUNT) )
+ END IF
+!
+!* scalar variables flux
+!
+ DO JSV=1,NSV
+ CALL LES_FLUX_ll ( XW_ANOM, XSV_ANOM(:,:,:,JSV), &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_WSv(:,NLES_CURRENT_TCOUNT,JSV) )
+ !
+ CALL LES_FLUX_ll ( XSV_ANOM(:,:,:,JSV), XSV_ANOM(:,:,:,JSV), &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_Sv2(:,NLES_CURRENT_TCOUNT,JSV) )
+ !
+ CALL LES_FLUX_ll ( ZTH_ANOM, XSV_ANOM(:,:,:,JSV), &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThSv(:,NLES_CURRENT_TCOUNT,JSV) )
+ !
+ IF (LUSERC) &
+ CALL LES_FLUX_ll ( XTHL_ANOM, XSV_ANOM(:,:,:,JSV), &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThlSv(:,NLES_CURRENT_TCOUNT,JSV) )
+ !
+ IF (LUSERV) &
+ CALL LES_FLUX_ll ( ZTHV_ANOM, XSV_ANOM(:,:,:,JSV), &
+ GDOWNDRAFT_MASK, &
+ XLES_DOWNDRAFT_ThvSv(:,NLES_CURRENT_TCOUNT,JSV) )
+ END DO
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+! 5. surface or 2D variables (only for the cartesian mask)
+! -----------------------
+!
+!* surface flux of temperature Qo
+!
+CALL LES_MEAN_MPROC ( XLES_Q0 (NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
+!
+!* surface flux of water vapor Eo
+!
+CALL LES_MEAN_MPROC ( XLES_E0 (NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
+!
+!* surface flux for scalar variables
+!
+DO JSV=1,NSV
+ CALL LES_MEAN_MPROC ( XLES_SV0 (NLES_CURRENT_TCOUNT,JSV), IAVG_PTS(1), IUND_PTS(1) )
+END DO
+!
+!* surface flux of U wind component
+!
+CALL LES_MEAN_MPROC ( XLES_UW0 (NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
+!
+!* surface flux of V wind component
+!
+CALL LES_MEAN_MPROC ( XLES_VW0 (NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
+!
+!* friction velocity u*
+!
+!* average of local u*
+!!CALL LES_MEAN_MPROC ( XLES_USTAR(NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
+!* or true global u*
+XLES_USTAR(NLES_CURRENT_TCOUNT) = SQRT(SQRT(XLES_UW0(NLES_CURRENT_TCOUNT)**2 &
+ +XLES_VW0(NLES_CURRENT_TCOUNT)**2 ))
+!
+!* Boundary layer height
+!
+IF (CBL_HEIGHT_DEF=='WTV') THEN
+!
+!* level where temperature flux is minimum
+!
+ALLOCATE(ZWORK(SIZE(XLES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,IMASK),1)))
+ZWORK=XLES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,IMASK)
+WHERE(ZWORK==XUNDEF) ZWORK=0.
+
+ IF (LUSERC) THEN
+ IKMIN_FLUX = MINLOC( XLES_RESOLVED_WThv(:,NLES_CURRENT_TCOUNT,1) &
+ + XLES_SUBGRID_WThl (:,NLES_CURRENT_TCOUNT,1) &
+ + ZWORK & ! flux if EDKF
+ + (XRV/XRD - 1.) *( XLES_SUBGRID_WRt (:,NLES_CURRENT_TCOUNT,1) &
+ -XLES_SUBGRID_WRc (:,NLES_CURRENT_TCOUNT,1)) )
+ ELSE IF (LUSERV) THEN
+ IKMIN_FLUX = MINLOC( XLES_RESOLVED_WThv(:,NLES_CURRENT_TCOUNT,1) &
+ + ZWORK & ! flux if EDKF
+ + XLES_SUBGRID_WThl (:,NLES_CURRENT_TCOUNT,1) &
+ + (XRV/XRD - 1.) * XLES_SUBGRID_WRt (:,NLES_CURRENT_TCOUNT,1) )
+ ELSE
+ IKMIN_FLUX = MINLOC( XLES_RESOLVED_WTh(:,NLES_CURRENT_TCOUNT,1) &
+ + ZWORK & ! flux if EDKF
+ + XLES_SUBGRID_WThl(:,NLES_CURRENT_TCOUNT,1) )
+ END IF
+DEALLOCATE(ZWORK)
+!
+!* boundary layer height
+!
+ XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(IKMIN_FLUX(1)) - XLES_ZS
+!
+ELSE IF (CBL_HEIGHT_DEF=='DTH') THEN
+ IKMAX_TH=MAXLOC( ZLES_MEAN_DTHDZ(:))
+ XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(IKMAX_TH(1)) - XLES_ZS
+!
+ELSE IF (CBL_HEIGHT_DEF=='KE ') THEN
+
+ XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(NLES_K) - XLES_ZS
+!
+!* total Turbulent Kinetic Energy
+!
+ ZKE_TOT(:) = 0.
+!
+ ZKE_TOT(:) = ZKE_TOT(:) + XLES_SUBGRID_TKE (:,NLES_CURRENT_TCOUNT,1)
+!
+ IF (CTURBLEN/='BL89' .AND. CTURBLEN/='RM17' .AND. LLES_RESOLVED) &
+ ZKE_TOT(:) = ZKE_TOT(:) + XLES_RESOLVED_KE(:,NLES_CURRENT_TCOUNT,1)
+!
+ ZINT_KE_TOT = 0.
+!
+!* integration of total kinetic energy on boundary layer depth
+!
+ ZINT_KE_TOT = ZINT_KE_TOT +XLES_Z(1)*ZKE_TOT(1)
+ DO JK=1,NLES_K-1
+ ZINT_KE_TOT = ZINT_KE_TOT + (XLES_Z(JK+1)-XLES_Z(JK)) &
+ * 0.5 *( ZKE_TOT(JK+1) + ZKE_TOT(JK) )
+!
+!* test of total kinetic energy smaller than 5% of the averaged value below
+!
+ IF ( ZKE_TOT(JK+1) < 0.05 * ZINT_KE_TOT / (XLES_Z(JK+1)-XLES_Z(1)) ) THEN
+ XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(JK) - XLES_ZS
+ EXIT
+ END IF
+!
+ END DO
+!
+ELSE IF (CBL_HEIGHT_DEF=='TKE') THEN
+
+ XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(NLES_K) - XLES_ZS
+!
+!* subgrid Turbulent Kinetic Energy
+!
+ ZKE_TOT(:) = XLES_SUBGRID_TKE (:,NLES_CURRENT_TCOUNT,1)
+!
+ ZINT_KE_TOT = 0.
+!
+!* integration of subgrid kinetic energy on boundary layer depth
+!
+ DO JK=1,NLES_K-1
+ ZINT_KE_TOT = ZINT_KE_TOT + (XLES_Z(JK+1)-XLES_Z(JK)) &
+ * 0.5 *( ZKE_TOT(JK+1) + ZKE_TOT(JK) )
+!
+!* test of subgrid kinetic energy smaller than 0.1% of the averaged value below
+!
+ IF ( ZKE_TOT(JK+1) < 0.001 * ZINT_KE_TOT / (XLES_Z(JK+1)-XLES_Z(1)) ) THEN
+ XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(JK) - XLES_ZS
+ EXIT
+ END IF
+ END DO
+ELSE IF (CBL_HEIGHT_DEF=='FRI') THEN
+ ZFRIC_LES = SQRT( ( XLES_SUBGRID_WU (:,NLES_CURRENT_TCOUNT,1) &
+ +XLES_RESOLVED_WU(:,NLES_CURRENT_TCOUNT,1))**2 &
+ +( XLES_SUBGRID_WV (:,NLES_CURRENT_TCOUNT,1) &
+ +XLES_RESOLVED_WV(:,NLES_CURRENT_TCOUNT,1))**2 )
+ ZFRIC_SURF = XLES_USTAR(NLES_CURRENT_TCOUNT)**2
+ CALL BL_DEPTH_DIAG(YLDIMPHYEX,ZFRIC_SURF, XLES_ZS, &
+ ZFRIC_LES, XLES_Z, &
+ XFTOP_O_FSURF,XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT))
+END IF
+!
+!
+!* integration of total kinetic energy on boundary layer depth
+!
+XLES_INT_TKE(NLES_CURRENT_TCOUNT)=ZINT_KE_TOT
+ !* integration of tke
+ ZTKET_LES(:,:) = 0.
+ DO JK=1,NLES_K-1
+ ZKE_LES(:,:,JK)=0.5*(XU_ANOM(:,:,JK)*XU_ANOM(:,:,JK)+&
+ XV_ANOM(:,:,JK)*XV_ANOM(:,:,JK)+XW_ANOM(:,:,JK)*XW_ANOM(:,:,JK))
+
+ ZTKET_LES(:,:) = ZTKET_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
+ * (ZTKE_LES(:,:,JK)+ZKE_LES(:,:,JK))
+ END DO
+ CALL LES_MEAN_ll ( ZTKET_LES, LLES_CURRENT_CART_MASK(:,:,1), &
+ XLES_INT_TKE(NLES_CURRENT_TCOUNT) )
+!
+!* convective velocity
+!
+XLES_WSTAR(NLES_CURRENT_TCOUNT) = 0.
+!
+IF ( XLES_Q0(NLES_CURRENT_TCOUNT) &
+ + (XRV/XRD-1.)*XLES_E0(NLES_CURRENT_TCOUNT) >0.) THEN
+ IF (LUSERV) THEN
+ XLES_WSTAR(NLES_CURRENT_TCOUNT) = &
+ ( XG / XLES_MEAN_Thv (1,NLES_CURRENT_TCOUNT,1) &
+ * ( XLES_Q0( NLES_CURRENT_TCOUNT ) &
+ + (XRV/XRD - 1.) * XLES_E0( NLES_CURRENT_TCOUNT )) &
+ * XLES_BL_HEIGHT( NLES_CURRENT_TCOUNT ) &
+ ) ** (1./3.)
+ ELSE
+ XLES_WSTAR(NLES_CURRENT_TCOUNT) = &
+ ( XG / XLES_MEAN_Th (1,NLES_CURRENT_TCOUNT,1) &
+ * ( XLES_Q0( NLES_CURRENT_TCOUNT ) &
+ + (XRV/XRD - 1.) * XLES_E0( NLES_CURRENT_TCOUNT )) &
+ * XLES_BL_HEIGHT( NLES_CURRENT_TCOUNT ) &
+ ) ** (1./3.)
+ END IF
+END IF
+!
+!* cloud base height
+ IF (LUSERC) THEN
+ ZINT_RHOKE =0.
+ JJ=1
+ DO JI=1,NLES_K
+ IF ((ZINT_RHOKE .EQ. 0) .AND. &
+ (XLES_MEAN_RC(JI,NLES_CURRENT_TCOUNT,1) .GT. 1.E-6)) THEN
+ ZINT_RHOKE=1.
+ JJ=JI
+ END IF
+ END DO
+ XLES_ZCB(NLES_CURRENT_TCOUNT)= XLES_Z(JJ)-XLES_ZS
+ ENDIF
+!
+!* height of max of cf
+ IF (LUSERC) THEN
+ IKMAX_CF= MAXLOC( XLES_MEAN_INDCf(:,NLES_CURRENT_TCOUNT,1))
+ XLES_ZMAXCF(NLES_CURRENT_TCOUNT) = XLES_Z(IKMAX_CF(1)) - XLES_ZS
+ IKMAX_CF= MAXLOC( XLES_MEAN_INDCf2(:,NLES_CURRENT_TCOUNT,1))
+ XLES_ZMAXCF2(NLES_CURRENT_TCOUNT) = XLES_Z(IKMAX_CF(1)) - XLES_ZS
+ ENDIF
+!
+!* Monin-Obukhov length
+!
+XLES_MO_LENGTH(NLES_CURRENT_TCOUNT) = 0.
+!
+IF (LUSERV) THEN
+ IF ( XLES_Q0(NLES_CURRENT_TCOUNT)+(XRV/XRD-1.)*XLES_E0(NLES_CURRENT_TCOUNT) /=0. )&
+ XLES_MO_LENGTH(NLES_CURRENT_TCOUNT) = (- (XLES_USTAR(NLES_CURRENT_TCOUNT))**3) &
+ / (XKARMAN*( XLES_Q0(NLES_CURRENT_TCOUNT) &
+ +(XRV/XRD-1.)*XLES_E0(NLES_CURRENT_TCOUNT)) &
+ *XG/XLES_MEAN_Thv(1,NLES_CURRENT_TCOUNT,1) )
+ELSE
+ IF ( XLES_Q0(NLES_CURRENT_TCOUNT) /=0. ) &
+ XLES_MO_LENGTH(NLES_CURRENT_TCOUNT) = (- (XLES_USTAR(NLES_CURRENT_TCOUNT))**3) &
+ / (XKARMAN*XLES_Q0(NLES_CURRENT_TCOUNT) &
+ *XG/XLES_MEAN_Th(1,NLES_CURRENT_TCOUNT,1) )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+! 6. correlations along x and y axes
+! -------------------------------
+!
+!* u * u
+!
+DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZU_SPEC(:,:,JK), ZU_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_UU(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_UU(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* v * v
+!
+DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZV_SPEC(:,:,JK), ZV_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_VV(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_VV(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* u * v
+!
+DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZU_SPEC(:,:,JK), ZV_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_UV(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_UV(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* w * u
+!
+DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZU_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WU(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_WU(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* w * v
+!
+DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZV_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WV(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_WV(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* w * w
+!
+DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZW_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WW(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_WW(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* w * th
+!
+DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZTH_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WTh(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_WTh(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* w * thl
+!
+DO JK=1,NSPECTRA_K
+ IF (LUSERC) &
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZTHL_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WThl(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_WThl(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* th * th
+!
+DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZTH_SPEC(:,:,JK), ZTH_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_ThTh(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_ThTh(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* thl * thl
+!
+DO JK=1,NSPECTRA_K
+ IF (LUSERC) &
+ CALL LES_HOR_CORR( ZTHL_SPEC(:,:,JK), ZTHL_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_ThlThl(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_ThlThl(:,JK,NLES_CURRENT_TCOUNT) )
+END DO
+!
+!* correlations with water vapor
+!
+IF (LUSERV) THEN
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZRV_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WRv(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_WRv(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZTH_SPEC(:,:,JK), ZRV_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_ThRv(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_ThRv(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ IF (LUSERC) &
+ CALL LES_HOR_CORR( ZTHL_SPEC(:,:,JK), ZRV_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_ThlRv(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_ThlRv(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZRV_SPEC(:,:,JK), ZRV_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_RvRv(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_RvRv(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+END IF
+!
+!
+!* correlations with cloud water
+!
+IF (LUSERC) THEN
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZRC_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WRc(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_WRc(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZTH_SPEC(:,:,JK), ZRC_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_ThRc(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_ThRc(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZTHL_SPEC(:,:,JK), ZRC_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_ThlRc(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_ThlRc(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZRC_SPEC(:,:,JK), ZRC_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_RcRc(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_RcRc(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+END IF
+!
+!* correlations with cloud ice
+!
+IF (LUSERI) THEN
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZRI_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WRi(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_WRi(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZTH_SPEC(:,:,JK), ZRI_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_ThRi(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_ThRi(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZTHL_SPEC(:,:,JK), ZRI_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_ThlRi(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_ThlRi(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZRI_SPEC(:,:,JK), ZRI_SPEC(:,:,JK), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_RiRi(:,JK,NLES_CURRENT_TCOUNT), &
+ XCORRj_RiRi(:,JK,NLES_CURRENT_TCOUNT) )
+ END DO
+END IF
+!
+!* correlations with scalar variables
+!
+DO JSV=1,NSV
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZSV_SPEC(:,:,JK,JSV), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_WSv(:,JK,NLES_CURRENT_TCOUNT,JSV), &
+ XCORRj_WSv(:,JK,NLES_CURRENT_TCOUNT,JSV) )
+ END DO
+ !
+ DO JK=1,NSPECTRA_K
+ CALL LES_HOR_CORR( ZSV_SPEC(:,:,JK,JSV), ZSV_SPEC(:,:,JK,JSV), &
+ CLES_LBCX , CLES_LBCY, &
+ XCORRi_SvSv(:,JK,NLES_CURRENT_TCOUNT,JSV), &
+ XCORRj_SvSv(:,JK,NLES_CURRENT_TCOUNT,JSV) )
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LES
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LES_n
diff --git a/src/PHYEX/ext/modn_turbn.f90 b/src/PHYEX/ext/modn_turbn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..35b271f9cbf2fd0634245e495fa635e44220815b
--- /dev/null
+++ b/src/PHYEX/ext/modn_turbn.f90
@@ -0,0 +1,167 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODN_TURB_n
+! ###################
+!
+!!**** *MODN_TURB$n* - declaration of namelist NAM_TURBn
+!!
+!! PURPOSE
+!! -------
+! The purpose of this module is to specify the namelist NAM_TURBn
+! which concern the parameters of the turbulence scheme for one nested
+! model.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_TURB$n : contains declaration of turbulence scheme
+!! variables entering by a namelist
+!!
+!! XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX
+!! LTURB_DIAG,LSUBG_COND,LTGT_FLX
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_TURBn)
+!!
+!! AUTHOR
+!! ------
+!! J. Cuxart and J. Stein * I.N.M. and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 9, 1995
+!! J.Cuxart February 15, 1995 add the switches for diagnostic storages
+!! J. Stein June 14, 1995 add the subgrid condensation switch
+!! J. Stein October, 1999 add the tangential fluxes switch
+!! M. Tomasini Jul 05, 2001 add the subgrid autoconversion
+!! P. Bechtold Feb 11, 2002 add switch for Sigma_s computation
+!! P. Jabouille Apr 4, 2002 add switch for Sigma_s convection
+!! V. Masson Nov 13 2002 add switch for SBL lengths
+!! D. Ricard May, 2021 add switch for Leonard Terms
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TURB_n, ONLY: &
+ XIMPL_n => XIMPL, &
+ XKEMIN_n => XKEMIN, &
+ XCEDIS_n => XCEDIS, &
+ XCADAP_n => XCADAP, &
+ CTURBLEN_n => CTURBLEN, &
+ CTURBDIM_n => CTURBDIM, &
+ LTURB_FLX_n => LTURB_FLX, &
+ LTURB_DIAG_n => LTURB_DIAG, &
+ LSUBG_COND_n => LSUBG_COND, &
+ LSIGMAS_n => LSIGMAS, &
+ LSIG_CONV_n => LSIG_CONV, &
+ LRMC01_n => LRMC01, &
+ CTOM_n => CTOM, &
+ CSUBG_AUCV_n => CSUBG_AUCV, &
+ VSIGQSAT_n => VSIGQSAT, &
+ CSUBG_AUCV_RI_n => CSUBG_AUCV_RI, &
+ CCONDENS_n => CCONDENS, &
+ CLAMBDA3_n => CLAMBDA3, &
+ CSUBG_MF_PDF_n => CSUBG_MF_PDF, &
+ LLEONARD_n => LLEONARD, &
+ XCOEFHGRADTHL_n => XCOEFHGRADTHL, &
+ XCOEFHGRADRM_n => XCOEFHGRADRM, &
+ XALTHGRAD_n => XALTHGRAD, &
+ XCLDTHOLD_n => XCLDTHOLD
+!
+IMPLICIT NONE
+!
+REAL,SAVE :: XIMPL
+REAL,SAVE :: XKEMIN
+REAL,SAVE :: XCEDIS
+REAL,SAVE :: XCADAP
+CHARACTER (LEN=4),SAVE :: CTURBLEN
+CHARACTER (LEN=4),SAVE :: CTURBDIM
+LOGICAL,SAVE :: LTURB_FLX
+LOGICAL,SAVE :: LTURB_DIAG
+LOGICAL,SAVE :: LSUBG_COND
+LOGICAL,SAVE :: LSIGMAS
+LOGICAL,SAVE :: LSIG_CONV
+LOGICAL,SAVE :: LRMC01
+CHARACTER (LEN=4),SAVE :: CTOM
+CHARACTER (LEN=4),SAVE :: CSUBG_AUCV
+CHARACTER (LEN=80),SAVE :: CSUBG_AUCV_RI
+CHARACTER (LEN=80),SAVE :: CCONDENS
+CHARACTER (LEN=4),SAVE :: CLAMBDA3
+CHARACTER (LEN=80),SAVE :: CSUBG_MF_PDF
+REAL,SAVE :: VSIGQSAT
+LOGICAL,SAVE :: LLEONARD
+REAL,SAVE :: XCOEFHGRADTHL
+REAL,SAVE :: XCOEFHGRADRM
+REAL,SAVE :: XALTHGRAD
+REAL,SAVE :: XCLDTHOLD
+!
+NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
+ LSUBG_COND,LSIGMAS,LSIG_CONV,LRMC01,CTOM,CSUBG_AUCV,&
+ XKEMIN,VSIGQSAT,XCEDIS,XCADAP,CSUBG_AUCV_RI,CCONDENS,&
+ CLAMBDA3,CSUBG_MF_PDF,LLEONARD,XCOEFHGRADTHL, XCOEFHGRADRM, &
+ XALTHGRAD, XCLDTHOLD
+
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_TURBn
+ XIMPL = XIMPL_n
+ XKEMIN = XKEMIN_n
+ XCEDIS = XCEDIS_n
+ XCADAP = XCADAP_n
+ CTURBLEN = CTURBLEN_n
+ CTURBDIM = CTURBDIM_n
+ LTURB_FLX = LTURB_FLX_n
+ LTURB_DIAG = LTURB_DIAG_n
+ LSUBG_COND = LSUBG_COND_n
+ LSIGMAS = LSIGMAS_n
+ LSIG_CONV = LSIG_CONV_n
+ LRMC01 = LRMC01_n
+ CTOM = CTOM_n
+ CSUBG_AUCV = CSUBG_AUCV_n
+ VSIGQSAT = VSIGQSAT_n
+ CSUBG_AUCV_RI = CSUBG_AUCV_RI_n
+ CCONDENS = CCONDENS_n
+ CLAMBDA3 = CLAMBDA3_n
+ CSUBG_MF_PDF = CSUBG_MF_PDF_n
+ LLEONARD = LLEONARD_n
+ XCOEFHGRADTHL = XCOEFHGRADTHL_n
+ XCOEFHGRADRM = XCOEFHGRADRM_n
+ XALTHGRAD = XALTHGRAD_n
+ XCLDTHOLD = XCLDTHOLD_n
+END SUBROUTINE INIT_NAM_TURBn
+
+SUBROUTINE UPDATE_NAM_TURBn
+ XIMPL_n = XIMPL
+ XKEMIN_n = XKEMIN
+ XCEDIS_n = XCEDIS
+ XCADAP_n = XCADAP
+ CTURBLEN_n = CTURBLEN
+ CTURBDIM_n = CTURBDIM
+ LTURB_FLX_n = LTURB_FLX
+ LTURB_DIAG_n = LTURB_DIAG
+ LSUBG_COND_n = LSUBG_COND
+ LSIGMAS_n = LSIGMAS
+ LSIG_CONV_n = LSIG_CONV
+ LRMC01_n = LRMC01
+ CTOM_n = CTOM
+ CSUBG_AUCV_n = CSUBG_AUCV
+ VSIGQSAT_n = VSIGQSAT
+ CSUBG_AUCV_RI_n = CSUBG_AUCV_RI
+ CCONDENS_n = CCONDENS
+ CLAMBDA3_n = CLAMBDA3
+ CSUBG_MF_PDF_n = CSUBG_MF_PDF
+ LLEONARD_n = LLEONARD
+ XCOEFHGRADTHL_n = XCOEFHGRADTHL
+ XCOEFHGRADRM_n = XCOEFHGRADRM
+ XALTHGRAD_n = XALTHGRAD
+ XCLDTHOLD_n = XCLDTHOLD
+END SUBROUTINE UPDATE_NAM_TURBn
+
+END MODULE MODN_TURB_n
diff --git a/src/PHYEX/ext/phys_paramn.f90 b/src/PHYEX/ext/phys_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2411666072a4afe4840ebd7fa0738139875ebb78
--- /dev/null
+++ b/src/PHYEX/ext/phys_paramn.f90
@@ -0,0 +1,1694 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_PHYS_PARAM_n
+! ########################
+!
+!
+INTERFACE
+!
+ SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
+ PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PDRAG,PEOL, PTURB, &
+ PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
+!
+USE MODD_IO, ONLY: TFILEDATA
+use modd_precision, only: MNHTIME
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
+! advection schemes
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER,PEOL ! to store CPU
+ ! time for computing time
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets statistics
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
+LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+ !
+END SUBROUTINE PHYS_PARAM_n
+!
+END INTERFACE
+!
+END MODULE MODI_PHYS_PARAM_n
+!
+! ########################################################################################
+ SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
+ PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PEOL, PDRAG, PTURB, &
+ PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
+! ########################################################################################
+!
+!!**** *PHYS_PARAM_n * -monitor of the parameterizations used by model _n
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to update the sources by adding the
+! parameterized terms. This is realized by sequentially calling the
+! specialized routines.
+!
+!!** METHOD
+!! ------
+!! The first parametrization is the radiation scheme:
+!! ----------------
+!! * CRAD = 'FIXE'
+!! In this case, a temporal interpolation is performed for the downward
+!! surface fluxes XFLALWD and XFLASWD.
+!! * CRAD = 'ECMWF'
+!! Several tests are performed before calling the radiation computations
+!! interface with the ECMWF radiation scheme code. A control is made to
+!! ensure that:
+!! - the full radiation code is called at the first model timestep
+!! - there is a priority for calling the full radiation instead of the
+!! cloud-only approximation if both must be called at the current
+!! timestep
+!! - the cloud-only option (approximation) is coherent with the
+!! occurence of one cloudy vertical column at least
+!! If all the above conditions are fulfilled (GRAD is .TRUE.) then the
+!! position of the sun is computed in routine SUNPOS_n and the interfacing
+!! routine RADIATIONS is called to update the radiative tendency XDTHRAD
+!! and the downward surface fluxes XFLALWD and XFLASWD. Finally, the
+!! radiative tendency is integrated as a source term in the THETA prognostic
+!! equation.
+!!
+!! The second parameterization is the soil scheme:
+!! -----------
+!!
+!! externalized surface
+!!
+!! The third parameterization is the turbulence scheme:
+!! -----------------
+!! * CTURB='NONE'
+!! no turbulent mixing is taken into account
+!! * CTURB='TKEL'
+!! The turbulent fluxes are computed according to a one and half order
+!! closure of the hydrodynamical equations. This scheme is based on a
+!! prognostic for the turbulent kinetic energy and a mixing length
+!! computation ( the mesh size or a physically based length). Other
+!! turbulent moments are diagnosed according to a stationarization of the
+!! second order turbulent moments. This turbulent scheme forecasts
+!! either a purely vertical turbulent mixing or 3-dimensional mixing
+!! according to its internal degrees of freedom.
+!!
+!!
+!! The LAST parameterization is the chemistry scheme:
+!! -----------------
+!! The chemistry part of MesoNH has two namelists, NAM_SOLVER for the
+!! parameters concerning the stiff solver, and NAM_MNHCn concerning the
+!! configuration and options of the chemistry module itself.
+!! The switch LUSECHEM in NAM_CONF acitvates or deactivates the chemistry.
+!! The only variables of MesoNH that are modified by chemistry are the
+!! scalar variables. If calculation of chemical surface fluxes is
+!! requested, those fluxes are calculated before
+!! entering the turbulence scheme, since those fluxes are taken into
+!! account by TURB as surface boundary conditions.
+!! CAUTION: chemistry has allways to be called AFTER ALL OTHER TERMS
+!! that affect the scalar variables (dynamical terms, forcing,
+!! parameterizations (like TURB, CONVECTION), since it uses the variables
+!! XRSVS as input in case of the time-split option.
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine SUNPOS_n : computes the position of the sun
+!! Subroutine RADIATIONS : computes the radiative tendency and fluxes
+!! Subroutine TSZ0 : computes the surface from temporally
+!! interpolated Ts and given z0
+!! Subroutine ISBA : computes the surface fluxes from a soil scheme
+!! Subroutine TURB : computes the turbulence source terms
+!! Subroutine CONVECTION : computes the convection source term
+!! Subroutine CH_SURFACE_FLUX_n: computes the surface flux for chemical
+!! species
+!! Subroutine CH_MONITOR_n : computes the chemistry source terms
+!! that are applied to the scalar variables
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! USE MODD_DYN
+!! USE MODD_CONF
+!! USE MODD_CONF_n
+!! USE MODD_CURVCOR_n
+!! USE MODD_DYN_n
+!! USE MODD_FIELD_n
+!! USE MODD_GR_FIELD_n
+!! USE MODD_LSFIELD_n
+!! USE MODD_GRID_n
+!! USE MODD_LBC_n
+!! USE MODD_PARAM_RAD_n
+!! USE MODD_RADIATIONS_n
+!! USE MODD_REF_n
+!! USE MODD_LUNIT_n
+!! USE MODD_TIME_n
+!! USE MODD_CH_MNHC_n
+!!
+!! REFERENCE
+!! ---------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! J. Stein * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/01/95
+!! Modifications Feb 14, 1995 (J.Cuxart) add the I/O arguments,
+!! the director cosinus and change the names of the surface fluxes
+!! Modifications March 21, 1995 (J.M.Carriere) take into account liquid
+!! water
+!! June 30,1995 (J.Stein) initialize at 0 the surf. fluxes
+!! Modifications Sept. 1, 1995 (S.Belair) ISBA scheme
+!! Modifications Sept.25, 1995 (J.Stein) switch on the radiation scheme
+!! Modifications Sept. 11, 1995 (J.-P. Pinty) radiation scheme
+!! Nov. 15, 1995 (J.Stein) cleaning + change the temporal
+!! algorithm for the soil scheme-turbulence
+!! Jan. 23, 1996 (J.Stein) add a new option for the surface
+!! fluxes where Ts and z0 are given
+!! March 18, 1996 (J.Stein) add the cloud fraction
+!! March 28, 1996 (J.Stein) the soil scheme gives energy
+!! fluxes + cleaning
+!! June 17, 1996 (Lafore) statistics of computing time
+!! August 4, 1996 (K. Suhre) add chemistry
+!! Oct. 12, 1996 (J.Stein) use XSRCM in the turbulence
+!! scheme
+!! Nov. 18, 1996 (J.-P. Pinty) add domain translation
+!! change arg. in radiations
+!! Fev. 4, 1997 (J.Viviand) change isba's calling for ice
+!! Jun. 22, 1997 (J.Stein) change the equation system and use
+!! the absolute pressure
+!! Jul. 09, 1997 (V.Masson) add directional z0
+!! Jan. 24, 1998 (P.Bechtold) add convective transport for tracers
+!! Jan. 24, 1998 (J.-P. Pinty) split SW and LW part for radiation
+!! Mai. 10, 1999 (P.Bechtold) shallow convection
+!! Oct. 20, 1999 (P.Jabouille) domain translation for turbulence
+!! Jan. 04, 2000 (V.Masson) removes TSZ0 case
+!! Jan. 04, 2000 (V.Masson) modifies albedo computation
+! Jul 02, 2000 (F.Solmon/V.Masson) adaptation for patch approach
+!! Nov. 15, 2000 (V.Masson) LES routines
+!! Nov. 15, 2000 (V.Masson) effect of slopes on surface fluxes
+!! Feb. 02, 2001 (P.Tulet) add friction velocities and aerodynamical
+!! resistance (patch approach)
+!! Jan. 04, 2000 (V.Masson) modify surf_rad_modif computation
+!! Mar. 04, 2002 (F.Solmon) new interface for radiation call
+!! Nov. 06, 2002 (V.Masson) LES budgets & budget time counters
+!! Jan. 2004 (V.Masson) surface externalization
+!! Jan. 13, 2004 (J.Escobar) bug correction : compute "GRAD" in parallel
+!! Jan. 20, 2005 (P. Tulet) add dust sedimentation
+!! Jan. 20, 2005 (P. Tulet) climatologic SSA
+!! Jan. 20, 2005 (P. Tulet) add aerosol / dust scavenging
+!! Jul. 2005 (N. Asencio) use the two-way result-fields
+!! before ground_param call
+!! May 2006 Remove EPS
+!! Oct. 2007 (J.Pergaud) Add shallow_MF
+!! Oct. 2009 (C.Lac) Introduction of different PTSTEP according to the
+!! advection schemes
+!! Oct. 2009 (V. MAsson) optimization of Pergaud et al massflux scheme
+!! Aug. 2010 (V.Masson, C.Lac) Exchange of SBL_DEPTH for
+!! reproducibility
+!! Oct. 2010 (J.Escobar) init ZTIME_LES_MF ( pb detected with g95 )
+!! Feb. 2011 (V.Masson, C.Lac) SBL_DEPTH values on outer pts
+!! for RMC01
+!! Sept.2011 (J.Escobar) init YINST_SFU ='M'
+!!
+!! Specific for 2D modeling :
+!!
+!! 06/2010 (P.Peyrille) add Call to aerozon.f90 if LAERO_FT=T
+!! to update
+!! aerosols and ozone climatology at each call to
+!! phys_param otherwise it is constant to monthly average
+!! 03/2013 (C.Lac) FIT temporal scheme
+!! 01/2014 (C.Lac) correction for the nesting of 2D surface
+!! fields if the number of the son model does not
+!! follow the number of the dad model
+!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!! 2014 (M.Faivre)
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! 2016 B.VIE LIMA
+!! M. Leriche 02/2017 Avoid negative fluxes if sv=0 outside the physics domain
+!! C.Lac 10/2017 : ch_monitor and aer_monitor extracted from phys_param
+!! to be called directly by modeln as the last process
+!! 02/2018 Q.Libois ECRAD
+! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 21/11/2019: ZRG_HOUR and ZRAT_HOUR are now parameter arrays
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! F. Auguste 02/2021: add IBM
+! JL Redelsperger 03/2021: add the SW flux penetration for Ocean model case
+! A. Costes 12/2021: add Blaze fire model
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ADV_n, ONLY : XRTKEMS
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_BLOWSNOW, ONLY : LBLOWSNOW,XRSNOW
+USE MODD_BUDGET, ONLY: NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ TBUDGETS, xtime_bu_process, TBUCONF
+USE MODD_CH_AEROSOL
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, &! indicates if chemistry is used
+ LCH_CONV_SCAV, &
+ LCH_CONV_LINOX
+USE MODD_CLOUD_MF_n
+USE MODD_CONDSAMP
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST, ONLY : CST
+USE MODD_CTURB, ONLY : CSTURB
+USE MODD_CURVCOR_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_DEF_EDDY_FLUX_n ! Ajout PP
+USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP
+USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
+USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll
+USE MODD_DRAGBLDG_n
+USE MODD_DRAGTREE_n
+USE MODD_DUST
+USE MODD_DYN
+USE MODD_DYN_n
+USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
+USE MODD_FIELD_n
+USE MODD_FRC
+USE MODD_FRC_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_EPSI, XIBM_LS, XIBM_XMUT
+USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LATZ_EDFLX
+USE MODD_LBC_n
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_LSFIELD_n
+USE MODD_LUNIT_n
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
+USE MODD_NSV, ONLY : NSV, NSV_LGBEG, NSV_LGEND, &
+ NSV_SLTBEG,NSV_SLTEND,NSV_SLT,&
+ NSV_AERBEG,NSV_AEREND, &
+ NSV_DSTBEG,NSV_DSTEND, NSV_DST,&
+ NSV_LIMA_NR,NSV_LIMA_NS,NSV_LIMA_NG,NSV_LIMA_NH
+USE MODD_OCEANH
+USE MODD_OUT_n
+USE MODD_PARAM_C2R2, ONLY : LSEDC
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY : LSEDIC
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
+USE MODD_PARAM_MFSHALL_n
+USE MODD_PARAM_n
+USE MODD_PARAM_RAD_n
+USE MODD_PASPOL
+USE MODD_PASPOL_n
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PRECIP_n
+use modd_precision, only: MNHTIME
+USE MODD_RADIATIONS_n
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_REF_n
+USE MODD_SALT
+USE MODD_SHADOWS_n
+USE MODD_SUB_PHYS_PARAM_n
+USE MODD_TIME_n
+USE MODD_TIME_n
+USE MODD_TIME, ONLY : TDTEXP ! Ajout PP
+USE MODD_TURB_CLOUD, ONLY : CTURBLEN_CLOUD,NMODEL_CLOUD, &
+ XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT
+USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
+USE MODD_TURB_n
+
+USE MODE_AERO_PSD
+use mode_budget, only: Budget_store_end, Budget_store_init
+USE MODE_DATETIME
+USE MODE_DUST_PSD
+USE MODE_ll
+USE MODE_GATHER_ll
+USE MODE_MNH_TIMING
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+USE MODE_SALT_PSD
+
+USE MODI_AEROZON ! Ajout PP
+USE MODI_CONDSAMP
+USE MODI_CONVECTION
+USE MODI_DRAG_BLD
+USE MODI_DRAG_VEG
+USE MODI_DUST_FILTER
+USE MODI_EDDY_FLUX_n ! Ajout PP
+USE MODI_EDDY_FLUX_ONE_WAY_n ! Ajout PP
+USE MODI_EDDYUV_FLUX_n ! Ajout PP
+USE MODI_EDDYUV_FLUX_ONE_WAY_n ! Ajout PP
+USE MODI_EOL_MAIN
+USE MODI_GROUND_PARAM_n
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_W
+USE MODI_PASPOL
+USE MODI_RADIATIONS
+USE MODI_SALT_FILTER
+USE MODI_SEDIM_DUST
+USE MODI_SEDIM_SALT
+USE MODI_SHALLOW_MF_PACK
+USE MODI_SUNPOS_n
+USE MODI_SURF_RAD_MODIF
+USE MODI_SWITCH_SBG_LES_N
+USE MODI_TURB
+
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
+! advection schemes
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER,PEOL ! to store CPU
+ ! time for computing time
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets statistics
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
+LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+ !
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFU ! surface flux of x and
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFV ! y component of wind
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFTH ! surface flux of theta
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV ! surface flux of vapor
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSFSV ! surface flux of scalars
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFCO2! surface flux of CO2
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSRAD ! surface temperature
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRGDST,ZSIGDST,ZNDST,ZSVDST
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRGSLT,ZSIGSLT,ZNSLT,ZSVSLT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRGAER,ZSIGAER,ZNAER,ZSVAER
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN ! Atmospheric density and Exner
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMF ! MF contribution to XSIGS
+!
+REAL, DIMENSION(0:24), parameter :: ZRG_HOUR = (/ 0., 0., 0., 0., 0., 32.04, 114.19, &
+ 228.01, 351.25, 465.49, 557.24, &
+ 616.82, 638.33, 619.43, 566.56, &
+ 474.71, 359.20, 230.87, 115.72, &
+ 32.48, 0., 0., 0., 0., 0. /)
+!
+REAL, DIMENSION(0:24), parameter :: ZRAT_HOUR = (/ 326.00, 325.93, 325.12, 324.41, &
+ 323.16, 321.95, 322.51, 325.16, &
+ 328.01, 331.46, 335.58, 340.00, &
+ 345.20, 350.32, 354.20, 356.58, &
+ 356.56, 355.33, 352.79, 351.34, &
+ 347.00, 342.00, 337.00, 332.00, &
+ 326.00 /)
+!
+!
+character(len=6) :: ynum
+INTEGER :: IHOUR ! parameters necessary for the temporal
+REAL :: ZTIME, ZDT ! interpolation
+REAL :: ZTEMP_DIST ! time between 2 instants (in seconds)
+!
+LOGICAL :: GRAD ! conditionnal call for the full radiation
+ ! computations
+REAL :: ZRAD_GLOB_ll ! 'real' global parallel mask of 'GRAD'
+INTEGER :: INFO_ll ! error report of parallel routines
+ ! the only cloudy columns
+!
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2, ZTIME3, ZTIME4 ! for computing time analysis
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_LES_MF ! time spent in LES computation in shallow conv.
+LOGICAL :: GDCONV ! conditionnal call for the deep convection
+ ! computations
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC, ZRI, ZWT ! additional dummies
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDXDY ! grid area
+ ! for rc, ri, w required if main variables not allocated
+!
+INTEGER :: IIU, IJU, IKU ! dimensional indexes
+!
+INTEGER :: JSV ! Loop index for Scalar Variables
+INTEGER :: JSWB ! loop on SW spectral bands
+INTEGER :: IIB,IIE,IJB,IJE, IKB, IKE, JI,JJ
+INTEGER :: IMODEIDX
+ ! index values for the Beginning or the End of the physical
+ ! domain in x and y directions
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+INTEGER :: IINFO_ll ! return code of parallel routine
+!
+!* variables for writing in a fm file
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ !in LFI subroutines at the open of the file
+INTEGER :: ILUOUT ! logical unit numbers of output-listing
+INTEGER :: IMI ! model index
+INTEGER :: JKID ! loop index to look for the KID models
+REAL :: ZINIRADIUSI, ZINIRADIUSJ ! ORILAM initial radius
+REAL, DIMENSION(NMODE_DST) :: ZINIRADIUS ! DUST initial radius
+REAL, DIMENSION(NMODE_SLT) :: ZINIRADIUS_SLT ! Sea Salt initial radius
+REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), SIZE(XRSVS,4)) :: ZRSVS
+LOGICAL :: GCLD ! conditionnal call for dust wet deposition
+! * arrays to store the surface fields before radiation and convection scheme
+! calls
+INTEGER :: IMODSON ! Number of son models of IMI with XWAY=2
+INTEGER :: IKIDM ! index loop
+INTEGER :: IGRADIENTS ! Number of horizontal gradients in turb
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSAVE_DIRFLASWD, ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD
+! for ocean model
+INTEGER :: JKM , JSW ! vertical index loop
+REAL :: ZSWA,TINTSW ! index for SW interpolation and int time betwenn forcings (ocean model)
+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 !OHARAT turb option from AROME (not allocated in MNH)
+ ! to be moved as optional args for turb
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTDIFF, ZTDISS
+REAL, DIMENSION(:),ALLOCATABLE :: ZXHAT_ll,ZYHAT_ll ! Position x/y in the conformal
+ ! plane (array on the complete domain)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDIST ! distance from the center of the cooling
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZHGRAD ! horizontal gradient used in turb
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
+LOGICAL :: GCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
+!-----------------------------------------------------------------------------
+
+NULLIFY(TZFIELDS_ll)
+IMI=GET_CURRENT_MODEL_INDEX()
+!
+ILUOUT = TLUOUT%NLU
+CALL GET_DIM_EXT_ll ('B',IIU,IJU)
+IKU=SIZE(XTHT,3)
+IKB = 1 + JPVEXT
+IKE = IKU - JPVEXT
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3),.TRUE.)
+!
+ZTIME1 = 0.0_MNHTIME
+ZTIME2 = 0.0_MNHTIME
+ZTIME3 = 0.0_MNHTIME
+ZTIME4 = 0.0_MNHTIME
+PTIME_BU = 0._MNHTIME
+ZTIME_LES_MF = 0.0_MNHTIME
+PWETDEPAER(:,:,:,:) = 0.
+!
+!* allocation of variables used in more than one parameterization
+!
+ALLOCATE(ZSFU (IIU,IJU)) ! surface schemes + turbulence
+ALLOCATE(ZSFV (IIU,IJU))
+ALLOCATE(ZSFTH (IIU,IJU))
+ALLOCATE(ZSFRV (IIU,IJU))
+ALLOCATE(ZSFSV (IIU,IJU,NSV))
+ALLOCATE(ZSFCO2(IIU,IJU))
+!
+!* if XWAY(son)=2 save surface fields before radiation or convective scheme
+! calls
+!
+IMODSON = 0
+DO JKID = IMI+1,NMODEL ! min value of the possible kids
+ IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. CPROGRAM=='MESONH' &
+ .AND. (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
+ IMODSON = IMODSON + 1
+ END IF
+END DO
+!
+ IF (IMODSON /= 0 ) THEN
+ IF (LUSERC .AND. ( &
+ (LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
+ (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
+ (MSEDC .AND. CCLOUD=='LIMA') &
+ )) THEN
+ ALLOCATE( ZSAVE_INPRC(SIZE(XINPRC,1),SIZE(XINPRC,2),IMODSON))
+ ELSE
+ ALLOCATE( ZSAVE_INPRC(0,0,0))
+ END IF
+ IF (LUSERR) THEN
+ ALLOCATE( ZSAVE_INPRR(SIZE(XINPRR,1),SIZE(XINPRR,2),IMODSON))
+ ELSE
+ ALLOCATE( ZSAVE_INPRR(0,0,0))
+ END IF
+ IF (LUSERS) THEN
+ ALLOCATE( ZSAVE_INPRS(SIZE(XINPRS,1),SIZE(XINPRS,2),IMODSON))
+ ELSE
+ ALLOCATE( ZSAVE_INPRS(0,0,0))
+ END IF
+ IF (LUSERG) THEN
+ ALLOCATE( ZSAVE_INPRG(SIZE(XINPRG,1),SIZE(XINPRG,2),IMODSON))
+ ELSE
+ ALLOCATE( ZSAVE_INPRG(0,0,0))
+ END IF
+ IF (LUSERH) THEN
+ ALLOCATE( ZSAVE_INPRH(SIZE(XINPRH,1),SIZE(XINPRH,2),IMODSON))
+ ELSE
+ ALLOCATE( ZSAVE_INPRH(0,0,0))
+ END IF
+ IF (CDCONV /= 'NONE') THEN
+ ALLOCATE( ZSAVE_PRCONV(SIZE(XPRCONV,1),SIZE(XPRCONV,2),IMODSON))
+ ALLOCATE( ZSAVE_PRSCONV(SIZE(XPRSCONV,1),SIZE(XPRSCONV,2),IMODSON))
+ ELSE
+ ALLOCATE( ZSAVE_PRCONV(0,0,0))
+ ALLOCATE( ZSAVE_PRSCONV(0,0,0))
+ END IF
+ IF (CRAD /= 'NONE') THEN
+ ALLOCATE( ZSAVE_DIRFLASWD(SIZE(XDIRFLASWD,1),SIZE(XDIRFLASWD,2),SIZE(XDIRFLASWD,3),IMODSON))
+ ALLOCATE( ZSAVE_SCAFLASWD(SIZE(XSCAFLASWD,1),SIZE(XSCAFLASWD,2),SIZE(XSCAFLASWD,3),IMODSON))
+ ALLOCATE( ZSAVE_DIRSRFSWD(SIZE(XDIRSRFSWD,1),SIZE(XDIRSRFSWD,2),SIZE(XDIRSRFSWD,3),IMODSON))
+ ELSE
+ ALLOCATE( ZSAVE_DIRFLASWD(0,0,0,0))
+ ALLOCATE( ZSAVE_SCAFLASWD(0,0,0,0))
+ ALLOCATE( ZSAVE_DIRSRFSWD(0,0,0,0))
+ END IF
+ ENDIF
+!
+IKIDM=0
+DO JKID = IMI+1,NMODEL ! min value of the possible kids
+ IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. CPROGRAM=='MESONH' &
+ .AND. (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
+! BUG if number of the son does not follow the number of the dad
+! IKIDM = JKID-IMI
+ IKIDM = IKIDM + 1
+ IF (LUSERC .AND. ( &
+ (LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
+ (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
+ (MSEDC .AND. CCLOUD=='LIMA') &
+ )) THEN
+ ZSAVE_INPRC(:,:,IKIDM) = XINPRC(:,:)
+ END IF
+ IF (LUSERR) THEN
+ ZSAVE_INPRR(:,:,IKIDM) = XINPRR(:,:)
+ END IF
+ IF (LUSERS) THEN
+ ZSAVE_INPRS(:,:,IKIDM) = XINPRS(:,:)
+ END IF
+ IF (LUSERG) THEN
+ ZSAVE_INPRG(:,:,IKIDM) = XINPRG(:,:)
+ END IF
+ IF (LUSERH) THEN
+ ZSAVE_INPRH(:,:,IKIDM) = XINPRH(:,:)
+ END IF
+ IF (CDCONV /= 'NONE') THEN
+ ZSAVE_PRCONV(:,:,IKIDM) = XPRCONV(:,:)
+ ZSAVE_PRSCONV(:,:,IKIDM) = XPRSCONV(:,:)
+ END IF
+ IF (CRAD /= 'NONE') THEN
+ ZSAVE_DIRFLASWD(:,:,:,IKIDM) = XDIRFLASWD(:,:,:)
+ ZSAVE_SCAFLASWD(:,:,:,IKIDM) = XSCAFLASWD(:,:,:)
+ ZSAVE_DIRSRFSWD(:,:,:,IKIDM) = XDIRSRFSWD(:,:,:)
+ END IF
+ ENDIF
+END DO
+!
+!-----------------------------------------------------------------------------
+!
+!* 1. RADIATION SCHEME
+! ----------------
+!
+!
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+CALL SECOND_MNH2(ZTIME1)
+!
+!
+!* 1.1 Tests to control how the radiation package should be called (at the current timestep)
+! -----------------------------------------------------------
+!
+!
+GRAD = .FALSE.
+OCLOUD_ONLY = .FALSE.
+!
+IF (CRAD /='NONE') THEN
+!
+! test to see if the partial radiations for cloudy must be called
+!
+ IF (CRAD =='ECMW' .OR. CRAD =='ECRA') THEN
+ CALL DATETIME_DISTANCE(TDTRAD_CLONLY,TDTCUR,ZTEMP_DIST)
+ IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTRAD_CLONLY/XTSTEP))==0 ) THEN
+ TDTRAD_CLONLY = TDTCUR
+ GRAD = .TRUE.
+ OCLOUD_ONLY = .TRUE.
+ END IF
+ END IF
+!
+! test to see if the full radiations must be called
+!
+ CALL DATETIME_DISTANCE(TDTCUR,TDTRAD_FULL,ZTEMP_DIST)
+ IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTRAD/XTSTEP))==0 ) THEN
+ TDTRAD_FULL = TDTCUR
+ GRAD = .TRUE.
+ OCLOUD_ONLY = .FALSE.
+ END IF
+!
+! tests to see if any cloud exists
+!
+ IF (CRAD =='ECMW' .OR. CRAD =='ECRA') THEN
+ IF (GRAD .AND. NRR.LE.3 ) THEN
+ IF( MAX(MAXVAL(XCLDFR(:,:,:)),MAXVAL(XICEFR(:,:,:))).LE. 1.E-10 .AND. OCLOUD_ONLY ) THEN
+ GRAD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no clouds
+ END IF
+ END IF
+!
+ IF (GRAD .AND. NRR.GE.4 ) THEN
+ IF( CCLOUD(1:3)=='ICE' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. OCLOUD_ONLY ) THEN
+ GRAD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='C3R5' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. OCLOUD_ONLY ) THEN
+ GRAD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='LIMA' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. OCLOUD_ONLY ) THEN
+ GRAD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ END IF
+ END IF
+!
+END IF
+!
+! global parallel mask for 'GRAD'
+ZRAD_GLOB_ll = 0.0
+IF (GRAD) ZRAD_GLOB_ll = 1.0
+CALL REDUCESUM_ll(ZRAD_GLOB_ll,INFO_ll)
+if (ZRAD_GLOB_ll .NE. 0.0 ) GRAD = .TRUE.
+!
+!
+IF( GRAD ) THEN
+ ALLOCATE(ZCOSZEN(IIU,IJU))
+ ALLOCATE(ZSINZEN(IIU,IJU))
+ ALLOCATE(ZAZIMSOL(IIU,IJU))
+!
+!
+!* 1.2. Astronomical computations
+! -------------------------
+!
+! Ajout PP
+IF (.NOT. OCLOUD_ONLY .AND. KTCOUNT /= 1) THEN
+ IF (LAERO_FT) THEN
+ CALL AEROZON (XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
+ NDLON,NFLEV,CAER,NAER,NSTATM, &
+ XSINDEL,XCOSDEL,XTSIDER,XCORSOL, &
+ XSTATM,XOZON, XAER)
+ XAER_CLIM = XAER
+ END IF
+END IF
+!
+CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
+!
+!* 1.3 Call to radiation scheme
+! ------------------------
+!
+ SELECT CASE ( CRAD )
+!
+!* 1.3.1 TOP of Atmposphere radiation
+! ----------------------------
+ CASE('TOPA')
+!
+ XFLALWD (:,:) = 300.
+ DO JSWB=1,NSWB_MNH
+ XDIRFLASWD(:,:,JSWB) = CST%XI0 * MAX(COS(XZENITH(:,:)),0.)/REAL(NSWB_MNH)
+ XSCAFLASWD(:,:,JSWB) = 0.
+ END DO
+ XDTHRAD(:,:,:) = 0.
+
+!
+!* 1.3.1 FIXEd radiative surface fluxes
+! ------------------------------
+!
+ CASE('FIXE')
+ ZTIME = MOD(TDTCUR%xtime +XLON0*240., CST%XDAY)
+ IHOUR = INT( ZTIME/3600. )
+ IF (IHOUR < 0) IHOUR=IHOUR + 24
+ ZDT = ZTIME/3600. - REAL(IHOUR)
+ XDIRFLASWD(:,:,:) =(( ZRG_HOUR(IHOUR+1)-ZRG_HOUR(IHOUR) )*ZDT + ZRG_HOUR(IHOUR)) / REAL(NSWB_MNH)
+ XFLALWD (:,:) = (ZRAT_HOUR(IHOUR+1)-ZRAT_HOUR(IHOUR))*ZDT + ZRAT_HOUR(IHOUR)
+ DO JSWB=1,NSWB_MNH
+ WHERE(ZCOSZEN(:,:)<0.) XDIRFLASWD(:,:,JSWB) = 0.
+ END DO
+
+ XSCAFLASWD(:,:,:) = XDIRFLASWD(:,:,:) * 0.2
+ XDIRFLASWD(:,:,:) = XDIRFLASWD(:,:,:) * 0.8
+ XDTHRAD(:,:,:) = 0.
+ !
+!
+!* 1.3.2 ECMWF or ECRAD radiative surface and atmospheric fluxes
+! ----------------------------------------------
+!
+ CASE('ECMW' , 'ECRA')
+ IF (LLES_MEAN) OCLOUD_ONLY=.FALSE.
+ XRADEFF(:,:,:)=0.0
+ XSWU(:,:,:)=0.0
+ XSWD(:,:,:)=0.0
+ XLWU(:,:,:)=0.0
+ XLWD(:,:,:)=0.0
+ XDTHRADSW(:,:,:)=0.0
+ XDTHRADLW(:,:,:)=0.0
+ CALL RADIATIONS( TPFILE, &
+ LCLEAR_SKY, OCLOUD_ONLY, NCLEARCOL_TM1, CEFRADL, CEFRADI, COPWSW, COPISW, &
+ COPWLW, COPILW, XFUDG, &
+ NDLON, NFLEV, NRAD_DIAG, NFLUX, NRAD, NAER, NSWB_OLD, NSWB_MNH, NLWB_MNH, &
+ NSTATM, NRAD_COLNBR, ZCOSZEN, XSEA, XCORSOL, &
+ XDIR_ALB, XSCA_ALB, XEMIS, MAX(XCLDFR,XICEFR), XCCO2, XTSRAD, XSTATM, XTHT, XRT, &
+ XPABST, XOZON, XAER,XDST_WL, XAER_CLIM, XSVT, &
+ XDTHRAD, XFLALWD, XDIRFLASWD, XSCAFLASWD, XRHODREF, XZZ , &
+ XRADEFF, XSWU, XSWD, XLWU, XLWD, XDTHRADSW, XDTHRADLW )
+!
+
+ WRITE(UNIT=ILUOUT,FMT='(" RADIATIONS called for KTCOUNT=",I6, &
+ & "with the CLOUD_ONLY option set ",L2)') KTCOUNT,OCLOUD_ONLY
+!
+ !
+ WHERE (XDIRFLASWD.LT.0.0)
+ XDIRFLASWD=0.0
+ ENDWHERE
+ !
+ WHERE (XDIRFLASWD.GT.1500.0)
+ XDIRFLASWD=1500.0
+ ENDWHERE
+ !
+ WHERE (XSCAFLASWD.LT.0.0)
+ XSCAFLASWD=0.0
+ ENDWHERE
+ !
+ WHERE (XSCAFLASWD.GT.1500.0)
+ XSCAFLASWD=1500.0
+ ENDWHERE
+ !
+ WHERE( XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) >0. )
+ XALBUV(:,:) = ( XDIR_ALB(:,:,1) * XDIRFLASWD(:,:,1) &
+ + XSCA_ALB(:,:,1) * XSCAFLASWD(:,:,1) ) &
+ / (XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) )
+ ELSEWHERE
+ XALBUV(:,:) = XDIR_ALB(:,:,1)
+ END WHERE
+!
+ END SELECT
+!
+ CALL SECOND_MNH2(ZTIME2)
+!
+ PRAD = PRAD + ZTIME2 - ZTIME1
+!
+ ZTIME1 = ZTIME2
+!
+ CALL SURF_RAD_MODIF (XMAP, XXHAT, XYHAT, &
+ ZCOSZEN, ZSINZEN, ZAZIMSOL, XZS, XZS_XY, &
+ XDIRFLASWD, XDIRSRFSWD )
+!
+!* Azimuthal angle to be sent later to surface processes
+! Defined in radian, clockwise, from North
+!
+ XAZIM = ZAZIMSOL
+!
+ CALL SECOND_MNH2(ZTIME2)
+!
+ PSHADOWS = PSHADOWS + ZTIME2 - ZTIME1
+!
+ ZTIME1 = ZTIME2
+!
+ DEALLOCATE(ZCOSZEN)
+ DEALLOCATE(ZSINZEN)
+ DEALLOCATE(ZAZIMSOL)
+!
+END IF
+!
+!
+!* 1.4 control prints
+! --------------
+!
+!* 1.5 Radiative tendency integration
+! ------------------------------
+!
+IF (CRAD /='NONE') THEN
+ if ( TBUCONF%LBUDGET_th ) call Budget_store_init( TBUDGETS(NBUDGET_TH), 'RAD', xrths(:, :, :) )
+ XRTHS(:,:,:) = XRTHS(:,:,:) + XRHODJ(:,:,:)*XDTHRAD(:,:,:)
+ if ( TBUCONF%LBUDGET_th ) call Budget_store_end ( TBUDGETS(NBUDGET_TH), 'RAD', xrths(:, :, :) )
+END IF
+!
+!
+!* 1.6 Ocean case:
+! Sfc turbulent fluxes & Radiative tendency due to SW penetrating ocean
+!
+IF (LCOUPLES) THEN
+ZSFU(:,:)= XSSUFL_C(:,:,1)
+ZSFV(:,:)= XSSVFL_C(:,:,1)
+ZSFTH(:,:)= XSSTFL_C(:,:,1)
+ZSFRV(:,:)=XSSRFL_C(:,:,1)
+ELSE
+IF (LOCEAN) THEN
+!
+ ALLOCATE( ZIZOCE(IKU)); ZIZOCE(:)=0.
+ ALLOCATE( ZPROSOL1(IKU))
+ ALLOCATE( ZPROSOL2(IKU))
+ ALLOCATE(XSSOLA(IIU,IJU))
+ ! Time interpolation
+ JSW = INT(TDTCUR%xtime/REAL(NINFRT))
+ ZSWA = TDTCUR%xtime/REAL(NINFRT)-REAL(JSW)
+ ZSFRV = 0.
+ ZSFTH = (XSSTFL_T(JSW+1)*(1.-ZSWA)+XSSTFL_T(JSW+2)*ZSWA)
+ ZSFU = (XSSUFL_T(JSW+1)*(1.-ZSWA)+XSSUFL_T(JSW+2)*ZSWA)
+ ZSFV = (XSSVFL_T(JSW+1)*(1.-ZSWA)+XSSVFL_T(JSW+2)*ZSWA)
+!
+ ZIZOCE(IKU) = XSSOLA_T(JSW+1)*(1.-ZSWA)+XSSOLA_T(JSW+2)*ZSWA
+ ZPROSOL1(IKU) = CST%XROC*ZIZOCE(IKU)
+ ZPROSOL2(IKU) = (1.-CST%XROC)*ZIZOCE(IKU)
+ IF(NVERB >= 5 ) THEN
+! WRITE(ILUOUT,*)'ZSWA JSW TDTCUR XTSTEP FT FU FV SolarR(IKU)', NINFRT, ZSWA,JSW,&
+! TDTCUR%xtime, XTSTEP, ZSFTH(2,2), ZSFU(2,2),ZSFV(2,2),ZIZOCE(IKU)
+ WRITE(ILUOUT,*)'XSSTP1,XSSTP,NINFRT,ZSWA,JSW,TDTCUR%xtime,ZSFT', &
+ XSSTFL_T(JSW+1),XSSTFL_T(JSW),NINFRT,ZSWA,JSW, TDTCUR%xtime,ZSFTH(2,2)
+ END IF
+ if ( TBUCONF%LBUDGET_th ) call Budget_store_init( TBUDGETS(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
+ DO JKM=IKU-1,2,-1
+ ZPROSOL1(JKM) = ZPROSOL1(JKM+1)* exp(-XDZZ(2,2,JKM)/CST%XD1)
+ ZPROSOL2(JKM) = ZPROSOL2(JKM+1)* exp(-XDZZ(2,2,JKM)/CST%XD2)
+ ZIZOCE(JKM) = (ZPROSOL1(JKM+1)-ZPROSOL1(JKM) + ZPROSOL2(JKM+1)-ZPROSOL2(JKM))/XDZZ(2,2,JKM)
+ ! Adding to temperature tendency, the solar radiation penetrating in ocean
+ XRTHS(:,:,JKM) = XRTHS(:,:,JKM) + XRHODJ(:,:,JKM)*ZIZOCE(JKM)
+ END DO
+ if ( TBUCONF%LBUDGET_th ) call Budget_store_end ( TBUDGETS(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
+ DEALLOCATE (XSSOLA)
+ DEALLOCATE( ZIZOCE)
+ DEALLOCATE (ZPROSOL1)
+ DEALLOCATE (ZPROSOL2)
+END IF! LOCEAN NO LCOUPLES
+END IF!NO LCOUPLES
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PRAD = PRAD + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+!
+!
+!-----------------------------------------------------------------------------
+!
+!* 2. DEEP CONVECTION SCHEME
+! ----------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+CALL SECOND_MNH2(ZTIME1)
+!
+IF( CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
+
+ if ( TBUCONF%LBUDGET_th ) call Budget_store_init( TBUDGETS(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
+ if ( TBUCONF%LBUDGET_rv ) call Budget_store_init( TBUDGETS(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
+ if ( TBUCONF%LBUDGET_rc ) call Budget_store_init( TBUDGETS(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
+ if ( TBUCONF%LBUDGET_ri ) call Budget_store_init( TBUDGETS(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
+ if ( TBUCONF%LBUDGET_sv .and. lchtrans ) then
+ do jsv = 1, size( xrsvs, 4 )
+ call Budget_store_init( TBUDGETS(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
+ end do
+ end if
+!
+! test to see if the deep convection scheme should be called
+!
+ GDCONV = .FALSE.
+!
+ CALL DATETIME_DISTANCE(TDTDCONV,TDTCUR,ZTEMP_DIST)
+ IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTCONV/XTSTEP))==0 ) THEN
+ TDTDCONV = TDTCUR
+ GDCONV = .TRUE.
+ END IF
+!
+ IF( GDCONV ) THEN
+ IF (CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
+ ALLOCATE( ZRC(IIU,IJU,IKU) )
+ ALLOCATE( ZRI(IIU,IJU,IKU) )
+ ALLOCATE( ZWT(IIU,IJU,IKU) )
+ ALLOCATE( ZDXDY(IIU,IJU) )
+ ! Compute grid area
+ ZDXDY(:,:) = SPREAD(XDXHAT(1:IIU),2,IJU) * SPREAD(XDYHAT(1:IJU),1,IIU)
+ !
+ IF( LUSERC .AND. LUSERI ) THEN
+ ZRC(:,:,:) = XRT(:,:,:,2)
+ ZRI(:,:,:) = XRT(:,:,:,4)
+ ELSE IF( LUSERC .AND. (.NOT. LUSERI) ) THEN
+ ZRC(:,:,:) = XRT(:,:,:,2)
+ ZRI(:,:,:) = 0.0
+ ELSE
+ ZRC(:,:,:) = 0.0
+ ZRI(:,:,:) = 0.0
+ END IF
+ WRITE(UNIT=ILUOUT,FMT='(" CONVECTION called for KTCOUNT=",I6)') &
+ KTCOUNT
+ IF ( LFORCING .AND. L1D ) THEN
+ ZWT(:,:,:) = XWTFRC(:,:,:)
+ ELSE
+ ZWT(:,:,:) = XWT(:,:,:)
+ ENDIF
+ IF (LDUST) CALL DUST_FILTER(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF(:,:,:))
+ IF (LSALT) CALL SALT_FILTER(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF(:,:,:))
+ IF (LCH_CONV_LINOX) THEN
+ CALL CONVECTION( XDTCONV, CDCONV, CSCONV, LREFRESH_ALL, LDOWN, NICE, &
+ LSETTADJ, XTADJD, XTADJS, LDIAGCONV, NENSM, &
+ XPABST, XZZ, ZDXDY, &
+ XTHT, XRT(:,:,:,1), ZRC, ZRI, XUT, XVT, &
+ ZWT,XTKET(:,:,IKB), &
+ NCOUNTCONV, XDTHCONV, XDRVCONV, XDRCCONV, XDRICONV, &
+ XPRCONV, XPRSCONV, &
+ XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV, &
+ XCAPE, NCLTOPCONV, NCLBASCONV, &
+ LCHTRANS, XSVT, XDSVCONV, &
+ LUSECHEM, LCH_CONV_SCAV, LCH_CONV_LINOX, &
+ LDUST, LSALT, &
+ XRHODREF, XIC_RATE, XCG_RATE )
+ ELSE
+ CALL CONVECTION( XDTCONV, CDCONV, CSCONV, LREFRESH_ALL, LDOWN, NICE, &
+ LSETTADJ, XTADJD, XTADJS, LDIAGCONV, NENSM, &
+ XPABST, XZZ, ZDXDY, &
+ XTHT, XRT(:,:,:,1), ZRC, ZRI, XUT, XVT, &
+ ZWT,XTKET(:,:,IKB), &
+ NCOUNTCONV, XDTHCONV, XDRVCONV, XDRCCONV, XDRICONV, &
+ XPRCONV, XPRSCONV, &
+ XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV, &
+ XCAPE, NCLTOPCONV, NCLBASCONV, &
+ LCHTRANS, XSVT, XDSVCONV, &
+ LUSECHEM, LCH_CONV_SCAV, LCH_CONV_LINOX, &
+ LDUST, LSALT, &
+ XRHODREF )
+ END IF
+!
+ DEALLOCATE( ZRC )
+ DEALLOCATE( ZRI )
+ DEALLOCATE( ZWT )
+ DEALLOCATE( ZDXDY )
+ END IF
+ END IF
+!
+! Deep convection tendency integration
+!
+ XRTHS(:,:,:) = XRTHS(:,:,:) + XRHODJ(:,:,:) * XDTHCONV(:,:,:)
+ XRRS(:,:,:,1) = XRRS(:,:,:,1) + XRHODJ(:,:,:) * XDRVCONV(:,:,:)
+!
+!
+! Aerosols size distribution
+! Compute Rg and sigma before tracers convection tendency (for orilam, dust and sea
+! salt)
+!
+
+ IF ( LCHTRANS ) THEN ! update tracers for chemical transport
+ IF (LORILAM) ZRSVS(:,:,:,:) = XRSVS(:,:,:,:) !
+ IF ((LDUST)) THEN ! dust convective balance
+ ALLOCATE(ZSIGDST(IIU,IJU,IKU,NMODE_DST))
+ ALLOCATE(ZRGDST(IIU,IJU,IKU,NMODE_DST))
+ ALLOCATE(ZNDST(IIU,IJU,IKU,NMODE_DST))
+ ALLOCATE(ZSVDST(IIU,IJU,IKU,NSV_DST))
+ !
+ DO JSV=1,NMODE_DST
+ IMODEIDX = JPDUSTORDER(JSV)
+ IF (CRGUNITD=="MASS") THEN
+ ZINIRADIUS(JSV) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2)
+ ELSE
+ ZINIRADIUS(JSV) = XINIRADIUS(IMODEIDX)
+ END IF
+ ZSIGDST(:,:,:,JSV) = XINISIG(IMODEIDX)
+ ZRGDST(:,:,:,JSV) = ZINIRADIUS(JSV)
+ ZNDST(:,:,:,JSV) = XN0MIN(IMODEIDX)
+ ENDDO
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
+ ENDDO
+ CALL PPP2DUST(ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
+ PSIG3D=ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ PN3D=ZNDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
+ END IF
+ !
+ IF ((LSALT)) THEN ! sea salt convective balance
+ ALLOCATE(ZSIGSLT(IIU,IJU,IKU,NMODE_SLT))
+ ALLOCATE(ZRGSLT(IIU,IJU,IKU,NMODE_SLT))
+ ALLOCATE(ZNSLT(IIU,IJU,IKU,NMODE_SLT))
+ ALLOCATE(ZSVSLT(IIU,IJU,IKU,NSV_SLT))
+ !
+ DO JSV=1,NMODE_SLT
+ IMODEIDX = JPSALTORDER(JSV)
+ IF (CRGUNITS=="MASS") THEN
+ ZINIRADIUS_SLT(JSV) = XINIRADIUS_SLT(IMODEIDX) * &
+ EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
+ ELSE
+ ZINIRADIUS_SLT(JSV) = XINIRADIUS_SLT(IMODEIDX)
+ END IF
+ ZSIGSLT(:,:,:,JSV) = XINISIG_SLT(IMODEIDX)
+ ZRGSLT(:,:,:,JSV) = ZINIRADIUS_SLT(JSV)
+ ZNSLT(:,:,:,JSV) = XN0MIN_SLT(IMODEIDX)
+ ENDDO
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
+ ENDDO
+ CALL PPP2SALT(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
+ PSIG3D=ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ PN3D=ZNSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
+ END IF
+ !
+!
+! Compute convective tendency for all tracers
+!
+ IF (LCHTRANS) THEN
+ DO JSV = 1, SIZE(XRSVS,4)
+ XRSVS(:,:,:,JSV) = XRSVS(:,:,:,JSV) + XRHODJ(:,:,:) * XDSVCONV(:,:,:,JSV)
+ END DO
+ IF (LORILAM) THEN
+ DO JSV = NSV_AERBEG,NSV_AEREND
+ PWETDEPAER(:,:,:,JSV-NSV_AERBEG+1) = XDSVCONV(:,:,:,JSV) * XRHODJ(:,:,:)
+ XRSVS(:,:,:,JSV) = ZRSVS(:,:,:,JSV)
+ END DO
+ END IF
+ END IF
+!
+ IF ((LDUST).AND.(LCHTRANS)) THEN ! dust convective balance
+ IF (CPROGRAM == "MESONH") THEN
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
+ ENDDO
+ ELSE
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XSVT(:,:,:,JSV)
+ ENDDO
+ ENDIF
+ CALL DUST2PPP(ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ XRSVS(:,:,:,JSV) = ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) * XRHODJ(:,:,:) / XTSTEP
+ ENDDO
+ !
+ DEALLOCATE(ZSVDST)
+ DEALLOCATE(ZNDST)
+ DEALLOCATE(ZRGDST)
+ DEALLOCATE(ZSIGDST)
+ END IF
+ !
+ IF ((LSALT).AND.(LCHTRANS)) THEN ! sea salt convective balance
+ IF (CPROGRAM == "MESONH") THEN
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
+ ENDDO
+ ELSE
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XSVT(:,:,:,JSV)
+ ENDDO
+ END IF
+ CALL SALT2PPP(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ XRSVS(:,:,:,JSV) = ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) * XRHODJ(:,:,:) / XTSTEP
+ ENDDO
+ !
+ DEALLOCATE(ZSVSLT)
+ DEALLOCATE(ZNSLT)
+ DEALLOCATE(ZRGSLT)
+ DEALLOCATE(ZSIGSLT)
+ END IF
+ !
+END IF
+!
+ IF( LUSERC .AND. LUSERI ) THEN
+ XRRS(:,:,:,2) = XRRS(:,:,:,2) + XRHODJ(:,:,:) * XDRCCONV(:,:,:)
+ XRRS(:,:,:,4) = XRRS(:,:,:,4) + XRHODJ(:,:,:) * XDRICONV(:,:,:)
+!
+ ELSE IF ( LUSERC .AND. (.NOT. LUSERI) ) THEN
+!
+! If only cloud water but no cloud ice is used, the convective tendency
+! for cloud ice is added to the tendency for cloud water
+!
+ XRRS(:,:,:,2) = XRRS(:,:,:,2) + XRHODJ(:,:,:) * (XDRCCONV(:,:,:) + &
+ XDRICONV(:,:,:) )
+! and cloud ice is melted
+!
+ XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) * &
+ ( XP00/XPABST(:,:,:) )**(XRD/XCPD) * CST%XLMTT / XCPD * XDRICONV(:,:,:)
+!
+ ELSE IF ( (.NOT. LUSERC) .AND. (.NOT. LUSERI) ) THEN
+!
+! If no cloud water and no cloud ice are used the convective tendencies for these
+! variables are added to the water vapor tendency
+!
+ XRRS(:,:,:,1) = XRRS(:,:,:,1) + XRHODJ(:,:,:) * (XDRCCONV(:,:,:) + &
+ XDRICONV(:,:,:) )
+! and all cloud condensate is evaporated
+!
+ XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) / XCPD * ( &
+ CST%XLVTT * XDRCCONV(:,:,:) + CST%XLSTT * XDRICONV(:,:,:) ) *&
+ ( XP00 / XPABST(:,:,:) ) ** ( XRD / XCPD )
+ END IF
+
+ if ( TBUCONF%LBUDGET_th ) call Budget_store_end( TBUDGETS(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
+ if ( TBUCONF%LBUDGET_rv ) call Budget_store_end( TBUDGETS(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
+ if ( TBUCONF%LBUDGET_rc ) call Budget_store_end( TBUDGETS(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
+ if ( TBUCONF%LBUDGET_ri ) call Budget_store_end( TBUDGETS(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
+ if ( TBUCONF%LBUDGET_sv .and. lchtrans ) then
+ do jsv = 1, size( xrsvs, 4 )
+ call Budget_store_end( TBUDGETS(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
+ end do
+ end if
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PKAFR = PKAFR + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+!
+!-----------------------------------------------------------------------------
+!
+!* 3. TURBULENT SURFACE FLUXES
+! ------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (CSURF=='EXTE') THEN
+ CALL GOTO_SURFEX(IMI)
+!
+ IF( LTRANS ) THEN
+ XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) + XUTRANS
+ XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) + XVTRANS
+ END IF
+ !
+ ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH))
+ ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
+ ALLOCATE(ZEMIS (IIU,IJU,NLWB_MNH))
+ ALLOCATE(ZTSRAD (IIU,IJU))
+ !
+ IKIDM=0
+ DO JKID = IMI+1,NMODEL ! min value of the possible kids
+ IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. &
+ CPROGRAM=='MESONH' .AND. &
+ (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
+ ! where kids exist, use the two-way output fields (i.e. OMASKkids true)
+ ! rather than the farther calculations in radiation and convection schemes
+! BUG if number of the son does not follow the number of the dad
+! IKIDM = JKID-IMI
+ IKIDM = IKIDM + 1
+ IF (LUSERC .AND. ( &
+ (LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
+ (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
+ (MSEDC .AND. CCLOUD=='LIMA') &
+ )) THEN
+ WHERE (OMASKkids(:,:) )
+ XINPRC(:,:) = ZSAVE_INPRC(:,:,IKIDM)
+ ENDWHERE
+ END IF
+ IF (LUSERR) THEN
+ WHERE (OMASKkids(:,:) )
+ XINPRR(:,:) = ZSAVE_INPRR(:,:,IKIDM)
+ ENDWHERE
+ END IF
+ IF (LUSERS) THEN
+ WHERE (OMASKkids(:,:) )
+ XINPRS(:,:) = ZSAVE_INPRS(:,:,IKIDM)
+ ENDWHERE
+ END IF
+ IF (LUSERG) THEN
+ WHERE (OMASKkids(:,:) )
+ XINPRG(:,:) = ZSAVE_INPRG(:,:,IKIDM)
+ ENDWHERE
+ END IF
+ IF (LUSERH) THEN
+ WHERE (OMASKkids(:,:) )
+ XINPRH(:,:) = ZSAVE_INPRH(:,:,IKIDM)
+ ENDWHERE
+ END IF
+ IF (CDCONV /= 'NONE') THEN
+ WHERE (OMASKkids(:,:) )
+ XPRCONV(:,:) = ZSAVE_PRCONV(:,:,IKIDM)
+ XPRSCONV(:,:) = ZSAVE_PRSCONV(:,:,IKIDM)
+ ENDWHERE
+ END IF
+ IF (CRAD /= 'NONE') THEN
+ DO JSWB=1,NSWB_MNH
+ WHERE (OMASKkids(:,:) )
+ XDIRFLASWD(:,:,JSWB) = ZSAVE_DIRFLASWD(:,:,JSWB,IKIDM)
+ XSCAFLASWD(:,:,JSWB) = ZSAVE_SCAFLASWD(:,:,JSWB,IKIDM)
+ XDIRSRFSWD(:,:,JSWB) = ZSAVE_DIRSRFSWD(:,:,JSWB,IKIDM)
+ ENDWHERE
+ ENDDO
+ END IF
+ ENDIF
+ END DO
+ !
+ IF (IMODSON /= 0 ) THEN
+ DEALLOCATE( ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH)
+ DEALLOCATE( ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV)
+ DEALLOCATE( ZSAVE_DIRFLASWD,ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD)
+ END IF
+ CALL GROUND_PARAM_n(YLDIMPHYEX,ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
+ ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD, KTCOUNT, TPFILE )
+ !
+ IF (LIBM) THEN
+ WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
+ ZSFTH(:,:)=0.
+ ZSFRV(:,:)=0.
+ ZSFU (:,:)=0.
+ ZSFV (:,:)=0.
+ ENDWHERE
+ IF (NSV>0) THEN
+ DO JSV = 1 , NSV
+ WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI) ZSFSV(:,:,JSV)=0.
+ ENDDO
+ ENDIF
+ ENDIF
+ !
+ IF (SIZE(XEMIS)>0) THEN
+ XDIR_ALB = ZDIR_ALB
+ XSCA_ALB = ZSCA_ALB
+ XEMIS = ZEMIS
+ XTSRAD = ZTSRAD
+ END IF
+ !
+ DEALLOCATE(ZDIR_ALB)
+ DEALLOCATE(ZSCA_ALB)
+ DEALLOCATE(ZEMIS )
+ DEALLOCATE(ZTSRAD )
+ !
+ !
+ IF( LTRANS ) THEN
+ XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) - XUTRANS
+ XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) - XVTRANS
+ END IF
+!
+ELSE ! case no SURFEX (CSURF logical)
+ ZSFSV = 0.
+ ZSFCO2 = 0.
+ IF (.NOT.LOCEAN) THEN
+ ZSFTH = 0.
+ ZSFRV = 0.
+ ZSFSV = 0.
+ ZSFCO2 = 0.
+ ZSFU = 0.
+ ZSFV = 0.
+ END IF
+END IF !CSURF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PGROUND = PGROUND + ZTIME2 - ZTIME1
+!
+!-----------------------------------------------------------------------------
+!
+!* 3.1 EDDY FLUXES PARAMETRIZATION
+! ------------------
+!
+IF (IMI==1) THEN ! On calcule les flus turb. comme preconise par PP
+
+ ! Heat eddy fluxes
+ IF ( LTH_FLX ) CALL EDDY_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRTHS,XVTH_FLUX_M,XWTH_FLUX_M)
+ !
+ ! Momentum eddy fluxes
+ IF ( LUV_FLX ) CALL EDDYUV_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRHODREF,XPABSM,XRVS,XVU_FLUX_M)
+
+ELSE
+ ! TEST pour maille infèrieure à 20km ?
+ ! car pb d'instabilités ?
+ ! Pour le modèle fils, on spawne les flux du modèle père
+ ! Heat eddy fluxes
+ IF ( LTH_FLX ) CALL EDDY_FLUX_ONE_WAY_n (IMI,KTCOUNT,NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),CLBCX,CLBCY)
+ !
+ ! Momentum eddy fluxes
+ IF ( LUV_FLX ) CALL EDDYUV_FLUX_ONE_WAY_n (IMI,KTCOUNT,NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),CLBCX,CLBCY)
+ !
+END IF
+!-----------------------------------------------------------------------------
+!
+!* 4. PASSIVE POLLUTANTS
+! ------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LPASPOL) CALL PASPOL(XTSTEP, ZSFSV, ILUOUT, NVERB, TPFILE)
+!
+!
+!* 4b. PASSIVE POLLUTANTS FOR MASS-FLUX SCHEME DIAGNOSTICS
+! ---------------------------------------------------
+!
+IF (LCONDSAMP) CALL CONDSAMP(XTSTEP, ZSFSV, ILUOUT, NVERB)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PTRACER = PTRACER + ZTIME2 - ZTIME1
+!-----------------------------------------------------------------------------
+!
+!* 5a. Drag force
+! ----------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LDRAGTREE) CALL DRAG_VEG( XTSTEP, XUT, XVT, XTKET, LDEPOTREE, XVDEPOTREE, &
+ CCLOUD, XPABST, XTHT, XRT, XSVT, XRHODJ, XZZ, &
+ XRUS, XRVS, XRTKES, XRRS, XRSVS )
+!
+IF (LDRAGBLDG) CALL DRAG_BLD( XTSTEP, XUT, XVT, XTKET, XRHODJ, XZZ, XRUS, XRVS, XRTKES )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PDRAG = PDRAG + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+!
+!* 5b. Drag force from wind turbines
+! -----------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN
+ CALL EOL_MAIN(KTCOUNT,XTSTEP, &
+ XDXX,XDYY,XDZZ, &
+ XRHODJ, &
+ XUT,XVT,XWT, &
+ XRUS, XRVS, XRWS )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PEOL = PEOL + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+!
+!*
+!-----------------------------------------------------------------------------
+!
+!* 6. TURBULENCE SCHEME
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZSFTH(:,:) = ZSFTH(:,:) * XDIRCOSZW(:,:)
+ZSFRV(:,:) = ZSFRV(:,:) * XDIRCOSZW(:,:)
+DO JSV=1,NSV
+ ZSFSV(:,:,JSV) = ZSFSV(:,:,JSV) * XDIRCOSZW(:,:)
+END DO
+!
+IF (LLES_CALL) CALL SWITCH_SBG_LES_n
+!
+!
+IF ( CTURB == 'TKEL' ) THEN
+!
+
+!* 6.1 complete surface flux fields on the border
+!
+!!$ IF(NHALO == 1) THEN
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFTH, 'PHYS_PARAM_n::ZSFTH' )
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFRV, 'PHYS_PARAM_n::ZSFRV' )
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFU, 'PHYS_PARAM_n::ZSFU' )
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFV, 'PHYS_PARAM_n::ZSFV' )
+ IF(NSV >0)THEN
+ DO JSV=1,NSV
+ write ( ynum, '( I6 ) ' ) jsv
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFSV(:,:,JSV), 'PHYS_PARAM_n::ZSFSV:'//trim( adjustl( ynum ) ) )
+ END DO
+ END IF
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFCO2, 'PHYS_PARAM_n::ZSFCO2' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!!$ END IF
+!
+ CALL MPPDB_CHECK2D(ZSFU,"phys_param::ZSFU",PRECISION)
+ !
+ IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ ZSFTH(IIB-1,:)=ZSFTH(IIB,:)
+ ZSFRV(IIB-1,:)=ZSFRV(IIB,:)
+ ZSFU(IIB-1,:)=ZSFU(IIB,:)
+ ZSFV(IIB-1,:)=ZSFV(IIB,:)
+ IF (NSV>0) THEN
+ ZSFSV(IIB-1,:,:)=ZSFSV(IIB,:,:)
+ WHERE ((ZSFSV(IIB-1,:,:).LT.0.).AND.(XSVT(IIB-1,:,IKB,:).EQ.0.))
+ ZSFSV(IIB-1,:,:) = 0.
+ END WHERE
+ ENDIF
+ ZSFCO2(IIB-1,:)=ZSFCO2(IIB,:)
+ END IF
+ !
+ IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ ZSFTH(IIE+1,:)=ZSFTH(IIE,:)
+ ZSFRV(IIE+1,:)=ZSFRV(IIE,:)
+ ZSFU(IIE+1,:)=ZSFU(IIE,:)
+ ZSFV(IIE+1,:)=ZSFV(IIE,:)
+ IF (NSV>0) THEN
+ ZSFSV(IIE+1,:,:)=ZSFSV(IIE,:,:)
+ WHERE ((ZSFSV(IIE+1,:,:).LT.0.).AND.(XSVT(IIE+1,:,IKB,:).EQ.0.))
+ ZSFSV(IIE+1,:,:) = 0.
+ END WHERE
+ ENDIF
+ ZSFCO2(IIE+1,:)=ZSFCO2(IIE,:)
+ END IF
+ !
+ IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ ZSFTH(:,IJB-1)=ZSFTH(:,IJB)
+ ZSFRV(:,IJB-1)=ZSFRV(:,IJB)
+ ZSFU(:,IJB-1)=ZSFU(:,IJB)
+ ZSFV(:,IJB-1)=ZSFV(:,IJB)
+ IF (NSV>0) THEN
+ ZSFSV(:,IJB-1,:)=ZSFSV(:,IJB,:)
+ WHERE ((ZSFSV(:,IJB-1,:).LT.0.).AND.(XSVT(:,IJB-1,IKB,:).EQ.0.))
+ ZSFSV(:,IJB-1,:) = 0.
+ END WHERE
+ ENDIF
+ ZSFCO2(:,IJB-1)=ZSFCO2(:,IJB)
+ END IF
+ !
+ IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ ZSFTH(:,IJE+1)=ZSFTH(:,IJE)
+ ZSFRV(:,IJE+1)=ZSFRV(:,IJE)
+ ZSFU(:,IJE+1)=ZSFU(:,IJE)
+ ZSFV(:,IJE+1)=ZSFV(:,IJE)
+ IF (NSV>0) THEN
+ ZSFSV(:,IJE+1,:)=ZSFSV(:,IJE,:)
+ WHERE ((ZSFSV(:,IJE+1,:).LT.0.).AND.(XSVT(:,IJE+1,IKB,:).EQ.0.))
+ ZSFSV(:,IJE+1,:) = 0.
+ END WHERE
+ ENDIF
+ ZSFCO2(:,IJE+1)=ZSFCO2(:,IJE)
+ END IF
+!
+ IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) + XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) + XVTRANS
+ END IF
+!
+!
+IF(ALLOCATED(XTHW_FLUX)) THEN
+ DEALLOCATE(XTHW_FLUX)
+ ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+ELSE
+ ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+END IF
+
+IF(ALLOCATED(XRCW_FLUX)) THEN
+ DEALLOCATE(XRCW_FLUX)
+ ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+ELSE
+ ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+END IF
+!
+IF(ALLOCATED(XSVW_FLUX)) THEN
+ DEALLOCATE(XSVW_FLUX)
+ ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
+ELSE
+ ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
+END IF
+!
+GCOMPUTE_SRC=SIZE(XSIGS, 3)/=0
+!
+ALLOCATE(ZTDIFF(IIU,IJU,IKU))
+ALLOCATE(ZTDISS(IIU,IJU,IKU))
+!
+!! Compute Shape of sfc flux for Oceanic Deep Conv Case
+!
+IF (LOCEAN .AND. LDEEPOC) THEN
+ ALLOCATE(ZDIST(IIU,IJU))
+ !* 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)
+ 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.) ZSFTH(JI,JJ)=0.
+ END DO
+ END DO
+END IF !END DEEP OCEAN CONV CASE
+!
+LSTATNW = .FALSE.
+LHARAT = .FALSE.
+!
+IF(LLEONARD) THEN
+ IGRADIENTS=6
+ ALLOCATE(ZHGRAD(IIU,IJU,IKU,IGRADIENTS))
+ ZHGRAD(:,:,:,1) = GX_W_UW(XWT(:,:,:), XDXX,XDZZ,XDZX,1,IKU,1)
+ ZHGRAD(:,:,:,2) = GY_W_VW(XWT(:,:,:), XDXX,XDZZ,XDZX,1,IKU,1)
+ ZHGRAD(:,:,:,3) = GX_M_M(XTHT(:,:,:), XDXX,XDZZ,XDZX,1,IKU,1)
+ ZHGRAD(:,:,:,4) = GY_M_M(XTHT(:,:,:), XDXX,XDZZ,XDZX,1,IKU,1)
+ ZHGRAD(:,:,:,5) = GX_M_M(XRT(:,:,:,1), XDXX,XDZZ,XDZX,1,IKU,1)
+ ZHGRAD(:,:,:,6) = GY_M_M(XRT(:,:,:,1), XDXX,XDZZ,XDZX,1,IKU,1)
+END IF
+ CALL TURB( CST,CSTURB, TBUCONF, TURBN,YLDIMPHYEX,TLES, &
+ IMI, NRR, NRRL, NRRI, CLBCX, CLBCY, IGRADIENTS, NHALO, &
+ 1, NMODEL_CLOUD, &
+ NSV, NSV_LGBEG, NSV_LGEND,CPROGRAM, &
+ NSV_LIMA_NR, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
+ L2D, LNOMIXLG,LFLAT, &
+ LCOUPLES, LBLOWSNOW, LIBM, &
+ GCOMPUTE_SRC, XRSNOW, &
+ LOCEAN, LDEEPOC, LDIAG_IN_RUN, &
+ CTURBLEN_CLOUD, CCLOUD, &
+ XTSTEP, TPFILE, &
+ XDXX, XDYY, XDZZ, XDZX, XDZY, XZZ, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, XCOSSLOPE, XSINSLOPE, &
+ XRHODJ, XTHVREF, ZHGRAD, XZS, &
+ ZSFTH, ZSFRV, ZSFSV, ZSFU, ZSFV, &
+ 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, XSIGS, XWTHVMF, &
+ XTHW_FLUX, XRCW_FLUX, XSVW_FLUX,XDYP, XTHP, ZTDIFF, ZTDISS, &
+ TBUDGETS, KBUDGETS=SIZE(TBUDGETS),PLEM=XLEM,PRTKEMS=XRTKEMS, &
+ PTR=XTR, PDISS=XDISS, PCURRENT_TKE_DISS=XCURRENT_TKE_DISS, &
+ PIBM_LS=XIBM_LS(:,:,:,1), PIBM_XMUT=XIBM_XMUT, &
+ PSSTFL=XSSTFL, PSSTFL_C=XSSTFL_C, PSSRFL_C=XSSRFL_C, &
+ PSSUFL_C=XSSUFL_C, PSSVFL_C=XSSVFL_C, PSSUFL=XSSUFL, PSSVFL=XSSVFL )
+!
+DEALLOCATE(ZTDIFF)
+DEALLOCATE(ZTDISS)
+IF(LLEONARD) DEALLOCATE(ZHGRAD)
+!
+IF (LRMC01) THEN
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, XSBL_DEPTH, 'PHYS_PARAM_n::XSBL_DEPTH' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ XSBL_DEPTH(IIB-1,:)=XSBL_DEPTH(IIB,:)
+ END IF
+ IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ XSBL_DEPTH(IIE+1,:)=XSBL_DEPTH(IIE,:)
+ END IF
+ IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ XSBL_DEPTH(:,IJB-1)=XSBL_DEPTH(:,IJB)
+ END IF
+ IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ XSBL_DEPTH(:,IJE+1)=XSBL_DEPTH(:,IJE)
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME3)
+!
+!-----------------------------------------------------------------------------
+!
+!* 7. EDMF SCHEME
+! -----------
+!
+IF (CSCONV == 'EDKF') THEN
+ ALLOCATE(ZEXN (IIU,IJU,IKU))
+ ALLOCATE(ZSIGMF (IIU,IJU,IKU))
+ ZSIGMF(:,:,:)=0.
+ ZEXN(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)
+ !$20131113 check3d on ZEXN
+ CALL MPPDB_CHECK3D(ZEXN,"physparan.7::ZEXN",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZEXN, 'PHYS_PARAM_n::ZEXN' )
+ !$20131113 add update_halo_ll
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ CALL MPPDB_CHECK3D(ZEXN,"physparam.7::ZEXN",PRECISION)
+ !
+ CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, &
+ LMF_FLX,TPFILE,ZTIME_LES_MF, &
+ XIMPL_MF, XTSTEP, &
+ XDZZ, XZZ,XDXHAT(1),XDYHAT(1), &
+ XRHODJ, XRHODREF, XPABST, ZEXN, ZSFTH, ZSFRV, &
+ XTHT,XRT,XUT,XVT,XTKET,XSVT, &
+ XRTHS,XRRS,XRUS,XRVS,XRSVS, &
+ ZSIGMF,XRC_MF, XRI_MF, XCF_MF, XWTHVMF)
+!
+ELSE
+ XWTHVMF(:,:,:)=0.
+ XRC_MF(:,:,:)=0.
+ XRI_MF(:,:,:)=0.
+ XCF_MF(:,:,:)=0.
+ENDIF
+!
+CALL SECOND_MNH2(ZTIME4)
+
+ IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) - XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) - XVTRANS
+ END IF
+ IF (CMF_CLOUD == 'STAT') THEN
+ XSIGS =SQRT( XSIGS**2 + ZSIGMF**2 )
+ ENDIF
+ IF (CSCONV == 'EDKF') THEN
+ DEALLOCATE(ZSIGMF)
+ DEALLOCATE(ZEXN)
+ ENDIF
+END IF
+!
+IF (LLES_CALL) CALL SWITCH_SBG_LES_n
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PTURB = PTURB + ZTIME2 - ZTIME1 - (XTIME_LES-ZTIME_LES_MF) - XTIME_LES_BU_PROCESS &
+ - XTIME_BU_PROCESS - (ZTIME4 - ZTIME3)
+!
+PMAFL = PMAFL + ZTIME4 - ZTIME3 - ZTIME_LES_MF
+!
+PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* deallocation of variables used in more than one parameterization
+!
+DEALLOCATE(ZSFU ) ! surface schemes + turbulence
+DEALLOCATE(ZSFV )
+DEALLOCATE(ZSFTH )
+DEALLOCATE(ZSFRV )
+DEALLOCATE(ZSFSV )
+DEALLOCATE(ZSFCO2)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE PHYS_PARAM_n
+
diff --git a/src/PHYEX/ext/prep_ideal_case.f90 b/src/PHYEX/ext/prep_ideal_case.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3a340fe6f0ce0330b6727c223f8c1b89204fad26
--- /dev/null
+++ b/src/PHYEX/ext/prep_ideal_case.f90
@@ -0,0 +1,1950 @@
+!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.
+!-----------------------------------------------------------------
+! #######################
+ PROGRAM PREP_IDEAL_CASE
+! #######################
+!
+!!**** *PREP_IDEAL_CASE* - program to write an initial FM-file
+!!
+!! PURPOSE
+!! -------
+! The purpose of this program is to prepare an initial meso-NH file
+! (LFIFM and DESFM files) filled with some idealized fields.
+!
+! ---- The present version can provide two types of fields:
+!
+! 1) CIDEAL = 'CSTN' : 3D fields derived from a vertical profile with
+! --------------- n levels of constant moist Brunt Vaisala frequency
+! The vertical profile is read in EXPRE file.
+! These fields can be used for model runs
+!
+! 2) CIDEAL = 'RSOU' : 3D fields derived from a radiosounding.
+! ---------------
+! The radiosounding is read in EXPRE file.
+! The following kind of data is permitted :
+! YKIND = 'STANDARD' : Zsol, Psol, Tsol, TDsol
+! (Pressure, dd, ff) ,
+! (Pressure, T, Td)
+! YKIND = 'PUVTHVMR' : zsol, Psol, Thvsol, Rsol
+! (Pressure, U, V) ,
+! (Pressure, THv, R)
+! YKIND = 'PUVTHVHU' : zsol, Psol, Thvsol, Husol
+! (Pressure, U, V) ,
+! (Pressure, THv, Hu)
+! YKIND = 'ZUVTHVHU' : zsol, Psol, Thvsol, Husol
+! (height, U, V) ,
+! (height, THv, Hu)
+! YKIND = 'ZUVTHVMR' : zsol, Psol, Thvsol, Rsol
+! (height, U, V) ,
+! (height, THv, R)
+! YKIND = 'PUVTHDMR' : zsol, Psol, Thdsol, Rsol
+! (Pressure, U, V) ,
+! (Pressure, THd, R)
+! YKIND = 'PUVTHDHU' : zsol, Psol, Thdsol, Husol
+! (Pressure, U, V) ,
+! (Pressure, THd, Hu)
+! YKIND = 'ZUVTHDMR' : zsol, Psol, Thdsol, Rsol
+! (height, U, V) ,
+! (height, THd, R)
+! YKIND = 'ZUVTHLMR' : zsol, Psol, Thdsol, Rsol
+! (height, U, V) ,
+! (height, THl, Rt)
+!
+! These fields can be used for model runs
+!
+! Cases (1) and (2) can be balanced
+! (geostrophic, hydrostatic and anelastic balances) if desired.
+!
+! ---- The orography can be flat (YZS='FLAT'), but also
+! sine-shaped (YZS='SINE') or bell-shaped (YZS='BELL')
+!
+! ---- The U(z) profile given in the RSOU and CSTN cases can
+! be multiplied (CUFUN="Y*Z") by a function of y (function FUNUY)
+! The V(z) profile given in the RSOU and CSTN cases can
+! be multiplied (CVFUN="X*Z") by a function of x (function FUNVX).
+! If it is not the case, i.e. U(y,z)=U(z) then CUFUN="ZZZ" and
+! CVFUN="ZZZ" for V(y,z)=V(z). Instead of these separable forms,
+! non-separables functions FUNUYZ (CUFUN="Y,Z") and FUNVXZ (CVFUN="X,Z")
+! can be used to specify the wind components.
+!
+!!** METHOD
+!! ------
+!! The directives and data to perform the preparation of the initial FM
+!! file are stored in EXPRE file. This file is composed of two parts :
+!! - a namelists-format part which is present in all cases
+!! - a free-format part which contains data in cases
+!! of discretised orography (CZS='DATA')
+!! of radiosounding (CIDEAL='RSOU') or Nv=cste profile (CIDEAL='CSTN')
+!! of forced version (LFORCING=.TRUE.)
+!!
+!!
+!! The following PREP_IDEAL_CASE program :
+!!
+!! - initializes physical constants by calling INI_CST
+!!
+!! - sets default values for global variables which will be
+!! written in DESFM file and for variables in EXPRE file (namelists part)
+!! which will be written in LFIFM file.
+!!
+!! - reads the namelists part of EXPRE file which gives
+!! informations about the preinitialization to perform,
+!!
+!! - allocates memory for arrays,
+!!
+!! - initializes fields depending on the
+!! directives (CIDEAL in namelist NAM_CONF_PRE) :
+!!
+!! * grid variables :
+!! The gridpoints are regularly spaced by XDELTAX, XDELTAY.
+!! The grid is stretched along the z direction, the mesh varies
+!! from XDZGRD near the ground to XDZTOP near the top and the
+!! weigthing function is a TANH function characterized by its
+!! center and width above and under this center
+!! The orography is initialized following the kind of orography
+!! (YZS in namelist NAM_CONF_PRE) and the degrees of freedom :
+!! sine-shape ---> ZHMAX, IEXPX,IEXPY
+!! bell-shape ---> ZHMAX, ZAX,ZAY,IIZS,IJZS
+!! The horizontal grid variables are initialized following
+!! the kind of geometry (LCARTESIAN in namelist NAM_CONF_PRE)
+!! and the grid parameters XLAT0,XLON0,XBETA in both geometries
+!! and XRPK,XLONORI,XLATORI in conformal projection.
+!! In the case of initialization from a radiosounding, the
+!! date and time is read in free-part of the EXPRE file. In other
+!! cases year, month and day are set to NUNDEF and time to 0.
+!!
+!! * prognostic fields :
+!!
+!! U,V,W, Theta and r. are first determined. They are
+!! multiplied by rhoj after the anelastic reference state
+!! computation.
+!! For the CSTN and RSOU cases, the determination of
+!! Theta and rv is performed respectively by SET_RSOU
+!! and by SET_CSTN which call the common routine SET_MASS.
+!! These three routines have the following actions :
+!! --- The input vertical profile is converted in
+!! variables (U,V,thetav,r) and interpolated
+!! on a mixed grid (with VERT_COORD) as in PREP_REAL_CASE
+!! --- A variation of the u-wind component( x-model axis component)
+!! is possible in y direction, a variation of the v-wind component
+!! (y-model axis component) is possible in x direction.
+!! --- Thetav could be computed with thermal wind balance
+!! (LGEOSBAL=.TRUE. with call of SET_GEOSBAL)
+!! --- The mass fields (theta and r ) and the wind components are
+!! then interpolated on the model grid with orography as in
+!! PREP_REAL_CASE with the option LSHIFT
+!! --- An anelastic correction is applied in PRESSURE_IN_PREP in
+!! the case of non-vanishing orography.
+!!
+!! * anelastic reference state variables :
+!!
+!! 1D reference state :
+!! RSOU and CSTN cases : rhorefz and thvrefz are computed
+!! by SET_REFZ (called by SET_MASS).
+!! They are deduced from thetav and r on the model grid
+!! without orography.
+!! The 3D reference state is computed by SET_REF
+!!
+!! * The total mass of dry air is computed by TOTAL_DMASS
+!!
+!! - writes the DESFM file,
+!!
+!! - writes the LFIFM file .
+!!
+!! EXTERNAL
+!! --------
+!! DEFAULT_DESFM : to set default values for variables which can be
+!! contained in DESFM file
+!! DEFAULT_EXPRE : to set default values for other global variables
+!! which can be contained in namelist-part of EXPRE file
+!! Module MODE_GRIDPROJ : contains conformal projection routines
+!! SM_GRIDPROJ : to compute some grid variables, in
+!! case of conformal projection.
+!! Module MODE_GRIDCART : contains cartesian geometry routines
+!! SM_GRIDCART : to compute some grid variables, in
+!! case of cartesian geometry.
+!! SET_RSOU : to initialize mass fields from a radiosounding
+!! SET_CSTN : to initialize mass fields from a vertical profile of
+!! n layers of Nv=cste
+!! SET_REF : to compute rhoJ
+!! RESSURE_IN_PREP : to apply an anelastic correction in the case of
+!! non-vanishing orography
+!! IO_File_open : to open a FM-file (DESFM + LFIFM)
+!! WRITE_DESFM : to write the DESFM file
+!! WRI_LFIFM : to write the LFIFM file
+!! IO_File_close : to close a FM-file (DESFM + LFIFM)
+!!
+!! MXM,MYM,MZM : Shuman operators
+!! WGUESS : to compute W with the continuity equation from
+!! the U,V values
+!!
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : contains parameters
+!! Module MODD_DIM1 : contains dimensions
+!! Module MODD_CONF : contains configuration variables for
+!! all models
+!! Module MODD_CST : contains physical constants
+!! Module MODD_GRID : contains grid variables for all models
+!! Module MODD_GRID1 : contains grid variables
+!! Module MODD_TIME : contains time variables for all models
+!! Module MODD_TIME1 : contains time variables
+!! Module MODD_REF : contains reference state variables for
+!! all models
+!! Module MODD_REF1 : contains reference state variables
+!! Module MODD_LUNIT : contains variables which concern names
+!! and logical unit numbers of files for all models
+!! Module MODD_FIELD1 : contains prognostics variables
+!! Module MODD_GR_FIELD1 : contains the surface prognostic variables
+!! Module MODD_LSFIELD1 : contains Larger Scale fields
+!! Module MODD_DYN1 : contains dynamic control variables for model 1
+!! Module MODD_LBC1 : contains lbc control variables for model 1
+!!
+!!
+!! Module MODN_CONF1 : contains configuration variables for model 1
+!! and the NAMELIST list
+!! Module MODN_LUNIT1 : contains variables which concern names
+!! and logical unit numbers of files and
+!! the NAMELIST list
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of MESO-NH documentation (program PREP_IDEAL_CASE)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/05/94
+!! updated V. Ducrocq 27/06/94
+!! updated P.M. 27/07/94
+!! updated V. Ducrocq 23/08/94
+!! updated V. Ducrocq 01/09/94
+!! namelist changes J. Stein 26/10/94
+!! namelist changes J. Stein 04/11/94
+!! remove the second step of the geostrophic balance 14/11/94 (J.Stein)
+!! add grid stretching in the z direction + Larger scale fields +
+!! cleaning 6/12/94 (J.Stein)
+!! periodize the orography and the grid sizes in the periodic case
+!! 19/12/94 (J.Stein)
+!! correct a bug in the Larger Scale Fields initialization
+!! 19/12/94 (J.Stein)
+!! add the vertical grid stretching 02/01/95 (J. Stein)
+!! Total mass of dry air computation 02/01/95 (J.P.Lafore)
+!! add the 1D switch 13/01/95 (J. Stein)
+!! enforce a regular vertical grid if desired 18/01/95 (J. Stein)
+!! add the tdtcur initialization 26/01/95 (J. Stein)
+!! bug in the test of the type of RS localization 25/02/95 (J. Stein)
+!! remove R from the historical variables 16/03/95 (J. Stein)
+!! error on the grid stretching 30/06/95 (J. Stein)
+!! add the soil fields 01/09/95 (S.Belair)
+!! change the streching function and the wind guess
+!! (J. Stein and V.Masson) 21/09/95
+!! reset to FALSE LUSERC,..,LUSERH 12/12/95 (J. Stein)
+!! enforce the RS localization in 1D and 2D config.
+!! + add the 'TSZ0' option for the soil variables 28/01/96 (J. Stein)
+!! initialization of domain from center point 31/01/96 (V. Masson)
+!! add the constant file reading 05/02/96 (J. Stein)
+!! enter vertical model levels values 20/10/95 (T.Montmerle)
+!! add LFORCING option 19/02/96 (K. Suhre)
+!! modify structure of NAM_CONF_PRE 20/02/96 (J.-P. Pinty)
+!! default of the domain center when use of pgd file 12/03/96 (V. Masson)
+!! change the surface initialization 20/03/96 ( Stein,
+!! Bougeault, Kastendeutsch )
+!! change the DEFAULT_DESFMN CALL 17/04/96 ( Lafore )
+!! set the STORAGE_TYPE to 'TT' (a single instant) 30/04/96 (Stein,
+!! Jabouille)
+!! new wguess to spread the divergence 15/05/96 (Stein)
+!! set LTHINSHELL to TRUE + return to the old wguess 29/08/96 (Stein)
+!! MY_NAME and DAD_NAME writing for nesting 30/07/96 (Lafore)
+!! MY_NAME and DAD_NAME reading in pgd file 26/09/96 (Masson)
+!! and reading of pgd grid in a new routine
+!! XXHAT and XYHAT are set to 0. at origine point 02/10/96 (Masson)
+!! add LTHINSHELL in namelist NAM_CONF_PRE 08/10/96 (Masson)
+!! restores use of TS and T2 26/11/96 (Masson)
+!! value XUNDEF for soil and vegetation fields on sea 27/11/96 (Masson)
+!! use of HUG and HU2 in both ISBA and TSZ0 cases 04/12/96 (Masson)
+!! add initialization of chemical variables 06/08/96 (K. Suhre)
+!! add MANUAL option for the terrain elevation 12/12/96 (J.-P. Pinty)
+!! set DATA instead of MANUAL for the terrain
+!! elevation option
+!! add new anelastic equations' systems 29/06/97 (Stein)
+!! split mode_lfifm_pgd 29/07/97 (Masson)
+!! add directional z0 and subgrid scale orography 31/07/97 (Masson)
+!! separates surface treatment in PREP_IDEAL_SURF 15/03/99 (Masson)
+!! new PGD fields allocations 15/03/99 (Masson)
+!! iterative call to pressure solver 15/03/99 (Masson)
+!! removes TSZ0 case 04/01/00 (Masson)
+!! parallelization 18/06/00 (Pinty)
+!! adaptation for patch approach 02/07/00 (Solmon/Masson)
+!! bug in W LB field on Y direction 05/03/01 (Stein)
+!! add module MODD_NSV for NSV variable 01/02/01 (D. Gazen)
+!! allow namelists in different orders 15/10/01 (I. Mallet)
+!! allow LUSERC and LUSERI in 1D configuration 05/06/02 (P. Jabouille)
+!! add ZUVTHLMR case (move in set_rsou latter) 05/12/02 Jabouille/Masson
+!! move LHORELAX_SV (after INI_NSV) 30/04/04 (Pinty)
+!! Correction Parallel bug IBEG & IDEND evalution 13/11/08 J.Escobar
+!! add the option LSHIFT for interpolation of 26/10/10 (G.Tanguy)
+!! correction for XHAT & parallelizarion of ZSDATA 23/09/11 J.Escobar
+!! the vertical profile (as in PREP_REAL_CASE)
+!! add use MODI of SURFEX routines 10/10/111 J.Escobar
+!!
+!! For 2D modeling:
+!! Initialization of ADVFRC profiles (SET_ADVFRC) 06/2010 (P.Peyrille)
+!! when LDUMMY(2)=T in PRE_IDEA1.nam
+!! USE MODDB_ADVFRC_n for grid-nesting 02*2012 (M. Tomasini)
+!! LBOUSS in MODD_REF 07/2013 (C.Lac)
+!! Correction for ZS in PGD file 04/2014 (G. TANGUY)
+!! Bug : remove NC WRITE_HGRID 05/2014 (S. Bielli via J.Escobar )
+!! BUG if ZFRC and ZFRC_ADV or ZFRC_REL are used together 11/2014 (G. Delautier)
+!! Bug : detected with cray compiler ,
+!! missing '&' in continuation string 3/12/2014 J.Escobar
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
+!! 01/2018 (G.Delautier) SURFEX 8.1
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
+! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! F. Auguste 02/2021: add IBM
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! Jean-Luc Redelsperger 03/2021: ocean LES case
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS ! Declarative modules
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_DIM_n
+USE MODD_CONF
+USE MODD_CST
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS
+USE MODD_METRICS_n
+USE MODD_PGDDIM
+USE MODD_PGDGRID
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_ASSOCIATE
+USE MODD_REF
+USE MODD_REF_n
+USE MODD_LUNIT
+USE MODD_FIELD_n
+USE MODD_DYN_n
+USE MODD_LBC_n
+USE MODD_LSFIELD_n
+USE MODD_PARAM_n
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM, LUSECHAQ, LUSECHIC, LCH_PH, LCH_INIT_FIELD
+USE MODD_CH_AEROSOL,ONLY: LORILAM, CORGANIC, LVARSIGI, LVARSIGJ, LINITPM, XINIRADIUSI, &
+ XINIRADIUSJ, XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT
+USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN
+USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT
+USE MODD_VAR_ll, ONLY: NPROC
+USE MODD_LUNIT, ONLY: TLUOUT0, TOUTDATAFILE
+USE MODD_LUNIT_n
+USE MODD_IO, ONLY: TFILE_DUMMY, TFILE_OUTPUTLISTING
+USE MODD_CONF_n
+USE MODD_NSV, ONLY: NSV
+use modd_precision, only: LFIINT, MNHREAL_MPI, MNHTIME
+!
+USE MODN_BLANK_n
+!
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_THERMO
+USE MODE_POS
+USE MODE_GRIDCART ! Executive modules
+USE MODE_GRIDPROJ
+USE MODE_GATHER_ll
+USE MODE_IO, only: IO_Config_set, IO_Init, IO_Pack_set
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars
+USE MODE_MSG
+!
+USE MODI_DEFAULT_DESFM_n ! Interface modules
+USE MODI_DEFAULT_EXPRE
+USE MODI_IBM_INIT_LS
+USE MODI_READ_HGRID
+USE MODI_SHUMAN
+USE MODI_SET_RSOU
+USE MODI_SET_CSTN
+USE MODI_SET_FRC
+USE MODI_PRESSURE_IN_PREP
+USE MODI_WRITE_DESFM_n
+USE MODI_WRITE_LFIFM_n
+USE MODI_METRICS
+USE MODI_UPDATE_METRICS
+USE MODI_SET_REF
+USE MODI_SET_PERTURB
+USE MODI_TOTAL_DMASS
+USE MODI_CH_INIT_FIELD_n
+USE MODI_INI_NSV
+USE MODI_READ_PRE_IDEA_NAM_n
+USE MODI_ZSMT_PIC
+USE MODI_ZSMT_PGD
+USE MODI_READ_VER_GRID
+USE MODI_READ_ALL_NAMELISTS
+USE MODI_PGD_GRID_SURF_ATM
+USE MODI_SPLIT_GRID
+USE MODI_PGD_SURF_ATM
+USE MODI_ICE_ADJUST_BIS
+USE MODI_WRITE_PGD_SURF_ATM_n
+USE MODI_PREP_SURF_MNH
+USE MODI_INIT_SALT
+USE MODI_AER2LIMA
+USE MODD_PARAM_LIMA
+!
+!JUAN
+USE MODE_SPLITTINGZ_ll
+USE MODD_SUB_MODEL_n
+USE MODE_MNH_TIMING
+USE MODN_CONFZ
+!JUAN
+!
+USE MODI_VERSION
+USE MODI_INIT_PGD_SURF_ATM
+USE MODI_WRITE_SURF_ATM_N
+USE MODD_MNH_SURFEX_n
+! Modif ADVFRC
+USE MODD_2D_FRC
+USE MODD_ADVFRC_n ! Modif for grid-nesting
+USE MODI_SETADVFRC
+USE MODD_RELFRC_n ! Modif for grid-nesting
+USE MODI_SET_RELFRC
+!
+USE MODI_INI_CST
+USE MODI_INI_NEB
+USE MODD_NEB, ONLY: NEB
+USE MODI_WRITE_HGRID
+USE MODD_MPIF
+USE MODD_VAR_ll
+USE MODD_IO, ONLY: TFILEDATA,TFILE_SURFEX
+!
+USE MODE_MPPDB
+!
+USE MODD_GET_n
+!
+USE MODN_CONFIO, ONLY : NAM_CONFIO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of global variables not declared in the modules
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XJ ! Jacobian
+REAL :: XLATCEN=XUNDEF, XLONCEN=XUNDEF ! latitude and longitude of the center of
+ ! the domain for initialization. This
+ ! point is vertical vorticity point
+ ! ------------------------
+REAL :: XDELTAX=0.5E4, XDELTAY=0.5E4 ! horizontal mesh lengths
+ ! used to determine XXHAT,XYHAT
+!
+INTEGER :: NLUPRE,NLUOUT ! Logical unit numbers for EXPRE file
+ ! and for output_listing file
+INTEGER :: NRESP ! return code in FM routines
+INTEGER :: NTYPE ! type of file (cpio or not)
+INTEGER(KIND=LFIINT) :: NNPRAR ! number of articles predicted in the LFIFM file
+LOGICAL :: GFOUND ! Return code when searching namelist
+!
+INTEGER :: JLOOP,JILOOP,JJLOOP ! Loop indexes
+!
+INTEGER :: NIB,NJB,NKB ! Begining useful area in x,y,z directions
+INTEGER :: NIE,NJE ! Ending useful area in x,y directions
+INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions
+CHARACTER(LEN=4) :: CIDEAL ='CSTN' ! kind of idealized fields
+ ! 'CSTN' : Nv=cste case
+ ! 'RSOU' : radiosounding case
+CHARACTER(LEN=4) :: CZS ='FLAT' ! orography selector
+ ! 'FLAT' : zero orography
+ ! 'SINE' : sine-shaped orography
+ ! 'BELL' : bell-shaped orography
+REAL :: XHMAX=XUNDEF ! Maximum height for orography
+REAL :: NEXPX=3,NEXPY=1 ! Exponents for orography in case of CZS='SINE'
+REAL :: XAX= 1.E4, XAY=1.E4 ! Widths for orography in case CZS='BELL'
+ ! along x and y
+INTEGER :: NIZS = 5, NJZS = 5 ! Localization of the center in
+ ! case CZS ='BELL'
+!
+!* 0.1.1 Declarations of local variables for N=cste and
+! radiosounding cases :
+!
+INTEGER :: NYEAR,NMONTH,NDAY ! year, month and day in EXPRE file
+REAL :: XTIME ! time in EXPRE file
+LOGICAL :: LPERTURB =.FALSE. ! Logical to add a perturbation to
+ ! a basic state
+LOGICAL :: LGEOSBAL =.FALSE. ! Logical to satisfy the geostrophic
+ ! balance
+ ! .TRUE. for geostrophic balance
+ ! .FALSE. to ignore this balance
+LOGICAL :: LSHIFT =.FALSE. ! flag to perform vertical shift or not.
+CHARACTER(LEN=3) :: CFUNU ='ZZZ' ! CHARACTER STRING for variation of
+ ! U in y direction
+ ! 'ZZZ' : U = U(Z)
+ ! 'Y*Z' : U = F(Y) * U(Z)
+ ! 'Y,Z' : U = G(Y,Z)
+CHARACTER(LEN=3) :: CFUNV ='ZZZ' ! CHARACTER STRING for variation of
+ ! V in x direction
+ ! 'ZZZ' : V = V(Z)
+ ! 'Y*Z' : V = F(X) * V(Z)
+ ! 'Y,Z' : V = G(X,Z)
+CHARACTER(LEN=6) :: CTYPELOC='IJGRID' ! Type of informations used to give the
+ ! localization of vertical profile
+ ! 'IJGRID' for (i,j) point on index space
+ ! 'XYHATM' for (x,y) coordinates on
+ ! conformal or cartesian plane
+ ! 'LATLON' for (latitude,longitude) on
+ ! spherical earth
+REAL :: XLATLOC= 45., XLONLOC=0.
+ ! Latitude and longitude of the vertical
+ ! profile localization (used in case
+ ! CTYPELOC='LATLON')
+REAL :: XXHATLOC=2.E4, XYHATLOC=2.E4
+ ! (x,y) of the vertical profile
+ ! localization (used in cases
+ ! CTYPELOC='LATLON' and 'XYHATM')
+INTEGER, DIMENSION(1) :: NILOC=4, NJLOC=4
+ ! (i,j) of the vertical profile
+ ! localization
+!
+!
+REAL,DIMENSION(:,:,:),ALLOCATABLE :: XCORIOZ ! Coriolis parameter (this
+ ! is exceptionnaly a 3D array
+ ! for computing needs)
+!
+!
+!* 0.1.2 Declarations of local variables used when a PhysioGraphic Data
+! file is used :
+!
+INTEGER :: JSV ! loop index on scalar var.
+CHARACTER(LEN=28) :: CPGD_FILE=' ' ! Physio-Graphic Data file name
+LOGICAL :: LREAD_ZS = .TRUE., & ! switch to use orography
+ ! coming from the PGD file
+ LREAD_GROUND_PARAM = .TRUE. ! switch to use soil parameters
+ ! useful for the soil scheme
+ ! coming from the PGD file
+
+INTEGER :: NSLEVE =12 ! number of iteration for smooth orography
+REAL :: XSMOOTH_ZS = XUNDEF ! optional uniform smooth orography for SLEVE coordinate
+CHARACTER(LEN=28) :: YPGD_NAME, YPGD_DAD_NAME ! general information
+CHARACTER(LEN=2) :: YPGD_TYPE
+!
+INTEGER :: IINFO_ll ! return code of // routines
+TYPE(LIST_ll), POINTER :: TZ_FIELDS_ll ! list of metric coefficient fields
+!
+INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the
+INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
+INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
+INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
+INTEGER :: IBEG,IEND,IXOR,IXDIM,IYOR,IYDIM,ILBX,ILBY
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll, ZYHAT_ll
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZTHL,ZT,ZRT,ZFRAC_ICE,&
+ ZEXN,ZLVOCPEXN,ZLSOCPEXN,ZCPH, &
+ ZRSATW, ZRSATI
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZBUF
+ ! variables for adjustement
+REAL :: ZDIST
+!
+!JUAN TIMING
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2, ZEND, ZTOT
+CHARACTER :: YMI
+INTEGER :: IMI
+!JUAN TIMING
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZS_ll
+INTEGER :: IJ
+!
+REAL :: ZZS_MAX, ZZS_MAX_ll
+INTEGER :: IJPHEXT
+!
+TYPE(TFILEDATA),POINTER :: TZEXPREFILE => NULL()
+!
+!
+!* 0.2 Namelist declarations
+!
+NAMELIST/NAM_CONF_PRE/ LTHINSHELL,LCARTESIAN, &! Declarations in MODD_CONF
+ LPACK, &!
+ NVERB,CIDEAL,CZS, &!+global variables initialized
+ LBOUSS,LOCEAN,LPERTURB, &! at their declarations
+ LFORCING,CEQNSYS, &! at their declarations
+ LSHIFT,L2D_ADV_FRC,L2D_REL_FRC, &
+ NHALO , JPHEXT
+NAMELIST/NAM_GRID_PRE/ XLON0,XLAT0, & ! Declarations in MODD_GRID
+ XBETA,XRPK, &
+ XLONORI,XLATORI
+NAMELIST/NAM_GRIDH_PRE/ XLATCEN,XLONCEN, & ! local variables initialized
+ XDELTAX,XDELTAY, & ! at their declarations
+ XHMAX,NEXPX,NEXPY, &
+ XAX,XAY,NIZS,NJZS
+NAMELIST/NAM_VPROF_PRE/LGEOSBAL, CFUNU,CFUNV, &! global variables initialized
+ CTYPELOC,XLATLOC,XLONLOC, &! at their declarations
+ XXHATLOC,XYHATLOC,NILOC,NJLOC
+NAMELIST/NAM_REAL_PGD/CPGD_FILE, & ! Physio-Graphic Data file
+ ! name
+ LREAD_ZS, & ! switch to use orography
+ ! coming from the PGD file
+ LREAD_GROUND_PARAM
+NAMELIST/NAM_SLEVE/NSLEVE, XSMOOTH_ZS
+!
+!* 0.3 Auxillary Namelist declarations
+!
+NAMELIST/NAM_AERO_PRE/ LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ, &
+ XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT, &
+ LDUST, LSALT, CRGUNITD, CRGUNITS,&
+ NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,&
+ XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, &
+ NMODE_SLT
+!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. PROLOGUE
+! --------
+CALL MPPDB_INIT()
+!
+CALL GOTO_MODEL(1)
+!
+CALL IO_Init()
+NULLIFY(TZ_FIELDS_ll)
+CALL VERSION
+CPROGRAM='IDEAL '
+!
+!JUAN TIMING
+ XT_START = 0.0_MNHTIME
+ XT_STORE = 0.0_MNHTIME
+!
+ CALL SECOND_MNH2(ZEND)
+!
+!JUAN TIMING
+!
+!* 1. INITIALIZE PHYSICAL CONSTANTS :
+! ------------------------------
+!
+NVERB = 5
+CALL INI_CST
+CALL INI_NEB
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. SET DEFAULT VALUES :
+! --------------------
+!
+!
+!* 2.1 For variables in DESFM file
+!
+CALL ALLOC_FIELD_SCALARS()
+CALL PARAM_ICE_ASSOCIATE()
+CALL DEFAULT_DESFM_n(1)
+!
+CSURF = "NONE"
+!
+!
+!* 2.2 For other global variables in EXPRE file
+!
+CALL DEFAULT_EXPRE
+!-------------------------------------------------------------------------------
+!
+!* 3. READ THE EXPRE FILE :
+! --------------------
+!
+!* 3.1 initialize logical unit numbers (EXPRE and output-listing files)
+! and open these files :
+!
+!
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING1','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
+NLUOUT = TLUOUT0%NLU
+!Set output files for PRINT_MSG
+TLUOUT => TLUOUT0
+TFILE_OUTPUTLISTING => TLUOUT0
+!
+CALL IO_File_add2list(TZEXPREFILE,'PRE_IDEA1.nam','NML','READ')
+CALL IO_File_open(TZEXPREFILE)
+NLUPRE=TZEXPREFILE%NLU
+!
+!* 3.2 read in NLUPRE the namelist informations
+!
+WRITE(NLUOUT,FMT=*) 'attempt to read ',TRIM(TZEXPREFILE%CNAME),' file'
+CALL POSNAM(NLUPRE,'NAM_REAL_PGD',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_REAL_PGD)
+!
+!
+CALL POSNAM(NLUPRE,'NAM_CONF_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONF_PRE)
+!JUANZ
+CALL POSNAM(NLUPRE,'NAM_CONFZ',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFZ)
+!JUANZ
+CALL POSNAM(NLUPRE,'NAM_CONFIO',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFIO)
+CALL IO_Config_set()
+CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE)
+CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
+CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
+CALL POSNAM(NLUPRE,'NAM_BLANKN',GFOUND,NLUOUT)
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=NLUPRE,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
+CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
+CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
+!
+CALL INI_FIELD_LIST(1)
+!
+CALL INI_FIELD_SCALARS()
+! Sea salt
+CALL INIT_SALT
+!
+IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
+ ! open the PGD_FILE
+ CALL IO_File_add2list(TPGDFILE,TRIM(CPGD_FILE),'PGD','READ',KLFINPRAR=NNPRAR,KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TPGDFILE)
+
+ ! read the grid in the PGD file
+ CALL IO_Field_read(TPGDFILE,'IMAX', NIMAX)
+ CALL IO_Field_read(TPGDFILE,'JMAX', NJMAX)
+ CALL IO_Field_read(TPGDFILE,'JPHEXT',IJPHEXT)
+
+ IF ( CPGD_FILE /= CINIFILEPGD) THEN
+ WRITE(NLUOUT,FMT=*) ' WARNING : in PRE_IDEA1.nam, in NAM_LUNITn you&
+ & have CINIFILEPGD= ',CINIFILEPGD
+ WRITE(NLUOUT,FMT=*) ' whereas in NAM_REAL_PGD you have CPGD_FILE = '&
+ ,CPGD_FILE
+ WRITE(NLUOUT,FMT=*) ' '
+ WRITE(NLUOUT,FMT=*) ' CINIFILEPGD HAS BEEN SET TO ',CPGD_FILE
+ CINIFILEPGD=CPGD_FILE
+ END IF
+ IF ( IJPHEXT .NE. JPHEXT ) THEN
+ WRITE(NLUOUT,FMT=*) ' PREP_IDEAL_CASE : JPHEXT in PRE_IDEA1.nam/NAM_CONF_PRE ( or default value )&
+ & JPHEXT=',JPHEXT
+ WRITE(NLUOUT,FMT=*) ' different from PGD files=', CINIFILEPGD,' value JPHEXT=',IJPHEXT
+ WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','')
+ !WRITE(NLUOUT,FMT=*) ' JPHEXT HAS BEEN SET TO ', IJPHEXT
+ !IJPHEXT = JPHEXT
+ END IF
+END IF
+!
+NIMAX_ll=NIMAX !! _ll variables are global variables
+NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file
+!
+!* 3.3 check some parameters:
+!
+L1D=.FALSE. ; L2D=.FALSE.
+!
+IF ((NIMAX == 1).OR.(NJMAX == 1)) THEN
+ L2D=.TRUE.
+ NJMAX_ll=1
+ NIMAX_ll=MAX(NIMAX,NJMAX)
+ WRITE(NLUOUT,FMT=*) ' NJMAX HAS BEEN SET TO 1 SINCE 2D INITIAL FILE IS REQUIRED &
+ & (L2D=TRUE) )'
+END IF
+!
+IF ((NIMAX == 1).AND.(NJMAX == 1)) THEN
+ L1D=.TRUE.
+ NIMAX_ll = 1
+ NJMAX_ll = 1
+ WRITE(NLUOUT,FMT=*) ' 1D INITIAL FILE IS REQUIRED (L1D=TRUE) '
+END IF
+!
+IF(.NOT. L1D) THEN
+ LHORELAX_UVWTH=.TRUE.
+ LHORELAX_RV=.TRUE.
+ENDIF
+!
+NRIMX= MIN(JPRIMMAX,NIMAX_ll/2)
+!
+IF (L2D) THEN
+ NRIMY=0
+ELSE
+ NRIMY= MIN(JPRIMMAX,NJMAX_ll/2)
+END IF
+!
+IF (L1D) THEN
+ NRIMX=0
+ NRIMY=0
+END IF
+!
+IF (L1D .AND. ( LPERTURB .OR. LGEOSBAL .OR. &
+ (.NOT. LCARTESIAN ) .OR. (.NOT. LTHINSHELL) ))THEN
+ LGEOSBAL = .FALSE.
+ LPERTURB = .FALSE.
+ LCARTESIAN = .TRUE.
+ LTHINSHELL = .TRUE.
+ WRITE(NLUOUT,FMT=*) ' LGEOSBAL AND LPERTURB HAVE BEEN SET TO FALSE &
+ & AND LCARTESIAN AND LTHINSHELL TO TRUE &
+ & SINCE 1D INITIAL FILE IS REQUIRED (L1D=TRUE)'
+END IF
+!
+IF (LGEOSBAL .AND. LSHIFT ) THEN
+ LSHIFT=.FALSE.
+ WRITE(NLUOUT,FMT=*) ' LSHIFT HAS BEEN SET TO FALSE SINCE &
+ & LGEOSBAL=.TRUE. IS REQUIRED '
+END IF
+!
+!* 3.4 compute the number of moist variables :
+!
+IF (.NOT.LUSERV) THEN
+ LUSERV = .TRUE.
+ WRITE(NLUOUT,FMT=*) ' LUSERV HAS BEEN RESET TO TRUE, SINCE A MOIST VARIABLE &
+ & IS PRESENT IN EXPRE FILE (CIDEAL = RSOU OR CSTN)'
+END IF
+!
+IF((LUSERI .OR. LUSERC).AND. (CIDEAL /= 'RSOU')) THEN
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','use of hydrometeors is only allowed in RSOU case')
+ENDIF
+IF (LUSERI) THEN
+ LUSERC =.TRUE.
+ LUSERR =.TRUE.
+ LUSERI =.TRUE.
+ LUSERS =.TRUE.
+ LUSERG =.TRUE.
+ LUSERH =.FALSE.
+ CCLOUD='ICE3'
+ELSEIF(LUSERC) THEN
+ LUSERR =.FALSE.
+ LUSERI =.FALSE.
+ LUSERS =.FALSE.
+ LUSERG =.FALSE.
+ LUSERH =.FALSE.
+ CCLOUD='REVE'
+ELSE
+ LUSERC =.FALSE.
+ LUSERR =.FALSE.
+ LUSERI =.FALSE.
+ LUSERS =.FALSE.
+ LUSERG =.FALSE.
+ LUSERH =.FALSE.
+ LHORELAX_RC=.FALSE.
+ LHORELAX_RR=.FALSE.
+ LHORELAX_RI=.FALSE.
+ LHORELAX_RS=.FALSE.
+ LHORELAX_RG=.FALSE.
+ LHORELAX_RH=.FALSE.
+ CCLOUD='NONE'
+!
+END IF
+!
+NRR=0
+IF (LUSERV) THEN
+ NRR=NRR+1
+ IDX_RVT = NRR
+END IF
+IF (LUSERC) THEN
+ NRR=NRR+1
+ IDX_RCT = NRR
+END IF
+IF (LUSERR) THEN
+ NRR=NRR+1
+ IDX_RRT = NRR
+END IF
+IF (LUSERI) THEN
+ NRR=NRR+1
+ IDX_RIT = NRR
+END IF
+IF (LUSERS) THEN
+ NRR=NRR+1
+ IDX_RST = NRR
+END IF
+IF (LUSERG) THEN
+ NRR=NRR+1
+ IDX_RGT = NRR
+END IF
+IF (LUSERH) THEN
+ NRR=NRR+1
+ IDX_RHT = NRR
+END IF
+!
+! NRR=4 for RSOU case because RI and Rc always computed
+IF (CIDEAL == 'RSOU' .AND. NRR < 4 ) NRR=4
+!
+!
+!* 3.5 Chemistry
+!
+IF (LORILAM .OR. LCH_INIT_FIELD) THEN
+ LUSECHEM = .TRUE.
+ IF (LORILAM) THEN
+ CORGANIC = "MPMPO"
+ LVARSIGI = .TRUE.
+ LVARSIGJ = .TRUE.
+ END IF
+END IF
+! initialise NSV_* variables
+CALL INI_NSV(1)
+LHORELAX_SV(:)=.FALSE.
+IF(.NOT. L1D) LHORELAX_SV(1:NSV)=.TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. ALLOCATE MEMORY FOR ARRAYS :
+! ----------------------------
+!
+!* 4.1 Vertical Spatial grid
+!
+CALL READ_VER_GRID(TZEXPREFILE)
+!
+!* 4.2 Initialize parallel variables and compute array's dimensions
+!
+!
+IF(LGEOSBAL) THEN
+ CALL SET_SPLITTING_ll('XSPLITTING') ! required for integration of thermal wind balance
+ELSE
+ CALL SET_SPLITTING_ll('BSPLITTING')
+ENDIF
+CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DAD0_ll()
+CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
+CALL IO_Pack_set(L1D,L2D,LPACK)
+CALL SET_LBX_ll(CLBCX(1), 1)
+CALL SET_LBY_ll(CLBCY(1), 1)
+CALL SET_XRATIO_ll(1, 1)
+CALL SET_YRATIO_ll(1, 1)
+CALL SET_XOR_ll(1, 1)
+CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
+CALL SET_YOR_ll(1, 1)
+CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
+CALL SET_DAD_ll(0, 1)
+CALL INI_PARAZ_ll(IINFO_ll)
+!
+! sizes of arrays of the extended sub-domain
+!
+CALL GET_DIM_EXT_ll('B',NIU,NJU)
+CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
+CALL GET_INDICE_ll(NIB,NJB,NIE,NJE)
+CALL GET_OR_ll('B',IXOR,IYOR)
+NKB=1+JPVEXT
+NKU=NKMAX+2*JPVEXT
+!
+!* 4.3 Global variables absent from the modules :
+!
+ALLOCATE(XJ(NIU,NJU,NKU))
+SELECT CASE(CIDEAL)
+ CASE('RSOU','CSTN')
+ IF (LGEOSBAL) ALLOCATE(XCORIOZ(NIU,NJU,NKU)) ! exceptionally a 3D array
+ CASE DEFAULT ! undefined preinitialization
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CIDEAL is not correctly defined')
+END SELECT
+!
+!* 4.4 Prognostic variables at M instant (module MODD_FIELD1):
+!
+ALLOCATE(XUT(NIU,NJU,NKU))
+ALLOCATE(XVT(NIU,NJU,NKU))
+ALLOCATE(XWT(NIU,NJU,NKU))
+ALLOCATE(XTHT(NIU,NJU,NKU))
+ALLOCATE(XPABST(NIU,NJU,NKU))
+ALLOCATE(XRT(NIU,NJU,NKU,NRR))
+ALLOCATE(XSVT(NIU,NJU,NKU,NSV))
+!
+!* 4.5 Grid variables (module MODD_GRID1 and MODD_METRICS1):
+!
+ALLOCATE(XMAP(NIU,NJU))
+ALLOCATE(XLAT(NIU,NJU))
+ALLOCATE(XLON(NIU,NJU))
+ALLOCATE(XDXHAT(NIU),XDYHAT(NJU))
+IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(XZS(NIU,NJU))
+IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(ZZS_ll(NIMAX_ll))
+IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(XZSMT(NIU,NJU))
+ALLOCATE(XZZ(NIU,NJU,NKU))
+!
+ALLOCATE(XDXX(NIU,NJU,NKU))
+ALLOCATE(XDYY(NIU,NJU,NKU))
+ALLOCATE(XDZX(NIU,NJU,NKU))
+ALLOCATE(XDZY(NIU,NJU,NKU))
+ALLOCATE(XDZZ(NIU,NJU,NKU))
+!
+!* 4.6 Reference state variables (modules MODD_REF and MODD_REF1):
+!
+ALLOCATE(XRHODREFZ(NKU),XTHVREFZ(NKU))
+XTHVREFZ(:)=0.0
+IF (LCOUPLES) THEN
+ ! Arrays for reference state different in ocean and atmosphere
+ ALLOCATE(XRHODREFZO(NKU),XTHVREFZO(NKU))
+ XTHVREFZO(:)=0.0
+END IF
+IF(CEQNSYS == 'DUR') THEN
+ ALLOCATE(XRVREF(NIU,NJU,NKU))
+ELSE
+ ALLOCATE(XRVREF(0,0,0))
+END IF
+ALLOCATE(XRHODREF(NIU,NJU,NKU),XTHVREF(NIU,NJU,NKU),XEXNREF(NIU,NJU,NKU))
+ALLOCATE(XRHODJ(NIU,NJU,NKU))
+!
+!* 4.7 Larger Scale fields (modules MODD_LSFIELD1):
+!
+ALLOCATE(XLSUM(NIU,NJU,NKU))
+ALLOCATE(XLSVM(NIU,NJU,NKU))
+ALLOCATE(XLSWM(NIU,NJU,NKU))
+ALLOCATE(XLSTHM(NIU,NJU,NKU))
+IF ( NRR >= 1) THEN
+ ALLOCATE(XLSRVM(NIU,NJU,NKU))
+ELSE
+ ALLOCATE(XLSRVM(0,0,0))
+ENDIF
+!
+! allocate lateral boundary field used for coupling
+!
+IF ( L1D) THEN ! 1D case
+!
+ NSIZELBX_ll=0
+ NSIZELBXU_ll=0
+ NSIZELBY_ll=0
+ NSIZELBYV_ll=0
+ NSIZELBXTKE_ll=0
+ NSIZELBXR_ll=0
+ NSIZELBXSV_ll=0
+ NSIZELBYTKE_ll=0
+ NSIZELBYR_ll=0
+ NSIZELBYSV_ll=0
+ ALLOCATE(XLBXUM(0,0,0))
+ ALLOCATE(XLBYUM(0,0,0))
+ ALLOCATE(XLBXVM(0,0,0))
+ ALLOCATE(XLBYVM(0,0,0))
+ ALLOCATE(XLBXWM(0,0,0))
+ ALLOCATE(XLBYWM(0,0,0))
+ ALLOCATE(XLBXTHM(0,0,0))
+ ALLOCATE(XLBYTHM(0,0,0))
+ ALLOCATE(XLBXTKEM(0,0,0))
+ ALLOCATE(XLBYTKEM(0,0,0))
+ ALLOCATE(XLBXRM(0,0,0,0))
+ ALLOCATE(XLBYRM(0,0,0,0))
+ ALLOCATE(XLBXSVM(0,0,0,0))
+ ALLOCATE(XLBYSVM(0,0,0,0))
+!
+ELSEIF( L2D ) THEN ! 2D case (not yet parallelized)
+!
+ CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
+ IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
+ IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
+ NSIZELBY_ll=0
+ NSIZELBYV_ll=0
+ NSIZELBYTKE_ll=0
+ NSIZELBYR_ll=0
+ NSIZELBYSV_ll=0
+ ALLOCATE(XLBYUM(0,0,0))
+ ALLOCATE(XLBYVM(0,0,0))
+ ALLOCATE(XLBYWM(0,0,0))
+ ALLOCATE(XLBYTHM(0,0,0))
+ ALLOCATE(XLBYTKEM(0,0,0))
+ ALLOCATE(XLBYRM(0,0,0,0))
+ ALLOCATE(XLBYSVM(0,0,0,0))
+ !
+ IF ( LHORELAX_UVWTH ) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBX_ll=2*NRIMX+2
+ ! NSIZELBXU_ll=2*NRIMX+2
+ ALLOCATE(XLBXUM(IISIZEXFU,NJU,NKU))
+ ALLOCATE(XLBXVM(IISIZEXF,NJU,NKU))
+ ALLOCATE(XLBXWM(IISIZEXF,NJU,NKU))
+ ALLOCATE(XLBXTHM(IISIZEXF,NJU,NKU))
+! =======
+ NSIZELBX_ll=2*NRIMX+2*JPHEXT
+ NSIZELBXU_ll=2*NRIMX+2*JPHEXT
+ ! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,NJU,NKU))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
+ ELSE
+ NSIZELBX_ll= 2*JPHEXT ! 2
+ NSIZELBXU_ll=2*(JPHEXT+1) ! 4
+ ALLOCATE(XLBXUM(NSIZELBXU_ll,NJU,NKU))
+ ALLOCATE(XLBXVM(NSIZELBX_ll,NJU,NKU))
+ ALLOCATE(XLBXWM(NSIZELBX_ll,NJU,NKU))
+ ALLOCATE(XLBXTHM(NSIZELBX_ll,NJU,NKU))
+ END IF
+ !
+ IF ( NRR > 0 ) THEN
+ IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
+ .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
+ ) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBXR_ll=2* NRIMX+2
+ ALLOCATE(XLBXRM(IISIZEXF,NJU,NKU,NRR))
+! =======
+ NSIZELBXR_ll=2*NRIMX+2*JPHEXT
+ ! ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,NJU,NKU,NRR))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
+ ELSE
+ NSIZELBXR_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXRM(NSIZELBXR_ll,NJU,NKU,NRR))
+ ENDIF
+ ELSE
+ NSIZELBXR_ll=0
+ ALLOCATE(XLBXRM(0,0,0,0))
+ END IF
+ !
+ IF ( NSV > 0 ) THEN
+ IF ( ANY( LHORELAX_SV(:)) ) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBXSV_ll=2* NRIMX+2
+ ALLOCATE(XLBXSVM(IISIZEXF,NJU,NKU,NSV))
+! =======
+ NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
+ ! ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,NJU,NKU,NSV))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
+ ELSE
+ NSIZELBXSV_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXSVM(NSIZELBXSV_ll,NJU,NKU,NSV))
+ END IF
+ ELSE
+ NSIZELBXSV_ll=0
+ ALLOCATE(XLBXSVM(0,0,0,0))
+ END IF
+!
+ELSE ! 3D case
+!
+ CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
+ IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
+ IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
+ CALL GET_SIZEY_LB(NIMAX_ll,NJMAX_ll,NRIMY, &
+ IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV, &
+ IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2)
+!
+ IF ( LHORELAX_UVWTH ) THEN
+ NSIZELBX_ll=2*NRIMX+2*JPHEXT
+ NSIZELBXU_ll=2*NRIMX+2*JPHEXT
+ NSIZELBY_ll=2*NRIMY+2*JPHEXT
+ NSIZELBYV_ll=2*NRIMY+2*JPHEXT
+ ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,NKU))
+ ALLOCATE(XLBYUM(IISIZEYF,IJSIZEYF,NKU))
+ ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,NKU))
+ ALLOCATE(XLBYVM(IISIZEYFV,IJSIZEYFV,NKU))
+ ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,NKU))
+ ALLOCATE(XLBYWM(IISIZEYF,IJSIZEYF,NKU))
+ ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,NKU))
+ ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,NKU))
+ ELSE
+ NSIZELBX_ll=2*JPHEXT ! 2
+ NSIZELBXU_ll=2*(JPHEXT+1) ! 4
+ NSIZELBY_ll=2*JPHEXT ! 2
+ NSIZELBYV_ll=2*(JPHEXT+1) ! 4
+ ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,NKU))
+ ALLOCATE(XLBYUM(IISIZEY2,IJSIZEY2,NKU))
+ ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,NKU))
+ ALLOCATE(XLBYVM(IISIZEY4,IJSIZEY4,NKU))
+ ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,NKU))
+ ALLOCATE(XLBYWM(IISIZEY2,IJSIZEY2,NKU))
+ ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,NKU))
+ ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,NKU))
+ END IF
+ !
+ IF ( NRR > 0 ) THEN
+ IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
+ .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
+ ) THEN
+ NSIZELBXR_ll=2*NRIMX+2*JPHEXT
+ NSIZELBYR_ll=2*NRIMY+2*JPHEXT
+ ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,NKU,NRR))
+ ALLOCATE(XLBYRM(IISIZEYF,IJSIZEYF,NKU,NRR))
+ ELSE
+ NSIZELBXR_ll=2*JPHEXT ! 2
+ NSIZELBYR_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,NKU,NRR))
+ ALLOCATE(XLBYRM(IISIZEY2,IJSIZEY2,NKU,NRR))
+ ENDIF
+ ELSE
+ NSIZELBXR_ll=0
+ NSIZELBYR_ll=0
+ ALLOCATE(XLBXRM(0,0,0,0))
+ ALLOCATE(XLBYRM(0,0,0,0))
+ END IF
+ !
+ IF ( NSV > 0 ) THEN
+ IF ( ANY( LHORELAX_SV(:)) ) THEN
+ NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
+ NSIZELBYSV_ll=2*NRIMY+2*JPHEXT
+ ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,NKU,NSV))
+ ALLOCATE(XLBYSVM(IISIZEYF,IJSIZEYF,NKU,NSV))
+ ELSE
+ NSIZELBXSV_ll=2*JPHEXT ! 2
+ NSIZELBYSV_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,NKU,NSV))
+ ALLOCATE(XLBYSVM(IISIZEY2,IJSIZEY2,NKU,NSV))
+ END IF
+ ELSE
+ NSIZELBXSV_ll=0
+ NSIZELBYSV_ll=0
+ ALLOCATE(XLBXSVM(0,0,0,0))
+ ALLOCATE(XLBYSVM(0,0,0,0))
+ END IF
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. INITIALIZE ALL THE MODEL VARIABLES
+! ----------------------------------
+!
+!
+!* 5.1 Grid variables and RS localization:
+!
+!* 5.1.1 Horizontal Spatial grid :
+!
+IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
+!--------------------------------------------------------
+! the MESONH horizontal grid will be read in the PGD_FILE
+!--------------------------------------------------------
+ CALL READ_HGRID(1,TPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
+! control the cartesian option
+ IF( LCARTESIAN ) THEN
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : IN GENERAL, THE USE OF A PGD_FILE &
+ & IMPLIES THAT YOU MUST TAKE INTO ACCOUNT THE EARTH SPHERICITY'
+ WRITE(NLUOUT,FMT=*) 'NEVERTHELESS, LCARTESIAN HAS BEEN KEPT TO TRUE'
+ END IF
+!
+!* use of the externalized surface
+!
+ CSURF = "EXTE"
+!
+! determine whether the model is flat or no
+!
+ ZZS_MAX = ABS( MAXVAL(XZS(NIB:NIU-JPHEXT,NJB:NJU-JPHEXT)))
+ CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MNHREAL_MPI, MPI_MAX, &
+ NMNH_COMM_WORLD,IINFO_ll)
+ IF( ABS(ZZS_MAX_ll) < 1.E-10 ) THEN
+ LFLAT=.TRUE.
+ ELSE
+ LFLAT=.FALSE.
+ END IF
+!
+
+ELSE
+!------------------------------------------------------------------------
+! the MESONH horizontal grid is built from the PRE_IDEA1.nam informations
+!------------------------------------------------------------------------
+!
+ ALLOCATE(XXHAT(NIU),XYHAT(NJU))
+!
+! define the grid localization at the earth surface by the central point
+! coordinates
+!
+ IF (XLONCEN/=XUNDEF .OR. XLATCEN/=XUNDEF) THEN
+ IF (XLONCEN/=XUNDEF .AND. XLATCEN/=XUNDEF) THEN
+!
+! it should be noted that XLATCEN and XLONCEN refer to a vertical
+! vorticity point and (XLATORI, XLONORI) refer to the mass point of
+! conformal coordinates (0,0). This is to allow the centering of the model in
+! a non-cyclic configuration regarding to XLATCEN or XLONCEN.
+!
+ ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
+ ZXHAT_ll=0.
+ ZYHAT_ll=0.
+ CALL SM_LATLON(XLATCEN,XLONCEN, &
+ -XDELTAX*(NIMAX_ll/2-0.5+JPHEXT), &
+ -XDELTAY*(NJMAX_ll/2-0.5+JPHEXT), &
+ XLATORI,XLONORI)
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+!
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : XLATORI=' , XLATORI, &
+ ' XLONORI= ', XLONORI
+ ELSE
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE',&
+ 'latitude and longitude of the center point must be initialized alltogether or not')
+ END IF
+ END IF
+!
+ IF (NPROC > 1) THEN
+ CALL GET_DIM_EXT_ll('B',IXDIM,IYDIM)
+ IBEG = IXOR-JPHEXT-1
+ IEND = IBEG+IXDIM-1
+ XXHAT(:) = (/ (REAL(JLOOP)*XDELTAX, JLOOP=IBEG,IEND) /)
+ IBEG = IYOR-JPHEXT-1
+ IEND = IBEG+IYDIM-1
+ XYHAT(:) = (/ (REAL(JLOOP)*XDELTAY, JLOOP=IBEG,IEND) /)
+!
+ ELSE
+ XXHAT(:) = (/ (REAL(JLOOP-NIB)*XDELTAX, JLOOP=1,NIU) /)
+ XYHAT(:) = (/ (REAL(JLOOP-NJB)*XDELTAY, JLOOP=1,NJU) /)
+ END IF
+END IF
+!
+!* 5.1.2 Orography and Gal-Chen Sommerville transformation :
+!
+IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN
+ SELECT CASE(CZS) ! 'FLAT' or 'SINE' or 'BELL'
+ CASE('FLAT')
+ LFLAT = .TRUE.
+ IF (XHMAX==XUNDEF) THEN
+ XZS(:,:) = 0.
+ ELSE
+ XZS(:,:) = XHMAX
+ END IF
+ CASE('SINE') ! sinus-shaped orography
+ IF (XHMAX==XUNDEF) XHMAX=300.
+ LFLAT =.FALSE.
+ XZS(:,:) = XHMAX & ! three-dimensional case
+ *SPREAD((/((SIN((XPI/(NIMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPX,JLOOP=IXOR-1,IXOR+NIU-2)/),2,NJU) &
+ *SPREAD((/((SIN((XPI/(NJMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPY,JLOOP=IYOR-1,IYOR+NJU-2)/),1,NIU)
+ IF(L1D) THEN ! one-dimensional case
+ XZS(:,:) = XHMAX
+ END IF
+ CASE('BELL') ! bell-shaped orography
+ IF (XHMAX==XUNDEF) XHMAX=300.
+ LFLAT = .FALSE.
+ IF(.NOT.L2D) THEN ! three-dimensional case
+ XZS(:,:) = XHMAX / ( 1. &
+ + ( (SPREAD(XXHAT(1:NIU),2,NJU) - REAL(NIZS) * XDELTAX) /XAX ) **2 &
+ + ( (SPREAD(XYHAT(1:NJU),1,NIU) - REAL(NJZS) * XDELTAY) /XAY ) **2 ) **1.5
+ ELSE ! two-dimensional case
+ XZS(:,:) = XHMAX / ( 1. &
+ + ( (SPREAD(XXHAT(1:NIU),2,NJU) - REAL(NIZS) * XDELTAX) /XAX ) **2 )
+ ENDIF
+ IF(L1D) THEN ! one-dimensional case
+ XZS(:,:) = XHMAX
+ END IF
+ CASE('COSI') ! (1+cosine)**4 shape
+ IF (XHMAX==XUNDEF) XHMAX=800.
+ LFLAT = .FALSE.
+ IF(L2D) THEN ! two-dimensional case
+ DO JILOOP = 1, NIU
+ ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
+ IF( ABS(ZDIST)<(4.0*XAX) ) THEN
+ XZS(JILOOP,:) = (XHMAX/16.0)*( 1.0 + COS((XPI*ZDIST)/(4.0*XAX)) )**4
+ ELSE
+ XZS(JILOOP,:) = 0.0
+ ENDIF
+ END DO
+ ENDIF
+ CASE('SCHA') ! exp(-(x/a)**2)*cosine(pi*x/lambda)**2 shape
+ IF (XHMAX==XUNDEF) XHMAX=800.
+ LFLAT = .FALSE.
+ IF(L2D) THEN ! two-dimensional case
+ DO JILOOP = 1, NIU
+ ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
+ IF( ABS(ZDIST)<(4.0*XAX) ) THEN
+ XZS(JILOOP,:) = XHMAX*EXP(-(ZDIST/XAY)**2)*COS((XPI*ZDIST)/XAX)**2
+ ELSE
+ XZS(JILOOP,:) = 0.0
+ ENDIF
+ END DO
+ ENDIF
+ CASE('AGNE') ! h*a**2/(x**2+a**2) shape
+ LFLAT = .FALSE.
+ IF(L2D) THEN ! two-dimensional case
+ DO JILOOP = 1, NIU
+ ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
+ XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2)
+ END DO
+ ELSE ! three dimensionnal case - infinite profile in y direction
+ DO JILOOP = 1, NIU
+ ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
+ XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2)
+ END DO
+ ENDIF
+
+ CASE('DATA') ! discretized orography
+ LFLAT =.FALSE.
+ WRITE(NLUOUT,FMT=*) 'CZS="DATA", ATTEMPT TO READ ARRAY &
+ &XZS(NIB:NIU-JPHEXT:1,NJU-JPHEXT:NJB:-1) &
+ &starting from the first index'
+ CALL POSKEY(NLUPRE,NLUOUT,'ZSDATA')
+ DO JJLOOP = NJMAX_ll+2*JPHEXT-1,JPHEXT+1,-1 ! input like a map prior the sounding
+ READ(NLUPRE,FMT=*) ZZS_ll
+ IF ( ( JJLOOP <= ( NJU-JPHEXT + IYOR-1 ) ) .AND. ( JJLOOP >= ( NJB + IYOR-1 ) ) ) THEN
+ IJ = JJLOOP - ( IYOR-1 )
+ XZS(NIB:NIU-JPHEXT,IJ) = ZZS_ll(IXOR:IXOR + NIU-JPHEXT - NIB )
+ END IF
+ END DO
+!
+ CASE DEFAULT ! undefined shape of orography
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','erroneous ground type')
+ END SELECT
+!
+ CALL ADD2DFIELD_ll( TZ_FIELDS_ll, XZS, 'PREP_IDEAL_CASE::XZS' )
+ CALL UPDATE_HALO_ll(TZ_FIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZ_FIELDS_ll)
+!
+END IF
+!
+!IF( ( LEN_TRIM(CPGD_FILE) /= 0 ) .AND. .NOT.LFLAT .AND. &
+! ((CLBCX(1) /= "OPEN" ) .OR. &
+! (CLBCX(2) /= "OPEN" ) .OR. (CLBCY(1) /= "OPEN" ) .OR. &
+! (CLBCY(2) /= "OPEN" )) ) THEN
+! !callabortstop
+! CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','with a PGD file, you cannot be in a cyclic LBC')
+!END IF
+!
+IF (LWEST_ll()) THEN
+ DO JILOOP = 1,JPHEXT
+ XZS(JILOOP,:) = XZS(NIB,:)
+ END DO
+END IF
+IF (LEAST_ll()) THEN
+ DO JILOOP = NIU-JPHEXT+1,NIU
+ XZS(JILOOP,:)=XZS(NIU-JPHEXT,:)
+ END DO
+END IF
+IF (LSOUTH_ll()) THEN
+ DO JJLOOP = 1,JPHEXT
+ XZS(:,JJLOOP)=XZS(:,NJB)
+ END DO
+END IF
+IF (LNORTH_ll()) THEN
+ DO JJLOOP =NJU-JPHEXT+1,NJU
+ XZS(:,JJLOOP)=XZS(:,NJU-JPHEXT)
+ END DO
+END IF
+!
+IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN
+ IF (LSLEVE) THEN
+ CALL ZSMT_PIC(NSLEVE,XSMOOTH_ZS)
+ ELSE
+ XZSMT(:,:) = 0.
+ END IF
+END IF
+!
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,XJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
+ XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,XJ)
+END IF
+!* 5.4.1 metrics coefficients and update halos:
+!
+CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+!* 5.1.3 Compute the localization in index space of the vertical profile
+! in CSTN and RSOU cases :
+!
+IF (CTYPELOC =='LATLON' ) THEN
+ IF (.NOT.LCARTESIAN) THEN ! compute (x,y) if
+ CALL SM_XYHAT(XLATORI,XLONORI, & ! the localization
+ XLATLOC,XLONLOC,XXHATLOC,XYHATLOC) ! is given in latitude
+ ELSE ! and longitude
+ WRITE(NLUOUT,FMT=*) 'CTYPELOC CANNOT BE LATLON IN CARTESIAN GEOMETRY'
+ WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CTYPELOC cannot be LATLON in cartesian geometry')
+ END IF
+END IF
+!
+ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT))
+CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP) !//
+CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP) !//
+IF (CTYPELOC /= 'IJGRID') THEN
+ NILOC = MINLOC(ABS(XXHATLOC-ZXHAT_ll(:)))
+ NJLOC = MINLOC(ABS(XYHATLOC-ZYHAT_ll(:)))
+END IF
+!
+IF ( L1D .AND. ( NILOC(1) /= 1 .OR. NJLOC(1) /= 1 ) ) THEN
+ NILOC = 1
+ NJLOC = 1
+ WRITE(NLUOUT,FMT=*) 'FOR 1D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT &
+ & I=1 AND J=1 (CENTRAL VERTICAL WITHOUT HALO)'
+END IF
+!
+IF ( L2D .AND. ( NJLOC(1) /= 1 ) ) THEN
+ NJLOC = 1
+ WRITE(NLUOUT,FMT=*) 'FOR 2D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT &
+ & J=1 (CENTRAL PLANE WITHOUT HALO)'
+END IF
+!
+!* 5.2 Prognostic variables (not multiplied by rhoJ) : u,v,w,theta,r
+! and 1D anelastic reference state
+!
+!
+!* 5.2.1 Use a Radiosounding : CIDEAL='RSOU''
+!
+IF (CIDEAL == 'RSOU') THEN
+ WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", attempt to read DATE'
+ CALL POSKEY(NLUPRE,NLUOUT,'RSOU')
+ READ(NLUPRE,FMT=*) NYEAR,NMONTH,NDAY,XTIME
+ TDTCUR = DATE_TIME(DATE(NYEAR,NMONTH,NDAY),XTIME)
+ TDTEXP = TDTCUR
+ TDTSEG = TDTCUR
+ TDTMOD = TDTCUR
+ WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", ATTEMPT TO PROCESS THE SOUNDING DATA'
+ IF (LGEOSBAL) THEN
+ CALL SET_RSOU(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
+ XJ,LSHIFT,XCORIOZ)
+ ELSE
+ CALL SET_RSOU(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
+ XJ,LSHIFT)
+ END IF
+!
+!* 5.2.2 N=cste and U(z) : CIDEAL='CSTN'
+!
+ELSE IF (CIDEAL == 'CSTN') THEN
+ WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", attempt to read DATE'
+ CALL POSKEY(NLUPRE,NLUOUT,'CSTN')
+ READ(NLUPRE,FMT=*) NYEAR,NMONTH,NDAY,XTIME
+ TDTCUR = DATE_TIME(DATE(NYEAR,NMONTH,NDAY),XTIME)
+ TDTEXP = TDTCUR
+ TDTSEG = TDTCUR
+ TDTMOD = TDTCUR
+ WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", ATTEMPT TO PROCESS THE SOUNDING DATA'
+ IF (LGEOSBAL) THEN
+ CALL SET_CSTN(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
+ XJ,LSHIFT,XCORIOZ)
+ ELSE
+ CALL SET_CSTN(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
+ XJ,LSHIFT)
+ END IF
+!
+END IF
+!
+!* 5.3 Forcing variables
+!
+IF (LFORCING) THEN
+ WRITE(NLUOUT,FMT=*) 'FORCING IS ENABLED, ATTEMPT TO SET FORCING FIELDS'
+ CALL POSKEY(NLUPRE,NLUOUT,'ZFRC ','PFRC')
+ CALL SET_FRC(TZEXPREFILE)
+END IF
+!
+!! ---------------------------------------------------------------------
+! Modif PP ADV FRC
+! 5.4.2 initialize profiles for adv forcings
+IF (L2D_ADV_FRC) THEN
+ WRITE(NLUOUT,FMT=*) 'L2D_ADV_FRC IS SET TO TRUE'
+ WRITE(NLUOUT,FMT=*) 'ADVECTING FORCING USED IS USER MADE, NOT STANDARD ONE '
+ WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY '
+ CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_ADV')
+ CALL SET_ADVFRC(TZEXPREFILE)
+ENDIF
+IF (L2D_REL_FRC) THEN
+ WRITE(NLUOUT,FMT=*) 'L2D_REL_FRC IS SET TO TRUE'
+ WRITE(NLUOUT,FMT=*) 'RELAXATION FORCING USED IS USER MADE, NOT STANDARD ONE '
+ WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY '
+ CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_REL')
+ CALL SET_RELFRC(TZEXPREFILE)
+ENDIF
+!* 5.4 3D Reference state variables :
+!
+!
+!* 5.4.1 metrics coefficients and update halos:
+!
+CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+!* 5.4.2 3D reference state :
+!
+CALL SET_REF(0,TFILE_DUMMY, &
+ XZZ,XZHAT,XJ,XDXX,XDYY,CLBCX,CLBCY, &
+ XREFMASS,XMASS_O_PHI0,XLINMASS, &
+ XRHODREF,XTHVREF,XRVREF,XEXNREF,XRHODJ)
+!
+!
+!* 5.5.1 Absolute pressure :
+!
+!
+!* 5.5.2 Total mass of dry air Md computation :
+!
+CALL TOTAL_DMASS(XJ,XRHODREF,XDRYMASST)
+!
+!
+!* 5.6 Complete prognostic variables (multipliy by rhoJ) at time t :
+!
+! U grid : gridpoint 2
+IF (LWEST_ll()) XUT(1,:,:) = 2.*XUT(2,:,:) - XUT(3,:,:)
+! V grid : gridpoint 3
+IF (LSOUTH_ll()) XVT(:,1,:) = 2.*XVT(:,2,:) - XVT(:,3,:)
+! SV : gridpoint 1
+XSVT(:,:,:,:) = 0.
+!
+!
+!* 5.7 Larger scale fields initialization :
+!
+XLSUM(:,:,:) = XUT(:,:,:) ! these fields do not satisfy the
+XLSVM(:,:,:) = XVT(:,:,:) ! lower boundary condition but are
+XLSWM(:,:,:) = XWT(:,:,:) ! in equilibrium
+XLSTHM(:,:,:)= XTHT(:,:,:)
+XLSRVM(:,:,:)= XRT(:,:,:,1)
+!
+! enforce the vertical homogeneity under the ground and above the top of
+! the model for the LS fields
+!
+XLSUM(:,:,NKB-1)=XLSUM(:,:,NKB)
+XLSUM(:,:,NKU)=XLSUM(:,:,NKU-1)
+XLSVM(:,:,NKB-1)=XLSVM(:,:,NKB)
+XLSVM(:,:,NKU)=XLSVM(:,:,NKU-1)
+XLSWM(:,:,NKB-1)=XLSWM(:,:,NKB)
+XLSWM(:,:,NKU)=XLSWM(:,:,NKU-1)
+XLSTHM(:,:,NKB-1)=XLSTHM(:,:,NKB)
+XLSTHM(:,:,NKU)=XLSTHM(:,:,NKU-1)
+IF ( NRR > 0 ) THEN
+ XLSRVM(:,:,NKB-1)=XLSRVM(:,:,NKB)
+ XLSRVM(:,:,NKU)=XLSRVM(:,:,NKU-1)
+END IF
+!
+ILBX=SIZE(XLBXUM,1)
+ILBY=SIZE(XLBYUM,2)
+IF(LWEST_ll() .AND. .NOT. L1D) THEN
+ XLBXUM(1:NRIMX+JPHEXT, :,:) = XUT(2:NRIMX+JPHEXT+1, :,:)
+ XLBXVM(1:NRIMX+JPHEXT, :,:) = XVT(1:NRIMX+JPHEXT, :,:)
+ XLBXWM(1:NRIMX+JPHEXT, :,:) = XWT(1:NRIMX+JPHEXT, :,:)
+ XLBXTHM(1:NRIMX+JPHEXT, :,:) = XTHT(1:NRIMX+JPHEXT, :,:)
+ XLBXRM(1:NRIMX+JPHEXT, :,:,:) = XRT(1:NRIMX+JPHEXT, :,:,:)
+ENDIF
+IF(LEAST_ll() .AND. .NOT. L1D) THEN
+ XLBXUM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XUT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
+ XLBXVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XVT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
+ XLBXWM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XWT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
+ XLBXTHM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XTHT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
+ XLBXRM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,:) = XRT(NIU-NRIMX-JPHEXT+1:NIU, :,:,:)
+ENDIF
+IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN
+ XLBYUM(:,1:NRIMY+JPHEXT, :) = XUT(:,1:NRIMY+JPHEXT, :)
+ XLBYVM(:,1:NRIMY+JPHEXT, :) = XVT(:,2:NRIMY+JPHEXT+1, :)
+ XLBYWM(:,1:NRIMY+JPHEXT, :) = XWT(:,1:NRIMY+JPHEXT, :)
+ XLBYTHM(:,1:NRIMY+JPHEXT, :) = XTHT(:,1:NRIMY+JPHEXT, :)
+ XLBYRM(:,1:NRIMY+JPHEXT, :,:) = XRT(:,1:NRIMY+JPHEXT, :,:)
+ENDIF
+IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
+ XLBYUM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XUT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
+ XLBYVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XVT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
+ XLBYWM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XWT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
+ XLBYTHM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XTHT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
+ XLBYRM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,:) = XRT(:,NJU-NRIMY-JPHEXT+1:NJU, :,:)
+ENDIF
+DO JSV = 1, NSV
+ IF(LWEST_ll() .AND. .NOT. L1D) &
+ XLBXSVM(1:NRIMX+JPHEXT, :,:,JSV) = XSVT(1:NRIMX+JPHEXT, :,:,JSV)
+ IF(LEAST_ll() .AND. .NOT. L1D) &
+ XLBXSVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,JSV) = XSVT(NIU-NRIMX-JPHEXT+1:NIU, :,:,JSV)
+ IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
+ XLBYSVM(:,1:NRIMY+JPHEXT, :,JSV) = XSVT(:,1:NRIMY+JPHEXT, :,JSV)
+ IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
+ XLBYSVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,JSV) = XSVT(:,NJU-NRIMY-JPHEXT+1:NJU, :,JSV)
+END DO
+!
+!
+!* 5.8 Add a perturbation to a basic state :
+!
+IF(LPERTURB) CALL SET_PERTURB(TZEXPREFILE)
+!
+!
+!* 5.9 Anelastic correction and pressure:
+!
+IF (.NOT.LOCEAN) THEN
+ CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+ IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
+ CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+END IF
+!
+!
+!* 5.10 Compute THETA, vapor and cloud mixing ratio
+!
+IF (CIDEAL == 'RSOU') THEN
+ ALLOCATE(ZEXN(NIU,NJU,NKU))
+ ALLOCATE(ZT(NIU,NJU,NKU))
+ ALLOCATE(ZTHL(NIU,NJU,NKU))
+ ALLOCATE(ZRT(NIU,NJU,NKU))
+ ALLOCATE(ZCPH(NIU,NJU,NKU))
+ ALLOCATE(ZLVOCPEXN(NIU,NJU,NKU))
+ ALLOCATE(ZLSOCPEXN(NIU,NJU,NKU))
+ ALLOCATE(ZFRAC_ICE(NIU,NJU,NKU))
+ ALLOCATE(ZRSATW(NIU,NJU,NKU))
+ ALLOCATE(ZRSATI(NIU,NJU,NKU))
+ ALLOCATE(ZBUF(NIU,NJU,NKU,16))
+ ZRT=XRT(:,:,:,1)+XRT(:,:,:,2)+XRT(:,:,:,4)
+IF (LOCEAN) THEN
+ ZEXN(:,:,:)= 1.
+ ZT=XTHT
+ ZTHL=XTHT
+ ZCPH=XCPD+ XCPV * XRT(:,:,:,1)
+ ZLVOCPEXN = XLVTT
+ ZLSOCPEXN = XLSTT
+ELSE
+ ZEXN=(XPABST/XP00) ** (XRD/XCPD)
+ ZT=XTHT*(XPABST/XP00)**(XRD/XCPD)
+ ZCPH=XCPD+ XCPV * XRT(:,:,:,1)+ XCL *XRT(:,:,:,2) + XCI * XRT(:,:,:,4)
+ ZLVOCPEXN = (XLVTT + (XCPV-XCL) * (ZT-XTT))/(ZCPH*ZEXN)
+ ZLSOCPEXN = (XLSTT + (XCPV-XCI) * (ZT-XTT))/(ZCPH*ZEXN)
+ ZTHL=XTHT-ZLVOCPEXN*XRT(:,:,:,2)-ZLSOCPEXN*XRT(:,:,:,4)
+ CALL TH_R_FROM_THL_RT(CST, NEB, SIZE(ZFRAC_ICE), 'T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
+ XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI,OOCEAN=.FALSE.,&
+ PBUF=ZBUF)
+END IF
+ DEALLOCATE(ZEXN)
+ DEALLOCATE(ZT)
+ DEALLOCATE(ZCPH)
+ DEALLOCATE(ZLVOCPEXN)
+ DEALLOCATE(ZLSOCPEXN)
+ DEALLOCATE(ZTHL)
+ DEALLOCATE(ZRT)
+ DEALLOCATE(ZBUF)
+! Coherence test
+ IF ((.NOT. LUSERI) ) THEN
+ IF (MAXVAL(XRT(:,:,:,4))/= 0) THEN
+ WRITE(NLUOUT,FMT=*) "*********************************"
+ WRITE(NLUOUT,FMT=*) 'WARNING'
+ WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERI=FALSE '
+ WRITE(NLUOUT,FMT=*) ' BUT WITH YOUR RADIOSOUNDING Ri/=0'
+ WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,4)),MAXVAL(XRT(:,:,:,4))
+ WRITE(NLUOUT,FMT=*) "*********************************"
+ ENDIF
+ ENDIF
+ IF ((.NOT. LUSERC)) THEN
+ IF (MAXVAL(XRT(:,:,:,2))/= 0) THEN
+ WRITE(NLUOUT,FMT=*) "*********************************"
+ WRITE(NLUOUT,FMT=*) 'WARNING'
+ WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERC=FALSE '
+ WRITE(NLUOUT,FMT=*) 'BUT WITH YOUR RADIOSOUNDING RC/=0'
+ WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,2)),MAXVAL(XRT(:,:,:,2))
+ WRITE(NLUOUT,FMT=*) "*********************************"
+ ENDIF
+ ENDIF
+ ! on remet les bonnes valeurs pour NRR
+ IF(CCLOUD=='NONE') NRR=1
+ IF(CCLOUD=='REVE') NRR=2
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. INITIALIZE SCALAR VARIABLES FOR CHEMISTRY
+! -----------------------------------------
+!
+! before calling chemistry
+CCONF = 'START'
+CSTORAGE_TYPE='TT'
+CALL IO_File_close(TZEXPREFILE) ! Close the EXPRE file
+!
+IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB)
+!
+! Initialization LIMA variables by ORILAM
+IF (CCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) &
+ CALL AER2LIMA(XSVT, XRHODREF, XRT(:,:,:,1), XPABST, XTHT, XZZ)
+!-------------------------------------------------------------------------------
+!
+!* 7. INITIALIZE LEVELSET FOR IBM
+! ---------------------------
+!
+IF (LIBM_LSF) THEN
+ !
+ ! In their current state, the IBM can only be used in
+ ! combination with cartesian coordinates and flat orography.
+ !
+ IF ((CZS.NE."FLAT").OR.(.NOT.LCARTESIAN)) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with flat ground')
+ ENDIF
+ !
+ ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
+ !
+ CALL IBM_INIT_LS(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. WRITE THE FMFILE
+! ----------------
+!
+CALL SECOND_MNH2(ZTIME1)
+!
+NNPRAR = 22 + 2*(NRR+NSV) & ! 22 = number of grid variables + reference
+ + 8 + 17 ! state variables + dimension variables
+ ! 2*(8+NRR+NSV) + 1 = number of prognostic
+ ! variables at time t and t-dt
+NTYPE=1
+!
+CALL IO_File_add2list(TINIFILE,TRIM(CINIFILE),'MNH','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB)
+!
+CALL IO_File_open(TINIFILE)
+!
+CALL IO_Header_write(TINIFILE)
+!
+CALL WRITE_DESFM_n(1,TINIFILE)
+!
+CALL WRITE_LFIFM_n(TINIFILE,'') ! There is no DAD model for PREP_IDEAL_CASE
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STORE = XT_STORE + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. EXTERNALIZED SURFACE
+! --------------------
+!
+!
+IF (CSURF =='EXTE') THEN
+ IF (LEN_TRIM(CINIFILEPGD)==0) THEN
+ IF (LEN_TRIM(CPGD_FILE)/=0) THEN
+ CINIFILEPGD=CPGD_FILE
+ ELSE
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CINIFILEPGD needed in NAM_LUNITn')
+ ENDIF
+ ENDIF
+ CALL SURFEX_ALLOC_LIST(1)
+ YSURF_CUR => YSURF_LIST(1)
+ CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
+ ! Switch to model 1 surface variables
+ CALL GOTO_SURFEX(1)
+ !* definition of physiographic fields
+ ! computed ...
+ IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN
+ TPGDFILE => TINIFILE
+ CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.,HDIR='-')
+ CALL PGD_SURF_ATM (YSURF_CUR,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.)
+ CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB)
+ CALL IO_File_open (TINIFILEPGD)
+ TPGDFILE => TINIFILEPGD
+ ELSE
+ ! ... or read from file.
+ CALL INIT_PGD_SURF_ATM( YSURF_CUR, 'MESONH', 'PGD', &
+ ' ', ' ', &
+ TDTCUR%nyear, TDTCUR%nmonth, &
+ TDTCUR%nday, TDTCUR%xtime )
+!
+ END IF
+ !
+ !* forces orography from atmospheric file
+ IF (.NOT. LREAD_ZS) CALL MNHPUT_ZS_n
+ !
+ ! on ecrit un nouveau fichier PGD que s'il n'existe pas
+ IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN
+ !* writing of physiographic fields in the file
+ CSTORAGE_TYPE='PG'
+ !
+ CALL IO_Header_write(TINIFILEPGD)
+ CALL IO_Field_write(TINIFILEPGD,'JPHEXT', JPHEXT)
+ CALL IO_Field_write(TINIFILEPGD,'SURF','EXTE')
+ CALL IO_Field_write(TINIFILEPGD,'L1D', L1D)
+ CALL IO_Field_write(TINIFILEPGD,'L2D', L2D)
+ CALL IO_Field_write(TINIFILEPGD,'PACK',LPACK)
+ CALL WRITE_HGRID(1,TINIFILEPGD)
+ !
+ TOUTDATAFILE => TINIFILEPGD
+ !
+ TFILE_SURFEX => TINIFILEPGD
+ ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
+ CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
+ NULLIFY(TFILE_SURFEX)
+ CSTORAGE_TYPE='TT'
+ ENDIF
+ !
+ !
+ !* rereading of physiographic fields and definition of prognostic fields
+ !* writing of all surface fields
+ TOUTDATAFILE => TINIFILE
+ TFILE_SURFEX => TINIFILE
+ CALL PREP_SURF_MNH(' ',' ')
+ NULLIFY(TFILE_SURFEX)
+ELSE
+ CSURF = "NONE"
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. CLOSES THE FILE
+! ---------------
+!
+IF (CSURF =='EXTE' .AND. (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM)) THEN
+ CALL IO_File_close(TINIFILEPGD)
+ENDIF
+CALL IO_File_close(TINIFILE)
+IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
+ CALL IO_File_close(TPGDFILE)
+ENDIF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. PRINTS ON OUTPUT-LISTING
+! ------------------------
+!
+IF (NVERB >= 5) THEN
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: LCARTESIAN,CIDEAL,CZS=', &
+ LCARTESIAN,CIDEAL,CZS
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: LUSERV=',LUSERV
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: XLON0,XLAT0,XBETA,XRPK,XLONORI,XLATORI=', &
+ XLON0,XLAT0,XBETA,XRPK,XLONORI,XLATORI
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: XDELTAX,XDELTAY=',XDELTAX,XDELTAY
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: NVERB=',NVERB
+ IF(LCARTESIAN) THEN
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: No map projection used.'
+ ELSE
+ IF (XRPK == 1.) THEN
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Polar stereo used.'
+ ELSE IF (XRPK == 0.) THEN
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Mercator used.'
+ ELSE
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Lambert used, cone factor=',XRPK
+ END IF
+ END IF
+END IF
+!
+IF (NVERB >= 5) THEN
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: IIB, IJB, IKB=',NIB,NJB,NKB
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: IIU, IJU, IKU=',NIU,NJU,NKU
+END IF
+!
+!
+!* 28.1 print statistics!
+!
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ XT_START=XT_START+ZTIME2-ZEND
+ !
+ ! Set File Timing OUTPUT
+ !
+ CALL SET_ILUOUT_TIMING(TLUOUT0)
+ !
+ ! Compute global time
+ !
+ CALL TIME_STAT_ll(XT_START,ZTOT)
+ !
+ !
+ IMI = 1
+ CALL TIME_HEADER_ll(IMI)
+ !
+ CALL TIME_STAT_ll(XT_STORE,ZTOT, ' STORE-FIELDS','=')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ WRITE(YMI,FMT="(I0)") IMI
+ CALL TIME_STAT_ll(XT_START,ZTOT, ' MODEL'//YMI,'+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+WRITE(NLUOUT,FMT=*) ' '
+WRITE(NLUOUT,FMT=*) '****************************************************'
+WRITE(NLUOUT,FMT=*) '* PREP_IDEAL_CASE: PREP_IDEAL_CASE ENDS CORRECTLY. *'
+WRITE(NLUOUT,FMT=*) '****************************************************'
+!
+CALL FINALIZE_MNH()
+!
+!
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
+END PROGRAM PREP_IDEAL_CASE
diff --git a/src/PHYEX/ext/prep_real_case.f90 b/src/PHYEX/ext/prep_real_case.f90
new file mode 100644
index 0000000000000000000000000000000000000000..01b3b16db84189f7722de5771b398d9bcd50f45d
--- /dev/null
+++ b/src/PHYEX/ext/prep_real_case.f90
@@ -0,0 +1,1421 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ PROGRAM PREP_REAL_CASE
+! ######################
+!
+!!**** *PREP_REAL_CASE* - program to write an initial FM file from real case
+!! situation.
+!!
+!! PURPOSE
+!! -------
+!!
+!! The purpose of this program is to prepare an initial meso-NH file
+!! (LFIFM and DESFM files) filled by some fields of a real situation.
+!! General data are given by the MESO-NH user in the namelist file
+!! 'PRE_REAL1.nam'. The fields are obtained from three sources:
+!! - an atmospheric input file, which can be:
+!! * an Aladin file, itself obtained from an Arpege file with
+!! the Aladin routine "FULLPOS".
+!! * a grib file (ECMWF, Grib Arpege or Grib Aladin)
+!! * a MESONH file
+!! - an physiographic data file.
+!!
+!! 1) Fields obtained from the Atmospheric file:
+!! -----------------------------------------
+!!
+!! - the projection parameters (checked with PGD file):
+!! reference latitude and longitude
+!! parameter of projection
+!! angle of rotation of the domain
+!!
+!! - the horizontal grid definition (checked with PGD file):
+!! grid mesh
+!! latitude and longitude of the reference point
+!! (with data from PRE_REAL1.nam)
+!!
+!! - thermodynamical 3D and 2D fields:
+!! potential temperature
+!! vapor mixing ratio
+!!
+!! - dynamical fields:
+!! three components of the wind
+!!
+!! - reference anelastic state variables:
+!! profile of virtual potential temperature
+!! profile of dry density
+!! Exner function at model top
+!!
+!! - total dry air mass
+!!
+!!
+!! 2) Fields obtained from the physiographic data file:
+!! ------------------------------------------------
+!!
+!! - the projection parameters:
+!! reference latitude and longitude
+!! parameter of projection
+!! angle of rotation of the domain
+!!
+!! - the horizontal grid definition:
+!! grid mesh
+!! latitude and longitude of the reference point
+!! (with data from PRE_REAL1.nam)
+!! - physiografic fields: (orographic, vegetation, soil and radiation fields)
+!!
+!!
+!! 3) Data obtained from the namelist file PRE_REAL1.nam:
+!! --------------------------------------------------
+!!
+!! - type of equations system
+!! - vertical grid definition
+!! - number of points in x and y directions
+!! - level of verbosity
+!! - name of the different files
+!!
+!!
+!!** METHOD
+!! ------
+!! In this program, once the MESO-NH domain is calculated, all the
+!! 2D or 3D fields are computed on the MESO-NH horizontal domain WITH
+!! the external points. This is particularly important for the large
+!! scale fields during the MESO-NH run.
+!!
+!! 1) The following PREP_REAL_CASE program:
+!!
+!! - set default values for global variables which will be written in
+!! DESFM file (by calling DEFAULT_DESFM1); lateral boundary conditions
+!! are open.
+!!
+!! - opens the different files (by calling OPEN_PRC_FILES).
+!!
+!! - initializes physical constants (by calling INI_CST).
+!!
+!! - initializes the horizontal domain from the data read in the
+!! descriptive part of the Aladin file and the directives read in the
+!! namelist file (routines READ_GENERAL and SET_SUBDOMAIN in
+!! READ_ALL_DATA). This MESO-NH domain is a part of the Aladin domain.
+!!
+!! - initializes global variables from namelists and the MESO-NH
+!! vertical grid definition variables in the namelist file
+!! (routine READ_VER_GRID).
+!!
+!! - initializes the physiographic 2D fields from the physiographic data
+!! file, in particular the MESO-NH orography.
+!!
+!! - reads the 3D and 2D variable fields in the Grib file
+!! (routine READ_ALL_DATA_GRIB_CASE),
+!! if HATMFILETYPE='GRIBEX':
+!! absolute temperature
+!! specific humidity
+!! horizontal contravariant wind
+!! surface pressure
+!! large scale orography
+!!
+!! - reads the 3D and 2D variable fields in the input MESONH file
+!! (routine READ_ALL_DATA_MESONH_CASE), if HATMFILETYPE='MESONH':
+!! potential temperature
+!! vapor mixing ratio
+!! horizontal wind
+!! other mixing ratios
+!! turbulence prognostic and semi-prognostic variables
+!! large scale orography
+!!
+!! - computes some geometric variables (routines SM_GRIDPROJ and METRICS),
+!! in particular:
+!! * altitude 3D array
+!! * metric coefficients
+!! * jacobian
+!!
+!! - initializes MESO-NH thermodynamical fields:
+!! * changes of variables (routine VER_PREP_mmmmmm_CASE):
+!! absolute temperature --> virtual potential temperature
+!! specific humidity --> vapor mixing ratio
+!! * interpolates/extrapolates the fields from the large scale
+!! orography to the MESO-NH one (routine VER_INT_THERMO in
+!! VER_THERMO, by using a shifting function method).
+!! in water vapor case, the interpolations are always performed
+!! on relative humidity.
+!! * the pressure is computed on each grid by integration of the
+!! hydrostatic equation from bottom or top. When input atmospheric
+!! file is a MESO-NH one, information about the difference between
+!! hydrostatic pressure and total pressure is kept and interpolated
+!! during the entire PREP_REAL_CASE process.
+!! * interpolates the fields to the MESO-NH vertical grid
+!! (also by routine VER_INT_THERMO in VER_THERMO).
+!! * computes the potential temperature (routine VER_THERMO).
+!! * sets to zero the mixing ratios, except the vapor mixing ratio
+!! (VER_THERMO).
+!!
+!! - initializes the reference anelastic state variables (routine SET_REFZ
+!! in VER_THERMO).
+!!
+!! - computes the total dry air mass (routine DRY_MASS in VER_THERMO).
+!!
+!! - initializes MESO-NH dynamical variables:
+!! * changes Aladin contravariant wind into true horizontal wind
+!! (in subroutine VER_PREP).
+!! * interpolates/extrapolates the momentum from the large scale
+!! orography to the MESO-NH one (routine VER_INT_DYN in
+!! VER_DYN, by using a shifting function method).
+!! * interpolates the fields to the MESO-NH vertical grid
+!! (also by routine VER_INT_DYN in VER_DYN). The fields
+!! are located on a horizontal Arakawa A-grid, as the Aladin fields.
+!! * The momentum is interpolated to the Arakawa C-grid
+!! (routine VER_DYN).
+!! * A first guess of the vertical momentum, verifying the
+!! uncompressible continuity equation and the material lower boundary
+!! condition against the ground, is computed (routine WGUESS).
+!! * computes the final non-divergent wind field (routine
+!! ANEL_BALANCE).
+!!
+!! - copies the interpolated fields also at t-dt and in the large scale
+!! fields (routine INI_PROG_VAR).
+!!
+!! - writes the DESFM and LFIFM files (routines WRITE_DESFM1 and
+!! WRITE_LFIFM1).
+!!
+!!
+!! 2) Some conventions are used in this program and its subroutines because
+!! of the number of different grids and fields:
+!!
+!! - subscripts:
+!! * the subscripts I and J are used for all the horizontal grid.
+!! * the subcript K is used for the MESO-NH vertical grid (increasing
+!! from bottom to top).
+!! * the subscript L is used for the Aladin or input Mesonh grids
+!! (increasing from bottom to top).
+!!
+!! - suffixes:
+!! * _LS:
+!! If used for a geographic or horizontal grid definition variable,
+!! this variable is connected to the large horizontal domain.
+!! If used for a surface variable, this variable corresponds to
+!! the large scale orography, and therefore will be modified.
+!! If used for another variable, this variable is discretized
+!! on the Aladin or input MESONH file vertical grid
+!! (large-scale orography with input vertical discretization,
+!! either coming from eta levels or input Gal-Chen grid).
+!! * _MX:
+!! Such a variable is discretized on the mixed grid.
+!! (large-scale orography with output Gal-Chen vertical grid
+!! discretization)
+!! * _SH:
+!! Such a variable is discretized on the shifted grid.
+!! (fine orography with a shifted vertical grid, NOT Gal-Chen)
+!! * no suffix:
+!! The variable is discretized on the MESO-NH grid.
+!! (fine orography with output Gal-Chen vertical grid discretization)
+!!
+!! - additional pre-suffixes: (for pressure, Exner and altitude fields)
+!! * MASS:
+!! The variable is discretized on a mass point
+!! * FLUX:
+!! The variable is discretized on a flux point
+!!
+!!
+!! - names of variables: for a physical variable VAR:
+!! * pVARs is the variable itself.
+!! * pRHODVARs is the variable multiplied by the dry density rhod.
+!! * pRHODJVARs is the variable multiplied by the dry density rhod
+!! and the Jacobian.
+!! * pRVARs is the variable multiplied by rhod_ref, the anelastic
+!! reference state dry density and the Jacobian.
+!! where p and s are the appropriate prefix and suffix.
+!!
+!! - allocation of arrays: the arrays are allocated
+!! * just before their initialization for the general arrays stored in
+!! modules.
+!! * in the subroutine in which they are declared for the local arrays
+!! in a subroutine.
+!! * in the routine in which they are initialized for the arrays
+!! defined in the monitor PREP_REAL_CASE. In this case they are in
+!! fact passed as pointer to the subroutines to allow their
+!! dynamical allocation (exception which confirms the rule: ZJ).
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! Routine DEFAULT_DESFM1 : to set default values for variables which can be
+!! contained in DESFM file.
+!! Routine OPEN_PRC_FILES: to open all files.
+!! Routine INI_CST : to initialize physical constants.
+!! Routine READ_ALL_DATA_GRIB_CASE : to read all input data.
+!! Routine READ_ALL_DATA_MESONH_CASE : to read all input data.
+!! Routine SM_GRIDPROJ : to compute some grid variables, in case of
+!! conformal projection.
+!! Routine METRICS : to compute metric coefficients.
+!! Routine VER_PREP_GRIBEX_CASE : to prepare the interpolations.
+!! Routine VER_PREP_MESONH_CASE : to prepare the interpolations.
+!! Routine VER_THERMO : to perform the interpolation of thermodynamical
+!! variables.
+!! Routine VER_DYN : to perform the interpolation of dynamical
+!! variables.
+!! Routine INI_PROG_VAR : to initialize the prognostic varaibles not yet
+!! initialized
+!! Routine WRITE_DESFM1 : to write a DESFM file.
+!! Routine WRITE_LFIFM1 : to write a LFIFM file.
+!! Routine IO_File_close : to close a FM-file (DESFM + LFIFM).
+!!
+!! Module MODE_GRIDPROJ : contains conformal projection routines
+!!
+!! Module MODI_DEFAULT_DESFM1 : interface module for routine DEFAULT_DESFM1
+!! Module MODI_OPEN_PRC_FILES : interface module for routine OPEN_PRC_FILES
+!! Module MODI_READ_ALL_DATA_MESONH_CASE : interface module for routine
+!! READ_ALL_DATA_MESONH_CASE
+!! Module MODI_METRICS : interface module for routine METRICS
+!! Module MODI_VER_PREP_GRIBEX_CASE : interface module for routine
+!! VER_PREP_GRIBEX_CASE
+!! Module MODI_VER_PREP_MESONH_CASE : interface module for routine
+!! VER_PREP_MESONH_CASE
+!! Module MODI_VER_THERMO : interface module for routine VER_THERMO
+!! Module MODI_VER_DYN : interface module for routine VER_DYN
+!! Module MODI_INI_PROG_VAR : interface module for routine INI_PROG_VAR
+!! Module MODI_WRITE_DESFM1 : interface module for routine WRITE_DESFM1
+!! Module MODI_WRITE_LFIFM1 : interface module for routine WRITE_LFIFM1
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! Module MODD_CONF1 : contains configuration variables for model 1.
+!! NRR : number of moist variables
+!! Module MODD_LUNIT : contains logical unit and names of files.
+!! Module MODD_LUNIT : contains logical unit and names of files (model1).
+!! CINIFILE: name of the FM file which will be used for the MESO-NH run.
+!! Module MODD_GRID1 : contains grid variables.
+!! XLAT : latitude of the grid points
+!! XLON : longitudeof the grid points
+!! XXHAT : position xhat in the conformal plane
+!! XYHAT : position yhat in the conformal plane
+!! XDXHAT : horizontal local meshlength on the conformal plane
+!! XDYHAT : horizontal local meshlength on the conformal plane
+!! XZS : MESO-NH orography
+!! XZZ : altitude
+!! XZHAT : height zhat
+!! XMAP : map factor
+!! Module MODD_LBC1 : contains declaration of lateral boundary conditions
+!! CLBCX : X-direction LBC type at left(1) and right(2) boundaries
+!! CLBCY : Y-direction LBC type at left(1) and right(2) boundaries
+!! Module MODD_PARAM1 : contains declaration of the parameterizations' names
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/01/95
+!! Sept. 21, 1995 (J.Stein and V.Masson) surface pressure
+!! Jan. 09, 1996 (V. Masson) pressure function deduced from
+!! hydrostatic pressure
+!! Jan. 31, 1996 (V. Masson) possibility to initialize
+!! atmospheric fields from MESONH file
+!! Mar. 18, 1996 (V. Masson) new vertical extrapolation of Ts
+!! in case of initialization with MESONH file
+!! Apr 17, 1996 (J. Stein ) change the DEFAULT_DESFM CALL
+!! May 25, 1996 (V. Masson) Variable CSTORAGE_TYPE
+!! Aug 26, 1996 (V. Masson) Only thinshell approximation is
+!! currently available.
+!! Sept 24, 1996 (V. Masson) add writing of varaibles for
+!! nesting ('DAD_NAME', 'DXRATIO', 'DYRATIO')
+!! Oct 11, 1996 (V. Masson) L1D and L2D configurations
+!! Oct 28, 1996 (V. Masson) add deallocations and NVERB
+!! default set to 1
+!! Dec 02, 1996 (V. Masson) vertical interpolation of
+!! surface fields in aladin case
+!! Dec 12, 1996 (V. Masson) add LS vertical velocity
+!! Jan 16, 1997 (J. Stein) Durran's anelastic system
+!! May 07, 1997 (V. Masson) add LS tke
+!! Jun 27, 1997 (V. Masson) add absolute pressure
+!! Jul 09, 1997 (V. Masson) add namelist NAM_REAL_CONF
+!! Jul 10, 1997 (V. Masson) add LS epsilon
+!! Aug 25, 1997 (V. Masson) add computing time analysis
+!! Jan 20, 1998 (J. Stein) add LB and LS fields
+!! Apr, 30, 1998 (V. Masson) Large scale VEG and LAI
+!! Jun, 04, 1998 (V. Masson) Large scale D2 and Aladin ISBA
+!! files
+!! Jun, 04, 1998 (V. Masson) Add new soil interface var.
+!! Jan 20, 1999 (J. Stein) add a Boundaries call
+!! March 15 1999 (J. Pettre, V. Bousquet and V. Masson)
+!! initialization from GRIB files
+!! Jul 2000 (F.solmon/V.Masson) Adaptation for patch
+!! according to GRIB or MESONH case
+!! Nov 22, 2000 (P.Tulet, I. Mallet) initialization
+!! from GRIB MOCAGE file
+!! Fev 01, 2001 (D.Gazen) add module MODD_NSV for NSV variable
+!! Jul 02, 2001 (J.Stein) add LCARTESIAN case
+!! Oct 15, 2001 (I.Mallet) allow namelists in different orders
+!! Dec 2003 (V.Masson) removes surface calls
+!! Jun 01, 2002 (O.Nuissier) filtering of tropical cyclone
+!! Aou 09, 2005 (D.Barbary) add CDADATMFILE CDADBOGFILE
+!! May 2006 Remove KEPS
+!! Feb 02, 2012 (C. Mari) interpolation from MOZART
+!! add call to READ_CHEM_NETCDF_CASE &
+!! VER_PREP_NETCDF_CASE
+!! Mar 2012 Add NAM_NCOUT for netcdf output
+!! July 2013 (Bosseur & Filippi) Adds Forefire
+!! Mars 2014 (J.Escobar) Missing 'full' UPDATE_METRICS for arp2lfi // run
+!! April 2014 (G.TANGUY) Add LCOUPLING
+!! 2014 (M.Faivre)
+!! Fevr 2015 (M.Moge) Cleaning up
+!! Aug 2015 (M.Moge) removing EXTRAPOL on XDXX and XDYY in part 8
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Leriche 2015 : add LUSECHEM dans NAM_CH_CONF
+!! Feb 02, 2012 (C. Mari & BV) interpolation from CAMS
+!! add call to READ_CAMS_NETCDF_CASE &
+!! VER_PREP_NETCDF_CASE
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 02/2016 (JP Pinty) Convert CAMS mix ratio to nbr conc
+!
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
+!! B.VIE 2016 : LIMA
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 20/03/2019: missing use MODI_INIT_SALT
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! T.Nagel 02/2021: add IBM
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
+!! M. Leriche 26/01/2022: add reading of CAMS reanalysis for chemistry
+!! and/or for LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CH_M9_n
+USE MODD_CH_MNHC_n, ONLY: LUSECHAQ_n=>LUSECHAQ,LUSECHIC_n=>LUSECHIC, LUSECHEM_n=>LUSECHEM
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_DIM_n
+!UPG*PT
+USE MODD_CH_AEROSOL
+USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN,&
+ LDSTCAMS
+!UPG*PT
+
+USE MODD_DYN_n, CPRESOPT_n=>CPRESOPT, LRES_n=>LRES, XRES_n=>XRES , NITR_n=>NITR
+USE MODD_FIELD_n
+USE MODD_GR_FIELD_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_HURR_CONF
+USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS
+USE MODD_IO, ONLY: TFILEDATA, TFILE_SURFEX
+USE MODD_LBC_n
+USE MODD_LSFIELD_n
+USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE
+USE MODD_LUNIT_n, ONLY: CINIFILE,TINIFILE,TLUOUT
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_n
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_ASSOCIATE
+USE MODD_PREP_REAL
+USE MODD_REF_n
+!UPG*PT
+USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT,&
+ LSLTCAMS
+USE MODD_CH_AERO_n, ONLY: XM3D, XRHOP3D, XSIG3D, XRG3D, XN3D, XCTOTA3D
+!UPG*PT
+USE MODD_TURB_n
+!
+USE MODE_EXTRAPOL
+use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_GRIDCART
+USE MODE_GRIDPROJ
+USE MODE_IO, only: IO_Init
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FIELD_WRITE, only: IO_Header_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_File_find_byname
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_MSG
+USE MODE_POS
+USE MODE_SPLITTINGZ_ll
+!
+USE MODI_BOUNDARIES
+USE MODI_COMPARE_DAD
+USE MODI_DEALLOCATE_MODEL1
+USE MODI_DEALLOC_PARA_LL
+USE MODI_DEFAULT_DESFM_n
+USE MODI_ERROR_ON_TEMPERATURE
+USE MODI_IBM_INIT_LS
+USE MODI_INI_PROG_VAR
+USE MODI_INIT_SALT
+USE MODI_LIMA_MIXRAT_TO_NCONC
+USE MODI_METRICS
+USE MODI_MNHREAD_ZS_DUMMY_n
+USE MODI_MNHWRITE_ZS_DUMMY_n
+USE MODI_OPEN_PRC_FILES
+USE MODI_PREP_SURF_MNH
+USE MODI_PRESSURE_IN_PREP
+USE MODI_READ_ALL_DATA_GRIB_CASE
+USE MODI_READ_ALL_DATA_MESONH_CASE
+USE MODI_READ_ALL_NAMELISTS
+!UPG*PT
+!USE MODI_READ_CAMS_DATA_NETCDF_CASE
+!USE MODI_READ_CHEM_DATA_NETCDF_CASE
+USE MODI_READ_CHEM_DATA_MOZART_CASE
+USE MODI_READ_CHEM_DATA_CAMS_CASE
+USE MODI_READ_LIMA_DATA_NETCDF_CASE
+USE MODI_AER2LIMA
+USE MODI_CH_AER_EQM_INIT_n
+!UPG*PT
+USE MODI_READ_VER_GRID
+USE MODI_SECOND_MNH
+USE MODI_SET_REF
+USE MODI_UPDATE_METRICS
+USE MODI_VER_DYN
+USE MODI_VER_PREP_GRIBEX_CASE
+USE MODI_VER_PREP_MESONH_CASE
+USE MODI_VER_PREP_NETCDF_CASE
+USE MODI_VERSION
+USE MODI_VER_THERMO
+USE MODI_WRITE_DESFM_n
+USE MODI_WRITE_LFIFM_n
+!
+USE MODN_CONF, ONLY: JPHEXT , NHALO
+USE MODN_CONFZ
+USE MODN_PARAM_LIMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of local variables
+! ------------------------------
+!
+CHARACTER(LEN=28) :: YATMFILE ! name of the Atmospheric file
+CHARACTER(LEN=6) :: YATMFILETYPE! type of the Atmospheric file
+CHARACTER(LEN=28) :: YCHEMFILE ! name of the Chemical file
+CHARACTER(LEN=6) :: YCHEMFILETYPE! type of the Chemical file
+!UP*PT
+!CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file
+!CHARACTER(LEN=6) :: YCAMSFILETYPE! type of the input CAMS file
+CHARACTER(LEN=28) :: YLIMAFILE ! name of the input MACC file
+CHARACTER(LEN=6) :: YLIMAFILETYPE! type of the input MACC file
+!UP*PT
+CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file
+CHARACTER(LEN=6) :: YSURFFILETYPE! type of the Surface file
+CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data
+! ! file
+!
+CHARACTER(LEN=28) :: YDAD_NAME ! true name of the atmospheric file
+!
+!* other variables
+!
+REAL,DIMENSION(:,:,:), ALLOCATABLE:: ZJ ! Jacobian
+!
+!* file management variables and counters
+!
+INTEGER :: ILUOUT0 ! logical unit for listing file
+INTEGER :: IPRE_REAL1 ! logical unit for namelist file
+INTEGER :: IRESP ! return code in FM routines
+LOGICAL :: GFOUND ! Return code when searching namelist
+INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions
+!
+REAL :: ZSTART, ZEND, ZTIME1, ZTIME2, ZTOT, ZALL ! for computing time analysis
+REAL :: ZMISC, ZREAD, ZHORI, ZPREP, ZSURF, ZTHERMO, ZDYN, ZDIAG, ZWRITE
+REAL :: ZDG ! diagnostics time in routines
+INTEGER :: IINFO_ll ! return code of // routines
+! Namelist model variables
+CHARACTER(LEN=5) :: CPRESOPT
+INTEGER :: NITR
+LOGICAL :: LRES
+REAL :: XRES
+LOGICAL :: LSHIFT ! flag to perform vertical shift or not.
+LOGICAL :: LDUMMY_REAL ! flag to read and interpolate
+ !dummy fields from GRIBex file
+INTEGER :: JRR ! loop counter for moist var.
+LOGICAL :: LUSECHAQ
+LOGICAL :: LUSECHIC
+LOGICAL :: LUSECHEM
+INTEGER :: JN
+!
+TYPE(TFILEDATA),POINTER :: TZATMFILE => NULL()
+TYPE(TFILEDATA),POINTER :: TZPRE_REAL1FILE => NULL()
+!
+!
+!* 0.3 Declaration of namelists
+! ------------------------
+!
+NAMELIST/NAM_REAL_CONF/ NVERB, CEQNSYS, CPRESOPT, LSHIFT, LDUMMY_REAL, &
+ LRES, XRES, NITR,LCOUPLING, NHALO , JPHEXT
+! Filtering and balancing of the large-scale and radar tropical cyclone
+NAMELIST/NAM_HURR_CONF/ LFILTERING, CFILTERING, &
+XLAMBDA, NK, XLATGUESS, XLONGUESS, XBOXWIND, XRADGUESS, NPHIL, NDIAG_FILT, &
+NLEVELR0,LBOGUSSING, &
+XLATBOG, XLONBOG, XVTMAXSURF, XRADWINDSURF, &
+XMAX, XC, XRHO_Z, XRHO_ZZ, XB_0, XBETA_Z, XBETA_ZZ,&
+XANGCONV0, XANGCONV1000, XANGCONV2000, &
+ CDADATMFILE, CDADBOGFILE
+ NAMELIST/NAM_AERO_CONF/ LORILAM, LINITPM, LDUST, XINIRADIUSI, XINIRADIUSJ,&
+ XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT, CRGUNITD,&
+ LSALT, CRGUNITS, NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,&
+!UPG*PT
+ XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT, &
+ LDSTCAMS, LSLTCAMS,CACTCCN,CCLOUD, NMOD_IFN, NMOD_CCN
+!UPG*PT
+
+NAMELIST/NAM_CH_CONF/ LUSECHAQ,LUSECHIC,LUSECHEM
+!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
+! name of dad of input FM file
+INTEGER :: II, IJ, IGRID, ILENGTH
+CHARACTER (LEN=100) :: HCOMMENT
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
+!UPG*PT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXRHO, ZLBYRHO
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXZZ, ZLBYZZ
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXPABST, ZLBYPABST
+INTEGER :: ILBX,ILBY,IIB,IJB,IIE,IJE
+!UPG*PT
+
+!-------------------------------------------------------------------------------
+!
+CALL MPPDB_INIT()
+!
+CALL GOTO_MODEL(1,ONOFIELDLIST=.TRUE.)
+!
+ZDIAG = 0.
+CALL SECOND_MNH (ZSTART)
+!
+ZHORI = 0.
+ZSURF = 0.
+ZTIME1 = ZSTART
+!
+!* 1. SET DEFAULT VALUES
+! ------------------
+!
+CALL VERSION
+CPROGRAM='REAL '
+!
+CALL ALLOC_FIELD_SCALARS()
+CALL PARAM_ICE_ASSOCIATE()
+CALL DEFAULT_DESFM_n(1)
+NRR=1
+IDX_RVT = 1
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. OPENNING OF THE FILES
+! ---------------------
+CALL IO_Init()
+!
+CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
+ ,YCHEMFILE,YCHEMFILETYPE &
+ ,YSURFFILE,YSURFFILETYPE &
+ ,YPGDFILE,TPGDFILE &
+!UPG*PT
+! ,YCAMSFILE,YCAMSFILETYPE)
+ ,YLIMAFILE,YLIMAFILETYPE)
+!UPG*PT
+ILUOUT0 = TLUOUT0%NLU
+TLUOUT => TLUOUT0
+!
+IF (YATMFILETYPE=='MESONH') THEN
+ LSHIFT = .FALSE.
+ELSE IF (YATMFILETYPE=='GRIBEX') THEN
+ LSHIFT = .TRUE.
+ELSE
+ LSHIFT = .TRUE.
+ WRITE(ILUOUT0,FMT=*) 'HATMFILETYPE WAS SET TO: '//TRIM(YATMFILETYPE)
+ WRITE(ILUOUT0,FMT=*) 'ONLY TWO VALUES POSSIBLE FOR HATMFILETYPE:'
+ WRITE(ILUOUT0,FMT=*) 'EITHER MESONH OR GRIBEX'
+ WRITE(ILUOUT0,FMT=*) '-> JOB ABORTED'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','')
+END IF
+!
+LCPL_AROME=.FALSE.
+LCOUPLING=.FALSE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITIALIZATION OF PHYSICAL CONSTANTS
+! ------------------------------------
+!
+CALL INI_CST
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. READING OF NAMELIST
+! -------------------
+!
+!* 4.1 reading of configuration variables
+!
+IPRE_REAL1 = TZPRE_REAL1FILE%NLU
+!
+CALL INIT_NMLVAR
+CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
+IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
+CALL POSNAM(IPRE_REAL1,'NAM_PARAM_LIMA',GFOUND,ILUOUT0)
+IF (GFOUND) READ(IPRE_REAL1,NAM_PARAM_LIMA)
+!
+CALL INI_FIELD_LIST(1)
+!
+CALL INI_FIELD_SCALARS()
+!
+!* 4.2 reading of values of some configuration variables in namelist
+!
+!
+!JUAN REALZ from prep_surfex
+!
+IF (YATMFILETYPE == 'GRIBEX') THEN
+!
+!* 4.1 Vertical Spatial grid
+!
+CALL INIT_NMLVAR()
+CALL READ_VER_GRID(TZPRE_REAL1FILE)
+!
+CALL IO_Field_read(TPGDFILE,'IMAX',NIMAX)
+CALL IO_Field_read(TPGDFILE,'JMAX',NJMAX)
+!
+NIMAX_ll=NIMAX !! _ll variables are global variables
+NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file
+!
+CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DAD0_ll()
+!JUAN 4/04/2014 correction for PREP_REAL_CASE on Gribex files
+!CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, 128)
+CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
+CALL SET_LBX_ll('OPEN',1)
+CALL SET_LBY_ll('OPEN', 1)
+CALL SET_XRATIO_ll(1, 1)
+CALL SET_YRATIO_ll(1, 1)
+CALL SET_XOR_ll(1, 1)
+CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
+CALL SET_YOR_ll(1, 1)
+CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
+CALL SET_DAD_ll(0, 1)
+!JUANZ
+!CALL INI_PARA_ll(IINFO_ll)
+CALL INI_PARAZ_ll(IINFO_ll)
+!JUANZ
+
+!
+! sizes of arrays of the extended sub-domain
+!
+CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
+!!$CALL GET_DIM_EXT_ll('B',NIU,NJU)
+!!$CALL GET_INDICE_ll(NIB,NJB,NIE,NJE)
+!!$CALL GET_OR_ll('B',IXOR,IYOR)
+ENDIF
+!JUAN REALZ
+!
+LDUMMY_REAL= .FALSE.
+LFILTERING= .FALSE.
+CFILTERING= 'UVT '
+XLATGUESS= XUNDEF ; XLONGUESS= XUNDEF ; XBOXWIND=XUNDEF; XRADGUESS= XUNDEF
+NK=50 ; XLAMBDA=0.2 ; NPHIL=24
+NLEVELR0=15
+NDIAG_FILT=-1
+LBOGUSSING= .FALSE.
+XLATBOG= XUNDEF ; XLONBOG= XUNDEF
+XVTMAXSURF= XUNDEF ; XRADWINDSURF= XUNDEF
+XMAX=16000. ; XC=0.7 ; XRHO_Z=-0.3 ; XRHO_ZZ=0.9
+XB_0=1.65 ; XBETA_Z=-0.5 ; XBETA_ZZ=0.35
+XANGCONV0=0. ; XANGCONV1000=0. ; XANGCONV2000=0.
+CDADATMFILE=' ' ; CDADBOGFILE=' '
+!
+CALL INIT_NMLVAR
+CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
+IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
+CALL POSNAM(IPRE_REAL1,'NAM_HURR_CONF',GFOUND,ILUOUT0)
+IF (GFOUND) READ(IPRE_REAL1,NAM_HURR_CONF)
+CALL POSNAM(IPRE_REAL1,'NAM_CH_CONF',GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CH_CONF)
+CALL UPDATE_MODD_FROM_NMLVAR
+CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
+CALL POSNAM(IPRE_REAL1,'NAM_CONFZ',GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
+CALL POSNAM(IPRE_REAL1,'NAM_IBM_LSF' ,GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF)
+!
+! Sea salt
+CALL INIT_SALT
+!
+!* 4.3 set soil scheme to ISBA for initialization from GRIB
+!
+IF (YATMFILETYPE=='GRIBEX') THEN
+ CLBCX(:) ='OPEN'
+ CLBCY(:) ='OPEN'
+END IF
+!
+CALL SECOND_MNH(ZTIME2)
+ZMISC = ZTIME2 - ZTIME1
+!-------------------------------------------------------------------------------
+!
+!* 5. READING OF THE INPUT DATA
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (YATMFILETYPE=='MESONH') THEN
+ CALL READ_ALL_DATA_MESONH_CASE(TZPRE_REAL1FILE,YATMFILE,TPGDFILE,YDAD_NAME)
+ELSE IF (YATMFILETYPE=='GRIBEX') THEN
+ IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX')THEN
+ CALL READ_ALL_DATA_GRIB_CASE('ATM1',TZPRE_REAL1FILE,YATMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+ ELSE
+ CALL READ_ALL_DATA_GRIB_CASE('ATM0',TZPRE_REAL1FILE,YATMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+ END IF
+!
+ YDAD_NAME=' '
+END IF
+!
+IF (NIMAX==1 .AND. NJMAX==1) THEN
+ L1D=.TRUE.
+ L2D=.FALSE.
+ELSE IF (NJMAX==1) THEN
+ L1D=.FALSE.
+ L2D=.TRUE.
+ELSE
+ L1D=.FALSE.
+ L2D=.FALSE.
+END IF
+!
+! UPG*PT
+!* 5.1 reading of the input chemical data
+!
+!IF(LEN_TRIM(YCHEMFILE)>0)THEN
+! ! read again Nam_aero_conf
+! CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+! IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
+! IF(YCHEMFILETYPE=='GRIBEX') &
+! CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+! IF (YCHEMFILETYPE=='NETCDF') &
+! CALL READ_CHEM_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+!END IF
+!
+!* 5.2 reading the input CAMS data
+!
+!IF(LEN_TRIM(YCAMSFILE)>0)THEN
+! IF(YCAMSFILETYPE=='NETCDF') THEN
+! CALL READ_CAMS_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCAMSFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+! ELSE
+! CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','CANNOT READ CAMS GRIB FILES YET')
+! END IF
+!END IF
+!* 5.1 reading CAMS or MACC files for init LIMA
+!
+IF(LEN_TRIM(YLIMAFILE)>0)THEN
+ IF(YLIMAFILETYPE=='NETCDF') THEN
+ CALL READ_LIMA_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YLIMAFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+ ELSE
+ WRITE(ILUOUT0,FMT=*)
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','Pb in MACC/CAMS file')
+ STOP
+ END IF
+END IF
+!
+!* 5.2 reading of the input chemical data + dusts + salts if needed
+!
+IF(LEN_TRIM(YCHEMFILE)>0)THEN
+ ! read again Nam_aero_conf
+ CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
+ IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
+ IF(YCHEMFILETYPE=='GRIBEX') &
+ CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+ IF (YCHEMFILETYPE=='MOZART') &
+ CALL READ_CHEM_DATA_MOZART_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+ IF (YCHEMFILETYPE=='CAMSEU') &
+ CALL READ_CHEM_DATA_CAMS_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB, &
+ LDUMMY_REAL,LUSECHEM)
+END IF
+
+!UPG*PT
+!
+CALL IO_File_close(TZPRE_REAL1FILE)
+!
+CALL SECOND_MNH(ZTIME2)
+ZREAD = ZTIME2 - ZTIME1 - ZHORI
+!-------------------------------------------------------------------------------
+!
+CALL IO_File_add2list(TINIFILE,CINIFILE,'MNH','WRITE',KLFITYPE=1,KLFIVERB=NVERB)
+CALL IO_File_open(TINIFILE)
+!
+ZTIME1=ZTIME2
+!
+!* 6. CONFIGURATION VARIABLES
+! -----------------------
+!
+!* 6.1 imposed values of some other configuration variables
+!
+CDCONV='NONE'
+CSCONV='NONE'
+CRAD='NONE'
+CCONF='START'
+NRIMX=6
+NRIMY=6
+LHORELAX_UVWTH=.TRUE.
+LHORELAX_RV=LUSERV
+LHORELAX_RC=LUSERC
+LHORELAX_RR=LUSERR
+LHORELAX_RI=LUSERI
+LHORELAX_RS=LUSERS
+LHORELAX_RG=LUSERG
+LHORELAX_RH=LUSERH
+LHORELAX_SV(:)=.FALSE.
+LHORELAX_SVC2R2 = (NSV_C2R2 > 0)
+LHORELAX_SVC1R3 = (NSV_C1R3 > 0)
+LHORELAX_SVLIMA = (NSV_LIMA > 0)
+LHORELAX_SVELEC = (NSV_ELEC > 0)
+LHORELAX_SVCHEM = (NSV_CHEM > 0)
+LHORELAX_SVCHIC = (NSV_CHIC > 0)
+LHORELAX_SVDST = (NSV_DST > 0)
+LHORELAX_SVSLT = (NSV_SLT > 0)
+LHORELAX_SVAER = (NSV_AER > 0)
+LHORELAX_SVPP = (NSV_PP > 0)
+#ifdef MNH_FOREFIRE
+LHORELAX_SVFF = (NSV_FF > 0)
+#endif
+LHORELAX_SVCS = (NSV_CS > 0)
+
+LHORELAX_SVLG = .FALSE.
+LHORELAX_SV(1:NSV)=.TRUE.
+IF ( CTURB /= 'NONE') THEN
+ LHORELAX_TKE = .TRUE.
+ELSE
+ LHORELAX_TKE = .FALSE.
+END IF
+!
+!
+CSTORAGE_TYPE='TT'
+!-------------------------------------------------------------------------------
+!
+!* 8. COMPUTATION OF GEOMETRIC VARIABLES
+! ----------------------------------
+!
+ZTIME1 = ZTIME2
+!
+ALLOCATE(XMAP(SIZE(XXHAT),SIZE(XYHAT)))
+ALLOCATE(XLAT(SIZE(XXHAT),SIZE(XYHAT)))
+ALLOCATE(XLON(SIZE(XXHAT),SIZE(XYHAT)))
+ALLOCATE(XDXHAT(SIZE(XXHAT)))
+ALLOCATE(XDYHAT(SIZE(XYHAT)))
+ALLOCATE(XZZ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
+ALLOCATE(ZJ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
+!
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS, &
+ LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
+ XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ )
+END IF
+!
+CALL MPPDB_CHECK2D(XZS,"prep_real_case8:XZS",PRECISION)
+CALL MPPDB_CHECK2D(XMAP,"prep_real_case8:XMAP",PRECISION)
+CALL MPPDB_CHECK2D(XLAT,"prep_real_case8:XLAT",PRECISION)
+CALL MPPDB_CHECK2D(XLON,"prep_real_case8:XLON",PRECISION)
+CALL MPPDB_CHECK3D(XZZ,"prep_real_case8:XZZ",PRECISION)
+CALL MPPDB_CHECK3D(ZJ,"prep_real_case8:ZJ",PRECISION)
+!
+ALLOCATE(XDXX(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
+ALLOCATE(XDYY(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
+ALLOCATE(XDZX(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
+ALLOCATE(XDZY(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
+ALLOCATE(XDZZ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
+!
+!20131024 add update halo
+!=> corrects on PDXX calculation in metrics and XDXX !!
+CALL ADD3DFIELD_ll( TZFIELDS_ll, XZZ, 'PREP_REAL_CASE::XZZ' )
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+CALL MPPDB_CHECK3D(XDXX,"prc8-beforeupdate_metrics:PDXX",PRECISION)
+CALL MPPDB_CHECK3D(XDYY,"prc8-beforeupdate_metrics:PDYY",PRECISION)
+CALL MPPDB_CHECK3D(XDZX,"prc8-beforeupdate_metrics:PDZX",PRECISION)
+CALL MPPDB_CHECK3D(XDZY,"prc8-beforeupdate_metrics:PDZY",PRECISION)
+!
+CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+!20131112 add update_halo for XDYY and XDZY!!
+CALL ADD3DFIELD_ll( TZFIELDS_ll, XDXX, 'PREP_REAL_CASE::XDXX' )
+CALL ADD3DFIELD_ll( TZFIELDS_ll, XDZX, 'PREP_REAL_CASE::XDZX' )
+CALL ADD3DFIELD_ll( TZFIELDS_ll, XDYY, 'PREP_REAL_CASE::XDYY' )
+CALL ADD3DFIELD_ll( TZFIELDS_ll, XDZY, 'PREP_REAL_CASE::XDZY' )
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+
+!CALL EXTRAPOL('W',XDXX,XDZX)
+!CALL EXTRAPOL('S',XDYY,XDZY)
+
+CALL SECOND_MNH(ZTIME2)
+
+ZMISC = ZMISC + ZTIME2 - ZTIME1
+!-------------------------------------------------------------------------------
+!
+!* 9. PREPARATION OF THE VERTICAL SHIFT AND INTERPOLATION
+! ---------------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (YATMFILETYPE=='GRIBEX') THEN
+ CALL VER_PREP_GRIBEX_CASE('ATM ',ZDG)
+ELSE IF (YATMFILETYPE=='MESONH') THEN
+ CALL VER_PREP_MESONH_CASE(ZDG)
+END IF
+!
+IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX') THEN
+ CALL VER_PREP_GRIBEX_CASE('CHEM',ZDG)
+END IF
+!UPG*PT
+!IF ((LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') .OR. &
+! (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF')) THEN
+! CALL VER_PREP_NETCDF_CASE(ZDG)
+!END IF
+IF (LEN_TRIM(YCHEMFILE)>0 .AND. ((YCHEMFILETYPE=='MOZART').OR. &
+ (YCHEMFILETYPE=='CAMSEU'))) THEN
+ CALL VER_PREP_NETCDF_CASE(ZDG,XSV_LS)
+
+ DEALLOCATE(XSV_LS)
+END IF
+!
+IF (LEN_TRIM(YLIMAFILE)>0 .AND. YLIMAFILETYPE=='NETCDF') THEN
+ CALL VER_PREP_NETCDF_CASE(ZDG,XSV_LS_LIMA)
+ DEALLOCATE(XSV_LS_LIMA)
+END IF
+!UPG*PT
+!
+CALL SECOND_MNH(ZTIME2)
+ZPREP = ZTIME2 - ZTIME1 - ZDG
+ZDIAG = ZDIAG + ZDG
+!-------------------------------------------------------------------------------
+!
+!* 10. VERTICAL INTERPOLATION OF ALL THERMODYNAMICAL VARIABLES
+! -------------------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+ALLOCATE(XPSURF(SIZE(XXHAT),SIZE(XYHAT)))
+!
+CALL EXTRAPOL('E',XEXNTOP2D)
+IF (YATMFILETYPE=='GRIBEX') THEN
+ CALL VER_THERMO(TINIFILE,LSHIFT,XTHV_MX,XR_MX,XZS_LS,XZSMT_LS,XZMASS_MX,XZFLUX_MX,XPMHP_MX,ZJ, &
+ XDXX,XDYY,XEXNTOP2D,XPSURF,ZDG )
+ELSE IF (YATMFILETYPE=='MESONH') THEN
+ CALL VER_THERMO(TINIFILE,LSHIFT,XTHV_MX,XR_MX,XZS_LS,XZSMT_LS,XZMASS_MX,XZFLUX_MX,XPMHP_MX,ZJ, &
+ XDXX,XDYY,XEXNTOP2D,XPSURF,ZDG, &
+ XLSTH_MX,XLSRV_MX )
+END IF
+!
+CALL SECOND_MNH(ZTIME2)
+ZTHERMO = ZTIME2 - ZTIME1 - ZDG
+ZDIAG = ZDIAG + ZDG
+!-------------------------------------------------------------------------------
+!
+!* 12. VERTICAL INTERPOLATION OF DYNAMICAL VARIABLES
+! ---------------------------------------------
+!
+ZTIME1 = ZTIME2
+IF (YATMFILETYPE=='GRIBEX') THEN
+ CALL VER_DYN(LSHIFT,XU_MX,XV_MX,XW_MX,XRHOD_MX,XZFLUX_MX,XZMASS_MX,XZS_LS, &
+ XDXX,XDYY,XDZZ,XDZX,XDZY,ZJ,YATMFILETYPE )
+ELSE IF (YATMFILETYPE=='MESONH') THEN
+ CALL VER_DYN(LSHIFT,XU_MX,XV_MX,XW_MX,XRHOD_MX,XZFLUX_MX,XZMASS_MX,XZS_LS, &
+ XDXX,XDYY,XDZZ,XDZX,XDZY,ZJ,YATMFILETYPE, &
+ XLSU_MX,XLSV_MX,XLSW_MX )
+END IF
+!
+!
+IF (ALLOCATED(XTHV_MX)) DEALLOCATE(XTHV_MX)
+IF (ALLOCATED(XR_MX)) DEALLOCATE(XR_MX)
+IF (ALLOCATED(XPMHP_MX)) DEALLOCATE(XPMHP_MX)
+IF (ALLOCATED(XU_MX)) DEALLOCATE(XU_MX)
+IF (ALLOCATED(XV_MX)) DEALLOCATE(XV_MX)
+IF (ALLOCATED(XW_MX)) DEALLOCATE(XW_MX)
+IF (ALLOCATED(XLSTH_MX)) DEALLOCATE(XLSTH_MX)
+IF (ALLOCATED(XLSRV_MX)) DEALLOCATE(XLSRV_MX)
+IF (ALLOCATED(XLSU_MX)) DEALLOCATE(XLSU_MX)
+IF (ALLOCATED(XLSV_MX)) DEALLOCATE(XLSV_MX)
+IF (ALLOCATED(XLSW_MX)) DEALLOCATE(XLSW_MX)
+IF (ALLOCATED(XZFLUX_MX)) DEALLOCATE(XZFLUX_MX)
+IF (ALLOCATED(XZMASS_MX)) DEALLOCATE(XZMASS_MX)
+IF (ALLOCATED(XRHOD_MX)) DEALLOCATE(XRHOD_MX)
+IF (ALLOCATED(XEXNTOP2D)) DEALLOCATE(XEXNTOP2D)
+IF (ALLOCATED(XZS_LS)) DEALLOCATE(XZS_LS)
+IF (ALLOCATED(XZSMT_LS)) DEALLOCATE(XZSMT_LS)
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. ANELASTIC CORRECTION
+! --------------------
+!
+CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+CALL SECOND_MNH(ZTIME2)
+ZDYN = ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 14. INITIALIZATION OF THE REMAINING PROGNOSTIC VARIABLES (COPIES)
+! -------------------------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='MESONH')THEN
+ CALL INI_PROG_VAR(XTKE_MX,XSV_MX,YCHEMFILE)
+ LHORELAX_SVCHEM = (NSV_CHEM > 0)
+ LHORELAX_SVCHIC = (NSV_CHIC > 0)
+ LHORELAX_SVDST = (NSV_DST > 0)
+ LHORELAX_SVSLT = (NSV_SLT > 0)
+ LHORELAX_SVAER = (NSV_AER > 0)
+ELSE
+!
+!UPG*PT
+!IF (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF') THEN
+IF (LEN_TRIM(YLIMAFILE)>0 .AND. YLIMAFILETYPE=='NETCDF') THEN
+!UPG*PT
+ CALL LIMA_MIXRAT_TO_NCONC(XPABST, XTHT, XRT(:,:,:,1), XSV_MX)
+END IF
+!
+ CALL INI_PROG_VAR(XTKE_MX,XSV_MX)
+END IF
+!
+
+! Initialization of ORILAM variables
+IF (LORILAM) THEN
+ IF (.NOT.(ASSOCIATED(XN3D))) ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
+ IF (.NOT.(ASSOCIATED(XRG3D))) ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
+ IF (.NOT.(ASSOCIATED(XSIG3D))) ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
+ IF (.NOT.(ASSOCIATED(XRHOP3D))) ALLOCATE(XRHOP3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
+ IF (.NOT.(ASSOCIATED(XM3D))) ALLOCATE(XM3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE*3))
+ IF (.NOT.(ASSOCIATED(XCTOTA3D))) &
+ ALLOCATE(XCTOTA3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSP+NCARB+NSOA,JPMODE))
+
+ CALL CH_AER_EQM_INIT_n(XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND),&
+ XSVT(:,:,:,NSV_AERBEG:NSV_AEREND),&
+ XM3D,XRHOP3D,XSIG3D,&
+ XRG3D,XN3D, XRHODREF, XCTOTA3D)
+END IF
+!
+! Initialization LIMA variables by ORILAM
+IF (CCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN
+
+ ! Init LIMA by ORILAM
+ CALL AER2LIMA(XSVT, XRHODREF, XRT(:,:,:,1), XPABST, XTHT,XZZ)
+
+ ! Init LB LIMA by ORILAM
+ ALLOCATE(ZLBXRHO(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
+ ALLOCATE(ZLBYRHO(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
+ ALLOCATE(ZLBXPABST(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
+ ALLOCATE(ZLBYPABST(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
+ ALLOCATE(ZLBXZZ(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
+ ALLOCATE(ZLBYZZ(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
+
+ ILBX=SIZE(XLBXSVM,1)/2-JPHEXT
+ ILBY=SIZE(XLBYSVM,2)/2-JPHEXT
+
+ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+
+ ZLBXRHO(1:ILBX+1,:,:) = XRHODREF(IIB-1:IIB-1+ILBX,:,:)
+ ZLBXRHO(ILBX+2:2*ILBX+2,:,:) = XRHODREF(IIE+1-ILBX:IIE+1,:,:)
+ ZLBYRHO(:,1:ILBY+1,:) = XRHODREF(:,IJB-1:IJB-1+ILBY,:)
+ ZLBYRHO(:,ILBY+2:2*ILBY+2,:) = XRHODREF(:,IJE+1-ILBY:IJE+1,:)
+ ZLBXPABST(1:ILBX+1,:,:) = XPABST(IIB-1:IIB-1+ILBX,:,:)
+ ZLBXPABST(ILBX+2:2*ILBX+2,:,:) = XPABST(IIE+1-ILBX:IIE+1,:,:)
+ ZLBYPABST(:,1:ILBY+1,:) = XPABST(:,IJB-1:IJB-1+ILBY,:)
+ ZLBYPABST(:,ILBY+2:2*ILBY+2,:) = XPABST(:,IJE+1-ILBY:IJE+1,:)
+ ZLBXZZ(1:ILBX+1,:,:) = XZZ(IIB-1:IIB-1+ILBX,:,:)
+ ZLBXZZ(ILBX+2:2*ILBX+2,:,:) = XZZ(IIE+1-ILBX:IIE+1,:,:)
+ ZLBYZZ(:,1:ILBY+1,:) = XZZ(:,IJB-1:IJB-1+ILBY,:)
+ ZLBYZZ(:,ILBY+2:2*ILBY+2,:) = XZZ(:,IJE+1-ILBY:IJE+1,:)
+
+ CALL AER2LIMA(XLBXSVM, ZLBXRHO, XLBXRM(:,:,:,1), ZLBXPABST, XLBXTHM, ZLBXZZ)
+ CALL AER2LIMA(XLBYSVM, ZLBYRHO, XLBYRM(:,:,:,1), ZLBYPABST, XLBYTHM, ZLBYZZ)
+
+ DEALLOCATE(ZLBXRHO)
+ DEALLOCATE(ZLBYRHO)
+ DEALLOCATE(ZLBXPABST)
+ DEALLOCATE(ZLBYPABST)
+ DEALLOCATE(ZLBXZZ)
+ DEALLOCATE(ZLBYZZ)
+
+END IF
+!
+IF (ALLOCATED(XSV_MX)) DEALLOCATE(XSV_MX)
+IF (ALLOCATED(XTKE_MX)) DEALLOCATE(XTKE_MX)
+!
+CALL BOUNDARIES ( &
+ 0.,CLBCX,CLBCY,NRR,NSV,1, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XRHODJ,XRHODREF, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
+!
+CALL SECOND_MNH(ZTIME2)
+ZMISC = ZMISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 15. Error on temperature during interpolations
+! ------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (YATMFILETYPE=='GRIBEX' .AND. NVERB>1) THEN
+ CALL ERROR_ON_TEMPERATURE(XT_LS,XPMASS_LS,XPABST,XPS_LS,XPSURF)
+END IF
+!
+IF (YATMFILETYPE=='GRIBEX') THEN
+ DEALLOCATE(XT_LS)
+ DEALLOCATE(XPMASS_LS)
+ DEALLOCATE(XPS_LS)
+END IF
+!
+IF (ALLOCATED(XPSURF)) DEALLOCATE(XPSURF)
+!
+CALL SECOND_MNH(ZTIME2)
+ZDIAG = ZDIAG + ZTIME2 - ZTIME1
+!-------------------------------------------------------------------------------
+!
+!* 16. INITIALIZE LEVELSET FOR IBM
+! ---------------------------
+!
+IF (LIBM_LSF) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with cartesian coordinates')
+ ENDIF
+ !
+ CALL GET_DIM_EXT_ll('B',NIU,NJU)
+ NKU=NKMAX+2*JPVEXT
+ !
+ ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
+ !
+ CALL IBM_INIT_LS(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. WRITING OF THE MESO-NH FM-FILE
+! ------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CSTORAGE_TYPE='TT'
+IF (YATMFILETYPE=='GRIBEX') THEN
+ CSURF = "EXTE"
+ DO JRR=1,NRR
+ IF (JRR==1) THEN
+ LUSERV=.TRUE.
+ IDX_RVT = JRR
+ END IF
+ IF (JRR==2) THEN
+ LUSERC=.TRUE.
+ IDX_RCT = JRR
+ END IF
+ IF (JRR==3) THEN
+ LUSERR=.TRUE.
+ IDX_RRT = JRR
+ END IF
+ IF (JRR==4) THEN
+ LUSERI=.TRUE.
+ IDX_RIT = JRR
+ END IF
+ IF (JRR==5) THEN
+ LUSERS=.TRUE.
+ IDX_RST = JRR
+ END IF
+ IF (JRR==6) THEN
+ LUSERG=.TRUE.
+ IDX_RGT = JRR
+ END IF
+ IF (JRR==7) THEN
+ LUSERH=.TRUE.
+ IDX_RHT = JRR
+ END IF
+ END DO
+END IF
+!
+CALL WRITE_DESFM_n(1,TINIFILE)
+CALL IO_Header_write(TINIFILE,HDAD_NAME=YDAD_NAME)
+CALL WRITE_LFIFM_n(TINIFILE,YDAD_NAME)
+!
+CALL SECOND_MNH(ZTIME2)
+ZWRITE = ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 18. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS
+! -----------------------------------------
+!
+!* reading in the PGD file
+!
+CALL MNHREAD_ZS_DUMMY_n(TPGDFILE)
+!
+!* writing in the output file
+!
+TOUTDATAFILE => TINIFILE
+CALL MNHWRITE_ZS_DUMMY_n(TINIFILE)
+!
+CALL DEALLOCATE_MODEL1(3)
+!
+IF (YATMFILETYPE=='MESONH'.AND. YATMFILE/=YPGDFILE) THEN
+ CALL IO_File_find_byname(TRIM(YATMFILE),TZATMFILE,IRESP)
+ CALL IO_File_close(TZATMFILE)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 19. INTERPOLATION OF SURFACE VARIABLES
+! ----------------------------------
+!
+IF (.NOT. LCOUPLING ) THEN
+ ZTIME1 = ZTIME2
+!
+ IF (CSURF=="EXTE") THEN
+ IF (YATMFILETYPE/='MESONH') THEN
+ CALL SURFEX_ALLOC_LIST(1)
+ YSURF_CUR => YSURF_LIST(1)
+ CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
+ ENDIF
+ CALL GOTO_SURFEX(1)
+ TFILE_SURFEX => TINIFILE
+ CALL PREP_SURF_MNH(YSURFFILE,YSURFFILETYPE)
+ NULLIFY(TFILE_SURFEX)
+ ENDIF
+!
+ CALL SECOND_MNH(ZTIME2)
+ ZSURF = ZSURF + ZTIME2 - ZTIME1
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 20. EPILOGUE
+! --------
+!
+WRITE(ILUOUT0,*)
+WRITE(ILUOUT0,*)
+WRITE(ILUOUT0,*)
+WRITE(ILUOUT0,*) '**************************************************'
+WRITE(ILUOUT0,*) '* PREP_REAL_CASE: PREP_REAL_CASE ends correctly. *'
+WRITE(ILUOUT0,*) '**************************************************'
+WRITE(ILUOUT0,*)
+!
+!-------------------------------------------------------------------------------
+!
+CALL SECOND_MNH (ZEND)
+!
+ZTOT = ZEND - ZSTART ! for computing time analysis
+!
+ZALL = ZMISC + ZREAD + ZHORI + ZPREP + ZTHERMO + ZSURF + ZDYN + ZDIAG + ZWRITE
+!
+WRITE(ILUOUT0,*)
+WRITE(ILUOUT0,*) ' ------------------------------------------------------------ '
+WRITE(ILUOUT0,*) '| |'
+WRITE(ILUOUT0,*) '| COMPUTING TIME ANALYSIS in PREP_REAL_CASE |'
+WRITE(ILUOUT0,*) '| |'
+WRITE(ILUOUT0,*) '|------------------------------------------------------------|'
+WRITE(ILUOUT0,*) '| | | |'
+WRITE(ILUOUT0,*) '| ROUTINE NAME | CPU-TIME | PERCENTAGE % |'
+WRITE(ILUOUT0,*) '| | | |'
+WRITE(ILUOUT0,*) '|---------------------|-------------------|------------------|'
+WRITE(ILUOUT0,*) '| | | |'
+WRITE(UNIT=ILUOUT0,FMT=2) ZREAD, 100.*ZREAD/ZTOT
+WRITE(UNIT=ILUOUT0,FMT=9) ZHORI, 100.*ZHORI/ZTOT
+WRITE(UNIT=ILUOUT0,FMT=3) ZPREP, 100.*ZPREP/ZTOT
+WRITE(UNIT=ILUOUT0,FMT=4) ZTHERMO, 100.*ZTHERMO/ZTOT
+WRITE(UNIT=ILUOUT0,FMT=6) ZDYN, 100.*ZDYN/ZTOT
+WRITE(UNIT=ILUOUT0,FMT=7) ZDIAG, 100.*ZDIAG/ZTOT
+WRITE(UNIT=ILUOUT0,FMT=8) ZWRITE, 100.*ZWRITE/ZTOT
+WRITE(UNIT=ILUOUT0,FMT=1) ZMISC, 100.*ZMISC/ZTOT
+WRITE(UNIT=ILUOUT0,FMT=5) ZSURF, 100.*ZSURF/ZTOT
+!
+WRITE(UNIT=ILUOUT0,FMT=10) ZTOT , 100.*ZALL/ZTOT
+WRITE(ILUOUT0,*) ' ------------------------------------------------------------ '
+!
+! FORMATS
+! -------
+!
+2 FORMAT(' | READING OF DATA | ',F8.3,' | ',F8.3,' |')
+9 FORMAT(' | HOR. INTERPOLATIONS | ',F8.3,' | ',F8.3,' |')
+3 FORMAT(' | VER_PREP | ',F8.3,' | ',F8.3,' |')
+4 FORMAT(' | VER_THERMO | ',F8.3,' | ',F8.3,' |')
+6 FORMAT(' | VER_DYN | ',F8.3,' | ',F8.3,' |')
+7 FORMAT(' | DIAGNOSTICS | ',F8.3,' | ',F8.3,' |')
+8 FORMAT(' | WRITE | ',F8.3,' | ',F8.3,' |')
+1 FORMAT(' | MISCELLANEOUS | ',F8.3,' | ',F8.3,' |')
+5 FORMAT(' | SURFACE | ',F8.3,' | ',F8.3,' |')
+10 FORMAT(' | PREP_REAL_CASE | ',F8.3,' | ',F8.3,' |')
+!
+!-------------------------------------------------------------------------------
+!
+IF (LEN_TRIM(YDAD_NAME)>0) THEN
+ WRITE(ILUOUT0,*) ' '
+ WRITE(ILUOUT0,*) ' ------------------------------------------------------------'
+ WRITE(ILUOUT0,*) '| Nesting allowed |'
+ WRITE(ILUOUT0,*) '| DAD_NAME="',YDAD_NAME,'" |'
+ WRITE(ILUOUT0,*) ' ------------------------------------------------------------'
+ WRITE(ILUOUT0,*) ' '
+ELSE
+ WRITE(ILUOUT0,*) ' '
+ WRITE(ILUOUT0,*) ' ------------------------------------------------------------'
+ WRITE(ILUOUT0,*) '| Nesting not allowed with a larger-scale model. |'
+ WRITE(ILUOUT0,*) '| The new file can only be used as model number 1 |'
+ WRITE(ILUOUT0,*) ' ------------------------------------------------------------'
+ WRITE(ILUOUT0,*) ' '
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+CALL IO_File_close(TINIFILE)
+CALL IO_File_close(TPGDFILE)
+!
+CALL FINALIZE_MNH()
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+
+SUBROUTINE INIT_NMLVAR
+CPRESOPT=CPRESOPT_n
+LRES=LRES_n
+XRES=XRES_n
+NITR=NITR_n
+LUSECHAQ=LUSECHAQ_n
+LUSECHIC=LUSECHIC_n
+LUSECHEM=LUSECHEM_n
+END SUBROUTINE INIT_NMLVAR
+
+SUBROUTINE UPDATE_MODD_FROM_NMLVAR
+CPRESOPT_n=CPRESOPT
+LRES_n=LRES
+XRES_n=XRES
+NITR_n=NITR
+LUSECHAQ_n=LUSECHAQ
+LUSECHIC_n=LUSECHIC
+LUSECHEM_n=LUSECHEM
+END SUBROUTINE UPDATE_MODD_FROM_NMLVAR
+
+END PROGRAM PREP_REAL_CASE
diff --git a/src/PHYEX/ext/resolved_cloud.f90 b/src/PHYEX/ext/resolved_cloud.f90
new file mode 100644
index 0000000000000000000000000000000000000000..de801f6af6b57543a3c919338819a40dd82793a0
--- /dev/null
+++ b/src/PHYEX/ext/resolved_cloud.f90
@@ -0,0 +1,1136 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_RESOLVED_CLOUD
+! ##########################
+INTERFACE
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+ KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
+ HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
+ OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
+ PTHM, PRCM, PPABSTT, &
+ PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
+ PICEFR, &
+ PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
+ ORAIN, OWARM, OHHONI, OCONVHG, &
+ PCF_MF,PRC_MF, PRI_MF, &
+ PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, &
+ PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, &
+ PSOLORG,PMI, &
+ PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
+ PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PSEA,PTOWN )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
+ ! paramerization
+CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integrations for rain sedimendation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integrations for ice sedimendation
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+ ! concentration at time t
+LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for ICE3
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation through temp.
+ ! evolution in C2R2 and KHKO
+LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for C2R2 or KHKO
+LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
+ ! cloud crystal sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
+ ! raindrop formation
+LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
+ ! by slow warm microphysical
+ ! processes
+LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
+LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
+ ! hail to graupel
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+END SUBROUTINE RESOLVED_CLOUD
+END INTERFACE
+END MODULE MODI_RESOLVED_CLOUD
+!
+! ##########################################################################
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+ KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
+ HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
+ OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
+ PTHM, PRCM, PPABSTT, &
+ PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
+ PICEFR, &
+ PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
+ ORAIN, OWARM, OHHONI, OCONVHG, &
+ PCF_MF,PRC_MF, PRI_MF, &
+ PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, &
+ PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, &
+ PSOLORG,PMI, &
+ PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
+ PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PSEA,PTOWN )
+! ##########################################################################
+!
+!!**** * - compute the resolved clouds and precipitation
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! related to the resolved clouds and precipitation
+!!
+!!
+!!** METHOD
+!! ------
+!! The main actions of this routine is to call the routines computing the
+!! microphysical sources. Before that:
+!! - it computes the real absolute pressure,
+!! - negative values of the current guess of all mixing ratio are removed.
+!! This is done by a global filling algorithm based on a multiplicative
+!! method (Rood, 1987), in order to conserved the total mass in the
+!! simulation domain.
+!! - Sources are transformed in physical tendencies, by removing the
+!! multiplicative term Rhod*J.
+!! - External points values are filled owing to the use of cyclic
+!! l.b.c., in order to performe computations on the full domain.
+!! After calling to microphysical routines, the physical tendencies are
+!! switched back to prognostic variables.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine SLOW_TERMS: Computes the explicit microphysical sources
+!! Subroutine FAST_TERMS: Performs the saturation adjustment for l
+!! Subroutine RAIN_ICE : Computes the explicit microphysical sources for i
+!! Subroutine ICE_ADJUST: Performs the saturation adjustment for i+l
+!! MIN_ll,SUM3D_ll : distributed functions equivalent to MIN and SUM
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : contains declarations of parameter variables
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CST
+!! CST%XP00 ! Reference pressure
+!! CST%XRD ! Gaz constant for dry air
+!! CST%XCPD ! Cpd (dry air)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1 and book2 of documentation ( routine RESOLVED_CLOUD )
+!!
+!! AUTHOR
+!! ------
+!! E. Richard * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/12/94
+!! Modifications: June 8, 1995 ( J.Stein )
+!! Cleaning to improve efficienty and clarity
+!! in agreement with the MESO-NH coding norm
+!! March 1, 1996 ( J.Stein )
+!! store the cloud fraction
+!! March 18, 1996 ( J.Stein )
+!! check that ZMASSPOS /= 0
+!! Oct. 12, 1996 ( J.Stein )
+!! remove the negative values correction
+!! for the KES2 case
+!! Modifications: Dec 14, 1995 (J.-P. Pinty)
+!! Add the mixed-phase option
+!! Modifications: Jul 01, 1996 (J.-P. Pinty)
+!! Change arg. list in routine FAST_TERMS
+!! Modifications: Jan 27, 1997 (J.-P. Pinty)
+!! add W and SV in arg. list
+!! Modifications: March 23, 98 (E.Richard)
+!! correction of negative value based on
+!! rv+rc+ri and thetal or thetail conservation
+!! Modifications: April 08, 98 (J.-P. Lafore and V. Ducrocq )
+!! modify the correction of negative values
+!! Modifications: June 08, 00 (J.-P. Pinty and J.-M. Cohard)
+!! add the C2R2 scheme
+!! Modifications: April 08, 01 (J.-P. Pinty)
+!! add the C3R5 scheme
+!! Modifications: July 21, 01 (J.-P. Pinty)
+!! Add OHHONI and PW_ACT (for haze freezing)
+!! Modifications: Sept 21, 01 (J.-P. Pinty)
+!! Add XCONC_CCN limitation
+!! Modifications: Nov 21, 02 (J.-P. Pinty)
+!! Add ICE4 and C3R5 options
+!! June, 2005 (V. Masson)
+!! Technical change in interface for scalar arguments
+!! Modifications : March, 2006 (O.Geoffroy)
+!! Add KHKO scheme
+!! Modifications : March 2013 (O.Thouron)
+!! Add prognostic supersaturation
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Mazoyer : 04/2016 : Temperature radiative tendency used for
+!! activation by cooling (OACTIT)
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 10/2016 M.Mazoyer New KHKO output fields
+!! 10/2016 (C.Lac) Add droplet deposition
+!! S.Riette : 11/2016 : ice_adjust before and after rain_ice
+!! ICE3/ICE4 modified, old version under LRED=F
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
+! C. Lac 02/2019: add rain fraction as an output field
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+! P. Wautelet 11/06/2020: bugfix: correct ZSVS array indices
+! P. Wautelet 11/06/2020: bugfix: add "Non local correction for precipitating species" for ICE4
+! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 23/06/2020: remove ZSVS and ZSVT to improve code readability
+! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
+! P. Wautelet 30/06/2020: remove non-local corrections
+! B. Vie 06/2020: add prognostic supersaturation for LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_BUDGET, ONLY: TBUDGETS, TBUCONF
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_DUST, ONLY: LDUST
+USE MODD_CST, ONLY: CST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_DUST , ONLY: LDUST
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NEB, ONLY: NEB
+USE MODD_NSV, ONLY: NSV, NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END, &
+ NSV_LIMA_BEG, NSV_LIMA_END, NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, &
+ NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR, NSV_AEREND,NSV_DSTEND,NSV_SLTEND
+USE MODD_PARAM_C2R2, ONLY: LSUPSAT
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_ICE, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED, &
+ PARAM_ICE
+USE MODD_PARAM_LIMA, ONLY: LADJ, LCOLD, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN, RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: TURBN, CSUBG_AUCV_RI, CCONDENS, CLAMBDA3, CSUBG_MF_PDF
+!
+USE MODE_ll
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+use mode_sources_neg_correct, only: Sources_neg_correct
+!
+USE MODI_C2R2_ADJUST
+USE MODI_FAST_TERMS
+USE MODI_GET_HALO
+USE MODI_ICE_ADJUST
+USE MODI_KHKO_NOTADJUST
+USE MODI_LIMA
+USE MODI_LIMA_ADJUST
+USE MODI_LIMA_ADJUST_SPLIT
+USE MODI_LIMA_COLD
+USE MODI_LIMA_MIXED
+USE MODI_LIMA_NOTADJUST
+USE MODI_LIMA_WARM
+USE MODI_RAIN_C2R2_KHKO
+USE MODI_RAIN_ICE
+USE MODI_RAIN_ICE_OLD
+USE MODI_SHUMAN
+USE MODI_SLOW_TERMS
+USE MODI_AER2LIMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integrations for rain sedimendation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integrations for ice sedimendation
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+ ! concentration at time t
+LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for ICE3
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation through temp.
+ ! evolution in C2R2 and KHKO
+LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
+ ! cloud crystal sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
+ ! raindrop formation
+LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
+ ! by slow warm microphysical
+ ! processes
+LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
+LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
+ ! hail to graupel
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JRR,JSV ! Loop index for the moist and scalar variables
+INTEGER :: IIB ! Define the physical domain
+INTEGER :: IIE !
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+INTEGER :: IKU
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: JK,JI,JL
+!
+!
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDZZ
+real, dimension(:,:,:), allocatable :: ZEXN
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ
+ ! model layer height
+! REAL :: ZMASSTOT ! total mass for one water category
+! ! including the negative values
+! REAL :: ZMASSPOS ! total mass for one water category
+! ! after removing the negative values
+! REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
+!
+INTEGER :: ISVBEG ! first scalar index for microphysics
+INTEGER :: ISVEND ! last scalar index for microphysics
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies
+!UPG*PT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
+!UPG*PT
+
+LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: LLMICRO ! mask to limit computation
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
+!
+INTEGER :: JMOD, JMOD_IFN
+LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
+LOGICAL :: LMFCONV ! =SIZE(PMFCONV)!=0
+! BVIE work array waiting for PINPRI
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZICEFR
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZPRCFR
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZTM
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSIGQSAT2D
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDUM
+ZSIGQSAT2D(:,:) = PSIGQSAT
+!
+!------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+IKU=SIZE(PZZ,3)
+!
+CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3))
+!
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+GSOUTH = LSOUTH_ll()
+GNORTH = LNORTH_ll()
+!
+LMFCONV=(SIZE(PMFCONV)/=0)
+!
+IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN
+ ISVBEG = NSV_C2R2BEG
+ ISVEND = NSV_C2R2END
+ELSE IF (HCLOUD == 'C3R5') THEN
+ ISVBEG = NSV_C2R2BEG
+ ISVEND = NSV_C1R3END
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ISVBEG = NSV_LIMA_BEG
+ IF (.NOT. LDUST .AND. .NOT. LSALT .AND. .NOT. LORILAM) THEN
+ ISVEND = NSV_LIMA_END
+ ELSE
+ IF (LORILAM) THEN
+ ISVEND = NSV_AEREND
+ END IF
+ IF (LDUST) THEN
+ ISVEND = NSV_DSTEND
+ END IF
+ IF (LSALT) THEN
+ ISVEND = NSV_SLTEND
+ END IF
+ END IF
+ELSE
+ ISVBEG = 0
+ ISVEND = 0
+END IF
+!
+!
+!
+!* 1. From ORILAM to LIMA:
+!
+IF (HCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN
+! ORILAM : tendance s --> variable instant t
+ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV))
+ DO JSV = 1, NSV
+ ZSVT(:,:,:,JSV) = PSVS(:,:,:,JSV) * PTSTEP / PRHODJ(:,:,:)
+ END DO
+
+CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,1),&
+ PPABST(IIB:IIE,IJB:IJE,IKB:IKE),&
+ PTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
+
+! LIMA : variable instant t --> tendance s
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+1) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE+2) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+2) * &
+ PRHODJ(:,:,:) / PTSTEP
+
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE+1) * &
+ PRHODJ(:,:,:) / PTSTEP
+
+DEALLOCATE(ZSVT)
+END IF
+
+!UPG*PT
+!
+IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN
+ ALLOCATE(ZRSMIN(SIZE(XRTMIN)))
+ ZRSMIN(:) = XRTMIN(:) / PTSTEP
+END IF
+!
+!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
+! ---------------------------------------
+!
+PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
+DO JRR = 1,KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
+END DO
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
+ ENDDO
+ENDIF
+!
+! complete the lateral boundaries to avoid possible problems
+!
+DO JI=1,JPHEXT
+ PTHS(JI,:,:) = PTHS(IIB,:,:)
+ PTHS(IIE+JI,:,:) = PTHS(IIE,:,:)
+ PTHS(:,JI,:) = PTHS(:,IJB,:)
+ PTHS(:,IJE+JI,:) = PTHS(:,IJE,:)
+!
+ PRS(JI,:,:,:) = PRS(IIB,:,:,:)
+ PRS(IIE+JI,:,:,:) = PRS(IIE,:,:,:)
+ PRS(:,JI,:,:) = PRS(:,IJB,:,:)
+ PRS(:,IJE+JI,:,:) = PRS(:,IJE,:,:)
+END DO
+!
+! complete the physical boundaries to avoid some computations
+!
+IF(GWEST .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0
+IF(GEAST .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0
+IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0
+IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+DO JI=1,JPHEXT
+ PSVS(JI, :, :, ISVBEG:ISVEND) = PSVS(IIB, :, :, ISVBEG:ISVEND)
+ PSVS(IIE+JI, :, :, ISVBEG:ISVEND) = PSVS(IIE, :, :, ISVBEG:ISVEND)
+ PSVS(:, JI, :, ISVBEG:ISVEND) = PSVS(:, IJB, :, ISVBEG:ISVEND)
+ PSVS(:, IJE+JI, :, ISVBEG:ISVEND) = PSVS(:, IJE, :, ISVBEG:ISVEND)
+END DO
+ !
+! complete the physical boundaries to avoid some computations
+!
+ IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0
+ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0
+ENDIF
+!
+! complete the vertical boundaries
+!
+PTHS(:,:,IKB-1) = PTHS(:,:,IKB)
+PTHS(:,:,IKE+1) = PTHS(:,:,IKE)
+!
+PRS(:,:,IKB-1,:) = PRS(:,:,IKB,:)
+PRS(:,:,IKE+1,:) = PRS(:,:,IKE,:)
+!
+PRT(:,:,IKB-1,:) = PRT(:,:,IKB,:)
+PRT(:,:,IKE+1,:) = PRT(:,:,IKE,:)
+!
+IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' &
+ .OR. HCLOUD == 'LIMA') THEN
+ PSVS(:,:,IKB-1,ISVBEG:ISVEND) = PSVS(:,:,IKB,ISVBEG:ISVEND)
+ PSVS(:,:,IKE+1,ISVBEG:ISVEND) = PSVS(:,:,IKE,ISVBEG:ISVEND)
+ PSVT(:,:,IKB-1,ISVBEG:ISVEND) = PSVT(:,:,IKB,ISVBEG:ISVEND)
+ PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND)
+ENDIF
+!
+!
+!* 3. REMOVE NEGATIVE VALUES
+! ----------------------
+!
+!* 3.1 Non local correction for precipitating species (Rood 87)
+!
+! IF ( HCLOUD == 'KESS' &
+! .OR. HCLOUD == 'ICE3' .OR. HCLOUD == 'ICE4' &
+! .OR. HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' &
+! .OR. HCLOUD == 'KHKO' .OR. HCLOUD == 'LIMA' ) THEN
+! !
+! DO JRR = 3,KRR
+! SELECT CASE (JRR)
+! CASE(3,5,6,7) ! rain, snow, graupel and hail
+!
+! IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll) < 0.0 ) THEN
+! !
+! ! compute the total water mass computation
+! !
+! ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
+! !
+! ! remove the negative values
+! !
+! PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
+! !
+! ! compute the new total mass
+! !
+! ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
+! !
+! ! correct again in such a way to conserve the total mass
+! !
+! ZRATIO = ZMASSTOT / ZMASSPOS
+! PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
+! !
+! END IF
+! END SELECT
+! END DO
+! END IF
+!
+!* 3.2 Adjustement for liquid and solid cloud
+!
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+!
+!* 3.4 Limitations of Na and Nc to the CCN max number concentration
+!
+! Commented by O.Thouron 03/2013
+!IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') &
+! .AND.(XCONC_CCN > 0)) THEN
+! IF ((HACTCCN /= 'ABRK')) THEN
+! ZSVT(:,:,:,1) = MIN( ZSVT(:,:,:,1),XCONC_CCN )
+! ZSVT(:,:,:,2) = MIN( ZSVT(:,:,:,2),XCONC_CCN )
+! ZSVS(:,:,:,1) = MIN( ZSVS(:,:,:,1),XCONC_CCN )
+! ZSVS(:,:,:,2) = MIN( ZSVS(:,:,:,2),XCONC_CCN )
+! END IF
+!END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HCLOUD )
+ CASE ('REVE')
+!
+!* 4. REVERSIBLE MICROPHYSICAL SCHEME
+! -------------------------------
+!
+ CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PCF_MF,PRC_MF, &
+ PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
+!
+ CASE ('KESS')
+!
+!* 5. KESSLER MICROPHYSICAL SCHEME
+! ----------------------------
+!
+!
+!* 5.1 Compute the explicit microphysical sources
+!
+ CALL SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, &
+ PZZ, PRHODJ, PRHODREF, PCLDFR, &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), PPABST, &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PINPRR, PINPRR3D, PEVAP3D )
+!
+!* 5.2 Perform the saturation adjustment
+!
+ CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PCF_MF,PRC_MF, &
+ PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3), &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
+!
+!
+ CASE ('C2R2','KHKO')
+!
+!* 7. 2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO
+! ---------------------------------------
+!
+!
+!* 7.1 Compute the explicit microphysical sources
+!
+!
+ CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PTHM, PRCM, PPABSTT, &
+ PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
+ PSVT(:,:,:,NSV_C2R2BEG), PSVT(:,:,:,NSV_C2R2BEG+1), &
+ PSVT(:,:,:,NSV_C2R2BEG+2), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG+2), &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D , &
+ PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN, &
+ PINDEP, PSUPSAT, PNACT )
+!
+!
+!* 7.2 Perform the saturation adjustment
+!
+ IF (LSUPSAT) THEN
+ CALL KHKO_NOTADJUST (KRR, KTCOUNT,TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PZZ, &
+ PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), &
+ PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+3), PCLDFR, PSRCS, PNPRO, PSSPRO )
+!
+ ELSE
+ CALL C2R2_ADJUST ( KRR,TPFILE, HRAD, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PCNUCS=PSVS(:,:,:,NSV_C2R2BEG), &
+ PCCS=PSVS(:,:,:,NSV_C2R2BEG+1), &
+ PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) )
+!
+ END IF
+!
+ CASE ('ICE3')
+!
+!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
+! -----------------------------------------------------
+!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+ ZEXN(:,:,:)= (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
+!
+!* 9.1 Compute the explicit microphysical sources
+!
+!
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF(LRED .AND. LADJ_BEFORE) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
+ CFRAC_ICE_ADJUST, &
+ 'ADJU', .FALSE., .FALSE., &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV,PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ ENDIF
+ IF (LRED) THEN
+ LLMICRO(:,:,:) = .FALSE.
+ LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE)=PRT(IIB:IIE,IJB:IJE,IKB:IKE,2)>XRTMIN(2) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,3)>XRTMIN(3) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,4)>XRTMIN(4) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,5)>XRTMIN(5) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,6)>XRTMIN(6)
+ LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE)=LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,2)>ZRSMIN(2) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,3)>ZRSMIN(3) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,4)>ZRSMIN(4) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,5)>ZRSMIN(5) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,6)>ZRSMIN(6)
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICE, RAIN_ICE_PARAM, RAIN_ICE_DESCR,TBUCONF,&
+ COUNT(LLMICRO), COUNT(LLMICRO), &
+ .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI,&
+ PTSTEP, KRR, LLMICRO, ZEXN, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC,PINPRR, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS,SIZE(TBUDGETS), &
+ PSEA,PTOWN, PFPR=ZFPR )
+ ELSE
+ CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
+ KSPLITR, PTSTEP, KRR, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
+ PSEA, PTOWN, PFPR=ZFPR)
+ END IF
+
+!
+!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
+!
+!
+ IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
+ CFRAC_ICE_ADJUST, &
+ 'DEPI', .FALSE., .FALSE., &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ END IF
+
+ deallocate( zexn )
+!
+ CASE ('ICE4')
+!
+!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
+! -----------------------------------------------------
+!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+ ZEXN(:,:,:)= (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
+!
+!* 10.1 Compute the explicit microphysical sources
+!
+!
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF(LRED .AND. LADJ_BEFORE) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
+ CFRAC_ICE_ADJUST, &
+ 'ADJU', .FALSE., .FALSE., &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV,PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ ENDIF
+ IF (LRED) THEN
+ LLMICRO(:,:,:) = .FALSE.
+ LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE)=PRT(IIB:IIE,IJB:IJE,IKB:IKE,2)>XRTMIN(2) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,3)>XRTMIN(3) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,4)>XRTMIN(4) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,5)>XRTMIN(5) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,6)>XRTMIN(6) .OR. &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,7)>XRTMIN(7)
+ LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE)=LLMICRO(IIB:IIE,IJB:IJE,IKB:IKE) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,2)>ZRSMIN(2) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,3)>ZRSMIN(3) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,4)>ZRSMIN(4) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,5)>ZRSMIN(5) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,6)>ZRSMIN(6) .OR. &
+ PRS(IIB:IIE,IJB:IJE,IKB:IKE,7)>ZRSMIN(7)
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICE, RAIN_ICE_PARAM, RAIN_ICE_DESCR,TBUCONF,&
+ COUNT(LLMICRO), COUNT(LLMICRO), &
+ .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI,&
+ PTSTEP, KRR, LLMICRO, ZEXN, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC, PINPRR, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS,SIZE(TBUDGETS), &
+ PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
+ ELSE
+ CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
+ KSPLITR, PTSTEP, KRR, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
+ PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR)
+ END IF
+
+
+!
+!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
+!
+ IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
+ CFRAC_ICE_ADJUST, &
+ 'DEPI', .FALSE., .FALSE., &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ END IF
+
+ deallocate( zexn )
+!
+!
+!* 12. 2-MOMENT MIXED-PHASE MICROPHYSICAL SCHEME LIMA
+! --------------------------------------------------------------
+!
+!
+!* 12.1 Compute the explicit microphysical sources
+!
+ CASE ('LIMA')
+ !
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF (LPTSPLIT) THEN
+ CALL LIMA (1, IKU, 1, &
+ PTSTEP, TPFILE, &
+ PRHODREF, PEXNREF, ZDZZ, &
+ PRHODJ, PPABST, &
+ NMOD_CCN, NMOD_IFN, NMOD_IMM, &
+ PDTHRAD, PTHT, PRT, &
+ PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PRAINFR )
+ ELSE
+
+ IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PW_ACT, PPABST, &
+ PDTHRAD, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
+!
+ IF (LCOLD) CALL LIMA_COLD(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRS, PINPRG, PINPRH )
+!
+ IF (OWARM .AND. LCOLD) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END) )
+ ENDIF
+!
+!* 12.2 Perform the saturation adjustment
+!
+ IF (LSPRO) THEN
+ CALL LIMA_NOTADJUST (KMI, TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PCLDFR, PICEFR, PRAINFR, PSRCS )
+ ELSE IF (LPTSPLIT) THEN
+ CALL LIMA_ADJUST_SPLIT(YLDIMPHYEX, KRR, KMI, TPFILE, CCONDENS, CLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PPABSTT, ZZZ,&
+ PDTHRAD, PW_ACT, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF )
+ ELSE
+ CALL LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABST, PPABSTT, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR, PICEFR, PRAINFR )
+ ENDIF
+!
+END SELECT
+!
+IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
+ PINPRC3D=ZFPR(:,:,:,2) / CST%XRHOLW
+ PINPRR3D=ZFPR(:,:,:,3) / CST%XRHOLW
+ PINPRS3D=ZFPR(:,:,:,5) / CST%XRHOLW
+ PINPRG3D=ZFPR(:,:,:,6) / CST%XRHOLW
+ IF(KRR==7) PINPRH3D=ZFPR(:,:,:,7) / CST%XRHOLW
+ WHERE (PRT(:,:,:,2) > 1.E-04 )
+ PSPEEDC=ZFPR(:,:,:,2) / (PRT(:,:,:,2) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,3) > 1.E-04 )
+ PSPEEDR=ZFPR(:,:,:,3) / (PRT(:,:,:,3) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,5) > 1.E-04 )
+ PSPEEDS=ZFPR(:,:,:,5) / (PRT(:,:,:,5) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,6) > 1.E-04 )
+ PSPEEDG=ZFPR(:,:,:,6) / (PRT(:,:,:,6) * PRHODREF(:,:,:))
+ ENDWHERE
+ IF(KRR==7) THEN
+ WHERE (PRT(:,:,:,7) > 1.E-04 )
+ PSPEEDH=ZFPR(:,:,:,7) / (PRT(:,:,:,7) * PRHODREF(:,:,:))
+ ENDWHERE
+ ENDIF
+ENDIF
+
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+
+!-------------------------------------------------------------------------------
+!
+!
+!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES
+! ---------------------------------------
+!
+PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
+!
+DO JRR = 1,KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
+END DO
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
+ ENDDO
+ENDIF
+
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RESOLVED_CLOUD
diff --git a/src/PHYEX/ext/set_rsou.f90 b/src/PHYEX/ext/set_rsou.f90
new file mode 100644
index 0000000000000000000000000000000000000000..352af8a53b1efdaca9aa28ef28c9658ef2d27ef5
--- /dev/null
+++ b/src/PHYEX/ext/set_rsou.f90
@@ -0,0 +1,1640 @@
+!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_SET_RSOU
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE SET_RSOU(TPFILE,TPEXPREFILE,HFUNU,HFUNV,KILOC,KJLOC,OBOUSS,&
+ PJ,OSHIFT,PCORIOZ)
+!
+USE MODD_IO, ONLY : TFILEDATA
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
+TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
+CHARACTER(LEN=*), INTENT(IN) :: HFUNU ! type of variation of U
+ ! in y direction
+CHARACTER(LEN=*), INTENT(IN) :: HFUNV ! type of variation of V
+ ! in x direction
+INTEGER, INTENT(IN) :: KILOC ! I Localisation of vertical profile
+INTEGER, INTENT(IN) :: KJLOC ! J Localisation of vertical profile
+LOGICAL, INTENT(IN) :: OBOUSS ! logical switch for Boussinesq version
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobien
+LOGICAL, INTENT(IN) :: OSHIFT ! logical switch for vertical shift
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PCORIOZ ! Coriolis parameter
+ ! (exceptionnaly 3D array)
+!
+END SUBROUTINE SET_RSOU
+!
+END INTERFACE
+!
+END MODULE MODI_SET_RSOU
+!
+! ########################################################################
+ SUBROUTINE SET_RSOU(TPFILE,TPEXPREFILE,HFUNU,HFUNV,KILOC,KJLOC,OBOUSS, &
+ PJ,OSHIFT,PCORIOZ)
+! ########################################################################
+!
+!!**** *SET_RSOU * - to initialize mass fiels from a radiosounding
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the mass field (theta,r,
+! thetavrefz,rhorefz) on model grid from a radiosounding located at point
+! (KILOC,KJLOC).
+!
+! The free-formatted part of EXPRE file contains the radiosounding data.The data
+! are stored in following order :
+!
+! - year,month,day, time (these variables are read in PREINIT program)
+! - kind of data in EXPRE file (see below for more explanations about
+! YKIND)
+! - ZGROUND
+! - PGROUND
+! - temperature variable at ground ( depending on the data Kind )
+! - moist variable at ground ( depending on the data Kind )
+! - number of wind data levels ( variable ILEVELU)
+! - height , dd , ff |
+! or or | ILEVELU times
+! pressure, U , V |
+! - number of mass levels ( variable ILEVELM), including the ground
+! level
+! - height , T , Td |
+! or or or | (ILEVELM-1) times
+! pressure, THeta_Dry , Mixing Ratio |
+! or or |
+! THeta_V , relative HUmidity|
+!
+! NB : the first mass level is at ground
+!
+! The following kind of data is permitted :
+! YKIND = 'STANDARD' : ZGROUND, PGROUND, TGROUND, TDGROUND
+! (Pressure, dd, ff) ,
+! (Pressure, T, Td)
+! YKIND = 'PUVTHVMR' : zGROUND, PGROUND, ThvGROUND, RGROUND
+! (Pressure, U, V) ,
+! (Pressure, THv, R)
+! YKIND = 'PUVTHVHU' : zGROUND, PGROUND, ThvGROUND, HuGROUND
+! (Pressure, U, V) ,
+! (Pressure, THv, Hu)
+! YKIND = 'ZUVTHVHU' : zGROUND, PGROUND, ThvGROUND, HuGROUND
+! (height, U, V) ,
+! (height, THv, Hu)
+! YKIND = 'ZUVTHVMR' : zGROUND, PGROUND, ThvGROUND, RGROUND
+! (height, U, V) ,
+! (height, THv, R)
+! YKIND = 'PUVTHDMR' : zGROUND, PGROUND, ThdGROUND, RGROUND
+! (Pressure, U, V) ,
+! (Pressure, THd, R)
+! YKIND = 'PUVTHDHU' : zGROUND, PGROUND, ThdGROUND, HuGROUND
+! (Pressure, U, V) ,
+! (Pressure, THd, Hu)
+! YKIND = 'ZUVTHDMR' : zGROUND, PGROUND, ThdGROUND,
+! RGROUND
+! (height, U, V) ,
+! (height, THd, R)
+! YKIND = 'PUVTHU' : ZGROUND, PGROUND, TGROUND, HuGROUND
+! (Pressure, U, V) ,
+! (Pressure, T, Hu)
+!
+! For ocean-LES case the following kind of data is permitted
+!
+! YKIND = 'IDEALOCE' : ZGROUND (Water depth),PGROUND(Sfc Atmos Press),
+! TGROUND (SST), RGROUND (SSS)
+! (Depth , U, V) starting from sfc
+! (Depth, T, S)
+! (Time, LE, H, SW_d,SW_u,LW_d,LW_u,Stress_X,Stress_Y)
+!
+! YKIND = 'STANDOCE' : (Depth , Temp, Salinity, U, V) starting from sfc
+! (Time, LE, H, SW_d,SW_u,LW_d,LW_u,Stress_X,Stress_Y)
+!
+!!** METHOD
+!! ------
+!! The radiosounding is first read, then data are converted in order to
+!! always obtain the following variables (case YKIND = 'ZUVTHVMR') :
+!! (height,U,V) and (height,Thetav,r) which are the model variables.
+!! That is to say :
+!! - YKIND = 'STANDARD' :
+!! dd,ff converted in U,V
+!! Td + pressure ----> r
+!! T,r ---> Tv + pressure ----> thetav
+!! Pressure + thetav + ZGROUND ----> height (for mass levels)
+!! Thetav at mass levels ----> thetav at wind levels
+!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
+!! - YKIND = 'PUVTHVMR' :
+!! Pressure + thetav + ZGROUND ----> height (for mass levels)
+!! Thetav at mass levels ----> thetav at wind levels
+!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
+!! - YKIND = 'PUVTHVHU' :
+!! thetav + pressure ----> Tv +pressure +Hu ----> r
+!! Pressure + thetav + ZGROUND ----> height (for mass levels)
+!! Thetav at mass levels ----> thetav at wind levels
+!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
+!! - YKIND = 'ZUVTHVHU' :
+!! height +thetav + PGROUND -----> pressure (for mass levels)
+!! thetav + pressure ----> Tv +pressure +Hu ----> r
+!! - YKIND = 'PUVTHDVMR' :
+!! thetad + r ----> thetav
+!! pressure + thetav + ZGROUND ----> height (for mass levels)
+!! Thetav at mass levels ----> thetav at wind levels
+!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
+!! - YKIND = 'PUVTHDHU' :
+!! thetad + pressure -----> T
+!! T + pressure + Hu -----> r
+!! thetad + r -----> thetav
+!! pressure + thetav + ZGROUND ----> height (for mass levels)
+!! Thetav at mass levels ----> thetav at wind levels
+!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
+!! - YKIND = 'ZUVTHDHU' :
+!! thetad + r -----> thetav
+!! - YKIND = 'PUVTHU' :
+!! T + pressure -----> thetad
+!! T + pressure + Hu -----> r
+!! thetad + r -----> thetav
+!! pressure + thetav + ZGROUND ----> height (for mass levels)
+!! Thetav at mass levels ----> thetav at wind levels
+!!
+!! The following basic formula are used :
+!! Rd es(Td)
+!! r = -- ----------
+!! Rv P - es(Td)
+!!
+!! 1 + (Rv/Rd) r
+!! Tv = -------------- T
+!! 1 + r
+!!
+!! P00 Rd/Cpd 1 + (Rv/Rd) r
+!! Thetav = Tv ( ---- ) = Thetad ( --------------)
+!! P 1 + r
+!! The integration of hydrostatic relation is used to compute height from
+!! pressure and vice-versa. This is done by HEIGHT_PRESS and PRESS_HEIGHT
+!! routines.
+!!
+!! Then, these data are interpolated on a vertical grid which is
+!! a mixed grid calaculated with VERT_COORD from the vertical levels of MNH
+!! grid and with a constant ororgraphy equal to the altitude of the vertical
+!! profile (ZZGROUND) (It permits to keep low levels information with a
+!! shifting function (as in PREP_REAL_CASE))
+!!
+!! Then, the 3D mass and wind fields are deduced in SET_MASS
+!!
+!!
+!! EXTERNAL
+!! --------
+!! SET_MASS : to compute mass field on 3D-model grid
+!! Module MODE_THERMO : contains thermodynamic routines
+!! SM_FOES : To compute saturation vapor pressure from
+!! temperature
+!! SM_PMR_HU : to compute vapor mixing ratio from pressure, virtual
+!! temperature and relative humidity
+!! HEIGHT_PRESS : to compute height from pressure and thetav
+!! by integration of hydrostatic relation
+!! PRESS_HEIGHT : to compute pressure from height and thetav
+!! by integration of hydrostatic relation
+!! THETAVPU_THETAVPM : to interpolate thetav on wind levels
+!! from thetav on mass levels
+!!
+!! Module MODI_HEIGHT_PRESS : interface for function HEIGHT_PRESS
+!! Module MODI_PRESS_HEIGHT : interface for function PRESS_HEIGHT
+!! Module MODI_THETAVPU_THETAVPM : interface for function
+!! THETAVPU_THETVPM
+!! Module MODI_SET_MASS : interface for subroutine SET_MASS
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!! XPI : Pi
+!! XRV : Gas constant for vapor
+!! XRD : Gas constant for dry air
+!! XCPD : Specific heat for dry air at constant pressure
+!!
+!! Module MODD_LUNIT1 : contains logical unit names
+!! TLUOUT : name of output-listing
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!!
+!! Module MODD_GRID1 : contains grid variables
+!! XZHAT : height of w-levels of vertical model grid without orography
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of MESO-NH documentation (routine SET_RSOU)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 25/08/94
+!! J.Stein 06/12/94 change the way to prescribe the horizontal wind
+!! variations + cleaning
+!! J.Stein 18/01/95 bug corrections in the ILEVELM readings
+!! J.Stein 16/04/95 put the same names of the declarative modules
+!! in the descriptive part
+!! J.Stein 30/01/96 use the RS ground pressure to initialize the
+!! hydrostatic pressure computation
+!! V.Masson 02/09/96 add allocation of ZTHVU in two cases
+!! P.Jabouille 14/02/96 bug in extrapolation of ZMRM below the first level
+!! Jabouille/Masson 05/12/02 add ZUVTHLMR case and hydrometeor initialization
+!! P.Jabouille 29/10/03 add hydrometeor initialization for ZUVTHDMR case
+!! G. Tanguy 26/10/10 change the interpolation of the RS : we use now a
+!! mixed grid (PREP_REAL_CASE method)
+!! add PUVTHU case
+!! V.Masson 12/08/13 Parallelization of the initilization profile
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! JL Redelsperger 01/2021: Ocean LES cases added
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_NEB, ONLY: NEB
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_FIELD_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NETCDF
+USE MODD_OCEANH
+USE MODD_PARAMETERS, ONLY: JPHEXT
+USE MODD_TYPE_DATE
+!
+USE MODE_ll
+USE MODE_MSG
+USE MODE_THERMO
+!
+USE MODI_COMPUTE_EXNER_FROM_GROUND
+USE MODI_HEIGHT_PRESS
+USE MODI_PRESS_HEIGHT
+USE MODI_SET_MASS
+USE MODI_SHUMAN
+USE MODI_THETAVPU_THETAVPM
+USE MODI_VERT_COORD
+!
+USE NETCDF ! for reading the NR files
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of arguments :
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
+TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
+CHARACTER(LEN=*), INTENT(IN) :: HFUNU ! type of variation of U
+ ! in y direction
+CHARACTER(LEN=*), INTENT(IN) :: HFUNV ! type of variation of V
+ ! in x direction
+INTEGER, INTENT(IN) :: KILOC ! I Localisation of vertical profile
+INTEGER, INTENT(IN) :: KJLOC ! J Localisation of vertical profile
+LOGICAL, INTENT(IN) :: OBOUSS ! logical switch for Boussinesq version
+LOGICAL, INTENT(IN) :: OSHIFT ! logical switch for vertical shift
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PCORIOZ ! Coriolis parameter
+ ! (exceptionnaly 3D array)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobien
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: ILUPRE ! logical unit number of the EXPRE return code
+INTEGER :: ILUOUT ! Logical unit number for output-listing
+! local variables for reading sea sfc flux forcing for ocean model
+INTEGER :: IFRCLT
+REAL, DIMENSION(:), ALLOCATABLE :: ZSSUFL_T,ZSSVFL_T,ZSSTFL_T,ZSSOLA_T !
+TYPE (DATE_TIME), DIMENSION(:), ALLOCATABLE :: ZFRCLT ! date/time of sea surface forcings
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! variables read in EXPRE file at the RS/CTD levels
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+CHARACTER(LEN=8) :: YKIND ! Kind of variables in
+ ! EXPRE FILE
+INTEGER :: ILEVELU ! number of wind levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZHEIGHTU ! Height at wind levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZPRESSU ! Pressure at wind levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHVU ! Thetav at wind levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZU,ZV ! wind components
+REAL, DIMENSION(:), ALLOCATABLE :: ZDD,ZFF ! dd (direction) and ff(force)
+ ! for wind
+REAL :: ZZGROUND,ZPGROUND ! height and Pressure at ground
+REAL :: ZTGROUND,ZTHVGROUND,ZTHDGROUND,ZTHLGROUND, &
+ ZTDGROUND,ZMRGROUND,ZHUGROUND
+ ! temperature and moisture
+ ! variables at ground
+INTEGER :: ILEVELM ! number of mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZHEIGHTM ! Height at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZPRESSM ! Pressure at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHV ! Thetav at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHD ! Theta (dry) at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHL ! Thetal at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZTH ! Theta at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZT ! Temperature at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZMR ! Vapor mixing ratio at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZMRC ! cloud mixing ratio at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZMRI ! ice mixing ratio or cloud concentration
+REAL, DIMENSION(:), ALLOCATABLE :: ZRT ! total mixing ratio
+REAL, DIMENSION(:), ALLOCATABLE :: ZPRESS ! pressure at mass level
+REAL, DIMENSION(:), ALLOCATABLE :: ZHU ! relative humidity at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZTD ! Td at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZTV ! Tv at mass levels
+REAL, DIMENSION(:), ALLOCATABLE :: ZEXN
+REAL, DIMENSION(:), ALLOCATABLE :: ZCPH
+REAL, DIMENSION(:), ALLOCATABLE :: ZLVOCPEXN
+REAL, DIMENSION(:), ALLOCATABLE :: ZLSOCPEXN
+REAL, DIMENSION(SIZE(XZHAT)) :: ZZFLUX_PROFILE ! altitude of flux points on the initialization columns
+REAL, DIMENSION(SIZE(XZHAT)) :: ZZMASS_PROFILE ! altitude of mass points on the initialization columns
+!
+! fields on the grid of the model without orography
+!
+REAL, DIMENSION(SIZE(XZHAT)) :: ZUW,ZVW ! Wind at w model grid levels
+REAL, DIMENSION(SIZE(XZHAT)) :: ZMRM ! vapor mixing ratio at mass model
+ !grid levels
+REAL, DIMENSION(SIZE(XZHAT)) :: ZMRCM,ZMRIM
+REAL, DIMENSION(SIZE(XZHAT)) :: ZTHVM ! Temperature at mass model grid levels
+REAL, DIMENSION(SIZE(XZHAT)) :: ZTHLM ! Thetal at mass model grid levels
+REAL, DIMENSION(SIZE(XZHAT)) :: ZTHM ! Thetal at mass model grid levels
+REAL, DIMENSION(SIZE(XZHAT)) :: ZRHODM ! density at mass model grid level
+REAL, DIMENSION(:), ALLOCATABLE :: ZMRT ! Total Vapor mixing ratio at mass levels on mixed grid
+REAL, DIMENSION(:), ALLOCATABLE :: ZEXNMASS ! exner fonction at mass level
+REAL, DIMENSION(:), ALLOCATABLE :: ZEXNFLUX ! exner fonction at flux level
+REAL :: ZEXNSURF ! exner fonction at surface
+REAL, DIMENSION(:), ALLOCATABLE :: ZPREFLUX ! pressure at flux model grid level
+REAL, DIMENSION(:), ALLOCATABLE :: ZFRAC_ICE ! ice fraction
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSATW, ZRSATI
+REAL :: ZDZSDH,ZDZ1SDH,ZDZ2SDH ! interpolation
+ ! working arrays
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUF
+!
+INTEGER :: JK,JKLEV,JKU,JKM,JKT,JJ,JI,JO,JLOOP ! Loop indexes
+INTEGER :: IKU ! Upper bound in z direction
+REAL :: ZRDSCPD,ZRADSDG, & ! Rd/Cpd, Pi/180.,
+ ZRVSRD,ZRDSRV, & ! Rv/Rd, Rd/Rv
+ ZPTOP ! Pressure at domain top
+LOGICAL :: GUSERC ! use of input data cloud
+INTEGER :: IIB, IIE, IJB, IJE
+INTEGER :: IXOR_ll, IYOR_ll
+INTEGER :: IINFO_ll
+LOGICAL :: GPROFILE_IN_PROC ! T : initialization profile is in current processor
+!
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) ::ZZS_LS
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) ::ZZFLUX_MX,ZZMASS_MX ! mixed grid
+!-------------------------------------------------------------------------------
+! For standard ocean version, reading external files
+CHARACTER(LEN=256) :: yinfile, yinfisf ! files to be read
+INTEGER :: IDX
+INTEGER(KIND=CDFINT) :: INZ, INLATI, INLONGI
+INTEGER(KIND=CDFINT) :: incid, ivarid, idimid, idimlen
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOC_TEMPERATURE,ZOC_SALINITY,ZOC_U,ZOC_V
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_DEPTH
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_LE,ZOC_H
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_SW_DOWN,ZOC_SW_UP,ZOC_LW_DOWN,ZOC_LW_UP
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_TAUX,ZOC_TAUY
+
+!--------------------------------------------------------------------------------
+!
+!* 1. PROLOGUE : INITIALIZE SOME CONSTANTS, RETRIEVE LOGICAL
+! UNIT NUMBERS AND READ KIND OF DATA IN EXPRE FILE
+! -------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+CALL GET_OR_ll('B',IXOR_ll,IYOR_ll)
+!
+!* 1.1 initialize some constants
+!
+ZRDSCPD = XRD / XCPD
+ZRADSDG = XPI/180.
+ZRVSRD = XRV/XRD
+ZRDSRV = XRD/XRV
+!
+!* 1.2 Retrieve logical unit numbers
+!
+ILUPRE = TPEXPREFILE%NLU
+ILUOUT = TLUOUT%NLU
+!
+!* 1.3 Read data kind in EXPRE file
+!
+READ(ILUPRE,*) YKIND
+WRITE(ILUOUT,*) 'YKIND read in set_rsou: ', YKIND
+!
+IF(LUSERC .AND. YKIND/='PUVTHDMR' .AND. YKIND/='ZUVTHDMR' .AND. YKIND/='ZUVTHLMR') THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','hydrometeors are not allowed for YKIND = '//trim(YKIND))
+ENDIF
+!
+IF(YKIND=='ZUVTHLMR' .AND. .NOT. LUSERC) THEN
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','LUSERC=T is required for YKIND=ZUVTHLMR')
+ENDIF
+!
+GUSERC=.FALSE.
+IF(LUSERC .AND. (YKIND == 'PUVTHDMR' .OR. YKIND == 'ZUVTHDMR')) GUSERC=.TRUE.
+!-------------------------------------------------------------------------------
+!
+!* 2. READ DATA AND CONVERT IN (height,U,V), (height,Thetav,r)
+! --------------------------------------------------------
+!
+SELECT CASE(YKIND)
+!
+! 2.0.1 Ocean case 1
+!
+ CASE ('IDEALOCE')
+!
+ XP00=XP00OCEAN
+ ! Read data in PRE_IDEA1.nam
+ ! Surface
+ WRITE(ILUOUT,FMT=*) 'Reading data for ideal ocean :IDEALOCE'
+ READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
+ READ(ILUPRE,*) ZTGROUND ! SST
+ READ(ILUPRE,*) ZMRGROUND ! SSS
+ WRITE(ILUOUT,FMT=*) 'Patm SST SSS', ZPTOP,ZTGROUND,ZMRGROUND
+ READ(ILUPRE,*) ILEVELU ! Read number of Current levels
+ ! Allocate required memory
+ ALLOCATE(ZHEIGHTU(ILEVELU),ZU(ILEVELU),ZV(ILEVELU))
+ ALLOCATE(ZOC_U(ILEVELU,1,1),ZOC_V(ILEVELU,1,1))
+ WRITE(ILUOUT,FMT=*) 'Level number for Current in data', ILEVELU
+ ! Read U and V at each wind level
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZHEIGHTU(JKU),ZOC_U(JKU,1,1),ZOC_V(JKU,1,1)
+ ! WRITE(ILUOUT,FMT=*) 'Leveldata D(m) under sfc: U_cur, V_cur', JKU, ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+ DO JKU=1,ILEVELU
+ ! Z axis reoriented as in the model
+ IDX = ILEVELU-JKU+1
+ ZU(JKU) = ZOC_U(IDX,1,1)
+ ZV(JKU) = ZOC_V(IDX,1,1)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ END DO
+ ! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+ ! Allocate required memory
+ ALLOCATE(ZOC_DEPTH(ILEVELM))
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM),ZTH(ILEVELM),ZTHV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM),ZRT(ILEVELM))
+ ALLOCATE(ZOC_TEMPERATURE(ILEVELM,1,1),ZOC_SALINITY(ILEVELM,1,1))
+ ! Read T and S at each mass level
+ DO JKM= 2,ILEVELM
+ READ(ILUPRE,*) ZOC_DEPTH(JKM),ZOC_TEMPERATURE(JKM,1,1),ZOC_SALINITY(JKM,1,1)
+ END DO
+ ! Complete the mass arrays with the ground informations read in EXPRE file
+ ZOC_DEPTH(1) = 0.
+ ZOC_TEMPERATURE(1,1,1)= ZTGROUND
+ ZOC_SALINITY(1,1,1)= ZMRGROUND
+ !!!!!!!!!!!!!!!!!!!!!!!!Inversing Axis!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Going from the data (axis downward i.e inverse model) grid to the model grid (axis upward)
+ ! Uniform bathymetry; depth goes from ocean sfc downwards (data grid)
+ ! ZHEIGHT goes from the model domain bottom up to the sfc ocean (top of model domain)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ZZGROUND = 0.
+ ZTGROUND = ZOC_TEMPERATURE(ILEVELM,1,1)
+ ZMRGROUND = ZOC_SALINITY(ILEVELM,1,1)
+ DO JKM= 1,ILEVELM
+ ! Z upward axis (oriented as in the model), i.e.
+ ! going from 0m (ocean bottom/model bottom) upward to H (ocean sfc/model top)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ IDX = ILEVELM-JKM+1
+ ZTH(JKM) = ZOC_TEMPERATURE(IDX,1,1)
+ ZMR(JKM) = ZOC_SALINITY(IDX,1,1)
+ ZHEIGHTM(JKM)= ZOC_DEPTH(ILEVELM)- ZOC_DEPTH(IDX)
+ WRITE(ILUOUT,FMT=*) 'Model oriented initial data: JKM IDX depth T S ZHEIGHTM', &
+ JKM,IDX,ZOC_DEPTH(IDX),ZTH(JKM),ZMR(JKM),ZHEIGHTM(JKM)
+ END DO
+ ! mass levels of the RS
+ ZTHV = ZTH ! TV==THETA=TL
+ ZTHL = ZTH
+ ZRT = ZMR
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! READ Sea Surface Forcing !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Reading the forcings from prep_idea1.nam
+ READ(ILUPRE,*) IFRCLT ! Number of time-dependent forcing
+ IF (IFRCLT > 99*8) THEN
+ ! CAUTION: number of forcing times is limited by the WRITE format 99(8E10.3)
+ ! and also by the name of forcing variables (format I3.3)
+ ! You have to modify those if you need more forcing times
+ CALL PRINT_MSG(NVERB_FATAL,'IO','SET_RSOU','maximum forcing times NFRCLT is 99*8')
+ END IF
+!
+ WRITE(UNIT=ILUOUT,FMT='(" THERE ARE ",I2," SFC FLUX FORCINGs AT:")') IFRCLT
+ ALLOCATE(ZFRCLT(IFRCLT))
+ ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
+ ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
+ ALLOCATE(ZSSTFL_T(IFRCLT)); ZSSTFL_T = 0.0
+ ALLOCATE(ZSSOLA_T(IFRCLT)); ZSSOLA_T = 0.0
+ DO JKT = 1,IFRCLT
+ WRITE(ILUOUT,FMT='(A, I4)') "SET_RSOU/Reading Sea Surface forcing: Number=", JKT
+ READ(ILUPRE,*) ZFRCLT(JKT)%nyear, ZFRCLT(JKT)%nmonth, &
+ ZFRCLT(JKT)%nday, ZFRCLT(JKT)%xtime
+ READ(ILUPRE,*) ZSSUFL_T(JKT)
+ READ(ILUPRE,*) ZSSVFL_T(JKT)
+ READ(ILUPRE,*) ZSSTFL_T(JKT)
+ READ(ILUPRE,*) ZSSOLA_T(JKT)
+ END DO
+!
+ DO JKT = 1 , IFRCLT
+ WRITE(UNIT=ILUOUT,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
+ ZFRCLT(JKT)%xtime, ZFRCLT(JKT)%nday, &
+ ZFRCLT(JKT)%nmonth, ZFRCLT(JKT)%nyear
+ END DO
+ NINFRT= INT(ZFRCLT(2)%xtime)
+ WRITE(ILUOUT,FMT='(A)') &
+ "Number U-Stress, V-Stress, Heat turb Flux, Solar Flux Interval(s)",NINFRT
+ DO JKT = 1, IFRCLT
+ WRITE(ILUOUT,FMT='(I10,99(3F10.2))') JKT, ZSSUFL_T(JKT),ZSSVFL_T(JKT),ZSSTFL_T(JKT)
+ END DO
+ NFRCLT = IFRCLT
+ ALLOCATE(TFRCLT(NFRCLT))
+ ALLOCATE(XSSUFL_T(NFRCLT));XSSUFL_T(:)=0.
+ ALLOCATE(XSSVFL_T(NFRCLT));XSSVFL_T(:)=0.
+ ALLOCATE(XSSTFL_T(NFRCLT));XSSTFL_T(:)=0.
+ ALLOCATE(XSSOLA_T(NFRCLT));XSSOLA_T(:)=0.
+!
+ DO JKT=1,NFRCLT
+ TFRCLT(JKT)= ZFRCLT(JKT)
+ XSSUFL_T(JKT)=ZSSUFL_T(JKT)/XRH00OCEAN
+ XSSVFL_T(JKT)=ZSSVFL_T(JKT)/XRH00OCEAN
+ ! working in SI
+ XSSTFL_T(JKT)=ZSSTFL_T(JKT) /(3900.*XRH00OCEAN)
+ XSSOLA_T(JKT)=ZSSOLA_T(JKT) /(3900.*XRH00OCEAN)
+ END DO
+ DEALLOCATE(ZFRCLT)
+ DEALLOCATE(ZSSUFL_T)
+ DEALLOCATE(ZSSVFL_T)
+ DEALLOCATE(ZSSTFL_T)
+ DEALLOCATE(ZSSOLA_T)
+!
+!--------------------------------------------------------------------------------
+! 2.0.2 Ocean standard initialize from netcdf files
+! U,V,T,S at Z levels + Forcings at model TOP (sea surface)
+!--------------------------------------------------------------------------------
+!
+ CASE ('STANDOCE')
+!
+ XP00=XP00OCEAN
+ READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
+ READ(ILUPRE,*) YINFILE, YINFISF
+ WRITE(ILUOUT,FMT=*) 'Netcdf files to read:', YINFILE, YINFISF
+ ! Open file containing initial profiles
+ CALL check(nf90_open(yinfile,NF90_NOWRITE,incid), "opening NC file")
+ ! Reading dimensions and lengths
+ CALL check( nf90_inq_dimid(incid, "depth",idimid), "getting depth dimension id" )
+ CALL check( nf90_inquire_dimension(incid, idimid, len=INZ), "getting INZ" )
+ CALL check( nf90_inquire_dimension(incid, INT(2,KIND=CDFINT), len=INLONGI), "getting NLONG" )
+ CALL check( nf90_inquire_dimension(incid, INT(1,KIND=CDFINT), len=INLATI), "getting NLAT" )
+!
+ WRITE(ILUOUT,FMT=*) 'NB LEVLS READ INZ, NLONG NLAT ', INZ, INLONGI,INLATI
+ ALLOCATE(ZOC_TEMPERATURE(INLATI,INLONGI,INZ),ZOC_SALINITY(INLATI,INLONGI,INZ))
+ ALLOCATE(ZOC_U(INLATI,INLONGI,INZ),ZOC_V(INLATI,INLONGI,INZ))
+ ALLOCATE(ZOC_DEPTH(INZ))
+ WRITE(ILUOUT,FMT=*) 'NETCDF READING ==> Temp'
+ CALL check(nf90_inq_varid(incid,"temperature",ivarid), "getting temp ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TEMPERATURE), "reading temp")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> salinity'
+ CALL check(nf90_inq_varid(incid,"salinity",ivarid), "getting salinity ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SALINITY), "reading salinity")
+ WRITE(ILUOUT,FMT=*) 'Netcdf ==> Reading depth'
+ CALL check(nf90_inq_varid(incid,"depth",ivarid), "getting depth ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_DEPTH), "reading depth")
+ WRITE(ILUOUT,FMT=*) 'depth: max min ', MAXVAL(ZOC_DEPTH),MINVAL(ZOC_DEPTH)
+ WRITE(ILUOUT,FMT=*) 'depth 1 nz: ', ZOC_DEPTH(1),ZOC_DEPTH(INZ)
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> Currents'
+ CALL check(nf90_inq_varid(incid,"u",ivarid), "getting u ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_U), "reading u")
+ CALL check(nf90_inq_varid(incid,"v",ivarid), "getting v ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_V), "reading v")
+ CALL check(nf90_close(incid), "closing yinfile")
+ WRITE(ILUOUT,FMT=*) 'End of initial file reading'
+!
+ DO JKM=1,INZ
+ ZOC_TEMPERATURE(1,1,JKM)=ZOC_TEMPERATURE(1,1,JKM)+273.15
+ WRITE(ILUOUT,FMT=*) 'Z T(Kelvin) S(Sverdup) U V K',&
+ JKM,ZOC_DEPTH(JKM),ZOC_TEMPERATURE(1,1,JKM),ZOC_SALINITY(1,1,JKM),ZOC_U(1,1,JKM),ZOC_V(1,1,JKM), JKM
+ ENDDO
+ ! number of data levels
+ ILEVELM=INZ
+ ! Model bottom
+ ZTGROUND = ZOC_TEMPERATURE(1,1,ILEVELM)
+ ZMRGROUND = ZOC_SALINITY(1,1,ILEVELM)
+ ZZGROUND=0.
+ ! Allocate required memory
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZT(ILEVELM))
+ ALLOCATE(ZTV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+ ! Going from the inverse model grid (data) to the normal one
+ DO JKM= 1,ILEVELM
+ ! Z axis reoriented as in the model
+ IDX = ILEVELM-JKM+1
+ ZT(JKM) = ZOC_TEMPERATURE(1,1,IDX)
+ ZMR(JKM) = ZOC_SALINITY(1,1,IDX)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ ! translation/inversion
+ ZHEIGHTM(JKM) = -ZOC_DEPTH(IDX) + ZOC_DEPTH(ILEVELM)
+ WRITE(ILUOUT,FMT=*) 'End gridmodel comput: JKM IDX depth T S ZHEIGHTM', &
+ JKM,IDX,ZOC_DEPTH(IDX),ZT(JKM),ZMR(JKM),ZHEIGHTM(JKM)
+ END DO
+ ! complete ther variables
+ ZTV = ZT
+ ZTHV = ZT
+ ZRT = ZMR
+ ZTHL = ZT
+ ZTH = ZT
+ ! INIT --- U V -----
+ ILEVELU = INZ ! Same nb of levels for u,v,T,S
+ !Assume that current and temp are given at same level
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+ ZHEIGHTU=ZHEIGHTM
+ DO JKM= 1,ILEVELU
+ ! Z axis reoriented as in the model
+ IDX = ILEVELU-JKM+1
+ ZU(JKM) = ZOC_U(1,1,IDX)
+ ZV(JKM) = ZOC_V(1,1,IDX)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ END DO
+!
+ DEALLOCATE(ZOC_TEMPERATURE)
+ DEALLOCATE(ZOC_SALINITY)
+ DEALLOCATE(ZOC_U)
+ DEALLOCATE(ZOC_V)
+ DEALLOCATE(ZOC_DEPTH)
+!
+ ! Reading/initializing surface forcings
+!
+ WRITE(ILUOUT,FMT=*) 'netcdf sfc forcings file to be read:',yinfisf
+ ! Open of sfc forcing file
+ CALL check(nf90_open(yinfisf,NF90_NOWRITE,incid), "opening NC file")
+ ! Reading dimension and length
+ CALL check( nf90_inq_dimid(incid,"t",idimid), "getting time dimension id" )
+ CALL check( nf90_inquire_dimension(incid, idimid, len=idimlen), "getting idimlen " )
+!
+ WRITE(ILUOUT,FMT=*) 'nb sfc-forcing time idimlen=',idimlen
+ ALLOCATE(ZOC_LE(idimlen))
+ ALLOCATE(ZOC_H(idimlen))
+ ALLOCATE(ZOC_SW_DOWN(idimlen))
+ ALLOCATE(ZOC_SW_UP(idimlen))
+ ALLOCATE(ZOC_LW_DOWN(idimlen))
+ ALLOCATE(ZOC_LW_UP(idimlen))
+ ALLOCATE(ZOC_TAUX(idimlen))
+ ALLOCATE(ZOC_TAUY(idimlen))
+!
+ WRITE(ILUOUT,FMT=*)'Netcdf Reading ==> LE'
+ CALL check(nf90_inq_varid(incid,"LE",ivarid), "getting LE ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LE), "reading LE flux")
+ WRITE(ILUOUT,FMT=*)'Netcdf Reading ==> H'
+ CALL check(nf90_inq_varid(incid,"H",ivarid), "getting H ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_H), "reading H flux")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> SW_DOWN'
+ CALL check(nf90_inq_varid(incid,"SW_DOWN",ivarid), "getting SW_DOWN ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SW_DOWN), "reading SW_DOWN")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> SW_UP'
+ CALL check(nf90_inq_varid(incid,"SW_UP",ivarid), "getting SW_UP ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SW_UP), "reading SW_UP")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> LW_DOWN'
+ CALL check(nf90_inq_varid(incid,"LW_DOWN",ivarid), "getting LW_DOWN ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LW_DOWN), "reading LW_DOWN")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> LW_UP'
+ CALL check(nf90_inq_varid(incid,"LW_UP",ivarid), "getting LW_UP ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LW_UP), "reading LW_UP")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> TAUX'
+ CALL check(nf90_inq_varid(incid,"TAUX",ivarid), "getting TAUX ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TAUX), "reading TAUX")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> TAUY'
+ CALL check(nf90_inq_varid(incid,"TAUY",ivarid), "getting TAUY ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TAUY), "reading TAUY")
+ CALL check(nf90_close(incid), "closing yinfifs")
+!
+ WRITE(ILUOUT,FMT=*) ' Forcing-Number LE H SW_down SW_up LW_down LW_up TauX TauY'
+ DO JKM = 1, idimlen
+ WRITE(ILUOUT,FMT=*) JKM, ZOC_LE(JKM), ZOC_H(JKM),ZOC_SW_DOWN(JKM),ZOC_SW_UP(JKM),&
+ ZOC_LW_DOWN(JKM),ZOC_LW_UP(JKM),ZOC_TAUX(JKM),ZOC_TAUY(JKM)
+ ENDDO
+ ! IFRCLT FORCINGS at sea surface
+ IFRCLT=idimlen
+ ALLOCATE(ZFRCLT(IFRCLT))
+ ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
+ ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
+ ALLOCATE(ZSSTFL_T(IFRCLT)); ZSSTFL_T = 0.0
+ ALLOCATE(ZSSOLA_T(IFRCLT)); ZSSOLA_T = 0.0
+ DO JKT=1,IFRCLT
+ ! Initial file for CINDY-DYNAMO: all fluxes correspond to the absolute value (>0)
+ ! modele ocean: axe z dirigé du bas vers la sfc de l'océan
+ ! => flux dirigé vers le haut (positif ocean vers l'atmopshere i.e. bas vers le haut)
+ ZSSOLA_T(JKT)=ZOC_SW_DOWN(JKT)-ZOC_SW_UP(JKT)
+ ZSSTFL_T(JKT)=(ZOC_LW_DOWN(JKT)-ZOC_LW_UP(JKT)-ZOC_LE(JKT)-ZOC_H(JKT))
+ ! assume that Tau given on file is along Ox
+ ! rho_air UW_air = rho_ocean UW_ocean= N/m2
+ ! uw_ocean
+ ZSSUFL_T(JKT)=ZOC_TAUX(JKT)
+ ZSSVFL_T(JKT)=ZOC_TAUY(JKT)
+ WRITE(ILUOUT,FMT=*) 'Forcing Nb Sol NSol UW_oc VW',&
+ JKT,ZSSOLA_T(JKT),ZSSTFL_T(JKT),ZSSUFL_T(JKT),ZSSVFL_T(JKT)
+ ENDDO
+ ! Allocate and Writing the corresponding variables in module MODD_OCEAN_FRC
+ NFRCLT=IFRCLT
+ ! value to read later on file ?
+ NINFRT=600
+ ALLOCATE(TFRCLT(NFRCLT))
+ ALLOCATE(XSSUFL_T(NFRCLT));XSSUFL_T(:)=0.
+ ALLOCATE(XSSVFL_T(NFRCLT));XSSVFL_T(:)=0.
+ ALLOCATE(XSSTFL_T(NFRCLT));XSSTFL_T(:)=0.
+ ALLOCATE(XSSOLA_T(NFRCLT));XSSOLA_T(:)=0.
+ ! on passe en unités SI, signe, etc pour le modele ocean
+ ! W/m2 => SI : /(CP_mer * rho_mer)
+ ! a revoir dans tt le code pour mettre de svaleurs plus exactes
+ DO JKT=1,NFRCLT
+ TFRCLT(JKT)= ZFRCLT(JKT)
+ XSSUFL_T(JKT)=ZSSUFL_T(JKT)/XRH00OCEAN
+ XSSVFL_T(JKT)=ZSSVFL_T(JKT)/XRH00OCEAN
+ XSSTFL_T(JKT)=ZSSTFL_T(JKT) /(3900.*XRH00OCEAN)
+ XSSOLA_T(JKT)=ZSSOLA_T(JKT) /(3900.*XRH00OCEAN)
+ END DO
+ DEALLOCATE(ZFRCLT)
+ DEALLOCATE(ZSSUFL_T)
+ DEALLOCATE(ZSSVFL_T)
+ DEALLOCATE(ZSSTFL_T)
+ DEALLOCATE(ZSSOLA_T)
+ DEALLOCATE(ZOC_LE)
+ DEALLOCATE(ZOC_H)
+ DEALLOCATE(ZOC_SW_DOWN)
+ DEALLOCATE(ZOC_SW_UP)
+ DEALLOCATE(ZOC_LW_DOWN)
+ DEALLOCATE(ZOC_LW_UP)
+ DEALLOCATE(ZOC_TAUX)
+ DEALLOCATE(ZOC_TAUY)
+ ! END OCEAN STANDARD
+!
+!
+!* 2.1 ATMOSPHERIC STANDARD case : ZGROUND, PGROUND, TGROUND, TDGROUND
+! (Pressure, dd, ff) ,
+! (Pressure, T, Td)
+!
+ CASE ('STANDARD')
+
+ READ(ILUPRE,*) ZZGROUND ! Read data at ground level
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTGROUND
+ READ(ILUPRE,*) ZTDGROUND
+!
+ READ(ILUPRE,*) ILEVELU ! Read number of wind levels
+ ALLOCATE(ZPRESSU(ILEVELU)) ! Allocate memory for arrays to be read
+ ALLOCATE(ZDD(ILEVELU),ZFF(ILEVELU))
+ ALLOCATE(ZHEIGHTU(ILEVELU)) ! Allocate memory for needed
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU)) ! arrays
+ ALLOCATE(ZTHVU(ILEVELU)) ! Allocate memory for intermediate
+ ! arrays
+!
+ DO JKU = 1,ILEVELU ! Read data at wind levels
+ READ(ILUPRE,*) ZPRESSU(JKU),ZDD(JKU),ZFF(JKU)
+ END DO
+!
+ READ(ILUPRE,*) ILEVELM ! Read number of mass levels
+ ! including the ground level
+ ALLOCATE(ZPRESSM(ILEVELM)) ! Allocate memory for arrays to be read
+ ALLOCATE(ZT(ILEVELM))
+ ALLOCATE(ZTD(ILEVELM))
+ ALLOCATE(ZHEIGHTM(ILEVELM)) ! Allocate memory for needed
+ ALLOCATE(ZTHV(ILEVELM)) ! arrays
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTV(ILEVELM)) ! Allocate memory for intermediate arrays
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+!
+!
+ DO JKM= 2,ILEVELM ! Read data at mass levels
+ READ(ILUPRE,*) ZPRESSM(JKM),ZT(JKM),ZTD(JKM)
+ END DO
+ ZPRESSM(1)=ZPGROUND ! Mass level 1 is at the ground
+ ZT(1)=ZTGROUND
+ ZTD(1)=ZTDGROUND
+!
+! recover the North-South and West-East wind components
+ ZU(:) = ZFF(:)*COS(ZRADSDG*(270.-ZDD(:)) )
+ ZV(:) = ZFF(:)*SIN(ZRADSDG*(270.-ZDD(:)) )
+!
+! compute vapor mixing ratio
+ ZMR(:) = SM_FOES(ZTD(:)) &
+ / ( (ZPRESSM(:) - SM_FOES(ZTD(:))) * ZRVSRD )
+!
+! compute Tv
+ ZTV(:) = ZT(:) * (1. + ZRVSRD * ZMR(:))/(1.+ZMR(:))
+!
+! compute thetav
+ ZTHV(:) = ZTV(:) * (XP00/ ZPRESSM(:)) **(ZRDSCPD)
+!
+! compute height at the mass levels of the RS
+ ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! compute thetav and height at the wind levels of the RS
+ ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
+ ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! Compute Thetal and Rt
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+!
+!* 2.2 PUVTHVMR case : zGROUND, PGROUND, ThvGROUND, RGROUND
+! (Pressure, U, V) ,
+! (Pressure, THv, R)
+!
+ CASE ('PUVTHVMR')
+!
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTHVGROUND
+ READ(ILUPRE,*) ZMRGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZTHVU(ILEVELU))
+!
+! Read the data at each wind level of the RS
+ DO JKU =1,ILEVELU
+ READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSM(ILEVELM))
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+!
+! Read the data at each mass level of the RS
+ DO JKM = 2,ILEVELM
+ READ(ILUPRE,*) ZPRESSM(JKM),ZTHV(JKM),ZMR(JKM)
+ END DO
+!
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZPRESSM(1) = ZPGROUND
+ ZTHV(1) = ZTHVGROUND
+ ZMR(1) = ZMRGROUND
+!
+! Compute height of the mass levels of the RS
+ ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! Compute thetav and heigth at the wind levels of the RS
+ ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
+ ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+!
+!* 2.3 PUVTHVHU case : zGROUND, PGROUND, ThvGROUND, HuGROUND
+! (Pressure, U, V) ,
+! (Pressure, THv, Hu)
+!
+ CASE ('PUVTHVHU')
+!
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTHVGROUND
+ READ(ILUPRE,*) ZHUGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZTHVU(ILEVELU))
+!
+! Read the data at each wind level of the RS
+ DO JKU =1,ILEVELU
+ READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSM(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZHU(ILEVELM))
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTV(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+!
+! Read the data at each mass level of the RS
+ DO JKM = 2,ILEVELM
+ READ(ILUPRE,*) ZPRESSM(JKM),ZTHV(JKM),ZHU(JKM)
+ END DO
+!
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZPRESSM(1) = ZPGROUND ! Mass level 1 is at the ground
+ ZTHV(1) = ZTHVGROUND
+ ZHU(1) = ZHUGROUND
+!
+! Compute Tv
+ ZTV(:)=ZTHV(:) * (ZPRESSM(:) / XP00) ** ZRDSCPD
+!
+! Compte mixing ratio
+ ZMR(:)=SM_PMR_HU(ZPRESSM(:),ZTV(:),ZHU(:),SPREAD(ZMR(:),2,1))
+!
+! Compute height of the mass levels of the RS
+ ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! Compute thetav and height of the wind levels of the RS
+ ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
+ ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+!
+!* 2.4 ZUVTHVHU case : zGROUND, PGROUND, ThvGROUND, HuGROUND
+! (height, U, V) ,
+! (height, THv, Hu)
+!
+ CASE ('ZUVTHVHU')
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTHVGROUND
+ READ(ILUPRE,*) ZHUGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSU(ILEVELU))
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+!
+!
+! Read the data at each wind level of the RS
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate the required memory
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZHU(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZPRESSM(ILEVELM))
+ ALLOCATE(ZTV(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+!
+! Read the data at each mass level of the RS
+ DO JKM = 2,ILEVELM
+ READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHV(JKM),ZHU(JKM)
+ END DO
+!
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZHEIGHTM(1) = ZZGROUND ! Mass level 1 is at the ground
+ ZTHV(1) = ZTHVGROUND
+ ZHU(1) = ZHUGROUND
+!
+! Compute Pressure at the mass levels of the RS
+ ZPRESSM= PRESS_HEIGHT(ZHEIGHTM,ZTHV,ZPGROUND,ZTHV(1),ZHEIGHTM(1))
+!
+! Compute Tv and the mixing ratio at the mass levels of the RS
+ ZTV(:)=ZTHV(:) * (ZPRESSM(:) / XP00) ** ZRDSCPD
+ ZMR(:)=SM_PMR_HU(ZPRESSM(:),ZTV(:),ZHU(:),SPREAD(ZMR(:),2,1))
+!
+! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+!
+!
+!* 2.5 ZUVTHVMR case : zGROUND, PGROUND, ThvGROUND, RGROUND
+! (height, U, V) ,
+! (height, THv, R)
+!
+!
+ CASE ('ZUVTHVMR')
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTHVGROUND
+ READ(ILUPRE,*) ZMRGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate the required memory
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+!
+! Read the data at each wind level of the RS
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate the required memory
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+!
+! Read the data at each mass level of the RS
+ DO JKM=2,ILEVELM
+ READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHV(JKM),ZMR(JKM)
+ END DO
+!
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZHEIGHTM(1)= ZZGROUND ! Mass level 1 is at the ground
+ ZTHV(1) = ZTHVGROUND
+ ZMR(1) = ZMRGROUND
+! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+!
+!
+!* 2.6 PUVTHDMR case : zGROUND, PGROUND, ThdGROUND, RGROUND
+! (Pressure, U, V) ,
+! (Pressure, THd, R)
+!
+ CASE ('PUVTHDMR')
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTHDGROUND
+ READ(ILUPRE,*) ZMRGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+ ALLOCATE(ZTHVU(ILEVELU))
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+!
+! Read the data at each wind level of the RS
+ DO JKU =1,ILEVELU
+ READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSM(ILEVELM))
+ ALLOCATE(ZTHD(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZMRC(ILEVELM))
+ ZMRC=0
+ ALLOCATE(ZMRI(ILEVELM))
+ ZMRI=0
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+!
+! Read the data at each mass level of the RS
+ DO JKM=2,ILEVELM
+ IF(LUSERI) THEN
+ READ(ILUPRE,*) ZPRESSM(JKM),ZTHD(JKM),ZMR(JKM),ZMRC(JKM),ZMRI(JKM)
+ ELSEIF (GUSERC) THEN
+ READ(ILUPRE,*) ZPRESSM(JKM),ZTHD(JKM),ZMR(JKM),ZMRC(JKM)
+ ELSE
+ READ(ILUPRE,*) ZPRESSM(JKM),ZTHD(JKM),ZMR(JKM)
+ ENDIF
+ END DO
+!
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZPRESSM(1) = ZPGROUND ! Mass level 1 is at the ground
+ ZTHD(1) = ZTHDGROUND
+ ZMR(1) = ZMRGROUND
+ IF(GUSERC) ZMRC(1) = ZMRC(2)
+ IF(LUSERI) ZMRI(1) = ZMRI(2)
+!
+! Compute thetav at the mass levels of the RS
+ ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:)+ZMRC(:)+ZMRI(:))
+!
+! Compute the heights at the mass levels of the RS
+ ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! Compute thetav and heights of the wind levels
+ ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
+ ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! Compute Theta l and Rt
+ IF (.NOT. GUSERC .AND. .NOT. LUSERI) THEN
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+ ELSE
+ ALLOCATE(ZEXN(ILEVELM))
+ ALLOCATE(ZT(ILEVELM))
+ ALLOCATE(ZCPH(ILEVELM))
+ ALLOCATE(ZLVOCPEXN(ILEVELM))
+ ALLOCATE(ZLSOCPEXN(ILEVELM))
+ ZRT(:)=ZMR(:)+ZMRI(:)+ZMRC(:)
+ ZEXN(:)=(ZPRESSM/XP00) ** (XRD/XCPD)
+ ZT(:)=ZTHV*(ZPRESSM(:)/XP00)**(ZRDSCPD)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+ ZCPH(:)=XCPD+ XCPV * ZMR(:)+ XCL *ZMRC(:) + XCI * ZMRI(:)
+ ZLVOCPEXN(:) = (XLVTT + (XCPV-XCL) * (ZT(:)-XTT))/(ZCPH*ZEXN(:))
+ ZLSOCPEXN(:) = (XLSTT + (XCPV-XCI) * (ZT(:)-XTT))/(ZCPH*ZEXN(:))
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))-ZLVOCPEXN(:)*ZMRC(:)-ZLSOCPEXN(:)*ZMRI(:)
+ DEALLOCATE(ZEXN)
+ DEALLOCATE(ZT)
+ DEALLOCATE(ZCPH)
+ DEALLOCATE(ZLVOCPEXN)
+ DEALLOCATE(ZLSOCPEXN)
+ ENDIF
+!
+!
+!* 2.7 PUVTHDHU case : zGROUND, PGROUND, ThdGROUND, HuGROUND
+! (Pressure, U, V) ,
+! (Pressure, THd, Hu)
+!
+ CASE ('PUVTHDHU')
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTHDGROUND
+ READ(ILUPRE,*) ZHUGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+ ALLOCATE(ZTHVU(ILEVELU))
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+!
+! Read the data at each wind level of the RS
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSM(ILEVELM))
+ ALLOCATE(ZTHD(ILEVELM))
+ ALLOCATE(ZHU(ILEVELM))
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZT(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+!
+! Read the data at each mass level of the RS
+ DO JKM =2,ILEVELM
+ READ(ILUPRE,*) ZPRESSM(JKM),ZTHD(JKM), ZHU(JKM)
+ END DO
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZPRESSM(1) = ZPGROUND ! Mass level 1 is at the ground
+ ZTHD(1) = ZTHDGROUND
+ ZHU(1) = ZHUGROUND
+!
+ ZT(:) = ZTHD(:) * (ZPRESSM(:)/XP00)**ZRDSCPD ! compute T and mixing ratio
+ ZMR(:) = ZRDSRV*SM_FOES(ZT(:))/((ZPRESSM(:)*100./ZHU(:)) -SM_FOES(ZT(:)))
+
+! Compute thetav at the mass levels of the RS
+ ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:))
+!
+! Compute height at mass levels
+ ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! Compute thetav and heights of the wind levels
+ ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
+ ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! Compute thetal and Rt
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+!
+!* 2.8 ZUVTHDMR case : zGROUND, PGROUND, ThdGROUND, RGROUND
+! (height, U, V) ,
+! (height, THd, R)
+!
+ CASE ('ZUVTHDMR')
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTHDGROUND
+ READ(ILUPRE,*) ZMRGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate required memory
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+!
+! Read the data at each wind level of the RS
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate required memory
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHD(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZMRC(ILEVELM))
+ ZMRC=0
+ ALLOCATE(ZMRI(ILEVELM))
+ ZMRI=0
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+!
+! Read the data at each mass level of the RS
+ DO JKM= 2,ILEVELM
+ IF(LUSERI) THEN
+ READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHD(JKM),ZMR(JKM),ZMRC(JKM),ZMRI(JKM)
+ ELSEIF (GUSERC) THEN
+ READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHD(JKM),ZMR(JKM),ZMRC(JKM)
+ ELSE
+ READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHD(JKM),ZMR(JKM)
+ ENDIF
+ END DO
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZHEIGHTM(1) = ZZGROUND ! Mass level 1 is at ground
+ ZTHD(1) = ZTHDGROUND
+ ZMR(1) = ZMRGROUND
+ IF(GUSERC) ZMRC(1) = ZMRC(2)
+ IF(LUSERI) ZMRI(1) = ZMRI(2)
+! Compute thetav at the mass levels of the RS
+ IF(LUSERI) THEN
+ ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:)+ZMRC(:)+ZMRI(:))
+ ELSEIF (GUSERC) THEN
+ ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:)+ZMRC(:))
+ ELSE
+ ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:))
+ ENDIF
+!
+! Compute Theta l and Rt
+ IF (.NOT. GUSERC .AND. .NOT. LUSERI) THEN
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+ ELSE
+ ALLOCATE(ZEXN(ILEVELM))
+ ALLOCATE(ZEXNFLUX(ILEVELM))
+ ALLOCATE(ZT(ILEVELM))
+ ALLOCATE(ZCPH(ILEVELM))
+ ALLOCATE(ZLVOCPEXN(ILEVELM))
+ ALLOCATE(ZLSOCPEXN(ILEVELM))
+ ZRT(:)=ZMR(:)+ZMRI(:)+ZMRC(:)
+ ZEXNSURF=(ZPGROUND/XP00) ** (XRD/XCPD)
+ CALL COMPUTE_EXNER_FROM_GROUND(ZTHV,ZHEIGHTM,ZEXNSURF,ZEXNFLUX,ZEXN)
+ ZT(:)=ZTHV*ZEXN(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+ ZCPH(:)=XCPD+ XCPV * ZMR(:)+ XCL *ZMRC(:) + XCI * ZMRI(:)
+ ZLVOCPEXN(:) = (XLVTT + (XCPV-XCL) * (ZT(:)-XTT))/(ZCPH*ZEXN(:))
+ ZLSOCPEXN(:) = (XLSTT + (XCPV-XCI) * (ZT(:)-XTT))/(ZCPH*ZEXN(:))
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))-ZLVOCPEXN(:)*ZMRC(:)-ZLSOCPEXN(:)*ZMRI(:)
+ DEALLOCATE(ZEXN)
+ DEALLOCATE(ZEXNFLUX)
+ DEALLOCATE(ZT)
+ DEALLOCATE(ZCPH)
+ DEALLOCATE(ZLVOCPEXN)
+ DEALLOCATE(ZLSOCPEXN)
+ ENDIF
+!
+! 2.9 ZUVTHLMR case : zGROUND, PGROUND, ThdGROUND, RGROUND
+! (height, U, V)
+! (height, THL, Rt)
+
+!
+ CASE ('ZUVTHLMR')
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTHLGROUND
+ READ(ILUPRE,*) ZMRGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate required memory
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+!
+! Read the data at each wind level of the RS
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate required memory
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZTH(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZMRC(ILEVELM))
+ ZMRC=0
+ ALLOCATE(ZMRI(ILEVELM))
+ ZMRI=0
+ ALLOCATE(ZRT(ILEVELM))
+!
+! Read the data at each mass level of the RS
+ DO JKM= 2,ILEVELM
+! IF(LUSERI) THEN
+! READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHL(JKM),ZMR(JKM),ZMRC(JKM),ZMRI(JKM)
+! ELSEIF (GUSERC) THEN
+ IF (GUSERC) THEN
+ READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHL(JKM),ZMR(JKM),ZMRC(JKM)
+ ELSE
+ READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHL(JKM),ZMR(JKM)
+ ENDIF
+ END DO
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZHEIGHTM(1) = ZZGROUND ! Mass level 1 is at ground
+ ZTHL(1) = ZTHLGROUND
+ ZMR(1) = ZMRGROUND
+ IF(GUSERC) ZMRC(1) = ZMRC(2)
+! IF(LUSERI) ZMRI(1) = ZMRI(2)
+!
+! Compute Rt
+ ZRT(:)=ZMR+ZMRC+ZMRI
+!
+!* 2.10 PUVTHU case : zGROUND, PGROUND, TempGROUND, HuGROUND
+! (Pressure, U, V) ,
+! (Pressure, Temp, Hu)
+!
+ CASE ('PUVTHU')
+! Read data at ground level
+ READ(ILUPRE,*) ZZGROUND
+ READ(ILUPRE,*) ZPGROUND
+ READ(ILUPRE,*) ZTGROUND
+ READ(ILUPRE,*) ZHUGROUND
+!
+! Read number of wind levels
+ READ(ILUPRE,*) ILEVELU
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+ ALLOCATE(ZTHVU(ILEVELU))
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+!
+! Read the data at each wind level of the RS
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+!
+! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+!
+! Allocate the required memory
+ ALLOCATE(ZPRESSM(ILEVELM))
+ ALLOCATE(ZTHD(ILEVELM))
+ ALLOCATE(ZHU(ILEVELM))
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZT(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+
+!
+! Read the data at each mass level of the RS
+ DO JKM =2,ILEVELM
+ READ(ILUPRE,*) ZPRESSM(JKM),ZT(JKM), ZHU(JKM)
+ END DO
+! Complete the mass arrays with the ground informations read in EXPRE file
+ ZPRESSM(1) = ZPGROUND ! Mass level 1 is at the ground
+ ZT(1) = ZTGROUND
+ ZHU(1) = ZHUGROUND
+!
+ ZTHD(:) = ZT(:) / (ZPRESSM(:)/XP00)**ZRDSCPD ! compute THD and mixing ratio
+ ZMR(:) = ZRDSRV*SM_FOES(ZT(:))/((ZPRESSM(:)*100./ZHU(:)) -SM_FOES(ZT(:)))
+! Compute thetav at the mass levels of the RS
+ ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:))
+!
+! Compute height at mass levels
+ ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! Compute thetav and heights of the wind levels
+ ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
+ ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
+!
+! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
+ ZRT(:)=ZMR(:)
+ ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
+ CASE DEFAULT
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','data type YKIND='//TRIM(YKIND)//' in PREFILE unknown')
+END SELECT
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INTERPOLATE ON THE VERTICAL MIXED MODEL GRID
+! ---------------------------------------------------------
+!
+!
+!
+IKU=SIZE(XZHAT)
+!
+!* 3.1 Compute mixed grid
+!
+IF (PRESENT(PCORIOZ)) THEN
+! LGEOSBAL=T (no shift allowed, MNH grid without ororgraphy)
+ ZZS_LS(:,:)=0
+ELSE
+ IF (OSHIFT) THEN
+ ZZS_LS(:,:)=ZZGROUND
+ ELSE
+ ZZS_LS(:,:)=0
+ ENDIF
+ENDIF
+CALL VERT_COORD(LSLEVE,ZZS_LS,ZZS_LS,XLEN1,XLEN2,XZHAT,ZZFLUX_MX)
+ZZMASS_MX(:,:,:)=MZF(ZZFLUX_MX)
+ZZMASS_MX(:,:,IKU)=1.5*ZZFLUX_MX(:,:,IKU)-0.5*ZZFLUX_MX(:,:,IKU-1)
+!
+!* 3.2 Interpolate and extrapolate U and V on w- mixed grid levels
+!
+!* vertical grid at initialization profile location
+GPROFILE_IN_PROC=(KILOC+JPHEXT-IXOR_ll+1>=IIB .AND. KILOC+JPHEXT-IXOR_ll+1<=IIE) &
+ & .AND. (KJLOC+JPHEXT-IYOR_ll+1>=IJB .AND. KJLOC+JPHEXT-IYOR_ll+1<=IJE)
+!
+IF (GPROFILE_IN_PROC) THEN
+ ZZMASS_PROFILE(:) = ZZMASS_MX(KILOC+JPHEXT-IXOR_ll+1,KJLOC+JPHEXT-IYOR_ll+1,:)
+ ZZFLUX_PROFILE(:) = ZZFLUX_MX(KILOC+JPHEXT-IXOR_ll+1,KJLOC+JPHEXT-IYOR_ll+1,:)
+ELSE
+ ZZMASS_PROFILE(:) = 0.
+ ZZFLUX_PROFILE(:) = 0.
+END IF
+DO JK = 1,IKU
+ CALL REDUCESUM_ll(ZZMASS_PROFILE(JK), IINFO_ll)
+ CALL REDUCESUM_ll(ZZFLUX_PROFILE(JK), IINFO_ll)
+END DO
+
+! interpolation of U and V
+DO JK = 1,IKU
+ IF (ZZFLUX_PROFILE(JK) <= ZHEIGHTU(1)) THEN ! extrapolation below the first level
+ ZDZSDH = (ZZFLUX_PROFILE(JK) - ZHEIGHTU(1)) / (ZHEIGHTU(2) - ZHEIGHTU(1))
+ ZUW(JK) = ZU(1) + (ZU(2) - ZU(1)) * ZDZSDH
+ ZVW(JK) = ZV(1) + (ZV(2) - ZV(1)) * ZDZSDH
+ ELSE IF (ZZFLUX_PROFILE(JK) > ZHEIGHTU(ILEVELU) ) THEN ! extrapolation above the last
+ ZDZSDH = (ZZFLUX_PROFILE(JK) - ZHEIGHTU(ILEVELU)) & ! level
+ / (ZHEIGHTU(ILEVELU) - ZHEIGHTU(ILEVELU-1))
+ ZUW(JK) = ZU(ILEVELU) + (ZU(ILEVELU) -ZU(ILEVELU -1)) * ZDZSDH
+ ZVW(JK) = ZV(ILEVELU) + (ZV(ILEVELU) -ZV(ILEVELU -1)) * ZDZSDH
+ ELSE ! interpolation between the first and last levels
+ DO JKLEV = 1,ILEVELU-1
+ IF ( (ZZFLUX_PROFILE(JK) > ZHEIGHTU(JKLEV)).AND. &
+ (ZZFLUX_PROFILE(JK) <= ZHEIGHTU(JKLEV+1)) )THEN
+ ZDZ1SDH = (ZZFLUX_PROFILE(JK) - ZHEIGHTU(JKLEV)) &
+ / (ZHEIGHTU(JKLEV+1)-ZHEIGHTU(JKLEV))
+ ZDZ2SDH = (ZHEIGHTU(JKLEV+1) - ZZFLUX_PROFILE(JK) ) &
+ / (ZHEIGHTU(JKLEV+1)-ZHEIGHTU(JKLEV))
+ ZUW(JK) = (ZU(JKLEV) * ZDZ2SDH) + (ZU(JKLEV+1) *ZDZ1SDH)
+ ZVW(JK) = (ZV(JKLEV) * ZDZ2SDH) + (ZV(JKLEV+1) *ZDZ1SDH)
+ END IF
+ END DO
+ END IF
+END DO
+!
+!* 3.3 Interpolate and extrapolate Thetav and r on mass mixed grid levels
+!
+ZMRCM=0
+ZMRIM=0
+DO JK = 1,IKU
+ IF (ZZMASS_PROFILE(JK) <= ZHEIGHTM(1)) THEN ! extrapolation below the first level
+ ZDZSDH = (ZZMASS_PROFILE(JK) - ZHEIGHTM(1)) / (ZHEIGHTM(2) - ZHEIGHTM(1))
+ ZTHLM(JK) = ZTHL(1) + (ZTHL(2) - ZTHL(1)) * ZDZSDH
+ ZMRM(JK) = ZRT(1) + (ZRT(2) - ZRT(1)) * ZDZSDH
+ IF (GUSERC) ZMRCM(JK) = ZMRC(1) + (ZMRC(2) - ZMRC(1)) * ZDZSDH
+ IF (LUSERI) ZMRIM(JK) = ZMRI(1) + (ZMRI(2) - ZMRI(1)) * ZDZSDH
+ ELSE IF (ZZMASS_PROFILE(JK) > ZHEIGHTM(ILEVELM) ) THEN ! extrapolation above the last
+ ZDZSDH = (ZZMASS_PROFILE(JK) - ZHEIGHTM(ILEVELM)) & ! level
+ / (ZHEIGHTM(ILEVELM) - ZHEIGHTM(ILEVELM-1))
+ ZTHLM(JK) = ZTHL(ILEVELM) + (ZTHL(ILEVELM) -ZTHL(ILEVELM -1)) * ZDZSDH
+ ZMRM(JK) = ZRT(ILEVELM) + (ZRT(ILEVELM) -ZRT(ILEVELM -1)) * ZDZSDH
+ IF (GUSERC) ZMRCM(JK) = ZMRC(ILEVELM) + (ZMRC(ILEVELM) -ZMRC(ILEVELM -1)) * ZDZSDH
+ IF (LUSERI) ZMRIM(JK) = ZMRI(ILEVELM) + (ZMRI(ILEVELM) -ZMRI(ILEVELM -1)) * ZDZSDH
+ ELSE ! interpolation between the first and last levels
+ DO JKLEV = 1,ILEVELM-1
+ IF ( (ZZMASS_PROFILE(JK) > ZHEIGHTM(JKLEV)).AND. &
+ (ZZMASS_PROFILE(JK) <= ZHEIGHTM(JKLEV+1)) )THEN
+ ZDZ1SDH = (ZZMASS_PROFILE(JK) - ZHEIGHTM(JKLEV)) &
+ / (ZHEIGHTM(JKLEV+1)-ZHEIGHTM(JKLEV))
+ ZDZ2SDH = (ZHEIGHTM(JKLEV+1) - ZZMASS_PROFILE(JK) ) &
+ / (ZHEIGHTM(JKLEV+1)-ZHEIGHTM(JKLEV))
+ ZTHLM(JK) = (ZTHL(JKLEV) * ZDZ2SDH) + (ZTHL(JKLEV+1) *ZDZ1SDH)
+ ZMRM(JK) = (ZRT(JKLEV) * ZDZ2SDH) + (ZRT(JKLEV+1) *ZDZ1SDH)
+ IF (GUSERC) ZMRCM(JK) = (ZMRC(JKLEV) * ZDZ2SDH) + (ZMRC(JKLEV+1) *ZDZ1SDH)
+ IF (LUSERI) ZMRIM(JK) = (ZMRI(JKLEV) * ZDZ2SDH) + (ZMRI(JKLEV+1) *ZDZ1SDH)
+ END IF
+ END DO
+ END IF
+END DO
+!
+! Compute thetaV rv ri and Rc with adjustement
+ALLOCATE(ZEXNFLUX(IKU))
+ALLOCATE(ZEXNMASS(IKU))
+ALLOCATE(ZPRESS(IKU))
+ALLOCATE(ZPREFLUX(IKU))
+ALLOCATE(ZFRAC_ICE(IKU))
+ALLOCATE(ZRSATW(IKU))
+ALLOCATE(ZRSATI(IKU))
+ALLOCATE(ZMRT(IKU))
+ALLOCATE(ZBUF(IKU,16))
+ZMRT=ZMRM+ZMRCM+ZMRIM
+ZTHVM=ZTHLM
+!
+IF (LOCEAN) THEN
+ ZRHODM(:)=XRH00OCEAN*(1.-XALPHAOC*(ZTHLM(:) - XTH00OCEAN)&
+ +XBETAOC* (ZMRM(:) - XSA00OCEAN))
+ ZPREFLUX(IKU)=ZPTOP
+ DO JK=IKU-1,2,-1
+ ZPREFLUX(JK) = ZPREFLUX(JK+1) + XG*ZRHODM(JK)*(ZZFLUX_PROFILE(JK+1)-ZZFLUX_PROFILE(JK))
+ END DO
+ ZPGROUND=ZPREFLUX(2)
+ WRITE(ILUOUT,FMT=*)'ZPGROUND i.e. Pressure at ocean domain bottom',ZPGROUND
+ ZTHM=ZTHVM
+ELSE
+! Atmospheric case
+ ZEXNSURF=(ZPGROUND/XP00)**(XRD/XCPD)
+ DO JLOOP=1,20 ! loop for pression
+ CALL COMPUTE_EXNER_FROM_GROUND(ZTHVM,ZZMASS_PROFILE(:),ZEXNSURF,ZEXNFLUX,ZEXNMASS)
+ ZPRESS(:)=XP00*(ZEXNMASS(:))**(XCPD/XRD)
+ CALL TH_R_FROM_THL_RT(CST,NEB,SIZE(ZPRESS,1),'T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
+ ZRSATW, ZRSATI,OOCEAN=.FALSE.,&
+ PBUF=ZBUF)
+ ZTHVM(:)=ZTHM(:)*(1.+XRV/XRD*ZMRM(:))/(1.+(ZMRM(:)+ZMRIM(:)+ZMRCM(:)))
+ ENDDO
+ENDIF
+!
+DEALLOCATE(ZEXNFLUX)
+DEALLOCATE(ZEXNMASS)
+DEALLOCATE(ZPRESS)
+DEALLOCATE(ZFRAC_ICE)
+DEALLOCATE(ZRSATW)
+DEALLOCATE(ZRSATI)
+DEALLOCATE(ZMRT)
+DEALLOCATE(ZBUF)
+!-------------------------------------------------------------------------------
+!
+!* 4. COMPUTE FIELDS ON THE MODEL GRID (WITH OROGRAPHY)
+! -------------------------------------------------
+CALL SET_MASS(TPFILE,GPROFILE_IN_PROC, ZZFLUX_PROFILE, &
+ KILOC+JPHEXT,KJLOC+JPHEXT,ZZS_LS,ZZMASS_MX,ZZFLUX_MX,ZPGROUND,&
+ ZTHVM,ZMRM,ZUW,ZVW,OSHIFT,OBOUSS,PJ,HFUNU,HFUNV, &
+ PMRCM=ZMRCM,PMRIM=ZMRIM,PCORIOZ=PCORIOZ)
+!
+DEALLOCATE(ZPREFLUX)
+DEALLOCATE(ZHEIGHTM)
+DEALLOCATE(ZTHV)
+DEALLOCATE(ZMR)
+DEALLOCATE(ZTHL)
+!-------------------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE CHECK( ISTATUS, YLOC )
+ INTEGER(KIND=CDFINT), INTENT(IN) :: ISTATUS
+ CHARACTER(LEN=*), INTENT(IN) :: YLOC
+
+ IF( ISTATUS /= NF90_NOERR ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'IO', 'SET_RSOU', 'error at ' // Trim( yloc) // ': ' // NF90_STRERROR( ISTATUS ) )
+ END IF
+ END SUBROUTINE check
+ !
+ INCLUDE "th_r_from_thl_rt.func.h"
+ INCLUDE "compute_frac_ice.func.h"
+ !
+END SUBROUTINE SET_RSOU
diff --git a/src/PHYEX/ext/shallow_mf_pack.f90 b/src/PHYEX/ext/shallow_mf_pack.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ee2f7e2fb5d794175d12979085583f31a02a53fd
--- /dev/null
+++ b/src/PHYEX/ext/shallow_mf_pack.f90
@@ -0,0 +1,383 @@
+!MNH_LIC Copyright 2010-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_SHALLOW_MF_PACK
+! ######################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
+ OMF_FLX,TPFILE,PTIME_LES, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, PDX,PDY, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXN, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PTKEM,PSVM, &
+ PRTHS,PRRS,PRUS,PRVS,PRSVS, &
+ PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF )
+! #################################################################
+!!
+use MODD_IO, only: TFILEDATA
+use modd_precision, only: MNHTIME
+!
+!* 1.1 Declaration of Arguments
+!
+!
+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) :: OMF_FLX ! switch to write the
+ ! MF fluxes in the synchronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function at t-dt
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(:,:,:,:),INTENT(IN):: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! wind components at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke at t-dt
+
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRTHS ! Meso-NH sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar sources
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
+!
+REAL, INTENT(IN) :: PDX,PDY ! Size of mesh in X/Y directions
+END SUBROUTINE SHALLOW_MF_PACK
+
+END INTERFACE
+!
+END MODULE MODI_SHALLOW_MF_PACK
+
+! #################################################################
+ SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
+ OMF_FLX,TPFILE,PTIME_LES, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, PDX,PDY, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXN, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PTKEM,PSVM, &
+ PRTHS,PRRS,PRUS,PRVS,PRSVS, &
+ PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF )
+! #################################################################
+!!
+!!**** *SHALLOW_MF_PACK* -
+!!
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is
+!!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V.Masson 09/2010
+! --------------------------------------------------------------------------
+! Modifications:
+! R. Honnert 07/2012: introduction of vertical wind for the height of the thermal
+! M. Leriche 02/2017: avoid negative values for sv tendencies
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! S. Riette 11/2016: support for CFRAC_ICE_SHALLOW_MF
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: CST
+USE MODD_NEB, ONLY: NEB
+USE MODD_TURB_n, ONLY: TURBN
+USE MODD_CTURB, ONLY: CSTURB
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+!
+USE MODD_BUDGET, ONLY: TBUDGETS,TBUCONF,lbudget_th,nbudget_th
+USE MODD_CONF
+USE MODD_IO, ONLY: TFILEDATA
+USE modd_field, ONLY: tfielddata, TYPEREAL
+USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY: CFRAC_ICE_SHALLOW_MF
+USE MODD_PARAM_MFSHALL_n
+USE modd_precision, ONLY: MNHTIME
+
+USE mode_budget, ONLY: Budget_store_init, Budget_store_end, Budget_store_add
+USE MODE_IO_FIELD_WRITE, ONLY: IO_Field_write
+
+USE MODI_DIAGNOS_LES_MF
+USE MODI_SHALLOW_MF
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+
+!* 0.1 Declaration of Arguments
+!
+!
+!
+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) :: OMF_FLX ! switch to write the
+ ! MF fluxes in the synchronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function at t-dt
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(:,:,:,:),INTENT(IN):: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! wind components at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke at t-dt
+
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRTHS ! Meso-NH sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar sources
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
+!
+REAL, INTENT(IN) :: PDX,PDY ! Size of mesh in X/Y directions
+! 0.2 Declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDUDT_TURB ! tendency of U by turbulence only
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDVDT_TURB ! tendency of V by turbulence only
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDTHLDT_TURB ! tendency of thl by turbulence only
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDRTDT_TURB ! tendency of rt by turbulence only
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PSVM,4)) :: ZDSVDT_TURB ! tendency of Sv by turbulence only
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDUDT_MF ! tendency of U by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDVDT_MF ! tendency of V by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDTHLDT_MF ! tendency of thl by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDRTDT_MF ! tendency of Rt by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PSVM,4)) :: ZDSVDT_MF ! tendency of Sv by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZSIGMF,ZRC_MF,ZRI_MF,ZCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZTHVMF ! Thermal production for TKE scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZTHMF
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZRMF
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZUMF
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZVMF
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTHL_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRT_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRV_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZU_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZV_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRC_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRI_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTHV_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZW_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFRAC_UP ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZEMF ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDETR ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZENTR ! updraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZUMM ! wind on mass point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZVMM ! wind on mass point
+!
+INTEGER,DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2)) :: IKLCL,IKETL,IKCTL ! level of LCL,ETL and CTL
+INTEGER :: IIU, IJU, IKU, IKB, IKE, IRR, ISV
+INTEGER :: JK,JRR,JSV ! Loop counters
+
+
+LOGICAL :: LSTATNW ! switch for HARMONIE-AROME turb physics option
+ ! TODO: linked with modd_turbn + init at default_desfmn
+
+TYPE(TFIELDDATA) :: TZFIELD
+TYPE(DIMPHYEX_t) :: YLDIMPHYEXPACK
+!------------------------------------------------------------------------
+!
+!!! 1. Initialisation
+CALL FILL_DIMPHYEX(YLDIMPHYEXPACK, SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3))
+!
+! Internal Domain
+IIU=SIZE(PTHM,1)
+IJU=SIZE(PTHM,2)
+IKU=SIZE(PTHM,3)
+IKB=1+JPVEXT
+IKE=IKU-JPVEXT
+!
+! number of moist var
+IRR=SIZE(PRM,4)
+! number of scalar var
+ISV=SIZE(PSVM,4)
+!
+! wind on mass points
+ZUMM=MXF(PUM)
+ZVMM=MYF(PVM)
+!
+!!! 2. Call of the physical parameterization of massflux vertical transport
+!
+LSTATNW = .FALSE.
+!
+CALL SHALLOW_MF(YLDIMPHYEXPACK, CST, NEB, PARAM_MFSHALLN, TURBN, CSTURB,&
+ KRR,KRRL,KRRI,ISV, &
+ CFRAC_ICE_SHALLOW_MF,LNOMIXLG,NSV_LGBEG,NSV_LGEND, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, &
+ PRHODJ,PRHODREF, &
+ PPABSM, PEXN, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,ZUMM,ZVMM,PTKEM,PSVM, &
+ ZDUDT_MF,ZDVDT_MF, &
+ ZDTHLDT_MF,ZDRTDT_MF,ZDSVDT_MF, &
+ ZSIGMF,ZRC_MF,ZRI_MF,ZCF_MF,ZFLXZTHVMF, &
+ ZFLXZTHMF,ZFLXZRMF,ZFLXZUMF,ZFLXZVMF, &
+ ZTHL_UP,ZRT_UP,ZRV_UP,ZRC_UP,ZRI_UP, &
+ ZU_UP, ZV_UP, ZTHV_UP, ZW_UP, &
+ ZFRAC_UP,ZEMF,ZDETR,ZENTR, &
+ IKLCL,IKETL,IKCTL,PDX,PDY,PRSVS,XSVMIN, &
+ TBUCONF, TBUDGETS,SIZE(TBUDGETS) )
+!
+! Fill non-declared-explicit-dimensions output variables
+PSIGMF(:,:,:) = ZSIGMF(:,:,:)
+PRC_MF(:,:,:) = ZRC_MF(:,:,:)
+PRI_MF(:,:,:) = ZRI_MF(:,:,:)
+PCF_MF(:,:,:) = ZCF_MF(:,:,:)
+PFLXZTHVMF(:,:,:) = ZFLXZTHVMF(:,:,:)
+!
+!!! 3. Compute source terms for Meso-NH pronostic variables
+!!! ----------------------------------------------------
+!
+! As the pronostic variable of Meso-Nh are not (yet) the conservative variables
+! the thl tendency is put in th and the rt tendency in rv
+! the adjustment will do later the repartition between vapor and cloud
+PRTHS(:,:,:) = PRTHS(:,:,:) + &
+ PRHODJ(:,:,:)*ZDTHLDT_MF(:,:,:)
+PRRS(:,:,:,1) = PRRS(:,:,:,1) + &
+ PRHODJ(:,:,:)*ZDRTDT_MF(:,:,:)
+PRUS(:,:,:) = PRUS(:,:,:) +MXM( &
+ PRHODJ(:,:,:)*ZDUDT_MF(:,:,:))
+PRVS(:,:,:) = PRVS(:,:,:) +MYM( &
+ PRHODJ(:,:,:)*ZDVDT_MF(:,:,:))
+!
+DO JSV=1,ISV
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ PRSVS(:,:,:,JSV) = MAX((PRSVS(:,:,:,JSV) + &
+ PRHODJ(:,:,:)*ZDSVDT_MF(:,:,:,JSV)),XSVMIN(JSV))
+END DO
+!
+!!! 4. Prints the fluxes in output file
+!
+IF ( OMF_FLX .AND. tpfile%lopened ) THEN
+ ! stores the conservative potential temperature vertical flux
+ TZFIELD%CMNHNAME = 'MF_THW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_THW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_THW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZTHMF)
+ !
+ ! stores the conservative mixing ratio vertical flux
+ TZFIELD%CMNHNAME = 'MF_RCONSW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_RCONSW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_RCONSW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZRMF)
+ !
+ ! stores the theta_v vertical flux
+ TZFIELD%CMNHNAME = 'MF_THVW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_THVW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_THVW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PFLXZTHVMF)
+ !
+ IF (PARAM_MFSHALLN%LMIXUV) THEN
+ ! stores the U momentum vertical flux
+ TZFIELD%CMNHNAME = 'MF_UW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_UW_FLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_UW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZUMF)
+ !
+ ! stores the V momentum vertical flux
+ TZFIELD%CMNHNAME = 'MF_VW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_VW_FLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_VW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZVMF)
+ !
+ END IF
+END IF
+!
+!!! 5. Externalised LES Diagnostic for Mass Flux Scheme
+!!! ------------------------------------------------
+!
+ CALL DIAGNOS_LES_MF(IIU,IJU,IKU,PTIME_LES, &
+ ZTHL_UP,ZRT_UP,ZRV_UP,ZRC_UP,ZRI_UP, &
+ ZU_UP,ZV_UP,ZTHV_UP,ZW_UP, &
+ ZFRAC_UP,ZEMF,ZDETR,ZENTR, &
+ ZFLXZTHMF,ZFLXZTHVMF,ZFLXZRMF, &
+ ZFLXZUMF,ZFLXZVMF, &
+ IKLCL,IKETL,IKCTL )
+!
+END SUBROUTINE SHALLOW_MF_PACK
diff --git a/src/PHYEX/ext/switch_sbg_lesn.f90 b/src/PHYEX/ext/switch_sbg_lesn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2920680faff50dbca286eaea17c310b045650675
--- /dev/null
+++ b/src/PHYEX/ext/switch_sbg_lesn.f90
@@ -0,0 +1,589 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$ $Date$
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+! ##########################
+ SUBROUTINE SWITCH_SBG_LES_n
+! ##########################
+!
+!!**** *SWITCH_SBG_LESn* - moves LES subgrid quantities from modd_les
+!! to modd_lesn or the contrary.
+!!
+!! PURPOSE
+!! -------
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original June 14, 2002
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_LES
+USE MODD_LES_n
+USE MODD_CONF_n
+USE MODD_NSV
+!
+USE MODI_SECOND_MNH
+!
+IMPLICIT NONE
+!
+REAL :: ZTIME1, ZTIME2
+!-------------------------------------------------------------------------------
+!
+!* 7.4 interactions of resolved and subgrid quantities
+! -----------------------------------------------
+!
+CALL SECOND_MNH(ZTIME1)
+!
+IF (.NOT. ASSOCIATED (X_LES_RES_W_SBG_WThl) ) THEN
+! ______
+ CALL LES_ALLOCATE('X_LES_RES_W_SBG_WThl',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'w'Thl'>
+! _____
+ CALL LES_ALLOCATE('X_LES_RES_W_SBG_Thl2',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'Thl'2>
+! _____
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_U_SBG_UaU',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <du'/dxa ua'u'>
+! _____
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_V_SBG_UaV',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dv'/dxa ua'v'>
+! _____
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaW',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dw'/dxa ua'w'>
+! _______
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaThl',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dw'/dxa ua'Thl'>
+! _____
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaW',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dThl'/dxa ua'w'>
+! ___
+ CALL LES_ALLOCATE('X_LES_RES_ddz_Thl_SBG_W2',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dThl'/dz w'2>
+! _______
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaThl',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dThl'/dxa ua'Thl'>
+!
+ IF (LUSERV) THEN
+! _____
+ CALL LES_ALLOCATE('X_LES_RES_W_SBG_WRt',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'w'Rt'>
+! ____
+ CALL LES_ALLOCATE('X_LES_RES_W_SBG_Rt2',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'Rt'2>
+! _______
+ CALL LES_ALLOCATE('X_LES_RES_W_SBG_ThlRt',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'Thl'Rt'>
+! ______
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaRt',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dw'/dxa ua'Rt'>
+! _____
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaW',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dRt'/dxa ua'w'>
+! ___
+ CALL LES_ALLOCATE('X_LES_RES_ddz_Rt_SBG_W2',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dRt'/dz w'2>
+! ______
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaRt',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dThl'/dxa ua'Rt'>
+! _______
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaThl',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dRt'/dxa ua'Thl'>
+! ______
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <dRt'/dxa ua'Rt'>
+ ELSE
+ CALL LES_ALLOCATE('X_LES_RES_W_SBG_WRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_RES_W_SBG_Rt2',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_RES_W_SBG_ThlRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaW',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_RES_ddz_Rt_SBG_W2',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaThl',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaRt',(/0,0,0/))
+ END IF
+! ______
+CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <dw'/dxa ua'Sv'>
+! _____
+CALL LES_ALLOCATE('X_LES_RES_ddxa_Sv_SBG_UaW',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <dSv'/dxa ua'w'>
+! ___
+CALL LES_ALLOCATE('X_LES_RES_ddz_Sv_SBG_W2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/) ) ! <dSv'/dz w'2>
+! ______
+CALL LES_ALLOCATE('X_LES_RES_ddxa_Sv_SBG_UaSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <dSv'/dxa ua'Sv'>
+! _____
+CALL LES_ALLOCATE('X_LES_RES_W_SBG_WSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'w'Sv'>
+! ____
+CALL LES_ALLOCATE('X_LES_RES_W_SBG_Sv2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'Sv'2>
+!
+!
+ X_LES_RES_W_SBG_WThl = XLES_RES_W_SBG_WThl
+ X_LES_RES_W_SBG_Thl2 = XLES_RES_W_SBG_Thl2
+ X_LES_RES_ddxa_U_SBG_UaU = XLES_RES_ddxa_U_SBG_UaU
+ X_LES_RES_ddxa_V_SBG_UaV = XLES_RES_ddxa_V_SBG_UaV
+ X_LES_RES_ddxa_W_SBG_UaW = XLES_RES_ddxa_W_SBG_UaW
+ X_LES_RES_ddxa_W_SBG_UaThl = XLES_RES_ddxa_W_SBG_UaThl
+ X_LES_RES_ddxa_Thl_SBG_UaW = XLES_RES_ddxa_Thl_SBG_UaW
+ X_LES_RES_ddz_Thl_SBG_W2 = XLES_RES_ddz_Thl_SBG_W2
+ X_LES_RES_ddxa_Thl_SBG_UaThl = XLES_RES_ddxa_Thl_SBG_UaThl
+ IF (LUSERV) THEN
+ X_LES_RES_W_SBG_WRt = XLES_RES_W_SBG_WRt
+ X_LES_RES_W_SBG_Rt2 = XLES_RES_W_SBG_Rt2
+ X_LES_RES_W_SBG_ThlRt = XLES_RES_W_SBG_ThlRt
+ X_LES_RES_ddxa_W_SBG_UaRt = XLES_RES_ddxa_W_SBG_UaRt
+ X_LES_RES_ddxa_Rt_SBG_UaW = XLES_RES_ddxa_Rt_SBG_UaW
+ X_LES_RES_ddz_Rt_SBG_W2 = XLES_RES_ddz_Rt_SBG_W2
+ X_LES_RES_ddxa_Thl_SBG_UaRt= XLES_RES_ddxa_Thl_SBG_UaRt
+ X_LES_RES_ddxa_Rt_SBG_UaThl= XLES_RES_ddxa_Rt_SBG_UaThl
+ X_LES_RES_ddxa_Rt_SBG_UaRt = XLES_RES_ddxa_Rt_SBG_UaRt
+ END IF
+ IF (NSV>0) THEN
+ X_LES_RES_ddxa_W_SBG_UaSv = XLES_RES_ddxa_W_SBG_UaSv
+ X_LES_RES_ddxa_Sv_SBG_UaW = XLES_RES_ddxa_Sv_SBG_UaW
+ X_LES_RES_ddz_Sv_SBG_W2 = XLES_RES_ddz_Sv_SBG_W2
+ X_LES_RES_ddxa_Sv_SBG_UaSv = XLES_RES_ddxa_Sv_SBG_UaSv
+ X_LES_RES_W_SBG_WSv = XLES_RES_W_SBG_WSv
+ X_LES_RES_W_SBG_Sv2 = XLES_RES_W_SBG_Sv2
+ END IF
+!
+!
+ CALL LES_ALLOCATE('X_LES_SUBGRID_U2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_V2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_W2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Thl2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Thl'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_UV',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'v'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WU',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'u'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WV',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'v'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_UThl',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'Thl'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_VThl',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'Thl'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WThl',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Thl'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WThv',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Thv'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_ThlThv',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Thl'Thv'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_W2Thl',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'2Thl>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WThl2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Thl'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Tke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <epsilon>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Thl2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <epsilon_Thl2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WP',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'p'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_PHI3',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! phi3
+ CALL LES_ALLOCATE('X_LES_SUBGRID_LMix',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Lmix
+ CALL LES_ALLOCATE('X_LES_SUBGRID_LDiss',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Ldiss
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Km',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Km
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Kh',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Kh
+ CALL LES_ALLOCATE('X_LES_SUBGRID_ThlPz',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Thl'dp'/dz>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_UTke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'Tke>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_VTke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'Tke>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WTke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Tke>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_ddz_WTke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <dw'Tke/dz>
+
+ CALL LES_ALLOCATE('X_LES_SUBGRID_THLUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Thl of the Updraft
+ CALL LES_ALLOCATE('X_LES_SUBGRID_RTUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Rt of the Updraft
+ CALL LES_ALLOCATE('X_LES_SUBGRID_RVUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Rv of the Updraft
+ CALL LES_ALLOCATE('X_LES_SUBGRID_RCUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Rc of the Updraft
+ CALL LES_ALLOCATE('X_LES_SUBGRID_RIUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Ri of the Updraft
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Thl of the Updraft
+ CALL LES_ALLOCATE('X_LES_SUBGRID_MASSFLUX',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Mass Flux
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DETR',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Detrainment
+ CALL LES_ALLOCATE('X_LES_SUBGRID_ENTR',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Entrainment
+ CALL LES_ALLOCATE('X_LES_SUBGRID_FRACUP',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Updraft Fraction
+ CALL LES_ALLOCATE('X_LES_SUBGRID_THVUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Thv of the Updraft
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WTHLMF',(/NLES_K,NLES_TIMES,NLES_MASKS/))! Flux of thl
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WRTMF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Flux of rt
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WTHVMF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Flux of thv
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WUMF',(/NLES_K,NLES_TIMES,NLES_MASKS/))! Flux of u
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WVMF',(/NLES_K,NLES_TIMES,NLES_MASKS/))! Flux of v
+
+ IF (LUSERV ) THEN
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Rt2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Rt'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_ThlRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Thl'Rt'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_URt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'Rt'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_VRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'Rt'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Rt'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_RtThv',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Rt'Thv'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_W2Rt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'2Rt'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WThlRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Thl'Rt'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WRt2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Rt'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Rt2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <epsilon_Rt2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_ThlRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <epsilon_ThlRt>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_RtPz',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Rt'dp'/dz>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_PSI3',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! psi3
+ ELSE
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Rt2',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_ThlRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_URt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_VRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_RtThv',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_W2Rt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WThlRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WRt2',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Rt2',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_ThlRt',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_RtPz',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_PSI3',(/0,0,0/))
+ END IF
+ IF (LUSERC ) THEN
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Rc2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Rc'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_URc',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'Rc'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_VRc',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'Rc'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WRc',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Rc'>
+ ELSE
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Rc2',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_URc',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_VRc',(/0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WRc',(/0,0,0/))
+ END IF
+ IF (LUSERI ) THEN
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Ri2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Ri'2>
+ ELSE
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Ri2',(/0,0,0/))
+ END IF
+ IF (NSV>0 ) THEN
+ CALL LES_ALLOCATE('X_LES_SUBGRID_USv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <u'Sv'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_VSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <v'Sv'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'Sv'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Sv2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <Sv'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_SvThv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <Sv'Thv'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_W2Sv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'2Sv'>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WSv2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'Sv'2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Sv2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <epsilon_Sv2>
+ CALL LES_ALLOCATE('X_LES_SUBGRID_SvPz',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <Sv'dp'/dz>
+ ELSE
+ CALL LES_ALLOCATE('X_LES_SUBGRID_USv',(/0,0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_VSv',(/0,0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WSv',(/0,0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_Sv2',(/0,0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_SvThv',(/0,0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_W2Sv',(/0,0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_WSv2',(/0,0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Sv2',(/0,0,0,0/))
+ CALL LES_ALLOCATE('X_LES_SUBGRID_SvPz',(/0,0,0,0/))
+ END IF
+!
+ X_LES_SUBGRID_U2 = XLES_SUBGRID_U2
+ X_LES_SUBGRID_V2 = XLES_SUBGRID_V2
+ X_LES_SUBGRID_W2 = XLES_SUBGRID_W2
+ X_LES_SUBGRID_Thl2= XLES_SUBGRID_Thl2
+ X_LES_SUBGRID_UV = XLES_SUBGRID_UV
+ X_LES_SUBGRID_WU = XLES_SUBGRID_WU
+ X_LES_SUBGRID_WV = XLES_SUBGRID_WV
+ X_LES_SUBGRID_UThl= XLES_SUBGRID_UThl
+ X_LES_SUBGRID_VThl= XLES_SUBGRID_VThl
+ X_LES_SUBGRID_WThl= XLES_SUBGRID_WThl
+ X_LES_SUBGRID_WThv = XLES_SUBGRID_WThv
+ X_LES_SUBGRID_ThlThv = XLES_SUBGRID_ThlThv
+ X_LES_SUBGRID_W2Thl = XLES_SUBGRID_W2Thl
+ X_LES_SUBGRID_WThl2 = XLES_SUBGRID_WThl2
+ X_LES_SUBGRID_DISS_Tke = XLES_SUBGRID_DISS_Tke
+ X_LES_SUBGRID_DISS_Thl2= XLES_SUBGRID_DISS_Thl2
+ X_LES_SUBGRID_WP = XLES_SUBGRID_WP
+ X_LES_SUBGRID_PHI3 = XLES_SUBGRID_PHI3
+ X_LES_SUBGRID_LMix = XLES_SUBGRID_LMix
+ X_LES_SUBGRID_LDiss = XLES_SUBGRID_LDiss
+ X_LES_SUBGRID_Km = XLES_SUBGRID_Km
+ X_LES_SUBGRID_Kh = XLES_SUBGRID_Kh
+ X_LES_SUBGRID_ThlPz = XLES_SUBGRID_ThlPz
+ X_LES_SUBGRID_UTke= XLES_SUBGRID_UTke
+ X_LES_SUBGRID_VTke= XLES_SUBGRID_VTke
+ X_LES_SUBGRID_WTke= XLES_SUBGRID_WTke
+ X_LES_SUBGRID_ddz_WTke =XLES_SUBGRID_ddz_WTke
+
+ X_LES_SUBGRID_THLUP_MF = XLES_SUBGRID_THLUP_MF
+ X_LES_SUBGRID_RTUP_MF = XLES_SUBGRID_RTUP_MF
+ X_LES_SUBGRID_RVUP_MF = XLES_SUBGRID_RVUP_MF
+ X_LES_SUBGRID_RCUP_MF = XLES_SUBGRID_RCUP_MF
+ X_LES_SUBGRID_RIUP_MF = XLES_SUBGRID_RIUP_MF
+ X_LES_SUBGRID_WUP_MF = XLES_SUBGRID_WUP_MF
+ X_LES_SUBGRID_MASSFLUX = XLES_SUBGRID_MASSFLUX
+ X_LES_SUBGRID_DETR = XLES_SUBGRID_DETR
+ X_LES_SUBGRID_ENTR = XLES_SUBGRID_ENTR
+ X_LES_SUBGRID_FRACUP = XLES_SUBGRID_FRACUP
+ X_LES_SUBGRID_THVUP_MF = XLES_SUBGRID_THVUP_MF
+ X_LES_SUBGRID_WTHLMF = XLES_SUBGRID_WTHLMF
+ X_LES_SUBGRID_WRTMF = XLES_SUBGRID_WRTMF
+ X_LES_SUBGRID_WTHVMF = XLES_SUBGRID_WTHVMF
+ X_LES_SUBGRID_WUMF = XLES_SUBGRID_WUMF
+ X_LES_SUBGRID_WVMF = XLES_SUBGRID_WVMF
+
+ IF (LUSERV ) THEN
+ X_LES_SUBGRID_Rt2 = XLES_SUBGRID_Rt2
+ X_LES_SUBGRID_ThlRt= XLES_SUBGRID_ThlRt
+ X_LES_SUBGRID_URt = XLES_SUBGRID_URt
+ X_LES_SUBGRID_VRt = XLES_SUBGRID_VRt
+ X_LES_SUBGRID_WRt = XLES_SUBGRID_WRt
+ X_LES_SUBGRID_RtThv = XLES_SUBGRID_RtThv
+ X_LES_SUBGRID_W2Rt = XLES_SUBGRID_W2Rt
+ X_LES_SUBGRID_WThlRt = XLES_SUBGRID_WThlRt
+ X_LES_SUBGRID_WRt2 = XLES_SUBGRID_WRt2
+ X_LES_SUBGRID_DISS_Rt2= XLES_SUBGRID_DISS_Rt2
+ X_LES_SUBGRID_DISS_ThlRt= XLES_SUBGRID_DISS_ThlRt
+ X_LES_SUBGRID_RtPz = XLES_SUBGRID_RtPz
+ X_LES_SUBGRID_PSI3 = XLES_SUBGRID_PSI3
+ END IF
+ IF (LUSERC ) THEN
+ X_LES_SUBGRID_Rc2 = XLES_SUBGRID_Rc2
+ X_LES_SUBGRID_URc = XLES_SUBGRID_URc
+ X_LES_SUBGRID_VRc = XLES_SUBGRID_VRc
+ X_LES_SUBGRID_WRc = XLES_SUBGRID_WRc
+ END IF
+ IF (LUSERI ) THEN
+ X_LES_SUBGRID_Ri2 = XLES_SUBGRID_Ri2
+ END IF
+ IF (NSV>0 ) THEN
+ X_LES_SUBGRID_USv = XLES_SUBGRID_USv
+ X_LES_SUBGRID_VSv = XLES_SUBGRID_VSv
+ X_LES_SUBGRID_WSv = XLES_SUBGRID_WSv
+ X_LES_SUBGRID_Sv2 = XLES_SUBGRID_Sv2
+ X_LES_SUBGRID_SvThv = XLES_SUBGRID_SvThv
+ X_LES_SUBGRID_W2Sv = XLES_SUBGRID_W2Sv
+ X_LES_SUBGRID_WSv2 = XLES_SUBGRID_WSv2
+ X_LES_SUBGRID_DISS_Sv2 = XLES_SUBGRID_DISS_Sv2
+ X_LES_SUBGRID_SvPz = XLES_SUBGRID_SvPz
+ END IF
+!
+!
+ CALL LES_ALLOCATE('X_LES_UW0',(/NLES_TIMES/))
+ CALL LES_ALLOCATE('X_LES_VW0',(/NLES_TIMES/))
+ CALL LES_ALLOCATE('X_LES_USTAR',(/NLES_TIMES/))
+ CALL LES_ALLOCATE('X_LES_Q0',(/NLES_TIMES/))
+ CALL LES_ALLOCATE('X_LES_E0',(/NLES_TIMES/))
+ CALL LES_ALLOCATE('X_LES_SV0',(/NLES_TIMES,NSV/))
+!
+ X_LES_UW0 = XLES_UW0
+ X_LES_VW0 = XLES_VW0
+ X_LES_USTAR = XLES_USTAR
+ X_LES_Q0 = XLES_Q0
+ X_LES_E0 = XLES_E0
+ IF (NSV>0) X_LES_SV0 = XLES_SV0
+
+ELSE
+!
+ XLES_RES_W_SBG_WThl = X_LES_RES_W_SBG_WThl
+ XLES_RES_W_SBG_Thl2 = X_LES_RES_W_SBG_Thl2
+ XLES_RES_ddxa_U_SBG_UaU = X_LES_RES_ddxa_U_SBG_UaU
+ XLES_RES_ddxa_V_SBG_UaV = X_LES_RES_ddxa_V_SBG_UaV
+ XLES_RES_ddxa_W_SBG_UaW = X_LES_RES_ddxa_W_SBG_UaW
+ XLES_RES_ddxa_W_SBG_UaThl = X_LES_RES_ddxa_W_SBG_UaThl
+ XLES_RES_ddxa_Thl_SBG_UaW = X_LES_RES_ddxa_Thl_SBG_UaW
+ XLES_RES_ddz_Thl_SBG_W2 = X_LES_RES_ddz_Thl_SBG_W2
+ XLES_RES_ddxa_Thl_SBG_UaThl = X_LES_RES_ddxa_Thl_SBG_UaThl
+ IF (LUSERV) THEN
+ XLES_RES_W_SBG_WRt = X_LES_RES_W_SBG_WRt
+ XLES_RES_W_SBG_Rt2 = X_LES_RES_W_SBG_Rt2
+ XLES_RES_W_SBG_ThlRt = X_LES_RES_W_SBG_ThlRt
+ XLES_RES_ddxa_W_SBG_UaRt = X_LES_RES_ddxa_W_SBG_UaRt
+ XLES_RES_ddxa_Rt_SBG_UaW = X_LES_RES_ddxa_Rt_SBG_UaW
+ XLES_RES_ddz_Rt_SBG_W2 = X_LES_RES_ddz_Rt_SBG_W2
+ XLES_RES_ddxa_Thl_SBG_UaRt= X_LES_RES_ddxa_Thl_SBG_UaRt
+ XLES_RES_ddxa_Rt_SBG_UaThl= X_LES_RES_ddxa_Rt_SBG_UaThl
+ XLES_RES_ddxa_Rt_SBG_UaRt = X_LES_RES_ddxa_Rt_SBG_UaRt
+ END IF
+ IF (NSV>0) THEN
+ XLES_RES_ddxa_W_SBG_UaSv = X_LES_RES_ddxa_W_SBG_UaSv
+ XLES_RES_ddxa_Sv_SBG_UaW = X_LES_RES_ddxa_Sv_SBG_UaW
+ XLES_RES_ddz_Sv_SBG_W2 = X_LES_RES_ddz_Sv_SBG_W2
+ XLES_RES_ddxa_Sv_SBG_UaSv = X_LES_RES_ddxa_Sv_SBG_UaSv
+ XLES_RES_W_SBG_WSv = X_LES_RES_W_SBG_WSv
+ XLES_RES_W_SBG_Sv2 = X_LES_RES_W_SBG_Sv2
+ END IF
+ XLES_SUBGRID_U2 = X_LES_SUBGRID_U2
+ XLES_SUBGRID_V2 = X_LES_SUBGRID_V2
+ XLES_SUBGRID_W2 = X_LES_SUBGRID_W2
+ XLES_SUBGRID_Thl2= X_LES_SUBGRID_Thl2
+ XLES_SUBGRID_UV = X_LES_SUBGRID_UV
+ XLES_SUBGRID_WU = X_LES_SUBGRID_WU
+ XLES_SUBGRID_WV = X_LES_SUBGRID_WV
+ XLES_SUBGRID_UThl= X_LES_SUBGRID_UThl
+ XLES_SUBGRID_VThl= X_LES_SUBGRID_VThl
+ XLES_SUBGRID_WThl= X_LES_SUBGRID_WThl
+ XLES_SUBGRID_WThv = X_LES_SUBGRID_WThv
+ XLES_SUBGRID_ThlThv = X_LES_SUBGRID_ThlThv
+ XLES_SUBGRID_W2Thl = X_LES_SUBGRID_W2Thl
+ XLES_SUBGRID_WThl2 = X_LES_SUBGRID_WThl2
+ XLES_SUBGRID_DISS_Tke = X_LES_SUBGRID_DISS_Tke
+ XLES_SUBGRID_DISS_Thl2= X_LES_SUBGRID_DISS_Thl2
+ XLES_SUBGRID_WP = X_LES_SUBGRID_WP
+ XLES_SUBGRID_PHI3 = X_LES_SUBGRID_PHI3
+ XLES_SUBGRID_LMix = X_LES_SUBGRID_LMix
+ XLES_SUBGRID_LDiss = X_LES_SUBGRID_LDiss
+ XLES_SUBGRID_Km = X_LES_SUBGRID_Km
+ XLES_SUBGRID_Kh = X_LES_SUBGRID_Kh
+ XLES_SUBGRID_ThlPz = X_LES_SUBGRID_ThlPz
+ XLES_SUBGRID_UTke= X_LES_SUBGRID_UTke
+ XLES_SUBGRID_VTke= X_LES_SUBGRID_VTke
+ XLES_SUBGRID_WTke= X_LES_SUBGRID_WTke
+ XLES_SUBGRID_ddz_WTke =X_LES_SUBGRID_ddz_WTke
+
+ XLES_SUBGRID_THLUP_MF = X_LES_SUBGRID_THLUP_MF
+ XLES_SUBGRID_RTUP_MF = X_LES_SUBGRID_RTUP_MF
+ XLES_SUBGRID_RVUP_MF = X_LES_SUBGRID_RVUP_MF
+ XLES_SUBGRID_RCUP_MF = X_LES_SUBGRID_RCUP_MF
+ XLES_SUBGRID_RIUP_MF = X_LES_SUBGRID_RIUP_MF
+ XLES_SUBGRID_WUP_MF = X_LES_SUBGRID_WUP_MF
+ XLES_SUBGRID_MASSFLUX = X_LES_SUBGRID_MASSFLUX
+ XLES_SUBGRID_DETR = X_LES_SUBGRID_DETR
+ XLES_SUBGRID_ENTR = X_LES_SUBGRID_ENTR
+ XLES_SUBGRID_FRACUP = X_LES_SUBGRID_FRACUP
+ XLES_SUBGRID_THVUP_MF = X_LES_SUBGRID_THVUP_MF
+ XLES_SUBGRID_WTHLMF = X_LES_SUBGRID_WTHLMF
+ XLES_SUBGRID_WRTMF = X_LES_SUBGRID_WRTMF
+ XLES_SUBGRID_WTHVMF = X_LES_SUBGRID_WTHVMF
+ XLES_SUBGRID_WUMF = X_LES_SUBGRID_WUMF
+ XLES_SUBGRID_WVMF = X_LES_SUBGRID_WVMF
+
+ IF (LUSERV ) THEN
+ XLES_SUBGRID_Rt2 = X_LES_SUBGRID_Rt2
+ XLES_SUBGRID_ThlRt= X_LES_SUBGRID_ThlRt
+ XLES_SUBGRID_URt = X_LES_SUBGRID_URt
+ XLES_SUBGRID_VRt = X_LES_SUBGRID_VRt
+ XLES_SUBGRID_WRt = X_LES_SUBGRID_WRt
+ XLES_SUBGRID_RtThv = X_LES_SUBGRID_RtThv
+ XLES_SUBGRID_W2Rt = X_LES_SUBGRID_W2Rt
+ XLES_SUBGRID_WThlRt = X_LES_SUBGRID_WThlRt
+ XLES_SUBGRID_WRt2 = X_LES_SUBGRID_WRt2
+ XLES_SUBGRID_DISS_Rt2= X_LES_SUBGRID_DISS_Rt2
+ XLES_SUBGRID_DISS_ThlRt= X_LES_SUBGRID_DISS_ThlRt
+ XLES_SUBGRID_RtPz = X_LES_SUBGRID_RtPz
+ XLES_SUBGRID_PSI3 = X_LES_SUBGRID_PSI3
+ END IF
+ IF (LUSERC ) THEN
+ XLES_SUBGRID_Rc2 = X_LES_SUBGRID_Rc2
+ XLES_SUBGRID_URc = X_LES_SUBGRID_URc
+ XLES_SUBGRID_VRc = X_LES_SUBGRID_VRc
+ XLES_SUBGRID_WRc = X_LES_SUBGRID_WRc
+ END IF
+ IF (LUSERI ) THEN
+ XLES_SUBGRID_Ri2 = X_LES_SUBGRID_Ri2
+ END IF
+ IF (NSV>0 ) THEN
+ XLES_SUBGRID_USv = X_LES_SUBGRID_USv
+ XLES_SUBGRID_VSv = X_LES_SUBGRID_VSv
+ XLES_SUBGRID_WSv = X_LES_SUBGRID_WSv
+ XLES_SUBGRID_Sv2 = X_LES_SUBGRID_Sv2
+ XLES_SUBGRID_SvThv = X_LES_SUBGRID_SvThv
+ XLES_SUBGRID_W2Sv = X_LES_SUBGRID_W2Sv
+ XLES_SUBGRID_WSv2 = X_LES_SUBGRID_WSv2
+ XLES_SUBGRID_DISS_Sv2 = X_LES_SUBGRID_DISS_Sv2
+ XLES_SUBGRID_SvPz = X_LES_SUBGRID_SvPz
+ END IF
+ XLES_UW0 = X_LES_UW0
+ XLES_VW0 = X_LES_VW0
+ XLES_USTAR = X_LES_USTAR
+ XLES_Q0 = X_LES_Q0
+ XLES_E0 = X_LES_E0
+ IF (NSV>0) XLES_SV0 = X_LES_SV0
+!
+ CALL LES_DEALLOCATE('X_LES_RES_W_SBG_WThl')
+ CALL LES_DEALLOCATE('X_LES_RES_W_SBG_Thl2')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_U_SBG_UaU')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_V_SBG_UaV')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_W_SBG_UaW')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_W_SBG_UaThl')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaW')
+ CALL LES_DEALLOCATE('X_LES_RES_ddz_Thl_SBG_W2')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaThl')
+ CALL LES_DEALLOCATE('X_LES_RES_W_SBG_WRt')
+ CALL LES_DEALLOCATE('X_LES_RES_W_SBG_Rt2')
+ CALL LES_DEALLOCATE('X_LES_RES_W_SBG_ThlRt')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_W_SBG_UaRt')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaW')
+ CALL LES_DEALLOCATE('X_LES_RES_ddz_Rt_SBG_W2')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaRt')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaThl')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaRt')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_W_SBG_UaSv')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_Sv_SBG_UaW')
+ CALL LES_DEALLOCATE('X_LES_RES_ddz_Sv_SBG_W2')
+ CALL LES_DEALLOCATE('X_LES_RES_ddxa_Sv_SBG_UaSv')
+ CALL LES_DEALLOCATE('X_LES_RES_W_SBG_WSv')
+ CALL LES_DEALLOCATE('X_LES_RES_W_SBG_Sv2')
+!
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_U2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_V2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_W2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_Thl2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_UV')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WU')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WV')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_UThl')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_VThl')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WThl')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WThv')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_ThlThv')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_W2Thl')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WThl2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_Tke')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_Thl2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WP')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_PHI3')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_LMix')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_LDiss')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_Km')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_Kh')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_ThlPz')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_UTke')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_VTke')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WTke')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_ddz_WTke')
+
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_THLUP_MF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_RTUP_MF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_RVUP_MF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_RCUP_MF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_RIUP_MF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WUP_MF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_MASSFLUX')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_DETR')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_ENTR')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_FRACUP')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_THVUP_MF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WTHLMF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WRTMF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WTHVMF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WUMF')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WVMF')
+
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_Rt2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_ThlRt')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_URt')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_VRt')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WRt')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_RtThv')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_W2Rt')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WThlRt')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WRt2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_Rt2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_ThlRt')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_RtPz')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_PSI3')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_Rc2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_URc')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_VRc')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WRc')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_Ri2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_USv')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_VSv')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WSv')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_Sv2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_SvThv')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_W2Sv')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_WSv2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_Sv2')
+ CALL LES_DEALLOCATE('X_LES_SUBGRID_SvPz')
+ !
+ CALL LES_DEALLOCATE('X_LES_UW0')
+ CALL LES_DEALLOCATE('X_LES_VW0')
+ CALL LES_DEALLOCATE('X_LES_USTAR')
+ CALL LES_DEALLOCATE('X_LES_Q0')
+ CALL LES_DEALLOCATE('X_LES_E0')
+ CALL LES_DEALLOCATE('X_LES_SV0')
+!
+END IF
+!
+CALL SECOND_MNH(ZTIME2)
+!
+XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+!
+END SUBROUTINE SWITCH_SBG_LES_n
diff --git a/src/PHYEX/ext/write_lesn.f90 b/src/PHYEX/ext/write_lesn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9b6b326bc92ca2ebae7d62a7019a319903edebc4
--- /dev/null
+++ b/src/PHYEX/ext/write_lesn.f90
@@ -0,0 +1,1319 @@
+!MNH_LIC Copyright 2000-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!######################
+module mode_write_les_n
+!######################
+
+use modd_field, only: tfield_metadata_base
+
+implicit none
+
+private
+
+public :: Write_les_n
+
+
+character(len=:), allocatable :: cgroup
+character(len=:), allocatable :: cgroupcomment
+
+logical :: ldoavg ! Compute and store time average
+logical :: ldonorm ! Compute and store normalized field
+
+type(tfield_metadata_base) :: tfield
+type(tfield_metadata_base) :: tfieldx
+type(tfield_metadata_base) :: tfieldy
+
+interface Les_diachro_write
+ module procedure Les_diachro_write_1D, Les_diachro_write_2D, Les_diachro_write_3D, Les_diachro_write_4D
+end interface
+
+contains
+
+!###################################
+subroutine Write_les_n( tpdiafile )
+!###################################
+!
+!
+!!**** *WRITE_LES_n* writes the LES final diagnostics for model _n
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!! 01/02/01 (D. Gazen) add module MODD_NSV for NSV variable
+!! 06/11/02 (V. Masson) some minor bugs
+!! 01/04/03 (V. Masson) idem
+!! 10/10/09 (P. Aumond) Add user multimaskS
+!! 11/15 (C.Lac) Add production terms of TKE
+!! 10/2016 (C.Lac) Add droplet deposition
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! C. Lac 02/2019: add rain fraction as a LES diagnostic
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 12/10/2020: remove HLES_AVG dummy argument and group all 4 calls
+! P. Wautelet 13/10/2020: bugfix: correct some names for LES_DIACHRO_2PT diagnostics (Ri)
+! P. Wautelet 26/10/2020: bugfix: correct some comments and conditions + add missing RES_RTPZ
+! P. Wautelet 26/10/2020: restructure subroutines to use tfield_metadata_base type
+! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_conf_n, only: luserv, luserc, luserr, luseri, lusers, luserg, luserh
+use modd_io, only: tfiledata
+use modd_field, only: NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_SV, NMNHDIM_BUDGET_LES_MASK, &
+ NMNHDIM_BUDGET_LES_PDF, &
+ NMNHDIM_SPECTRA_2PTS_NI, NMNHDIM_SPECTRA_2PTS_NJ, NMNHDIM_SPECTRA_LEVEL, NMNHDIM_UNUSED, &
+ TYPEREAL
+use modd_grid_n, only: xdxhat, xdyhat
+use modd_nsv, only: nsv
+use modd_les
+use modd_les_n
+use modd_param_n, only: ccloud
+use modd_param_c2r2, only: ldepoc
+use modd_param_ice, only: ldeposc
+use modd_parameters, only: XUNDEF
+
+use mode_les_spec_n, only: Les_spec_n
+use mode_modeln_handler, only: Get_current_model_index
+use mode_write_les_budget_n, only: Write_les_budget_n
+use mode_write_les_rt_budget_n, only: Write_les_rt_budget_n
+use mode_write_les_sv_budget_n, only: Write_les_sv_budget_n
+
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
+!
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IMASK
+!
+INTEGER :: JSV ! scalar loop counter
+INTEGER :: JI ! loop counter
+!
+character(len=3) :: ynum
+CHARACTER(len=5) :: YGROUP
+character(len=7), dimension(nles_masks) :: ymasks
+!
+logical :: gdoavg ! Compute and store time average
+logical :: gdonorm ! Compute and store normalized field
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAVG_PTS_ll
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUND_PTS_ll
+REAL :: ZCART_PTS_ll
+INTEGER :: IMI ! Current model inde
+!
+!-------------------------------------------------------------------------------
+!
+IF (.NOT. LLES) RETURN
+!
+!
+!* 1. Initializations
+! ---------------
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!
+!* 1.1 Normalization variables
+! -----------------------
+!
+IF (CLES_NORM_TYPE/='NONE' ) THEN
+ CALL LES_ALLOCATE('XLES_NORM_M', (/NLES_TIMES/))
+ CALL LES_ALLOCATE('XLES_NORM_S', (/NLES_TIMES/))
+ CALL LES_ALLOCATE('XLES_NORM_K', (/NLES_TIMES/))
+ CALL LES_ALLOCATE('XLES_NORM_RHO',(/NLES_TIMES/))
+ CALL LES_ALLOCATE('XLES_NORM_RV', (/NLES_TIMES/))
+ CALL LES_ALLOCATE('XLES_NORM_SV', (/NLES_TIMES,NSV/))
+ CALL LES_ALLOCATE('XLES_NORM_P', (/NLES_TIMES/))
+ !
+ IF (CLES_NORM_TYPE=='CONV') THEN
+ WHERE (XLES_WSTAR(:)>0.)
+ XLES_NORM_M(:) = XLES_BL_HEIGHT(:)
+ XLES_NORM_S(:) = XLES_NORM_M(:) / XLES_WSTAR(:)
+ XLES_NORM_K(:) = XLES_Q0(:) / XLES_WSTAR(:)
+ XLES_NORM_RHO(:) = XLES_MEAN_RHO(1,:,1)
+ XLES_NORM_RV(:) = XLES_E0(:) / XLES_WSTAR(:)
+ XLES_NORM_P(:) = XLES_MEAN_RHO(1,:,1) * XLES_WSTAR(:)**2
+ ELSEWHERE
+ XLES_NORM_M(:) = 0.
+ XLES_NORM_S(:) = 0.
+ XLES_NORM_K(:) = 0.
+ XLES_NORM_RHO(:) = 0.
+ XLES_NORM_RV(:) = 0.
+ XLES_NORM_P(:) = 0.
+ END WHERE
+ DO JSV=1,NSV
+ WHERE (XLES_WSTAR(:)>0.)
+ XLES_NORM_SV(:,JSV)= XLES_SV0(:,JSV) / XLES_WSTAR(:)
+ ELSEWHERE
+ XLES_NORM_SV(:,JSV)= 0.
+ END WHERE
+ END DO
+ ELSE IF (CLES_NORM_TYPE=='EKMA') THEN
+ WHERE (XLES_USTAR(:)>0.)
+ XLES_NORM_M(:) = XLES_BL_HEIGHT(:)
+ XLES_NORM_S(:) = XLES_NORM_M(:) / XLES_USTAR(:)
+ XLES_NORM_K(:) = XLES_Q0(:) / XLES_USTAR(:)
+ XLES_NORM_RHO(:) = XLES_MEAN_RHO(1,:,1)
+ XLES_NORM_RV(:) = XLES_E0(:) / XLES_USTAR(:)
+ XLES_NORM_P(:) = XLES_MEAN_RHO(1,:,1) * XLES_USTAR(:)**2
+ ELSEWHERE
+ XLES_NORM_M(:) = 0.
+ XLES_NORM_S(:) = 0.
+ XLES_NORM_K(:) = 0.
+ XLES_NORM_RHO(:) = 0.
+ XLES_NORM_RV(:) = 0.
+ XLES_NORM_P(:) = 0.
+ END WHERE
+ DO JSV=1,NSV
+ WHERE (XLES_USTAR(:)>0.)
+ XLES_NORM_SV(:,JSV)= XLES_SV0(:,JSV) / XLES_USTAR(:)
+ ELSEWHERE
+ XLES_NORM_SV(:,JSV)= 0.
+ END WHERE
+ END DO
+ ELSE IF (CLES_NORM_TYPE=='MOBU') THEN
+ XLES_NORM_M(:) = XLES_MO_LENGTH(:)
+ WHERE (XLES_USTAR(:)>0.)
+ XLES_NORM_S(:) = XLES_NORM_M(:) / XLES_USTAR(:)
+ XLES_NORM_K(:) = XLES_Q0(:) / XLES_USTAR(:)
+ XLES_NORM_RHO(:) = XLES_MEAN_RHO(1,:,1)
+ XLES_NORM_RV(:) = XLES_E0(:) / XLES_USTAR(:)
+ XLES_NORM_P(:) = XLES_MEAN_RHO(1,:,1) * XLES_USTAR(:)**2
+ ELSEWHERE
+ XLES_NORM_S(:) = 0.
+ XLES_NORM_K(:) = 0.
+ XLES_NORM_RHO(:) = 0.
+ XLES_NORM_RV(:) = 0.
+ XLES_NORM_P(:) = 0.
+ END WHERE
+ DO JSV=1,NSV
+ WHERE (XLES_USTAR(:)>0.)
+ XLES_NORM_SV(:,JSV)= XLES_SV0(:,JSV) / XLES_USTAR(:)
+ ELSEWHERE
+ XLES_NORM_SV(:,JSV)= 0.
+ END WHERE
+ END DO
+ END IF
+END IF
+!
+!* 1.2 Initializations for WRITE_DIACHRO
+! ---------------------------------
+!
+NLES_CURRENT_TIMES=NLES_TIMES
+!
+CALL LES_ALLOCATE('XLES_CURRENT_Z',(/NLES_K/))
+
+XLES_CURRENT_Z(:) = XLES_Z(:)
+!
+XLES_CURRENT_ZS = XLES_ZS
+!
+NLES_CURRENT_IINF=NLESn_IINF(IMI)
+NLES_CURRENT_ISUP=NLESn_ISUP(IMI)
+NLES_CURRENT_JINF=NLESn_JINF(IMI)
+NLES_CURRENT_JSUP=NLESn_JSUP(IMI)
+!
+XLES_CURRENT_DOMEGAX=XDXHAT(1)
+XLES_CURRENT_DOMEGAY=XDYHAT(1)
+
+tfield%ngrid = 0 !Not on the Arakawa grid
+tfield%ntype = TYPEREAL
+!
+!* 2. (z,t) profiles (all masks)
+! --------------
+IMASK = 1
+ymasks(imask) = 'cart'
+IF (LLES_NEB_MASK) THEN
+ IMASK=IMASK+1
+ ymasks(imask) = 'neb'
+ IMASK=IMASK+1
+ ymasks(imask) = 'clear'
+END IF
+IF (LLES_CORE_MASK) THEN
+ IMASK=IMASK+1
+ ymasks(imask) = 'core'
+ IMASK=IMASK+1
+ ymasks(imask) = 'env'
+END IF
+IF (LLES_MY_MASK) THEN
+ DO JI=1,NLES_MASKS_USER
+ IMASK=IMASK+1
+ Write( ynum, '( i3.3 )' ) ji
+ ymasks(imask) = 'user' // ynum
+ END DO
+END IF
+IF (LLES_CS_MASK) THEN
+ IMASK=IMASK+1
+ ymasks(imask) = 'cs1'
+ IMASK=IMASK+1
+ ymasks(imask) = 'cs2'
+ IMASK=IMASK+1
+ ymasks(imask) = 'cs3'
+END IF
+!
+!* 2.0 averaging diagnostics
+! ---------------------
+!
+ALLOCATE(ZAVG_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(ZUND_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
+
+ZAVG_PTS_ll(:,:,:) = NLES_AVG_PTS_ll(:,:,:)
+ZUND_PTS_ll(:,:,:) = NLES_UND_PTS_ll(:,:,:)
+ZCART_PTS_ll = (NLESn_ISUP(IMI)-NLESn_IINF(IMI)+1) * (NLESn_JSUP(IMI)-NLESn_JINF(IMI)+1)
+
+tfield%ndims = 3
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ldonorm = .false.
+
+cgroup = 'Miscellaneous'
+cgroupcomment = 'Miscellaneous terms (geometry, various unclassified averaged terms...)'
+
+call Les_diachro_write( tpdiafile, zavg_pts_ll, 'AVG_PTS', 'number of points used for averaging', '1', ymasks )
+call Les_diachro_write( tpdiafile, zavg_pts_ll / zcart_pts_ll, 'AVG_PTSF', 'fraction of points used for averaging', '1', ymasks )
+call Les_diachro_write( tpdiafile, zund_pts_ll, 'UND_PTS', 'number of points below orography', '1', ymasks )
+call Les_diachro_write( tpdiafile, zund_pts_ll / zcart_pts_ll, 'UND_PTSF', 'fraction of points below orography', '1', ymasks )
+
+DEALLOCATE(ZAVG_PTS_ll)
+DEALLOCATE(ZUND_PTS_ll)
+!
+!* 2.1 mean quantities
+! ---------------
+!
+cgroup = 'Mean'
+cgroupcomment = 'Mean vertical profiles of the model variables'
+
+tfield%ndims = 3
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ldonorm = trim(cles_norm_type) /= 'NONE'
+
+call Les_diachro_write( tpdiafile, XLES_MEAN_U, 'MEAN_U', 'Mean U Profile', 'm s-1', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_V, 'MEAN_V', 'Mean V Profile', 'm s-1', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_W, 'MEAN_W', 'Mean W Profile', 'm s-1', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_P, 'MEAN_PRE', 'Mean pressure Profile', 'Pa', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_DP, 'MEAN_DP', 'Mean Dyn production TKE Profile', 'm2 s-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_TP, 'MEAN_TP', 'Mean Thermal production TKE Profile', 'm2 s-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_TR, 'MEAN_TR', 'Mean transport production TKE Profile', 'm2 s-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_DISS, 'MEAN_DISS', 'Mean Dissipation TKE Profile', 'm2 s-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_LM, 'MEAN_LM', 'Mean mixing length Profile', 'm', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_RHO, 'MEAN_RHO', 'Mean density Profile', 'kg m-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Th, 'MEAN_TH', 'Mean potential temperature Profile', 'K', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Mf, 'MEAN_MF', 'Mass-flux Profile', 'm s-1', ymasks )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Thl, 'MEAN_THL', 'Mean liquid potential temperature Profile', 'K', ymasks )
+if ( luserv ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Thv, 'MEAN_THV', 'Mean virtual potential temperature Profile', 'K', ymasks )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rt, 'MEAN_RT', 'Mean Rt Profile', 'kg kg-1', ymasks )
+if ( luserv ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rv, 'MEAN_RV', 'Mean Rv Profile', 'kg kg-1', ymasks )
+if ( luserv ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rehu, 'MEAN_REHU', 'Mean Rh Profile', 'percent', ymasks )
+if ( luserv ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Qs, 'MEAN_QS', 'Mean Qs Profile', 'kg kg-1', ymasks )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_KHt, 'MEAN_KHT', 'Eddy-diffusivity (temperature) Profile', 'm2 s-1', ymasks )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_KHr, 'MEAN_KHR', 'Eddy-diffusivity (vapor) Profile', 'm2 s-1', ymasks )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rc, 'MEAN_RC', 'Mean Rc Profile', 'kg kg-1', ymasks )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Cf, 'MEAN_CF', 'Mean Cf Profile', '1', ymasks )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_INDCf, 'MEAN_INDCF', 'Mean Cf>1-6 Profile (0 or 1)', '1', ymasks )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_INDCf2, 'MEAN_INDCF2', 'Mean Cf>1-5 Profile (0 or 1)', '1', ymasks )
+if ( luserr ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rr, 'MEAN_RR', 'Mean Rr Profile', 'kg kg-1', ymasks )
+if ( luserr ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_RF, 'MEAN_RF', 'Mean RF Profile', '1', ymasks )
+if ( luseri ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Ri, 'MEAN_RI', 'Mean Ri Profile', 'kg kg-1', ymasks )
+if ( luseri ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_If, 'MEAN_IF', 'Mean If Profile', '1', ymasks )
+if ( lusers ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rs, 'MEAN_RS', 'Mean Rs Profile', 'kg kg-1', ymasks )
+if ( luserg ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rg, 'MEAN_RG', 'Mean Rg Profile', 'kg kg-1', ymasks )
+if ( luserh ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rh, 'MEAN_RH', 'Mean Rh Profile', 'kg kg-1', ymasks )
+
+if ( nsv > 0 ) then
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_MEAN_Sv, 'MEAN_SV', 'Mean Sv Profiles', 'kg kg-1', ymasks )
+
+ tfield%ndims = 3
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !tfield%ndimlist(5:) = NMNHDIM_UNUSED
+end if
+
+call Les_diachro_write( tpdiafile, XLES_MEAN_WIND, 'MEANWIND', 'Profile of Mean Modulus of Wind', 'm s-1', ymasks )
+call Les_diachro_write( tpdiafile, XLES_RESOLVED_MASSFX, 'MEANMSFX', 'Total updraft mass flux', 'kg m-2 s-1', ymasks )
+
+if ( lles_pdf ) then
+ cgroup = 'PDF'
+ cgroupcomment = ''
+
+ tfield%ndims = 4
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_PDF
+ tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_PDF_TH, 'PDF_TH', 'Pdf potential temperature Profiles', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_PDF_W, 'PDF_W', 'Pdf vertical velocity Profiles', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_PDF_THV, 'PDF_THV', 'Pdf virtual pot. temp. Profiles', '1', ymasks )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_PDF_RV, 'PDF_RV', 'Pdf Rv Profiles', '1', ymasks )
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_PDF_RC, 'PDF_RC', 'Pdf Rc Profiles', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_PDF_RT, 'PDF_RT', 'Pdf Rt Profiles', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_PDF_THL, 'PDF_THL', 'Pdf Thl Profiles', '1', ymasks )
+ end if
+ if ( luserr ) &
+ call Les_diachro_write( tpdiafile, XLES_PDF_RR, 'PDF_RR', 'Pdf Rr Profiles', '1', ymasks )
+ if ( luseri ) &
+ call Les_diachro_write( tpdiafile, XLES_PDF_RI, 'PDF_RI', 'Pdf Ri Profiles', '1', ymasks )
+ if ( lusers ) &
+ call Les_diachro_write( tpdiafile, XLES_PDF_RS, 'PDF_RS', 'Pdf Rs Profiles', '1', ymasks )
+ if ( luserg ) &
+ call Les_diachro_write( tpdiafile, XLES_PDF_RG, 'PDF_RG', 'Pdf Rg Profiles', '1', ymasks )
+end if
+!
+!* 2.2 resolved quantities
+! -------------------
+!
+if ( lles_resolved ) then
+ !Prepare metadata (used in Les_diachro_write calls)
+ ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ ldonorm = trim(cles_norm_type) /= 'NONE'
+
+ cgroup = 'Resolved'
+ cgroupcomment = 'Mean vertical profiles of the resolved fluxes, variances and covariances'
+
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_U2, 'RES_U2', 'Resolved <u2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_V2, 'RES_V2', 'Resolved <v2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2, 'RES_W2', 'Resolved <w2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UV, 'RES_UV', 'Resolved <uv> Flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WU, 'RES_WU', 'Resolved <wu> Flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WV, 'RES_WV', 'Resolved <wv> Flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Ke, 'RES_KE', 'Resolved TKE Profile', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_P2, 'RES_P2', 'Resolved pressure variance', 'Pa2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UP, 'RES_UPZ', 'Resolved <up> horizontal Flux', 'Pa s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VP, 'RES_VPZ', 'Resolved <vp> horizontal Flux', 'Pa s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WP, 'RES_WPZ', 'Resolved <wp> vertical Flux', 'Pa s-1', ymasks )
+
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThThv, 'RES_THTV', &
+ 'Resolved potential temperature - virtual potential temperature covariance', 'K2', ymasks )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlThv, 'RES_TLTV', &
+ 'Resolved liquid potential temperature - virtual potential temperature covariance', 'K2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Th2, 'RES_TH2', 'Resolved potential temperature variance', 'K2', ymasks )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Thl2, 'RES_THL2', 'Resolved liquid potential temperature variance', 'K2',&
+ ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UTh, 'RES_UTH', 'Resolved <uth> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VTh, 'RES_VTH', 'Resolved <vth> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WTh, 'RES_WTH', 'Resolved <wth> vertical Flux', 'm K s-1', ymasks )
+
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UThl, 'RES_UTHL', 'Resolved <uthl> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VThl, 'RES_VTHL', 'Resolved <vthl> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThl, 'RES_WTHL', 'Resolved <wthl> vertical Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rt2, 'RES_RT2', 'Resolved total water variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRt, 'RES_WRT', 'Resolved <wrt> vertical Flux', 'm kg kg-1 s-1', ymasks )
+ end if
+
+ if ( luserv ) then
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UThv, 'RES_UTHV', 'Resolved <uthv> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VThv, 'RES_VTHV', 'Resolved <vthv> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThv, 'RES_WTHV', 'Resolved <wthv> vertical Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rv2, 'RES_RV2', 'Resolved water vapor variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRv, 'RES_THRV', 'Resolved <thrv> covariance', 'K kg kg-1', ymasks )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRv, 'RES_TLRV', 'Resolved <thlrv> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRv, 'RES_TVRV', 'Resolved <thvrv> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_URv, 'RES_URV', 'Resolved <urv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRv, 'RES_VRV', 'Resolved <vrv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRv, 'RES_WRV', 'Resolved <wrv> vertical flux', 'm kg kg-1 s-1', ymasks )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rc2, 'RES_RC2', 'Resolved cloud water variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRc, 'RES_THRC', 'Resolved <thrc> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRc, 'RES_TLRC', 'Resolved <thlrc> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRc, 'RES_TVRC', 'Resolved <thvrc> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_URc, 'RES_URC', 'Resolved <urc> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRc, 'RES_VRC', 'Resolved <vrc> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRc, 'RES_WRC', 'Resolved <wrc> vertical flux', 'm kg kg-1 s-1', ymasks )
+ end if
+
+ if ( luseri ) then
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Ri2, 'RES_RI2', 'Resolved cloud ice variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRi, 'RES_THRI', 'Resolved <thri> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRi, 'RES_TLRI', 'Resolved <thlri> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRi, 'RES_TVRI', 'Resolved <thvri> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_URi, 'RES_URI', 'Resolved <uri> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRi, 'RES_VRI', 'Resolved <vri> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRi, 'RES_WRI', 'Resolved <wri> vertical flux', 'm kg kg-1 s-1', ymasks )
+ end if
+
+ if ( luserr ) then
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRr, 'RES_WRR', 'Resolved <wrr> vertical flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_INPRR3D, 'INPRR3D', 'Precipitation flux', 'm s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_MAX_INPRR3D, 'MAXINPR3D', 'Max Precip flux', 'm s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_EVAP3D, 'EVAP3D', 'Evaporation profile', 'kg kg-1 s-1', ymasks )
+ end if
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Sv2, 'RES_SV2', 'Resolved scalar variables variances', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThSv, 'RES_THSV', 'Resolved <ThSv> variance', 'K kg kg-1', ymasks )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlSv, 'RES_TLSV', 'Resolved <ThlSv> variance', 'K kg kg-1', ymasks )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvSv, 'RES_TVSV', 'Resolved <ThvSv> variance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_USv, 'RES_USV', 'Resolved <uSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VSv, 'RES_VSV', 'Resolved <vSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WSv, 'RES_WSV', 'Resolved <wSv> vertical flux', 'm kg kg-1 s-1', ymasks )
+
+ tfield%ndims = 3
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !tfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_U3, 'RES_U3', 'Resolved <u3>', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_V3, 'RES_V3', 'Resolved <v3>', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W3, 'RES_W3', 'Resolved <w3>', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_U4, 'RES_U4', 'Resolved <u4>', 'm4 s-4', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_V4, 'RES_V4', 'Resolved <v4>', 'm4 s-4', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W4, 'RES_W4', 'Resolved <w4>', 'm4 s-4', ymasks )
+
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThl2, 'RES_WTL2', 'Resolved <wThl2>', 'm K2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Thl, 'RES_W2TL', 'Resolved <w2Thl>', 'm2 K s-2', ymasks )
+
+ if ( luserv ) then
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRv2, 'RES_WRV2', 'Resolved <wRv2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rv, 'RES_W2RV', 'Resolved <w2Rv>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRt2, 'RES_WRT2', 'Resolved <wRt2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rt, 'RES_W2RT', 'Resolved <w2Rt>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRv, 'RE_WTLRV', 'Resolved <wThlRv>', 'm K kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRt, 'RE_WTLRT', 'Resolved <wThlRt>', 'm K kg kg-1 s-1', ymasks )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRc2, 'RES_WRC2', 'Resolved <wRc2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rc, 'RES_W2RC', 'Resolved <w2Rc>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRc, 'RE_WTLRC', 'Resolved <wThlRc>', 'm K kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvRc, 'RE_WRVRC', 'Resolved <wRvRc>', 'm kg2 kg-2 s-1', ymasks )
+ end if
+
+ if ( luseri ) then
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRi2, 'RES_WRI2', 'Resolved <wRi2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Ri, 'RES_W2RI', 'Resolved <w2Ri>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRi, 'RE_WTLRI', 'Resolved <wThlRi>', 'm K kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvRi, 'RE_WRVRI', 'Resolved <wRvRi>', 'm kg2 kg-2 s-1', ymasks )
+ end if
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WSv2, 'RES_WSV2', 'Resolved <wSv2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Sv, 'RES_W2SV', 'Resolved <w2Sv>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlSv, 'RE_WTLSV', 'Resolved <wThlSv>', 'm K kg kg-1 s-1', ymasks )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvSv, 'RE_WRVSV', 'Resolved <wRvSv>', 'm kg2 kg-2 s-1', ymasks )
+
+ tfield%ndims = 3
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !tfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlPz, 'RES_TLPZ', 'Resolved <Thldp/dz>', 'K Pa m-1', ymasks )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_RtPz, 'RES_RTPZ', 'Resolved <Rtdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_RvPz, 'RES_RVPZ', 'Resolved <Rvdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_RcPz, 'RES_RCPZ', 'Resolved <Rcdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
+ if ( luseri ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_RiPz, 'RES_RIPZ', 'Resolved <Ridp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_SvPz, 'RES_SVPZ', 'Resolved <Svdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
+
+ tfield%ndims = 3
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !tfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UKe, 'RES_UKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VKe, 'RES_VKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WKe, 'RES_WKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
+end if
+!
+!
+!* 2.3 subgrid quantities
+! ------------------
+!
+if ( lles_subgrid ) then
+ !Prepare metadata (used in Les_diachro_write calls)
+ ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ ldonorm = trim(cles_norm_type) /= 'NONE'
+
+ cgroup = 'Subgrid'
+ cgroupcomment = 'Mean vertical profiles of the subgrid fluxes, variances and covariances'
+
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Tke, 'SBG_TKE', 'Subgrid TKE', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_U2, 'SBG_U2', 'Subgrid <u2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_V2, 'SBG_V2', 'Subgrid <v2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_W2, 'SBG_W2', 'Subgrid <w2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_UV, 'SBG_UV', 'Subgrid <uv> flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WU, 'SBG_WU', 'Subgrid <wu> flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WV, 'SBG_WV', 'Subgrid <wv> flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Thl2, 'SBG_THL2', 'Subgrid liquid potential temperature variance', &
+ 'K2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_UThl, 'SBG_UTHL', 'Subgrid horizontal flux of liquid potential temperature', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VThl, 'SBG_VTHL', 'Subgrid horizontal flux of liquid potential temperature', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThl, 'SBG_WTHL', 'Subgrid vertical flux of liquid potential temperature', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WP, 'SBG_WP', 'Subgrid <wp> vertical Flux', 'm Pa s-1', ymasks )
+
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_THLUP_MF, 'THLUP_MF', 'Subgrid <thl> of updraft', 'K', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_RTUP_MF, 'RTUP_MF', 'Subgrid <rt> of updraft', 'kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_RVUP_MF, 'RVUP_MF', 'Subgrid <rv> of updraft', 'kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_RCUP_MF, 'RCUP_MF', 'Subgrid <rc> of updraft', 'kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_RIUP_MF, 'RIUP_MF', 'Subgrid <ri> of updraft', 'kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WUP_MF, 'WUP_MF', 'Subgrid <w> of updraft', 'm s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_MASSFLUX, 'MAFLX_MF', 'Subgrid <MF> of updraft', 'kg m-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_DETR, 'DETR_MF', 'Subgrid <detr> of updraft', 'kg m-3 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_ENTR, 'ENTR_MF', 'Subgrid <entr> of updraft', 'kg m-3 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_FRACUP, 'FRCUP_MF', 'Subgrid <FracUp> of updraft', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_THVUP_MF, 'THVUP_MF', 'Subgrid <thv> of updraft', 'K', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTHLMF, 'WTHL_MF', 'Subgrid <wthl> of mass flux convection scheme', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRTMF, 'WRT_MF', 'Subgrid <wrt> of mass flux convection scheme', &
+ 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTHVMF, 'WTHV_MF', 'Subgrid <wthv> of mass flux convection scheme', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WUMF, 'WU_MF', 'Subgrid <wu> of mass flux convection scheme', &
+ 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WVMF, 'WV_MF', 'Subgrid <wv> of mass flux convection scheme', &
+ 'm2 s-2', ymasks )
+
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_PHI3, 'SBG_PHI3', 'Subgrid Phi3 function', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_LMix, 'SBG_LMIX', 'Subgrid Mixing Length', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_LDiss, 'SBG_LDIS', 'Subgrid Dissipation Length', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Km, 'SBG_KM', 'Eddy diffusivity for momentum', 'm2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Kh, 'SBG_KH', 'Eddy diffusivity for heat', 'm2 s-1', ymasks )
+
+ if ( luserv ) then
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThv, 'SBG_WTHV', 'Subgrid vertical flux of liquid potential temperature', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Rt2, 'SBG_RT2', 'Subgrid total water variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_ThlRt, 'SBG_TLRT', 'Subgrid <thlrt> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_URt, 'SBG_URT', 'Subgrid total water horizontal flux', &
+ 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VRt, 'SBG_VRT', 'Subgrid total water horizontal flux', &
+ 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRt, 'SBG_WRT', 'Subgrid total water vertical flux', &
+ 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_PSI3, 'SBG_PSI3', 'Subgrid Psi3 function', '1', ymasks )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Rc2, 'SBG_RC2', 'Subgrid cloud water variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_URc, 'SBG_URC', 'Subgrid cloud water horizontal flux', 'm kg kg-1 s-1', &
+ ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VRc, 'SBG_VRC', 'Subgrid cloud water horizontal flux', 'm kg kg-1 s-1', &
+ ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRc, 'SBG_WRC', 'Subgrid cloud water vertical flux', 'm kg kg-1 s-1', &
+ ymasks )
+ end if
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_USv, 'SBG_USV', 'Subgrid <uSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VSv, 'SBG_VSV', 'Subgrid <vSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WSv, 'SBG_WSV', 'Subgrid <wSv> vertical flux', 'm kg kg-1 s-1', ymasks )
+
+ tfield%ndims = 3
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+
+ end if
+
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_UTke, 'SBG_UTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VTke, 'SBG_VTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTke, 'SBG_WTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_W2Thl, 'SBG_W2TL', 'Subgrid flux of subgrid kinetic energy', 'm2 K s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThl2, 'SBG_WTL2', 'Subgrid flux of subgrid kinetic energy', 'm K2 s-1', ymasks )
+end if
+
+
+!Prepare metadata (used in Les_diachro_write calls)
+tfield%ndims = 2
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(3:) = NMNHDIM_UNUSED
+
+ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ldonorm = trim(cles_norm_type) /= 'NONE'
+!
+!* 2.4 Updraft quantities
+! ------------------
+!
+if ( lles_updraft ) then
+ cgroup = 'Updraft'
+ cgroupcomment = 'Updraft vertical profiles of some resolved and subgrid fluxes, variances and covariances'
+
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT, 'UP_FRAC', 'Updraft fraction', '1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_W, 'UP_W', 'Updraft W mean value', 'm s-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Th, 'UP_TH', 'Updraft potential temperature mean value', 'K' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thl, 'UP_THL', 'Updraft liquid potential temperature mean value', 'K' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thv, 'UP_THV', 'Updraft virtual potential temperature mean value', 'K' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ke, 'UP_KE', 'Updraft resolved TKE mean value', 'm2 s-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Tke, 'UP_TKE', 'Updraft subgrid TKE mean value', 'm2 s-2' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rv, 'UP_RV', 'Updraft water vapor mean value', 'kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rc, 'UP_RC', 'Updraft cloud water mean value', 'kg kg-1' )
+ if ( luserr ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rr, 'UP_RR', 'Updraft rain mean value', 'kg kg-1' )
+ if ( luseri ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ri, 'UP_RI', 'Updraft ice mean value', 'kg kg-1' )
+ if ( lusers ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rs, 'UP_RS', 'Updraft snow mean value', 'kg kg-1' )
+ if ( luserg ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rg, 'UP_RG', 'Updraft graupel mean value', 'kg kg-1' )
+ if ( luserh ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rh, 'UP_RH', 'Updraft hail mean value', 'kg kg-1' )
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Sv, 'UP_SV', 'Updraft scalar variables mean values', 'kg kg-1' )
+
+ tfield%ndims = 2
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_UNUSED
+ !tfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Th2, 'UP_TH2', 'Updraft resolved Theta variance', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thl2, 'UP_THL2', 'Updraft resolved Theta_l variance', 'K2' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThThv, 'UP_THTV', 'Updraft resolved Theta Theta_v covariance', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlThv, 'UP_TLTV', 'Updraft resolved Theta_l Theta_v covariance', 'K2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WTh, 'UP_WTH', 'Updraft resolved WTh flux', 'm K s-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WThl, 'UP_WTHL', 'Updraft resolved WThl flux', 'm K s-1' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WThv, 'UP_WTHV', 'Updraft resolved WThv flux', 'm K s-1' )
+
+ if ( luserv ) then
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rv2, 'UP_RV2', 'Updraft resolved water vapor variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRv, 'UP_THRV', 'Updraft resolved <thrv> covariance', 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRv, 'UP_THLRV', 'Updraft resolved <thlrv> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRv, 'UP_THVRV', 'Updraft resolved <thvrv> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRv, 'UP_WRV', 'Updraft resolved <wrv> vertical flux', 'm kg kg-1 s-1' )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rc2, 'UP_RC2', 'Updraft resolved cloud water variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRc, 'UP_THRC', 'Updraft resolved <thrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRc, 'UP_THLRC', 'Updraft resolved <thlrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRc, 'UP_THVRC', 'Updraft resolved <thvrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRc, 'UP_WRC', 'Updraft resolved <wrc> vertical flux', 'm kg kg-1 s-1' )
+ end if
+
+ if ( luseri ) then
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ri2, 'UP_RI2', 'Updraft resolved cloud ice variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRi, 'UP_THRI', 'Updraft resolved <thri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRi, 'UP_THLRI', 'Updraft resolved <thlri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRi, 'UP_THVRI', 'Updraft resolved <thvri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRi, 'UP_WRI', 'Updraft resolved <wri> vertical flux', 'm kg kg-1 s-1' )
+ end if
+
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Sv2, 'UP_SV2', 'Updraft resolved scalar variables variances', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThSv, 'UP_THSV', 'Updraft resolved <ThSv> variance', 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlSv, 'UP_THLSV', 'Updraft resolved <ThlSv> variance', 'K kg kg-1' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvSv, 'UP_THVSV', 'Updraft resolved <ThvSv> variance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WSv, 'UP_WSV', 'Updraft resolved <wSv> vertical flux', 'm kg kg-1 s-1' )
+
+ tfield%ndims = 2
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_UNUSED
+ !tfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+end if
+!
+!
+!* 2.5 Downdraft quantities
+! --------------------
+!
+if ( lles_downdraft ) then
+ cgroup = 'Downdraft'
+ cgroupcomment = 'Downdraft vertical profiles of some resolved and subgrid fluxes, variances and covariances'
+
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT, 'DW_FRAC', 'Downdraft fraction', '1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_W, 'DW_W', 'Downdraft W mean value', 'm s-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Th, 'DW_TH', 'Downdraft potential temperature mean value', 'K' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thl, 'DW_THL', 'Downdraft liquid potential temperature mean value', 'K' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thv, 'DW_THV', 'Downdraft virtual potential temperature mean value', 'K' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ke, 'DW_KE', 'Downdraft resolved TKE mean value', 'm2 s-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Tke, 'DW_TKE', 'Downdraft subgrid TKE mean value', 'm2 s-2' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rv, 'DW_RV', 'Downdraft water vapor mean value', 'kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rc, 'DW_RC', 'Downdraft cloud water mean value', 'kg kg-1' )
+ if ( luserr ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rr, 'DW_RR', 'Downdraft rain mean value', 'kg kg-1' )
+ if ( luseri ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ri, 'DW_RI', 'Downdraft ice mean value', 'kg kg-1' )
+ if ( lusers ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rs, 'DW_RS', 'Downdraft snow mean value', 'kg kg-1' )
+ if ( luserg ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rg, 'DW_RG', 'Downdraft graupel mean value', 'kg kg-1' )
+ if ( luserh ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rh, 'DW_RH', 'Downdraft hail mean value', 'kg kg-1' )
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Sv, 'DW_SV', 'Downdraft scalar variables mean values', 'kg kg-1' )
+
+ tfield%ndims = 2
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_UNUSED
+ !tfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Th2, 'DW_TH2', 'Downdraft resolved Theta variance', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thl2, 'DW_THL2', 'Downdraft resolved Theta_l variance', 'K2' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThThv, 'DW_THTV', 'Downdraft resolved Theta Theta_v covariance', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlThv, 'DW_TLTV', 'Downdraft resolved Theta_l Theta_v covariance', 'K2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WTh, 'DW_WTH', 'Downdraft resolved WTh flux', 'm K s-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WThl, 'DW_WTHL', 'Downdraft resolved WThl flux', 'm K s-1' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WThv, 'DW_WTHV', 'Downdraft resolved WThv flux', 'm K s-1' )
+
+ if ( luserv ) then
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rv2, 'DW_RV2', 'Downdraft resolved water vapor variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRv, 'DW_THRV', 'Downdraft resolved <thrv> covariance', 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRv, 'DW_THLRV', 'Downdraft resolved <thlrv> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRv, 'DW_THVRV', 'Downdraft resolved <thvrv> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRv, 'DW_WRV', 'Downdraft resolved <wrv> vertical flux', &
+ 'm kg kg-1 s-1' )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rc2, 'DW_RC2', 'Downdraft resolved cloud water variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRc, 'DW_THRC', 'Downdraft resolved <thrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRc, 'DW_THLRC', 'Downdraft resolved <thlrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRc, 'DW_THVRC', 'Downdraft resolved <thvrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRc, 'DW_WRC', 'Downdraft resolved <wrc> vertical flux', &
+ 'm kg kg-1 s-1' )
+ end if
+
+ if ( luseri ) then
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ri2, 'DW_RI2', 'Downdraft resolved cloud ice variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRi, 'DW_THRI', 'Downdraft resolved <thri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRi, 'DW_THLRI', 'Downdraft resolved <thlri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRi, 'DW_THVRI', 'Downdraft resolved <thvri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRi, 'DW_WRI', 'Downdraft resolved <wri> vertical flux', &
+ 'm kg kg-1 s-1' )
+ end if
+
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Sv2, 'DW_SV2', 'Downdraft resolved scalar variables variances', &
+ 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThSv, 'DW_THSV', 'Downdraft resolved <ThSv> variance', &
+ 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlSv, 'DW_THLSV', 'Downdraft resolved <ThlSv> variance', &
+ 'K kg kg-1' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvSv, 'DW_THVSV', 'Downdraft resolved <ThvSv> variance', &
+ 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WSv, 'DW_WSV', 'Downdraft resolved <wSv> vertical flux', &
+ 'm kg kg-1 s-1' )
+
+ tfield%ndims = 2
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_UNUSED
+ !tfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+end if
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. surface normalization parameters
+! --------------------------------
+!
+cgroup = 'Radiation'
+cgroupcomment = 'Radiative terms'
+
+!Prepare metadata (used in Les_diachro_write calls)
+tfield%ndims = 2
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(3:) = NMNHDIM_UNUSED
+
+ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ldonorm = .false.
+
+call Les_diachro_write( tpdiafile, XLES_SWU, 'SWU', 'SW upward radiative flux', 'W m-2' )
+call Les_diachro_write( tpdiafile, XLES_SWD, 'SWD', 'SW downward radiative flux', 'W m-2' )
+call Les_diachro_write( tpdiafile, XLES_LWU, 'LWU', 'LW upward radiative flux', 'W m-2' )
+call Les_diachro_write( tpdiafile, XLES_LWD, 'LWD', 'LW downward radiative flux', 'W m-2' )
+call Les_diachro_write( tpdiafile, XLES_DTHRADSW, 'DTHRADSW', 'SW radiative temperature tendency', 'K s-1' )
+call Les_diachro_write( tpdiafile, XLES_DTHRADLW, 'DTHRADLW', 'LW radiative temperature tendency', 'K s-1' )
+!writes mean_effective radius at all levels
+call Les_diachro_write( tpdiafile, XLES_RADEFF, 'RADEFF', 'Mean effective radius', 'micron' )
+
+
+cgroup = 'Surface'
+cgroupcomment = 'Averaged surface fields'
+
+! !Prepare metadate (used in Les_diachro_write calls)
+tfield%ndims = 1
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(2:) = NMNHDIM_UNUSED
+
+call Les_diachro_write( tpdiafile, XLES_Q0, 'Q0', 'Sensible heat flux at the surface', 'm K s-1' )
+if ( luserv ) &
+call Les_diachro_write( tpdiafile, XLES_E0, 'E0', 'Latent heat flux at the surface', 'kg kg-1 m s-1' )
+
+if ( nsv > 0 ) then
+ tfield%ndims = 2
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(3:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_SV0, 'SV0', 'Scalar variable fluxes at the surface', 'kg kg-1 m s-1' )
+
+ tfield%ndims = 1
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(2) = NMNHDIM_UNUSED
+ !tfield%ndimlist(3:) = NMNHDIM_UNUSED
+end if
+
+call Les_diachro_write( tpdiafile, XLES_USTAR, 'Ustar', 'Friction velocity', 'm s-1' )
+call Les_diachro_write( tpdiafile, XLES_WSTAR, 'Wstar', 'Convective velocity', 'm s-1' )
+call Les_diachro_write( tpdiafile, XLES_MO_LENGTH, 'L_MO', 'Monin-Obukhov length', 'm' )
+if ( luserr ) &
+call Les_diachro_write( tpdiafile, XLES_PRECFR, 'PREC_FRAC', 'Fraction of columns where rain at surface', '1' )
+if ( luserr ) &
+call Les_diachro_write( tpdiafile, XLES_INPRR, 'INST_PREC', 'Instantaneous precipitation rate', 'mm day-1' )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_INPRC, 'INST_SEDIM', 'Instantaneous cloud precipitation rate', 'mm day-1' )
+if ( luserc .and. ( ldeposc .or. ldepoc ) ) &
+call Les_diachro_write( tpdiafile, XLES_INDEP, 'INST_DEPOS', 'Instantaneous cloud deposition rate', 'mm day-1' )
+if ( luserr ) &
+call Les_diachro_write( tpdiafile, XLES_RAIN_INPRR, 'RAIN_PREC', 'Instantaneous precipitation rate over rainy grid cells', &
+ 'mm day-1' )
+if ( luserr ) &
+call Les_diachro_write( tpdiafile, XLES_ACPRR, 'ACCU_PREC', 'Accumulated precipitation rate', 'mm' )
+
+
+cgroup = 'Miscellaneous'
+cgroupcomment = 'Miscellaneous terms (geometry, various unclassified averaged terms...)'
+
+call Les_diachro_write( tpdiafile, XLES_BL_HEIGHT, 'BL_H', 'Boundary Layer Height', 'm' )
+call Les_diachro_write( tpdiafile, XLES_INT_TKE, 'INT_TKE', 'Vertical integrated TKE', 'm2 s-2' )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_ZCB, 'ZCB', 'Cloud base Height', 'm' )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_CFtot, 'ZCFTOT', 'Total cloud cover (rc>1e-6)', '1' )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_CF2tot, 'ZCF2TOT', 'Total cloud cover (rc>1e-5)', '1' )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_LWP, 'LWP', 'Liquid Water path', 'kg m-2' )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_LWPVAR, 'LWPVAR', 'Liquid Water path variance', 'kg m-4' )
+if ( luserr ) &
+call Les_diachro_write( tpdiafile, XLES_RWP, 'RWP', 'Rain Water path', 'kg m-2' )
+if ( luseri ) &
+call Les_diachro_write( tpdiafile, XLES_IWP, 'IWP', 'Ice Water path', 'kg m-2' )
+if ( lusers ) &
+call Les_diachro_write( tpdiafile, XLES_SWP, 'SWP', 'Snow Water path', 'kg m-2' )
+if ( luserg ) &
+call Les_diachro_write( tpdiafile, XLES_GWP, 'GWP', 'Graupel Water path', 'kg m-2' )
+if ( luserh ) &
+call Les_diachro_write( tpdiafile, XLES_HWP, 'HWP', 'Hail Water path', 'kg m-2' )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_ZMAXCF, 'ZMAXCF', 'Height of Cloud fraction maximum (rc>1e-6)', 'm' )
+if ( luserc ) &
+call Les_diachro_write( tpdiafile, XLES_ZMAXCF2, 'ZMAXCF2', 'Height of Cloud fraction maximum (rc>1e-5)', 'm' )
+
+!-------------------------------------------------------------------------------
+!
+!* 4. LES budgets
+! -----------
+!
+call Write_les_budget_n( tpdiafile )
+
+if ( luserv ) call Write_les_rt_budget_n( tpdiafile )
+
+if ( nsv > 0 ) call Write_les_sv_budget_n( tpdiafile )
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. (ni,z,t) and (nj,z,t) 2points correlations
+! ------------------------------------------
+!
+if ( nspectra_k > 0 ) then
+ tfieldx%cstdname = ''
+ tfieldx%ngrid = 0 !Not on the Arakawa grid
+ tfieldx%ntype = TYPEREAL
+ tfieldx%ndims = 3
+ tfieldx%ndimlist(1) = NMNHDIM_SPECTRA_2PTS_NI
+ tfieldx%ndimlist(2) = NMNHDIM_SPECTRA_LEVEL
+ tfieldx%ndimlist(3) = NMNHDIM_BUDGET_LES_TIME
+ tfieldx%ndimlist(4:) = NMNHDIM_UNUSED
+
+ tfieldy%cstdname = ''
+ tfieldy%ngrid = 0 !Not on the Arakawa grid
+ tfieldy%ntype = TYPEREAL
+ tfieldy%ndims = 3
+ tfieldy%ndimlist(1) = NMNHDIM_SPECTRA_2PTS_NJ
+ tfieldy%ndimlist(2) = NMNHDIM_SPECTRA_LEVEL
+ tfieldy%ndimlist(3) = NMNHDIM_BUDGET_LES_TIME
+ tfieldy%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_UU, XCORRj_UU, 'UU', 'U*U 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_VV, XCORRj_VV, 'VV', 'V*V 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WW, XCORRj_WW, 'WW', 'W*W 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_UV, XCORRj_UV, 'UV', 'U*V 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WU, XCORRj_WU, 'WU', 'W*U 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WV, XCORRj_WV, 'WV', 'W*V 2 points correlations', 'm2 s-2' )
+
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThTh, XCORRj_ThTh, 'THTH', 'Th*Th 2 points correlations', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlThl, XCORRj_ThlThl, 'TLTL', 'Thl*Thl 2 points correlations', 'K2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WTh, XCORRj_WTh, 'WTH', 'W*Th 2 points correlations', 'm K s-1' )
+ if ( luserc ) &
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WThl, XCORRj_WThl, 'WTHL', 'W*Thl 2 points correlations', 'm K s-1' )
+
+ if ( luserv ) then
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_RvRv, XCORRj_RvRv, 'RVRV', 'rv*rv 2 points correlations', 'kg2 kg-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRv, XCORRj_ThRv, 'THRV', 'TH*RV 2 points correlations', 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRv, XCORRj_ThlRv, 'TLRV', 'thl*rv 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WRv, XCORRj_WRv, 'WRV', 'W*rv 2 points correlations', 'm kg s-1 kg-1' )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_RcRc, XCORRj_RcRc, 'RCRC', 'rc*rc 2 points correlations', 'kg2 kg-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRc, XCORRj_ThRc, 'THRC', 'th*rc 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRc, XCORRj_ThlRc, 'TLRC', 'thl*rc 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WRc, XCORRj_WRc, 'WRC', 'W*rc 2 points correlations', 'm kg s-1 kg-1' )
+ end if
+
+ if ( luseri ) then
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_RiRi, XCORRj_RiRi, 'RIRI', 'ri*ri 2 points correlations', 'kg2 kg-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRi, XCORRj_ThRi, 'THRI', 'th*ri 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRi, XCORRj_ThlRi, 'TLRI', 'thl*ri 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WRi, XCORRj_WRi, 'WRI', 'W*ri 2 points correlations', 'm kg s-1 kg-1' )
+ end if
+
+!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
+ do jsv = 1, nsv
+ Write( ygroup, fmt = "( a2, i3.3 )" ) "SS", jsv
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_SvSv(:,:,:,JSV), XCORRj_SvSv(:,:,:,JSV), ygroup, &
+ 'Sv*Sv 2 points correlations','kg2 kg-2' )
+ end do
+
+!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
+ do jsv = 1, nsv
+ Write( ygroup, fmt = "( a2, i3.3 )" ) "WS", jsv
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WSv(:,:,:,JSV), XCORRj_WSv(:,:,:,JSV), ygroup, &
+ 'W*Sv 2 points correlations','m kg s-1 kg-1' )
+ end do
+end if
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. spectra and time-averaged profiles (if first call to WRITE_LES_n)
+! ----------------------------------
+!
+call Les_spec_n( tpdiafile )
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. deallocations
+! -------------
+!
+CALL LES_DEALLOCATE('XLES_CURRENT_Z')
+
+IF (CLES_NORM_TYPE/='NONE' ) THEN
+ CALL LES_DEALLOCATE('XLES_NORM_M')
+ CALL LES_DEALLOCATE('XLES_NORM_S')
+ CALL LES_DEALLOCATE('XLES_NORM_K')
+ CALL LES_DEALLOCATE('XLES_NORM_RHO')
+ CALL LES_DEALLOCATE('XLES_NORM_RV')
+ CALL LES_DEALLOCATE('XLES_NORM_SV')
+ CALL LES_DEALLOCATE('XLES_NORM_P')
+END IF
+
+end subroutine Write_les_n
+
+!------------------------------------------------------------------------------
+
+subroutine Les_diachro_write_1D( tpdiafile, pdata, hmnhname, hcomment, hunits )
+
+use modd_io, only: tfiledata
+
+use mode_les_diachro, only: Les_diachro
+
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:), intent(in) :: pdata
+character(len=*), intent(in) :: hmnhname
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
+
+tfield%cmnhname = hmnhname
+tfield%clongname = hmnhname
+tfield%ccomment = hcomment
+tfield%cunits = hunits
+
+call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata )
+
+end subroutine Les_diachro_write_1D
+
+!------------------------------------------------------------------------------
+
+subroutine Les_diachro_write_2D( tpdiafile, pdata, hmnhname, hcomment, hunits )
+
+use modd_io, only: tfiledata
+
+use mode_les_diachro, only: Les_diachro
+
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:,:), intent(in) :: pdata
+character(len=*), intent(in) :: hmnhname
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
+
+tfield%cmnhname = hmnhname
+tfield%clongname = hmnhname
+tfield%ccomment = hcomment
+tfield%cunits = hunits
+
+call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata )
+
+end subroutine Les_diachro_write_2D
+
+!------------------------------------------------------------------------------
+
+subroutine Les_diachro_write_3D( tpdiafile, pdata, hmnhname, hcomment, hunits, hmasks )
+
+use modd_io, only: tfiledata
+
+use mode_les_diachro, only: Les_diachro
+
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:,:,:), intent(in) :: pdata
+character(len=*), intent(in) :: hmnhname
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
+character(len=*), dimension(:), optional, intent(in) :: hmasks
+
+tfield%cmnhname = hmnhname
+tfield%clongname = hmnhname
+tfield%ccomment = hcomment
+tfield%cunits = hunits
+
+call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata, hmasks = hmasks )
+
+end subroutine Les_diachro_write_3D
+
+!------------------------------------------------------------------------------
+
+subroutine Les_diachro_write_4D( tpdiafile, pdata, hmnhname, hcomment, hunits, hmasks )
+
+use modd_io, only: tfiledata
+
+use mode_les_diachro, only: Les_diachro
+
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:,:,:,:), intent(in) :: pdata
+character(len=*), intent(in) :: hmnhname
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
+character(len=*), dimension(:), optional, intent(in) :: hmasks
+
+tfield%cmnhname = hmnhname
+tfield%clongname = hmnhname
+tfield%ccomment = hcomment
+tfield%cunits = hunits
+
+call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata, hmasks = hmasks )
+
+end subroutine Les_diachro_write_4D
+
+!------------------------------------------------------------------------------
+
+subroutine Les_diachro_2pt_write( tpdiafile, zcorri, zcorrj, hmnhname, hcomment, hunits )
+
+use modd_io, only: tfiledata
+
+use mode_les_diachro, only: Les_diachro_2pt
+
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:,:,:), intent(in) :: zcorri ! 2 pts correlation data
+real, dimension(:,:,:), intent(in) :: zcorrj ! 2 pts correlation data
+character(len=*), intent(in) :: hmnhname
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
+
+tfieldx%cmnhname = hmnhname
+tfieldx%clongname = hmnhname
+tfieldx%ccomment = hcomment
+tfieldx%cunits = hunits
+
+tfieldy%cmnhname = hmnhname
+tfieldy%clongname = hmnhname
+tfieldy%ccomment = hcomment
+tfieldy%cunits = hunits
+
+call Les_diachro_2pt( tpdiafile, tfieldx, tfieldy, zcorri, zcorrj )
+
+end subroutine Les_diachro_2pt_write
+
+!------------------------------------------------------------------------------
+
+end module mode_write_les_n
diff --git a/src/PHYEX/micro/compute_frac_ice.func.h b/src/PHYEX/micro/compute_frac_ice.func.h
new file mode 100644
index 0000000000000000000000000000000000000000..8c6d4e617d519e2277d3a7defe3b11c95513cafc
--- /dev/null
+++ b/src/PHYEX/micro/compute_frac_ice.func.h
@@ -0,0 +1,54 @@
+!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+ ELEMENTAL SUBROUTINE COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,PFRAC_ICE,PT,KERR)
+
+! ******* TO BE INCLUDED IN THE *CONTAINS* OF A SUBROUTINE, IN ORDER TO EASE AUTOMATIC INLINING ******
+! => Don't use drHook !!!
+!
+!!**** *COMPUTE_FRAC_ICE* - computes ice fraction
+!
+!! AUTHOR
+!! ------
+!! Julien PERGAUD * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/03/06
+!! S. Riette April 2011 optimisation
+!! S. Riette 08/2016 add option O
+!! R. El Khatib 12-Aug-2021 written as a include file
+!
+!! --------------------------------------------------------------------------
+USE MODD_NEB, ONLY : NEB_t
+USE MODD_CST, ONLY : XTT
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! scheme to use
+TYPE(NEB_t), INTENT(IN) :: NEB
+REAL, INTENT(IN) :: PT ! temperature
+REAL, INTENT(INOUT) :: PFRAC_ICE ! Ice fraction (1 for ice only, 0 for liquid only)
+INTEGER, OPTIONAL, INTENT(OUT) :: KERR ! Error code in return
+!
+!------------------------------------------------------------------------
+
+! 1. Compute FRAC_ICE
+!
+IF (PRESENT(KERR)) KERR=0
+SELECT CASE(HFRAC_ICE)
+ CASE ('T') !using Temperature
+ PFRAC_ICE = MAX( 0., MIN(1., (( NEB%XTMAXMIX - PT ) / ( NEB%XTMAXMIX - NEB%XTMINMIX )) ) ) ! freezing interval
+ CASE ('O') !using Temperature with old formulae
+ PFRAC_ICE = MAX( 0., MIN(1., (( XTT - PT ) / 40.) ) ) ! freezing interval
+ CASE ('N') !No ice
+ PFRAC_ICE = 0.
+ CASE ('S') !Same as previous
+ ! (almost) nothing to do
+ PFRAC_ICE = MAX( 0., MIN(1., PFRAC_ICE ) )
+ CASE DEFAULT
+ IF (PRESENT(KERR)) KERR=1
+END SELECT
+
+END SUBROUTINE COMPUTE_FRAC_ICE
diff --git a/src/PHYEX/micro/condensation.f90 b/src/PHYEX/micro/condensation.f90
index ec60d40671691d994a02f4b1f4981f4cc70c06aa..8b46541123e578150e769d33e4a467814ecd8bd4 100644
--- a/src/PHYEX/micro/condensation.f90
+++ b/src/PHYEX/micro/condensation.f90
@@ -4,66 +4,15 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODI_CONDENSATION
-! ########################
-!
-INTERFACE
-!
- SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL,&
- HFRAC_ICE, HCONDENS, HLAMBDA3, &
- PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
- OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF)
-!
-INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
-INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
-INTEGER, INTENT(IN) :: KKU ! vertical dimension
-INTEGER, INTENT(IN) :: KIB ! value of the first point in x
-INTEGER, INTENT(IN) :: KIE ! value of the last point in x
-INTEGER, INTENT(IN) :: KJB ! value of the first point in y
-INTEGER, INTENT(IN) :: KJE ! value of the last point in y
-INTEGER, INTENT(IN) :: KKB ! value of the first point in z
-INTEGER, INTENT(IN) :: KKE ! value of the last point in z
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-CHARACTER(len=4), INTENT(IN) :: HCONDENS
-CHARACTER(len=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRC ! grid scale r_c mixing ratio (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRI ! grid scale r_i (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only solid condensate (OUSERI=.FALSE.)
-LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
- ! or that from turbulence scheme
-REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC !cloud water content in precipitating part
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF !precipitating part
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI !
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF !
-
-END SUBROUTINE CONDENSATION
-!
-END INTERFACE
-!
-END MODULE MODI_CONDENSATION
-! ######spl
- SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- HFRAC_ICE, HCONDENS, HLAMBDA3, &
- PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
- OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
+ SUBROUTINE CONDENSATION(D, CST, ICEP, NEB, TURBN, &
+ &HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ &PPABS, PZZ, PRHODREF, PT, PRV_IN, PRV_OUT, PRC_IN, PRC_OUT, PRI_IN, PRI_OUT, &
+ &PRR, PRS, PRG, PSIGS, LMFCONV, PMFCONV, PCLDFR, PSIGRC, OUSERI, &
+ &OSIGMAS, OCND2, LHGT_QS, &
+ &PICLDFR, PWCLDFR, PSSIO, PSSIU, PIFR, PSIGQSAT, &
+ &PLV, PLS, PCPH, &
+ &PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ &PICE_CLD_WGT)
! ################################################################################
!
!!
@@ -123,91 +72,126 @@ END MODULE MODI_CONDENSATION
!! Set ZCOND to zero if PCLDFR==0
!! Safety limitation to .99*Pressure for saturation vapour pressure
!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
-!! 2015 C.Lac Change min value of ZSIGMA to be in agreement with AROME
-!! 2016 G.Delautier Restore min value of ZSIGMA (instability)
-!! 2016 S.Riette Change INQ1
+!! 2014-11 K.I Ivarsson add possibility to run with OCND2 option
+!! 2016 S.Riette Change INQ1
!! 2016-11 S. Riette: use HFRAC_ICE, output adjusted state
+!! 2018-02 K.I Ivarsson: Some modificatons of OCND2 option, mainly for optimation - new outputs
+!! 2019-06 W.C. de Rooy: Mods for new set up statistical cloud scheme
+!! 2019-07 K.I.Ivarsson: Switch for height dependent VQSIGSAT: LHGT_QS
+!! 2020-12 U. Andrae : Introduce SPP for HARMONIE-AROME
+!! R. El Khatib 24-Aug-2021 Optimizations
+!! 2021-01: SPP computations moved in aro_adjust (AROME/HARMONIE)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
-!
-use mode_msg
-!
-USE MODI_COMPUTE_FRAC_ICE
-!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODE_TIWMX, ONLY : ESATW, ESATI
+USE MODE_ICECLOUD, ONLY : ICECLOUD
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
-INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
-INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
-INTEGER, INTENT(IN) :: KKU ! vertical dimension
-INTEGER, INTENT(IN) :: KIB ! value of the first point in x
-INTEGER, INTENT(IN) :: KIE ! value of the last point in x
-INTEGER, INTENT(IN) :: KJB ! value of the first point in y
-INTEGER, INTENT(IN) :: KJE ! value of the last point in y
-INTEGER, INTENT(IN) :: KKB ! value of the first point in z
-INTEGER, INTENT(IN) :: KKE ! value of the last point in z
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-CHARACTER(len=4), INTENT(IN) :: HCONDENS
-CHARACTER(len=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRC ! grid scale r_c mixing ratio (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRI ! grid scale r_i (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(LEN=4), INTENT(IN) :: HCONDENS
+CHARACTER(LEN=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABS ! pressure (Pa)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PT ! grid scale T (K)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRV_IN ! grid scale water vapor mixing ratio (kg/kg) in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRV_OUT! grid scale water vapor mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC_IN ! grid scale r_c mixing ratio (kg/kg) in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRC_OUT! grid scale r_c mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRI_IN ! grid scale r_i (kg/kg) in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRI_OUT! grid scale r_i (kg/kg) in output
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRR ! grid scale mixing ration of rain (kg/kg)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+LOGICAL, INTENT(IN) :: LMFCONV ! =SIZE(PMFCONV)!=0
+REAL, DIMENSION(MERGE(D%NIJT,0,LMFCONV),&
+ MERGE(D%NKT,0,LMFCONV)), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF
LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
! liquid and solid condensate (OUSERI=.TRUE.)
! or only solid condensate (OUSERI=.FALSE.)
LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
! or that from turbulence scheme
-REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+LOGICAL, INTENT(IN) :: OCND2 ! logical switch to sparate liquid and ice
+ ! more rigid (DEFALT value : .FALSE.)
+LOGICAL, INTENT(IN) :: LHGT_QS! logical switch for height dependent VQSIGSAT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PICLDFR ! ice cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWCLDFR ! water or mixed-phase cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSSIO ! Super-saturation with respect to ice in the
+ ! supersaturated fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSSIU ! Sub-saturation with respect to ice in the
+ ! subsaturated fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PIFR ! Ratio cloud ice moist part
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+ ! multiplied by PSIGQSAT
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
!
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: JI, JJ, JK, JKP, JKM, IKTB, IKTE ! loop index
-REAL, DIMENSION(KIU,KJU,KKU) :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
-REAL, DIMENSION(KIU,KJU,KKU) :: ZL ! length scale
-REAL, DIMENSION(KIU,KJU,KKU) :: ZFRAC ! Ice fraction
-REAL, DIMENSION(KIU,KJU,KKU) :: ZCRIAUTI !
-INTEGER, DIMENSION(KIU,KJU) :: ITPL ! top levels of troposphere
-REAL, DIMENSION(KIU,KJU) :: ZTMIN ! minimum Temp. related to ITPL
-!
-REAL, DIMENSION(KIU,KJU,KKU) :: ZLV, ZLS, ZCPD
-REAL, DIMENSION(KIU,KJU,KKU) :: ZCOND
-REAL :: ZGCOND, ZSBAR, ZSBARC, ZQ1, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI ! Used for integration in Gaussian Probability Density Function
-REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZLVS ! thermodynamics
-REAL :: ZLL, DZZ, ZZZ ! used for length scales
-REAL :: ZAH, ZA, ZB, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
-REAL :: ZRCOLD, ZRIOLD
+INTEGER :: JIJ, JK, JKP, JKM ! loop index
+INTEGER :: IKTB, IKTE, IKB, IKE, IKL, IIJB, IIJE
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZL ! length scale
+INTEGER, DIMENSION(D%NIJT) :: ITPL ! top levels of troposphere
+REAL, DIMENSION(D%NIJT) :: ZTMIN ! minimum Temp. related to ITPL
+!
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZLV, ZLS, ZCPD
+REAL :: ZGCOND, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI, ZCRIAUTI ! Used for Gaussian PDF integration
+REAL :: ZLVS ! thermodynamics
+REAL, DIMENSION(D%NIJT) :: ZPV, ZPIV, ZQSL, ZQSI ! thermodynamics
+REAL :: ZLL, DZZ, ZZZ ! used for length scales
+REAL :: ZAH, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
+REAL, DIMENSION(D%NIJT) :: ZA, ZB, ZSBAR, ZSIGMA, ZQ1 ! related to computation of Sig_s
+REAL, DIMENSION(D%NIJT) :: ZCOND
+REAL, DIMENSION(D%NIJT) :: ZFRAC ! Ice fraction
INTEGER :: INQ1
REAL :: ZINC
+! related to OCND2 noise check :
+REAL :: ZRSP, ZRSW, ZRFRAC, ZRSDIF, ZRCOLD
+! related to OCND2 ice cloud calulation :
+REAL, DIMENSION(D%NIJT) :: ESATW_T
+REAL :: ZDUM1,ZDUM2,ZDUM3,ZDUM4,ZPRIFACT,ZLWINC
+REAL, DIMENSION(D%NIJT) :: ZDZ, ZARDUM, ZARDUM2, ZCLDINI
+! end OCND2
+
+! LHGT_QS:
+REAL :: ZDZFACT,ZDZREF
+! LHGT_QS END
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IERR
+!
!
!* 0.3 Definition of constants :
!
@@ -232,282 +216,389 @@ REAL, DIMENSION(-22:11),PARAMETER :: ZSRC_1D =(/ &
!-------------------------------------------------------------------------------
!
!
-
-IKTB=1+JPVEXT
-IKTE=KKU-JPVEXT
-
-PCLDFR(:,:,:) = 0. ! Initialize values
-PSIGRC(:,:,:) = 0. ! Initialize values
+IF (LHOOK) CALL DR_HOOK('CONDENSATION',0,ZHOOK_HANDLE)
+!
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
+IIJB=D%NIJB
+IIJE=D%NIJE
+!
+PCLDFR(:,:) = 0. ! Initialize values
+PSIGRC(:,:) = 0. ! Initialize values
+ZPRIFACT = 1. ! Initialize value
+ZARDUM2 = 0. ! Initialize values
+ZCLDINI = -1. ! Dummy Initialized cloud input to icecloud routine
+PIFR = 10. ! ratio of cloud ice water mixing ratio wet to dry
+ ! part of a gridbox
+ZDZREF = ICEP%XFRMIN(25) ! Thickness for unchanged vqsigsat (only used for LHGT_QS)
+! Init of the HALO (should be on HALO points only)
+#ifdef REPRO55
+PRC_OUT = PRC_IN
+PRV_OUT = PRV_IN
+PRI_OUT = PRI_IN
+PHLC_HRC = 0.
+PHLC_HCF = 0.
+PHLI_HRI = 0.
+PHLI_HCF = 0.
+#endif
+IF(OCND2)ZPRIFACT = 0.
!
!
!-------------------------------------------------------------------------------
! store total water mixing ratio
DO JK=IKTB,IKTE
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- ZRT(JI,JJ,JK) = PRV(JI,JJ,JK) + PRC(JI,JJ,JK) + PRI(JI,JJ,JK)
- END DO
+ DO JIJ=IIJB,IIJE
+ ZRT(JIJ,JK) = PRV_IN(JIJ,JK) + PRC_IN(JIJ,JK) + PRI_IN(JIJ,JK)*ZPRIFACT
END DO
END DO
!-------------------------------------------------------------------------------
! Preliminary calculations
! latent heat of vaporisation/sublimation
IF(PRESENT(PLV) .AND. PRESENT(PLS)) THEN
- ZLV(:,:,:)=PLV(:,:,:)
- ZLS(:,:,:)=PLS(:,:,:)
+ ZLV(:,:)=PLV(:,:)
+ ZLS(:,:)=PLS(:,:)
ELSE
DO JK=IKTB,IKTE
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- ZTEMP = PT(JI,JJ,JK)
- ! latent heat of vaporisation/sublimation
- ZLV(JI,JJ,JK) = XLVTT + ( XCPV - XCL ) * ( ZTEMP - XTT )
- ZLS(JI,JJ,JK) = XLSTT + ( XCPV - XCI ) * ( ZTEMP - XTT )
- ENDDO
+ DO JIJ=IIJB,IIJE
+ ! latent heat of vaporisation/sublimation
+ ZLV(JIJ,JK) = CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( PT(JIJ,JK) - CST%XTT )
+ ZLS(JIJ,JK) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( PT(JIJ,JK) - CST%XTT )
ENDDO
ENDDO
ENDIF
IF(PRESENT(PCPH)) THEN
- ZCPD(:,:,:)=PCPH(:,:,:)
+ ZCPD(:,:)=PCPH(:,:)
ELSE
DO JK=IKTB,IKTE
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- ZCPD(JI,JJ,JK) = XCPD + XCPV*PRV(JI,JJ,JK) + XCL*PRC(JI,JJ,JK) + XCI*PRI(JI,JJ,JK) + &
- XCI*(PRS(JI,JJ,JK) + PRG(JI,JJ,JK) )
- ENDDO
+ DO JIJ=IIJB,IIJE
+ ZCPD(JIJ,JK) = CST%XCPD + CST%XCPV*PRV_IN(JIJ,JK) + CST%XCL*PRC_IN(JIJ,JK) + CST%XCI*PRI_IN(JIJ,JK) + &
+#if defined(REPRO48) || defined(REPRO55)
+#else
+ CST%XCL*PRR(JIJ,JK) + &
+#endif
+ CST%XCI*(PRS(JIJ,JK) + PRG(JIJ,JK) )
ENDDO
ENDDO
ENDIF
-!-------------------------------------------------------------------------------
! Preliminary calculations needed for computing the "turbulent part" of Sigma_s
IF ( .NOT. OSIGMAS ) THEN
DO JK=IKTB,IKTE
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- ZTEMP = PT(JI,JJ,JK)
- ! store temperature at saturation
- ZTLK(JI,JJ,JK) = ZTEMP - ZLV(JI,JJ,JK)*PRC(JI,JJ,JK)/ZCPD(JI,JJ,JK) &
- - ZLS(JI,JJ,JK)*PRI(JI,JJ,JK)/ZCPD(JI,JJ,JK)
- END DO
+ DO JIJ=IIJB,IIJE
+ ! store temperature at saturation
+ ZTLK(JIJ,JK) = PT(JIJ,JK) - ZLV(JIJ,JK)*PRC_IN(JIJ,JK)/ZCPD(JIJ,JK) &
+ - ZLS(JIJ,JK)*PRI_IN(JIJ,JK)/ZCPD(JIJ,JK)*ZPRIFACT
END DO
END DO
! Determine tropopause/inversion height from minimum temperature
- ITPL(:,:) = KIB+1
- ZTMIN(:,:) = 400.
+#ifdef REPRO48
+ ITPL(:) = IIJB+1
+ !I (Sébastien Riette) don't understand why tropopause level is set
+ !with the index of the second physical point on the horizontal (i.e. 2+JPHEXT)!!!
+ !I assume it is a bug...
+#else
+ ITPL(:) = IKB+IKL
+#endif
+ ZTMIN(:) = 400.
DO JK = IKTB+1,IKTE-1
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- IF ( PT(JI,JJ,JK) < ZTMIN(JI,JJ) ) THEN
- ZTMIN(JI,JJ) = PT(JI,JJ,JK)
- ITPL(JI,JJ) = JK
- ENDIF
- END DO
+ DO JIJ=IIJB,IIJE
+ IF ( PT(JIJ,JK) < ZTMIN(JIJ) ) THEN
+ ZTMIN(JIJ) = PT(JIJ,JK)
+ ITPL(JIJ) = JK
+ ENDIF
END DO
END DO
! Set the mixing length scale
- ZL(:,:,KKB) = 20.
- DO JK = KKB+KKL,KKE,KKL
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- ! free troposphere
- ZL(JI,JJ,JK) = ZL0
- ZZZ = PZZ(JI,JJ,JK) - PZZ(JI,JJ,KKB)
- JKP = ITPL(JI,JJ)
- ! approximate length for boundary-layer
- IF ( ZL0 > ZZZ ) ZL(JI,JJ,JK) = ZZZ
- ! gradual decrease of length-scale near and above tropopause
- IF ( ZZZ > 0.9*(PZZ(JI,JJ,JKP)-PZZ(JI,JJ,KKB)) ) &
- ZL(JI,JJ,JK) = .6 * ZL(JI,JJ,JK-KKL)
- END DO
+ ZL(:,IKB) = 20.
+ DO JK = IKB+IKL,IKE,IKL
+ DO JIJ=IIJB,IIJE
+ ! free troposphere
+ ZL(JIJ,JK) = ZL0
+ ZZZ = PZZ(JIJ,JK) - PZZ(JIJ,IKB)
+ JKP = ITPL(JIJ)
+ ! approximate length for boundary-layer
+ IF ( ZL0 > ZZZ ) ZL(JIJ,JK) = ZZZ
+ ! gradual decrease of length-scale near and above tropopause
+ IF ( ZZZ > 0.9*(PZZ(JIJ,JKP)-PZZ(JIJ,IKB)) ) &
+ ZL(JIJ,JK) = .6 * ZL(JIJ,JK-IKL)
END DO
END DO
END IF
!-------------------------------------------------------------------------------
!
-!
-!Ice fraction
-ZFRAC(:,:,:) = 0.
-IF (OUSERI) THEN
- WHERE(PRC(:,:,:)+PRI(:,:,:) > 1.E-20)
- ZFRAC(:,:,:) = PRI(:,:,:) / (PRC(:,:,:)+PRI(:,:,:))
- ENDWHERE
- CALL COMPUTE_FRAC_ICE(HFRAC_ICE, ZFRAC, PT)
-ENDIF
-!
DO JK=IKTB,IKTE
- JKP=MAX(MIN(JK+KKL,IKTE),IKTB)
- JKM=MAX(MIN(JK-KKL,IKTE),IKTB)
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- ! latent heats
- ZTEMP = PT(JI,JJ,JK)
- ! saturated water vapor mixing ratio over liquid water
- ZPV = MIN(EXP( XALPW - XBETAW / ZTEMP - XGAMW * LOG( ZTEMP ) ), .99*PPABS(JI,JJ,JK))
- ZQSL = XRD / XRV * ZPV / ( PPABS(JI,JJ,JK) - ZPV )
-
- ! saturated water vapor mixing ratio over ice
- ZPIV = MIN(EXP( XALPI - XBETAI / ZTEMP - XGAMI * LOG( ZTEMP ) ), .99*PPABS(JI,JJ,JK))
- ZQSI = XRD / XRV * ZPIV / ( PPABS(JI,JJ,JK) - ZPIV )
-
- ! interpolate between liquid and solid as function of temperature
- ZQSL = (1. - ZFRAC(JI,JJ,JK)) * ZQSL + ZFRAC(JI,JJ,JK) * ZQSI
- ZLVS = (1. - ZFRAC(JI,JJ,JK)) * ZLV(JI,JJ,JK) + &
- & ZFRAC(JI,JJ,JK) * ZLS(JI,JJ,JK)
-
- ! coefficients a and b
- ZAH = ZLVS * ZQSL / ( XRV * ZTEMP**2 ) * (XRV * ZQSL / XRD + 1.)
- ZA = 1. / ( 1. + ZLVS/ZCPD(JI,JJ,JK) * ZAH )
- ZB = ZAH * ZA
+ JKP=MAX(MIN(JK+IKL,IKTE),IKTB)
+ JKM=MAX(MIN(JK-IKL,IKTE),IKTB)
+ IF (OCND2) THEN
+ DO JIJ = IIJB, IIJE
+ ZDZ(JIJ) = PZZ(JIJ,JKP) - PZZ(JIJ,JKP-IKL)
+ ENDDO
+ CALL ICECLOUD(D,PPABS(:,JK),PZZ(:,JK),ZDZ(:), &
+ & PT(:,JK),PRV_IN(:,JK),1.,-1., &
+ & ZCLDINI(:),PIFR(IIJB,JK),PICLDFR(:,JK), &
+ & PSSIO(:,JK),PSSIU(:,JK),ZARDUM2(:),ZARDUM(:))
+ ! latent heats
+ ! saturated water vapor mixing ratio over liquid water and ice
+ DO JIJ=IIJB,IIJE
+ ESATW_T(JIJ)=ESATW(PT(JIJ,JK))
+ ZPV(JIJ) = MIN(ESATW_T(JIJ), .99*PPABS(JIJ,JK))
+ ZPIV(JIJ) = MIN(ESATI(PT(JIJ,JK)), .99*PPABS(JIJ,JK))
+ END DO
+ ELSE
+ ! latent heats
+ ! saturated water vapor mixing ratio over liquid water and ice
+ DO JIJ=IIJB,IIJE
+ ZPV(JIJ) = MIN(EXP( CST%XALPW - CST%XBETAW / PT(JIJ,JK) - CST%XGAMW * LOG( PT(JIJ,JK) ) ), .99*PPABS(JIJ,JK))
+ ZPIV(JIJ) = MIN(EXP( CST%XALPI - CST%XBETAI / PT(JIJ,JK) - CST%XGAMI * LOG( PT(JIJ,JK) ) ), .99*PPABS(JIJ,JK))
+ END DO
+ ENDIF
+ !Ice fraction
+ ZFRAC(:) = 0.
+ IF (OUSERI .AND. .NOT.OCND2) THEN
+ DO JIJ=IIJB,IIJE
+ IF (PRC_IN(JIJ,JK)+PRI_IN(JIJ,JK) > 1.E-20) THEN
+ ZFRAC(JIJ) = PRI_IN(JIJ,JK) / (PRC_IN(JIJ,JK)+PRI_IN(JIJ,JK))
+ ENDIF
+ END DO
+ DO JIJ=IIJB,IIJE
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE, NEB, ZFRAC(JIJ), PT(JIJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
+ ENDDO
+ ENDIF
+ DO JIJ=IIJB,IIJE
+ ZQSL(JIJ) = CST%XRD / CST%XRV * ZPV(JIJ) / ( PPABS(JIJ,JK) - ZPV(JIJ) )
+ ZQSI(JIJ) = CST%XRD / CST%XRV * ZPIV(JIJ) / ( PPABS(JIJ,JK) - ZPIV(JIJ) )
- ZSBAR = ZA * ( ZRT(JI,JJ,JK) - ZQSL + &
- & ZAH * ZLVS * (PRC(JI,JJ,JK)+PRI(JI,JJ,JK)) / ZCPD(JI,JJ,JK))
+ ! interpolate between liquid and solid as function of temperature
+ ZQSL(JIJ) = (1. - ZFRAC(JIJ)) * ZQSL(JIJ) + ZFRAC(JIJ) * ZQSI(JIJ)
+ ZLVS = (1. - ZFRAC(JIJ)) * ZLV(JIJ,JK) + &
+ & ZFRAC(JIJ) * ZLS(JIJ,JK)
- ! switch to take either present computed value of SIGMAS
- ! or that of Meso-NH turbulence scheme
- IF ( OSIGMAS ) THEN
- IF (PSIGQSAT/=0.) THEN
- ZSIGMA = SQRT((2*PSIGS(JI,JJ,JK))**2 + (PSIGQSAT*ZQSL*ZA)**2)
+ ! coefficients a and b
+ ZAH = ZLVS * ZQSL(JIJ) / ( CST%XRV * PT(JIJ,JK)**2 ) * (CST%XRV * ZQSL(JIJ) / CST%XRD + 1.)
+ ZA(JIJ) = 1. / ( 1. + ZLVS/ZCPD(JIJ,JK) * ZAH )
+ ZB(JIJ) = ZAH * ZA(JIJ)
+ ZSBAR(JIJ) = ZA(JIJ) * ( ZRT(JIJ,JK) - ZQSL(JIJ) + &
+ & ZAH * ZLVS * (PRC_IN(JIJ,JK)+PRI_IN(JIJ,JK)*ZPRIFACT) / ZCPD(JIJ,JK))
+ END DO
+ ! switch to take either present computed value of SIGMAS
+ ! or that of Meso-NH turbulence scheme
+ IF ( OSIGMAS ) THEN
+ DO JIJ=IIJB,IIJE
+ IF (PSIGQSAT(JIJ)/=0.) THEN
+ ZDZFACT = 1.
+ IF(LHGT_QS .AND. JK+1 <= IKTE)THEN
+ ZDZFACT= MAX(ICEP%XFRMIN(23),MIN(ICEP%XFRMIN(24),(PZZ(JIJ,JK) - PZZ(JIJ,JK+1))/ZDZREF))
+ ELSEIF(LHGT_QS)THEN
+ ZDZFACT= MAX(ICEP%XFRMIN(23),MIN(ICEP%XFRMIN(24),((PZZ(JIJ,JK-1) - PZZ(JIJ,JK)))*0.8/ZDZREF))
+ ENDIF
+ IF (TURBN%LSTATNW) THEN
+ ZSIGMA(JIJ) = SQRT((PSIGS(JIJ,JK))**2 + (PSIGQSAT(JIJ)*ZDZFACT*ZQSL(JIJ)*ZA(JIJ))**2)
ELSE
- ZSIGMA = 2*PSIGS(JI,JJ,JK)
- END IF
+ ZSIGMA(JIJ) = SQRT((2*PSIGS(JIJ,JK))**2 + (PSIGQSAT(JIJ)*ZQSL(JIJ)*ZA(JIJ))**2)
+ ENDIF
ELSE
- ! parameterize Sigma_s with first_order closure
- DZZ = PZZ(JI,JJ,JKP) - PZZ(JI,JJ,JKM)
- ZDRW = ZRT(JI,JJ,JKP) - ZRT(JI,JJ,JKM)
- ZDTL = ZTLK(JI,JJ,JKP) - ZTLK(JI,JJ,JKM) + XG/ZCPD(JI,JJ,JK) * DZZ
- ZLL = ZL(JI,JJ,JK)
- ! standard deviation due to convection
- ZSIG_CONV =0.
- IF( SIZE(PMFCONV) /= 0) &
- ZSIG_CONV = ZCSIG_CONV * PMFCONV(JI,JJ,JK) / ZA
- ! zsigma should be of order 4.e-4 in lowest 5 km of atmosphere
- ZSIGMA = SQRT( MAX( 1.E-25, ZCSIGMA * ZCSIGMA * ZLL*ZLL/(DZZ*DZZ)*(&
- ZA*ZA*ZDRW*ZDRW - 2.*ZA*ZB*ZDRW*ZDTL + ZB*ZB*ZDTL*ZDTL) + &
- ZSIG_CONV * ZSIG_CONV ) )
+ IF (TURBN%LSTATNW) THEN
+ ZSIGMA(JIJ) = PSIGS(JIJ,JK)
+ ELSE
+ ZSIGMA(JIJ) = 2*PSIGS(JIJ,JK)
+ ENDIF
END IF
- ZSIGMA= MAX( 1.E-10, ZSIGMA )
-! ZSIGMA= MAX( 1.E-12, ZSIGMA )
-
- ! normalized saturation deficit
- ZQ1 = ZSBAR/ZSIGMA
-
- IF(HCONDENS == 'GAUS')THEN
- ! Gaussian Probability Density Function around ZQ1
- ! Computation of ZG and ZGAM(=erf(ZG))
- ZGCOND = -ZQ1/SQRT(2.)
-
- !Approximation of erf function for Gaussian distribution
- ZGAUV = 1 - SIGN(1., ZGCOND) * SQRT(1-EXP(-4*ZGCOND**2/XPI))
+ END DO
+ ELSE
+ DO JIJ=IIJB,IIJE
+ ! parameterize Sigma_s with first_order closure
+ DZZ = PZZ(JIJ,JKP) - PZZ(JIJ,JKM)
+ ZDRW = ZRT(JIJ,JKP) - ZRT(JIJ,JKM)
+ ZDTL = ZTLK(JIJ,JKP) - ZTLK(JIJ,JKM) + CST%XG/ZCPD(JIJ,JK) * DZZ
+ ZLL = ZL(JIJ,JK)
+ ! standard deviation due to convection
+ ZSIG_CONV =0.
+ IF(LMFCONV) ZSIG_CONV = ZCSIG_CONV * PMFCONV(JIJ,JK) / ZA(JIJ)
+ ! zsigma should be of order 4.e-4 in lowest 5 km of atmosphere
+ ZSIGMA(JIJ) = SQRT( MAX( 1.E-25, ZCSIGMA * ZCSIGMA * ZLL*ZLL/(DZZ*DZZ)*(&
+ ZA(JIJ)*ZA(JIJ)*ZDRW*ZDRW - 2.*ZA(JIJ)*ZB(JIJ)*ZDRW*ZDTL + ZB(JIJ)*ZB(JIJ)*ZDTL*ZDTL) + &
+ ZSIG_CONV * ZSIG_CONV ) )
+ END DO
+ END IF
+ DO JIJ=IIJB,IIJE
+ ZSIGMA(JIJ)= MAX( 1.E-10, ZSIGMA(JIJ) )
- !Computation Cloud Fraction
- PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUV))
+ ! normalized saturation deficit
+ ZQ1(JIJ) = ZSBAR(JIJ)/ZSIGMA(JIJ)
+ END DO
+ IF(HCONDENS == 'GAUS') THEN
+ DO JIJ=IIJB,IIJE
+ ! Gaussian Probability Density Function around ZQ1
+ ! Computation of ZG and ZGAM(=erf(ZG))
+ ZGCOND = -ZQ1(JIJ)/SQRT(2.)
- !Computation of condensate
- ZCOND(JI,JJ,JK) = (EXP(-ZGCOND**2)-ZGCOND*SQRT(XPI)*ZGAUV)*ZSIGMA/SQRT(2.*XPI)
- ZCOND(JI,JJ,JK) = MAX(ZCOND(JI,JJ,JK), 0.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUV = 1 - SIGN(1., ZGCOND) * SQRT(1-EXP(-4*ZGCOND**2/CST%XPI))
- PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK)
+ !Computation Cloud Fraction
+ PCLDFR(JIJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUV))
- !Computation warm/cold Cloud Fraction and content in high water content part
- IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
- IF(1-ZFRAC(JI,JJ,JK) > 1.E-20)THEN
- ZAUTC = (ZSBAR - XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI,JJ,JK))))/ZSIGMA
- ZGAUTC = -ZAUTC/SQRT(2.)
- !Approximation of erf function for Gaussian distribution
- ZGAUC = 1 - SIGN(1., ZGAUTC) * SQRT(1-EXP(-4*ZGAUTC**2/XPI))
- PHLC_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUC))
- PHLC_HRC(JI,JJ,JK) = (1-ZFRAC(JI,JJ,JK))*(EXP(-ZGAUTC**2)-ZGAUTC*SQRT(XPI)*ZGAUC)*ZSIGMA/SQRT(2.*XPI)
- PHLC_HRC(JI,JJ,JK) = PHLC_HRC(JI,JJ,JK) + XCRIAUTC/PRHODREF(JI,JJ,JK) * PHLC_HCF(JI,JJ,JK)
- PHLC_HRC(JI,JJ,JK) = MAX(PHLC_HRC(JI,JJ,JK), 0.)
- ELSE
- PHLC_HCF(JI,JJ,JK)=0.
- PHLC_HRC(JI,JJ,JK)=0.
- ENDIF
- ENDIF
+ !Computation of condensate
+ ZCOND(JIJ) = (EXP(-ZGCOND**2)-ZGCOND*SQRT(CST%XPI)*ZGAUV)*ZSIGMA(JIJ)/SQRT(2.*CST%XPI)
+ ZCOND(JIJ) = MAX(ZCOND(JIJ), 0.)
- IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
- IF(ZFRAC(JI,JJ,JK) > 1.E-20)THEN
- ZCRIAUTI(JI,JJ,JK)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(JI,JJ,JK)-XTT)+XBCRIAUTI))
- ZAUTI = (ZSBAR - ZCRIAUTI(JI,JJ,JK)/ZFRAC(JI,JJ,JK))/ZSIGMA
- ZGAUTI = -ZAUTI/SQRT(2.)
- !Approximation of erf function for Gaussian distribution
- ZGAUI = 1 - SIGN(1., ZGAUTI) * SQRT(1-EXP(-4*ZGAUTI**2/XPI))
- PHLI_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUI))
- PHLI_HRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK)*(EXP(-ZGAUTI**2)-ZGAUTI*SQRT(XPI)*ZGAUI)*ZSIGMA/SQRT(2.*XPI)
- PHLI_HRI(JI,JJ,JK) = PHLI_HRI(JI,JJ,JK) + ZCRIAUTI(JI,JJ,JK)*PHLI_HCF(JI,JJ,JK)
- PHLI_HRI(JI,JJ,JK) = MAX(PHLI_HRI(JI,JJ,JK), 0.)
- ELSE
- PHLI_HCF(JI,JJ,JK)=0.
- PHLI_HRI(JI,JJ,JK)=0.
- ENDIF
+ PSIGRC(JIJ,JK) = PCLDFR(JIJ,JK)
+ END DO
+ !Computation warm/cold Cloud Fraction and content in high water content part
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ DO JIJ=IIJB,IIJE
+ IF(1-ZFRAC(JIJ) > 1.E-20)THEN
+ ZAUTC = (ZSBAR(JIJ) - ICEP%XCRIAUTC/(PRHODREF(JIJ,JK)*(1-ZFRAC(JIJ))))/ZSIGMA(JIJ)
+ ZGAUTC = -ZAUTC/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUC = 1 - SIGN(1., ZGAUTC) * SQRT(1-EXP(-4*ZGAUTC**2/CST%XPI))
+ PHLC_HCF(JIJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUC))
+ PHLC_HRC(JIJ,JK) = (1-ZFRAC(JIJ))*(EXP(-ZGAUTC**2)-ZGAUTC*SQRT(CST%XPI)*ZGAUC)*ZSIGMA(JIJ)/SQRT(2.*CST%XPI)
+ PHLC_HRC(JIJ,JK) = PHLC_HRC(JIJ,JK) + ICEP%XCRIAUTC/PRHODREF(JIJ,JK) * PHLC_HCF(JIJ,JK)
+ PHLC_HRC(JIJ,JK) = MAX(PHLC_HRC(JIJ,JK), 0.)
+ ELSE
+ PHLC_HCF(JIJ,JK)=0.
+ PHLC_HRC(JIJ,JK)=0.
ENDIF
+ END DO
+ ENDIF
- ELSEIF(HCONDENS == 'CB02')THEN
- !Cloud fraction
- PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1)) )
-
- !Total condensate
- IF (ZQ1 > 0. .AND. ZQ1 <= 2) THEN
- ZCOND(JI,JJ,JK) = MIN(EXP(-1.)+.66*ZQ1+.086*ZQ1**2, 2.) ! We use the MIN function for continuity
- ELSE IF (ZQ1 > 2.) THEN
- ZCOND(JI,JJ,JK) = ZQ1
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ DO JIJ=IIJB,IIJE
+ IF(ZFRAC(JIJ) > 1.E-20)THEN
+ ZCRIAUTI=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(PT(JIJ,JK)-CST%XTT)+ICEP%XBCRIAUTI))
+ ZAUTI = (ZSBAR(JIJ) - ZCRIAUTI/ZFRAC(JIJ))/ZSIGMA(JIJ)
+ ZGAUTI = -ZAUTI/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUI = 1 - SIGN(1., ZGAUTI) * SQRT(1-EXP(-4*ZGAUTI**2/CST%XPI))
+ PHLI_HCF(JIJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUI))
+ PHLI_HRI(JIJ,JK) = ZFRAC(JIJ)*(EXP(-ZGAUTI**2)-ZGAUTI*SQRT(CST%XPI)*ZGAUI)*ZSIGMA(JIJ)/SQRT(2.*CST%XPI)
+ PHLI_HRI(JIJ,JK) = PHLI_HRI(JIJ,JK) + ZCRIAUTI*PHLI_HCF(JIJ,JK)
+ PHLI_HRI(JIJ,JK) = MAX(PHLI_HRI(JIJ,JK), 0.)
ELSE
- ZCOND(JI,JJ,JK) = EXP( 1.2*ZQ1-1. )
+ PHLI_HCF(JIJ,JK)=0.
+ PHLI_HRI(JIJ,JK)=0.
ENDIF
- ZCOND(JI,JJ,JK) = ZCOND(JI,JJ,JK) * ZSIGMA
-
- INQ1 = MIN( MAX(-22,FLOOR(MIN(100., MAX(-100., 2*ZQ1))) ), 10) !inner min/max prevents sigfpe when 2*zq1 does not fit into an int
- ZINC = 2.*ZQ1 - INQ1
-
- PSIGRC(JI,JJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
+ END DO
+ ENDIF
- IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
- PHLC_HCF(JI,JJ,JK)=0.
- PHLC_HRC(JI,JJ,JK)=0.
- ENDIF
- IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
- PHLI_HCF(JI,JJ,JK)=0.
- PHLI_HRI(JI,JJ,JK)=0.
- ENDIF
+ ELSEIF(HCONDENS == 'CB02')THEN
+ DO JIJ=IIJB,IIJE
+ !Total condensate
+ IF (ZQ1(JIJ) > 0. .AND. ZQ1(JIJ) <= 2) THEN
+ ZCOND(JIJ) = MIN(EXP(-1.)+.66*ZQ1(JIJ)+.086*ZQ1(JIJ)**2, 2.) ! We use the MIN function for continuity
+ ELSE IF (ZQ1(JIJ) > 2.) THEN
+ ZCOND(JIJ) = ZQ1(JIJ)
+ ELSE
+ ZCOND(JIJ) = EXP( 1.2*ZQ1(JIJ)-1. )
ENDIF
+ ZCOND(JIJ) = ZCOND(JIJ) * ZSIGMA(JIJ)
- IF ( ZCOND(JI,JJ,JK) < 1.E-12 ) THEN
- ZCOND(JI,JJ,JK) = 0.
- PCLDFR(JI,JJ,JK) = 0.
+ !Cloud fraction
+ IF (ZCOND(JIJ) < 1.E-12) THEN
+ PCLDFR(JIJ,JK) = 0.
+ ELSE
+ PCLDFR(JIJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1(JIJ))) )
ENDIF
- IF (PCLDFR(JI,JJ,JK)==0.) THEN
- ZCOND(JI,JJ,JK)=0.
+ IF (PCLDFR(JIJ,JK)==0.) THEN
+ ZCOND(JIJ)=0.
ENDIF
- ZRCOLD=PRC(JI,JJ,JK)
- ZRIOLD=PRI(JI,JJ,JK)
+ INQ1 = MIN( MAX(-22,FLOOR(MIN(100., MAX(-100., 2*ZQ1(JIJ)))) ), 10) !inner min/max prevents sigfpe when 2*zq1 does not fit into an int
+ ZINC = 2.*ZQ1(JIJ) - INQ1
- PRC(JI,JJ,JK) = (1.-ZFRAC(JI,JJ,JK)) * ZCOND(JI,JJ,JK) ! liquid condensate
- PRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK) * ZCOND(JI,JJ,JK) ! solid condensate
-
- PT(JI,JJ,JK) = PT(JI,JJ,JK) + ((PRC(JI,JJ,JK)-ZRCOLD)*ZLV(JI,JJ,JK) + &
- &(PRI(JI,JJ,JK)-ZRIOLD)*ZLS(JI,JJ,JK) ) &
- & /ZCPD(JI,JJ,JK)
- PRV(JI,JJ,JK) = ZRT(JI,JJ,JK) - PRC(JI,JJ,JK) - PRI(JI,JJ,JK)
+ PSIGRC(JIJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
+ END DO
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ PHLC_HCF(:,JK)=0.
+ PHLC_HRC(:,JK)=0.
+ ENDIF
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ PHLI_HCF(:,JK)=0.
+ PHLI_HRI(:,JK)=0.
+ ENDIF
+ END IF !HCONDENS
-! s r_c/ sig_s^2
-! PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK) ! use simple Gaussian relation
-!
-! multiply PSRCS by the lambda3 coefficient
-!
-! PSIGRC(JI,JJ,JK) = 2.*PCLDFR(JI,JJ,JK) * MIN( 3. , MAX(1.,1.-ZQ1) )
-! in the 3D case lambda_3 = 1.
+ IF(.NOT. OCND2) THEN
+ DO JIJ=IIJB,IIJE
+ PRC_OUT(JIJ,JK) = (1.-ZFRAC(JIJ)) * ZCOND(JIJ) ! liquid condensate
+ PRI_OUT(JIJ,JK) = ZFRAC(JIJ) * ZCOND(JIJ) ! solid condensate
+ PT(JIJ,JK) = PT(JIJ,JK) + ((PRC_OUT(JIJ,JK)-PRC_IN(JIJ,JK))*ZLV(JIJ,JK) + &
+ &(PRI_OUT(JIJ,JK)-PRI_IN(JIJ,JK))*ZLS(JIJ,JK) ) &
+ & /ZCPD(JIJ,JK)
+ PRV_OUT(JIJ,JK) = ZRT(JIJ,JK) - PRC_OUT(JIJ,JK) - PRI_OUT(JIJ,JK)*ZPRIFACT
+ END DO
+ ELSE
+ DO JIJ=IIJB,IIJE
+ PRC_OUT(JIJ,JK) = (1.-ZFRAC(JIJ)) * ZCOND(JIJ) ! liquid condensate
+ ZLWINC = PRC_OUT(JIJ,JK) - PRC_IN(JIJ,JK)
+ !
+! This check is mainly for noise reduction :
+! -------------------------
+ IF(ABS(ZLWINC)>1.0E-12 .AND. ESATW(PT(JIJ,JK)) < PPABS(JIJ,JK)*0.5 )THEN
+ ZRCOLD = PRC_OUT(JIJ,JK)
+ ZRFRAC = PRV_IN(JIJ,JK) - ZLWINC
+ IF( PRV_IN(JIJ,JK) < ZRSW )THEN ! sub - saturation over water:
+ ! Avoid drying of cloudwater leading to supersaturation with
+ ! respect to water
+ ZRSDIF= MIN(0.,ZRSP-ZRFRAC)
+ ELSE ! super - saturation over water:
+ ! Avoid deposition of water leading to sub-saturation with
+ ! respect to water
+ ! ZRSDIF= MAX(0.,ZRSP-ZRFRAC)
+ ZRSDIF= 0. ! t7
+ ENDIF
+ PRC_OUT(JIJ,JK) = ZCOND(JIJ) - ZRSDIF
+ ELSE
+ ZRCOLD = PRC_IN(JIJ,JK)
+ ENDIF
+ ! end check
- IF(HLAMBDA3=='CB')THEN
- PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
- ELSEIF(HLAMBDA3=='NONE') THEN
+ ! compute separate ice cloud:
+ PWCLDFR(JIJ,JK) = PCLDFR(JIJ,JK)
+ ZDUM1 = MIN(1.0,20.* PRC_OUT(JIJ,JK)*SQRT(ZDZ(JIJ))/ZQSL(JIJ)) ! cloud liquid water factor
+ ZDUM3 = MAX(0.,PICLDFR(JIJ,JK)-PWCLDFR(JIJ,JK)) ! pure ice cloud part
+ IF (JK==IKTB) THEN
+ ZDUM4 = PRI_IN(JIJ,JK)
ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'CONDENSATION', 'invalid value for HLAMBDA3: ' // TRIM( HLAMBDA3 ) )
+ ZDUM4 = PRI_IN(JIJ,JK) + PRS(JIJ,JK)*0.5 + PRG(JIJ,JK)*0.25
ENDIF
+ ZDUM4 = MAX(0.,MIN(1.,PICE_CLD_WGT(JIJ)*ZDUM4*SQRT(ZDZ(JIJ))/ZQSI(JIJ))) ! clould ice+solid
+ ! precip. water factor
+
+ ZDUM2 = (0.8*PCLDFR(JIJ,JK)+0.2)*MIN(1.,ZDUM1 + ZDUM4*PCLDFR(JIJ,JK))
+ ! water cloud, use 'statistical' cloud, but reduce it in case of low liquid content
+
+ PCLDFR(JIJ,JK) = MIN(1., ZDUM2 + (0.5*ZDUM3+0.5)*ZDUM4) ! Rad cloud
+ ! Reduce ice cloud part in case of low ice water content
+ PRI_OUT(JIJ,JK) = PRI_IN(JIJ,JK)
+ PT(JIJ,JK) = PT(JIJ,JK) + ((PRC_OUT(JIJ,JK)-ZRCOLD)*ZLV(JIJ,JK) + &
+ &(PRI_OUT(JIJ,JK)-PRI_IN(JIJ,JK))*ZLS(JIJ,JK) ) &
+ & /ZCPD(JIJ,JK)
+ PRV_OUT(JIJ,JK) = ZRT(JIJ,JK) - PRC_OUT(JIJ,JK) - PRI_OUT(JIJ,JK)*ZPRIFACT
END DO
- END DO
+ END IF ! End OCND2
+ IF(HLAMBDA3=='CB')THEN
+ DO JIJ=IIJB,IIJE
+ ! s r_c/ sig_s^2
+ ! PSIGRC(JIJ,JK) = PCLDFR(JIJ,JK) ! use simple Gaussian relation
+ !
+ ! multiply PSRCS by the lambda3 coefficient
+ !
+ ! PSIGRC(JIJ,JK) = 2.*PCLDFR(JIJ,JK) * MIN( 3. , MAX(1.,1.-ZQ1(JIJ)) )
+ ! in the 3D case lambda_3 = 1.
+
+ PSIGRC(JIJ,JK) = PSIGRC(JIJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1(JIJ)) )
+ END DO
+ END IF
END DO
!
+IF (LHOOK) CALL DR_HOOK('CONDENSATION',1,ZHOOK_HANDLE)
+!
+CONTAINS
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE CONDENSATION
diff --git a/src/PHYEX/micro/ice_adjust.f90 b/src/PHYEX/micro/ice_adjust.f90
index 8f5a8b35e7619d83bd9bf3c290e0eff346138ea8..deec98d8ef92cda88971c6eb49b4b497ea1caac5 100644
--- a/src/PHYEX/micro/ice_adjust.f90
+++ b/src/PHYEX/micro/ice_adjust.f90
@@ -3,98 +3,22 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ######################
- MODULE MODI_ICE_ADJUST
-! ######################
-!
-INTERFACE
-!
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
- HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
- PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
- PPABST, PZZ, &
- PEXN, PCF_MF, PRC_MF, PRI_MF, &
- PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
- PRR, PRI, PRIS, PRS, PRG, PRH, &
- POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
-!
-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 variables
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-CHARACTER(len=80), INTENT(IN) :: HCONDENS
-CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
-CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
- ! Condensation
-LOGICAL :: OSIGMAS ! Switch for Sigma_s:
- ! use values computed in CONDENSATION
- ! or that from turbulence scheme
-CHARACTER(len=*), INTENT(IN) :: HSUBG_MF_PDF
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model layer
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! Theta to adjust
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Cloud ice m.r. at t+1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRR ! Rain water m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG ! Graupel m.r. to adjust
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
-!
-!
-END SUBROUTINE ICE_ADJUST
-!
-END INTERFACE
-!
-END MODULE MODI_ICE_ADJUST
-
! ##########################################################################
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
- HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
- PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
- PPABST, PZZ, &
- PEXN, PCF_MF, PRC_MF, PRI_MF, &
- PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
- PRR, PRI, PRIS, PRS, PRG, PRH, &
- POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
+ SUBROUTINE ICE_ADJUST (D, CST, ICEP, NEB, TURBN, BUCONF, KRR, &
+ &HFRAC_ICE, HBUNAME, OCND2, LHGT_QS, &
+ &PTSTEP, PSIGQSAT, &
+ &PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,&
+ &PPABST, PZZ, &
+ &PEXN, PCF_MF, PRC_MF, PRI_MF, &
+ &PICLDFR, PWCLDFR, PSSIO, PSSIU, PIFR, &
+ &PRV, PRC, PRVS, PRCS, PTH, PTHS, &
+ &OCOMPUTE_SRC, PSRCS, PCLDFR, &
+ &PRR, PRI, PRIS, PRS, PRG, TBUDGETS, KBUDGETS, &
+ &PICE_CLD_WGT, &
+ &PRH, &
+ &POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ &PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF)
+
! #########################################################################
!
!!**** *ICE_ADJUST* - compute the ajustment of water vapor in mixed-phase
@@ -168,138 +92,154 @@ END MODULE MODI_ICE_ADJUST
!! J.Pergaud and S.Malardel Add EDKF case
!! S. Riette ice for EDKF
!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 2016-07 S. Riette: adjustement is now realized on state variables (PRV, PRC, PRI, PTH)
!! whereas tendencies are still applied on S variables.
!! This modification allows to call ice_adjust on T variable
!! or to call it on S variables
!! 2016-11 S. Riette: all-or-nothing adjustment now uses condensation
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+!! 2018-02 K.I.Ivarsson : More outputs for OCND2 option
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!! 2020-12 U. Andrae : Introduce SPP for HARMONIE-AROME
+!! R. El Khatib 24-Aug-2021 Optimizations
+!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, &
- tbudgets
-USE MODD_CONF
-USE MODD_CST
-USE MODD_PARAMETERS
-
-use mode_budget, only: Budget_store_init, Budget_store_end
-USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
-use mode_tools_ll, only: GET_INDICE_ll
-
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI
+USE MODD_RAIN_ICE_PARAM, ONLY : RAIN_ICE_PARAM_t
+!
+USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+!
USE MODI_CONDENSATION
-USE MODI_GET_HALO
-
+!
IMPLICIT NONE
!
!
!* 0.1 Declarations of dummy arguments :
!
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-CHARACTER(len=80), INTENT(IN) :: HCONDENS
-CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
-CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
- ! Condensation
-LOGICAL :: OSIGMAS ! Switch for Sigma_s:
- ! use values computed in CONDENSATION
- ! or that from turbulence scheme
-CHARACTER(len=*), INTENT(IN) :: HSUBG_MF_PDF
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(LEN=4), INTENT(IN) :: HBUNAME ! Name of the budget
+LOGICAL, INTENT(IN) :: OCND2 ! logical switch to separate liquid
+ ! and ice
+ ! more rigid (DEFAULT value : .FALSE.)
+LOGICAL, INTENT(IN) :: LHGT_QS ! logical switch for height dependent VQSIGSAT
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
-REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model layer
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! Theta to adjust
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRR ! Rain water m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG ! Graupel m.r. to adjust
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%LSUBG_COND),&
+ MERGE(D%NKT,0,TURBN%LSUBG_COND)), INTENT(IN) :: PSIGS ! Sigma_s at time t
+LOGICAL, INTENT(IN) :: LMFCONV ! =SIZE(PMFCONV)!=0
+REAL, DIMENSION(MERGE(D%NIJT,0,LMFCONV),&
+ MERGE(D%NKT,0,LMFCONV)), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! height of model layer
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PCF_MF ! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC_MF ! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRI_MF ! Convective Mass Flux ice mixing ratio
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTH ! Theta to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHS ! Theta source
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PICLDFR ! ice cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWCLDFR ! water or mixed-phase cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSSIO ! Super-saturation with respect to ice in the
+ ! supersaturated fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSSIU ! Sub-saturation with respect to ice in the
+ ! subsaturated fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PIFR ! Ratio cloud ice moist part to dry part
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRR ! Rain water m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRG ! Graupel m.r. to adjust
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT):: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+!
!
!* 0.2 Declarations of local variables :
!
!
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+REAL :: ZW1,ZW2 ! intermediate fields
+REAL, DIMENSION(D%NIJT,D%NKT) &
:: ZT, & ! adjusted temperature
ZRV, ZRC, ZRI, & ! adjusted state
ZCPH, & ! guess of the CPh for the mixing
ZLV, & ! guess of the Lv at t+1
- ZLS, & ! guess of the Ls at t+1
- ZW1,ZW2, & ! Work arrays for intermediate fields
- ZCRIAUT, & ! Autoconversion thresholds
- ZHCF, ZHR
-!
-INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
-INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
-INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
-INTEGER :: IKB ! K index value of the first inner mass point
-INTEGER :: IKE ! K index value of the last inner mass point
+ ZLS ! guess of the Ls at t+1
+REAL :: ZCRIAUT, & ! Autoconversion thresholds
+ ZHCF, ZHR
+!
INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
+INTEGER :: JIJ, JK
+INTEGER :: IKTB, IKTE, IIJB, IIJE
!
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZSIGS,ZSRCS
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZSIGS, ZSRCS
+REAL, DIMENSION(D%NIJT) :: ZSIGQSAT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
! -------------
!
-if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
-
-IIU = SIZE(PEXNREF,1)
-IJU = SIZE(PEXNREF,2)
-IKU = SIZE(PEXNREF,3)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=KKA+JPVEXT*KKL
-IKE=KKU-JPVEXT*KKL
+IF (LHOOK) CALL DR_HOOK('ICE_ADJUST',0,ZHOOK_HANDLE)
+!
+IKTB=D%NKTB
+IKTE=D%NKTE
+IIJB=D%NIJB
+IIJE=D%NIJE
!
ITERMAX=1
!
+IF(BUCONF%LBUDGET_TH) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), TRIM(HBUNAME), PTHS(:, :)*PRHODJ(:, :))
+IF(BUCONF%LBUDGET_RV) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), TRIM(HBUNAME), PRVS(:, :)*PRHODJ(:, :))
+IF(BUCONF%LBUDGET_RC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), TRIM(HBUNAME), PRCS(:, :)*PRHODJ(:, :))
+IF(BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), TRIM(HBUNAME), PRIS(:, :)*PRHODJ(:, :))
!-------------------------------------------------------------------------------
!
!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
@@ -307,70 +247,28 @@ ITERMAX=1
!
!
! beginning of the iterative loop (to compute the adjusted state)
-ZRV(:,:,:)=PRV(:,:,:)
-ZRC(:,:,:)=PRC(:,:,:)
-ZRI(:,:,:)=PRI(:,:,:)
-ZT(:,:,:)=PTH(:,:,:) * PEXN(:,:,:)
!
DO JITER =1,ITERMAX
!
!* 2.3 compute the latent heat of vaporization Lv(T*) at t+1
! and the latent heat of sublimation Ls(T*) at t+1
!
- ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
- ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+ DO JK=IKTB,IKTE
+ DO JIJ=IIJB,IIJE
+ IF (JITER==1) ZT(JIJ,JK) = PTH(JIJ,JK) * PEXN(JIJ,JK)
+ ZLV(JIJ,JK) = CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( ZT(JIJ,JK) -CST%XTT )
+ ZLS(JIJ,JK) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( ZT(JIJ,JK) -CST%XTT )
+ ENDDO
+ ENDDO
!
- !* 2.4 compute the specific heat for moist air (Cph) at t+1
+ !* 2.4 Iterate
!
- IF ( KRR == 7 ) THEN
- ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
- + XCL * (ZRC(:,:,:) + PRR(:,:,:)) &
- + XCI * (ZRI(:,:,:) + PRS(:,:,:) + PRG(:,:,:) + PRH(:,:,:))
- ELSE IF( KRR == 6 ) THEN
- ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
- + XCL * (ZRC(:,:,:) + PRR(:,:,:)) &
- + XCI * (ZRI(:,:,:) + PRS(:,:,:) + PRG(:,:,:))
- ELSE IF( KRR == 5 ) THEN
- ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
- + XCL * (ZRC(:,:,:) + PRR(:,:,:)) &
- + XCI * (ZRI(:,:,:) + PRS(:,:,:))
- ELSE IF( KRR == 3 ) THEN
- ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
- + XCL * (ZRC(:,:,:) + PRR(:,:,:))
- ELSE IF( KRR == 2 ) THEN
- ZCPH(:,:,:) = XCPD + XCPV * ZRV(:,:,:) &
- + XCL * ZRC(:,:,:)
- END IF
- !
- IF ( OSUBG_COND ) THEN
- !
- !* 3. SUBGRID CONDENSATION SCHEME
- ! ---------------------------
- !
- ! PSRC= s'rci'/Sigma_s^2
- ! ZT, ZRV, ZRC and ZRI are INOUT
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- HFRAC_ICE, HCONDENS, HLAMBDA3, &
- PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, &
- PSRCS, .TRUE., OSIGMAS, &
- PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
+ IF (JITER==1) THEN
+ ! compute with input values
+ CALL ITERATION(PRV,PRC,PRI,ZRV,ZRC,ZRI)
ELSE
- !
- !* 4. ALL OR NOTHING CONDENSATION SCHEME
- ! FOR MIXED-PHASE CLOUD
- ! -----------------------------------------------
- !
- !
- ! ZT, ZRV, ZRC and ZRI are INOUT
- !
- !CALL ADJUST_LANGLOIS(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- ! PPABST, ZT, ZRV, ZRC, ZRI, ZLV, ZLS, ZCPH) HFRAC_ICE must be implemented in Langlois before using it again
- ZSIGS=0.
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- HFRAC_ICE, HCONDENS, HLAMBDA3, &
- PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
- ZSRCS, .TRUE., OSIGMAS=.TRUE., &
- PSIGQSAT=0., PLV=ZLV, PLS=ZLS, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
+ ! compute with updated values
+ CALL ITERATION(ZRV,ZRC,ZRI,ZRV,ZRC,ZRI)
ENDIF
ENDDO ! end of the iterative loop
!
@@ -378,147 +276,233 @@ ENDDO ! end of the iterative loop
! -------------------------------------------------
!
!
-!* 5.0 compute the variation of mixing ratio
-!
- ! Rc - Rc*
-ZW1(:,:,:) = (ZRC(:,:,:) - PRC(:,:,:)) / PTSTEP ! Pcon = ----------
- ! 2 Delta t
-
-ZW2(:,:,:) = (ZRI(:,:,:) - PRI(:,:,:)) / PTSTEP ! idem ZW1 but for Ri
-!
-!* 5.1 compute the sources
-!
-WHERE( ZW1(:,:,:) < 0.0 )
- ZW1(:,:,:) = MAX ( ZW1(:,:,:), -PRCS(:,:,:) )
-ELSEWHERE
- ZW1(:,:,:) = MIN ( ZW1(:,:,:), PRVS(:,:,:) )
-END WHERE
-PRVS(:,:,:) = PRVS(:,:,:) - ZW1(:,:,:)
-PRCS(:,:,:) = PRCS(:,:,:) + ZW1(:,:,:)
-PTHS(:,:,:) = PTHS(:,:,:) + &
- ZW1(:,:,:) * ZLV(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
-!
-WHERE( ZW2(:,:,:) < 0.0 )
- ZW2(:,:,:) = MAX ( ZW2(:,:,:), -PRIS(:,:,:) )
-ELSEWHERE
- ZW2(:,:,:) = MIN ( ZW2(:,:,:), PRVS(:,:,:) )
-END WHERE
-PRVS(:,:,:) = PRVS(:,:,:) - ZW2(:,:,:)
-PRIS(:,:,:) = PRIS(:,:,:) + ZW2(:,:,:)
-PTHS(:,:,:) = PTHS(:,:,:) + &
- ZW2(:,:,:) * ZLS(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
-!
-!
-!* 5.2 compute the cloud fraction PCLDFR
-!
-IF ( .NOT. OSUBG_COND ) THEN
- WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / PTSTEP)
- PCLDFR(:,:,:) = 1.
- ELSEWHERE
- PCLDFR(:,:,:) = 0.
- ENDWHERE
- IF ( SIZE(PSRCS,3) /= 0 ) THEN
- PSRCS(:,:,:) = PCLDFR(:,:,:)
- END IF
-ELSE
- !We limit PRC_MF+PRI_MF to PRVS*PTSTEP to avoid negative humidity
- ZW1(:,:,:)=PRC_MF(:,:,:)/PTSTEP
- ZW2(:,:,:)=PRI_MF(:,:,:)/PTSTEP
- WHERE(ZW1(:,:,:)+ZW2(:,:,:)>PRVS(:,:,:))
- ZW1(:,:,:)=ZW1(:,:,:)*PRVS(:,:,:)/(ZW1(:,:,:)+ZW2(:,:,:))
- ZW2(:,:,:)=PRVS(:,:,:)-ZW1(:,:,:)
- ENDWHERE
- IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
- ZCRIAUT(:,:,:)=XCRIAUTC/PRHODREF
- IF(HSUBG_MF_PDF=='NONE')THEN
- WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT)
- PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZW1(:,:,:)*PTSTEP
- PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+PCF_MF(:,:,:))
- ENDWHERE
- ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
- !ZHCF is the precipitating part of the *cloud* and not of the grid cell
- WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT(:,:,:))
- ZHCF(:,:,:)=1.-.5*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:) / MAX(1.E-20, ZW1(:,:,:)*PTSTEP))**2
- ZHR(:,:,:)=ZW1(:,:,:)*PTSTEP-(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3 / &
- &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
- ELSEWHERE(2.*ZW1(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT(:,:,:))
- ZHCF(:,:,:)=0.
- ZHR(:,:,:)=0.
- ELSEWHERE
- ZHCF(:,:,:)=(2.*ZW1(:,:,:)*PTSTEP-ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2 / &
- &(2.*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
- ZHR(:,:,:)=(4.*(ZW1(:,:,:)*PTSTEP)**3-3.*ZW1(:,:,:)*PTSTEP*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2+&
- (ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3) / &
- &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
- ENDWHERE
- ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
- PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
- PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZHR(:,:,:)
+DO JK=IKTB,IKTE
+ DO JIJ=IIJB,IIJE
+ !
+ !* 5.0 compute the variation of mixing ratio
+ !
+ ! Rc - Rc*
+ ZW1 = (ZRC(JIJ,JK) - PRC(JIJ,JK)) / PTSTEP ! Pcon = ----------
+ ! 2 Delta t
+ ZW2 = (ZRI(JIJ,JK) - PRI(JIJ,JK)) / PTSTEP ! idem ZW1 but for Ri
+ !
+ !* 5.1 compute the sources
+ !
+ IF( ZW1 < 0.0 ) THEN
+ ZW1 = MAX ( ZW1, -PRCS(JIJ,JK) )
+ ELSE
+ ZW1 = MIN ( ZW1, PRVS(JIJ,JK) )
ENDIF
- ENDIF
- IF(PRESENT(PHLI_HRI) .AND. PRESENT(PHLI_HCF)) THEN
- ZCRIAUT(:,:,:)=MIN(XCRIAUTI,10**(XACRIAUTI*(ZT(:,:,:)-XTT)+XBCRIAUTI))
- IF(HSUBG_MF_PDF=='NONE')THEN
- WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT(:,:,:))
- PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZW2(:,:,:)*PTSTEP
- PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+PCF_MF(:,:,:))
- ENDWHERE
- ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
- !ZHCF is the precipitating part of the *cloud* and not of the grid cell
- WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT)
- ZHCF(:,:,:)=1.-.5*(ZCRIAUT*PCF_MF(:,:,:) / (ZW2(:,:,:)*PTSTEP))**2
- ZHR(:,:,:)=ZW2(:,:,:)*PTSTEP-(ZCRIAUT*PCF_MF(:,:,:))**3/(3*(ZW2(:,:,:)*PTSTEP)**2)
- ELSEWHERE(2.*ZW2(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT)
- ZHCF(:,:,:)=0.
- ZHR(:,:,:)=0.
- ELSEWHERE
- ZHCF(:,:,:)=(2.*ZW2(:,:,:)*PTSTEP-ZCRIAUT*PCF_MF(:,:,:))**2 / (2.*(ZW2(:,:,:)*PTSTEP)**2)
- ZHR(:,:,:)=(4.*(ZW2(:,:,:)*PTSTEP)**3-3.*ZW2(:,:,:)*PTSTEP*(ZCRIAUT*PCF_MF(:,:,:))**2+&
- (ZCRIAUT*PCF_MF(:,:,:))**3)/(3*(ZW2(:,:,:)*PTSTEP)**2)
- ENDWHERE
- ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
- PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
- PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZHR(:,:,:)
+ PRVS(JIJ,JK) = PRVS(JIJ,JK) - ZW1
+ PRCS(JIJ,JK) = PRCS(JIJ,JK) + ZW1
+ PTHS(JIJ,JK) = PTHS(JIJ,JK) + &
+ ZW1 * ZLV(JIJ,JK) / (ZCPH(JIJ,JK) * PEXNREF(JIJ,JK))
+ !
+ IF( ZW2 < 0.0 ) THEN
+ ZW2 = MAX ( ZW2, -PRIS(JIJ,JK) )
+ ELSE
+ ZW2 = MIN ( ZW2, PRVS(JIJ,JK) )
ENDIF
- ENDIF
- PCLDFR(:,:,:)=MIN(1.,PCLDFR(:,:,:)+PCF_MF(:,:,:))
- PRCS(:,:,:)=PRCS(:,:,:)+ZW1(:,:,:)
- PRIS(:,:,:)=PRIS(:,:,:)+ZW2(:,:,:)
- PRVS(:,:,:)=PRVS(:,:,:)-(ZW1(:,:,:)+ZW2(:,:,:))
- PTHS(:,:,:) = PTHS(:,:,:) + &
- (ZW1 * ZLV(:,:,:) + ZW2 * ZLS(:,:,:)) / ZCPH(:,:,:) &
- / PEXNREF(:,:,:)
- IF(PRESENT(POUT_RV) .OR. PRESENT(POUT_RC) .OR. &
- &PRESENT(POUT_RI) .OR. PRESENT(POUT_TH)) THEN
- ZW1(:,:,:)=PRC_MF(:,:,:)
- ZW2(:,:,:)=PRI_MF(:,:,:)
- WHERE(ZW1(:,:,:)+ZW2(:,:,:)>ZRV(:,:,:))
- ZW1(:,:,:)=ZW1(:,:,:)*ZRV(:,:,:)/(ZW1(:,:,:)+ZW2(:,:,:))
- ZW2(:,:,:)=ZRV(:,:,:)-ZW1(:,:,:)
- ENDWHERE
- ZRC(:,:,:)=ZRC(:,:,:)+ZW1(:,:,:)
- ZRI(:,:,:)=ZRI(:,:,:)+ZW2(:,:,:)
- ZRV(:,:,:)=ZRV(:,:,:)-(ZW1(:,:,:)+ZW2(:,:,:))
- ZT(:,:,:) = ZT(:,:,:) + &
- (ZW1 * ZLV(:,:,:) + ZW2 * ZLS(:,:,:)) / ZCPH(:,:,:)
- ENDIF
-ENDIF
+ PRVS(JIJ,JK) = PRVS(JIJ,JK) - ZW2
+ PRIS(JIJ,JK) = PRIS(JIJ,JK) + ZW2
+ PTHS(JIJ,JK) = PTHS(JIJ,JK) + &
+ ZW2 * ZLS(JIJ,JK) / (ZCPH(JIJ,JK) * PEXNREF(JIJ,JK))
+ ENDDO
+ !
+ !* 5.2 compute the cloud fraction PCLDFR
+ !
+ IF ( .NOT. TURBN%LSUBG_COND ) THEN
+ DO JIJ=IIJB,IIJE
+ IF (PRCS(JIJ,JK) + PRIS(JIJ,JK) > 1.E-12 / PTSTEP) THEN
+ PCLDFR(JIJ,JK) = 1.
+ ELSE
+ PCLDFR(JIJ,JK) = 0.
+ ENDIF
+ IF (OCOMPUTE_SRC) THEN
+ PSRCS(JIJ,JK) = PCLDFR(JIJ,JK)
+ END IF
+ ENDDO
+ ELSE !TURBN%LSUBG_COND case
+ DO JIJ=IIJB,IIJE
+ !We limit PRC_MF+PRI_MF to PRVS*PTSTEP to avoid negative humidity
+ ZW1=PRC_MF(JIJ,JK)/PTSTEP
+ ZW2=PRI_MF(JIJ,JK)/PTSTEP
+ IF(ZW1+ZW2>PRVS(JIJ,JK)) THEN
+ ZW1=ZW1*PRVS(JIJ,JK)/(ZW1+ZW2)
+ ZW2=PRVS(JIJ,JK)-ZW1
+ ENDIF
+ PCLDFR(JIJ,JK)=MIN(1.,PCLDFR(JIJ,JK)+PCF_MF(JIJ,JK))
+ PRCS(JIJ,JK)=PRCS(JIJ,JK)+ZW1
+ PRIS(JIJ,JK)=PRIS(JIJ,JK)+ZW2
+ PRVS(JIJ,JK)=PRVS(JIJ,JK)-(ZW1+ZW2)
+ PTHS(JIJ,JK) = PTHS(JIJ,JK) + &
+ (ZW1 * ZLV(JIJ,JK) + ZW2 * ZLS(JIJ,JK)) / ZCPH(JIJ,JK) / PEXNREF(JIJ,JK)
+ !
+ IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
+ ZCRIAUT=ICEP%XCRIAUTC/PRHODREF(JIJ,JK)
+ IF(TURBN%CSUBG_MF_PDF=='NONE')THEN
+ IF(ZW1*PTSTEP>PCF_MF(JIJ,JK) * ZCRIAUT) THEN
+ PHLC_HRC(JIJ,JK)=PHLC_HRC(JIJ,JK)+ZW1*PTSTEP
+ PHLC_HCF(JIJ,JK)=MIN(1.,PHLC_HCF(JIJ,JK)+PCF_MF(JIJ,JK))
+ ENDIF
+ ELSEIF(TURBN%CSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ IF(ZW1*PTSTEP>PCF_MF(JIJ,JK)*ZCRIAUT) THEN
+ ZHCF=1.-.5*(ZCRIAUT*PCF_MF(JIJ,JK) / MAX(1.E-20, ZW1*PTSTEP))**2
+ ZHR=ZW1*PTSTEP-(ZCRIAUT*PCF_MF(JIJ,JK))**3 / &
+ &(3*MAX(1.E-20, ZW1*PTSTEP)**2)
+ ELSEIF(2.*ZW1*PTSTEP<=PCF_MF(JIJ,JK) * ZCRIAUT) THEN
+ ZHCF=0.
+ ZHR=0.
+ ELSE
+ ZHCF=(2.*ZW1*PTSTEP-ZCRIAUT*PCF_MF(JIJ,JK))**2 / &
+ &(2.*MAX(1.E-20, ZW1*PTSTEP)**2)
+ ZHR=(4.*(ZW1*PTSTEP)**3-3.*ZW1*PTSTEP*(ZCRIAUT*PCF_MF(JIJ,JK))**2+&
+ (ZCRIAUT*PCF_MF(JIJ,JK))**3) / &
+ &(3*MAX(1.E-20, ZW1*PTSTEP)**2)
+ ENDIF
+ ZHCF=ZHCF*PCF_MF(JIJ,JK) !to retrieve the part of the grid cell
+ PHLC_HCF(JIJ,JK)=MIN(1.,PHLC_HCF(JIJ,JK)+ZHCF) !total part of the grid cell that is precipitating
+ PHLC_HRC(JIJ,JK)=PHLC_HRC(JIJ,JK)+ZHR
+ ENDIF
+ ENDIF
+ IF(PRESENT(PHLI_HRI) .AND. PRESENT(PHLI_HCF)) THEN
+ ZCRIAUT=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(ZT(JIJ,JK)-CST%XTT)+ICEP%XBCRIAUTI))
+ IF(TURBN%CSUBG_MF_PDF=='NONE')THEN
+ IF(ZW2*PTSTEP>PCF_MF(JIJ,JK) * ZCRIAUT) THEN
+ PHLI_HRI(JIJ,JK)=PHLI_HRI(JIJ,JK)+ZW2*PTSTEP
+ PHLI_HCF(JIJ,JK)=MIN(1.,PHLI_HCF(JIJ,JK)+PCF_MF(JIJ,JK))
+ ENDIF
+ ELSEIF(TURBN%CSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ IF(ZW2*PTSTEP>PCF_MF(JIJ,JK)*ZCRIAUT) THEN
+ ZHCF=1.-.5*(ZCRIAUT*PCF_MF(JIJ,JK) / (ZW2*PTSTEP))**2
+ ZHR=ZW2*PTSTEP-(ZCRIAUT*PCF_MF(JIJ,JK))**3/(3*(ZW2*PTSTEP)**2)
+ ELSEIF(2.*ZW2*PTSTEP<=PCF_MF(JIJ,JK) * ZCRIAUT) THEN
+ ZHCF=0.
+ ZHR=0.
+ ELSE
+ ZHCF=(2.*ZW2*PTSTEP-ZCRIAUT*PCF_MF(JIJ,JK))**2 / (2.*(ZW2*PTSTEP)**2)
+ ZHR=(4.*(ZW2*PTSTEP)**3-3.*ZW2*PTSTEP*(ZCRIAUT*PCF_MF(JIJ,JK))**2+&
+ (ZCRIAUT*PCF_MF(JIJ,JK))**3)/(3*(ZW2*PTSTEP)**2)
+ ENDIF
+ ZHCF=ZHCF*PCF_MF(JIJ,JK) !to retrieve the part of the grid cell
+ PHLI_HCF(JIJ,JK)=MIN(1.,PHLI_HCF(JIJ,JK)+ZHCF) !total part of the grid cell that is precipitating
+ PHLI_HRI(JIJ,JK)=PHLI_HRI(JIJ,JK)+ZHR
+ ENDIF
+ ENDIF
+ ENDDO
+ !
+ IF(PRESENT(POUT_RV) .OR. PRESENT(POUT_RC) .OR. &
+ &PRESENT(POUT_RI) .OR. PRESENT(POUT_TH)) THEN
+ DO JIJ=IIJB,IIJE
+ ZW1=PRC_MF(JIJ,JK)
+ ZW2=PRI_MF(JIJ,JK)
+ IF(ZW1+ZW2>ZRV(JIJ,JK)) THEN
+ ZW1=ZW1*ZRV(JIJ,JK)/(ZW1+ZW2)
+ ZW2=ZRV(JIJ,JK)-ZW1
+ ENDIF
+ ZRC(JIJ,JK)=ZRC(JIJ,JK)+ZW1
+ ZRI(JIJ,JK)=ZRI(JIJ,JK)+ZW2
+ ZRV(JIJ,JK)=ZRV(JIJ,JK)-(ZW1+ZW2)
+ ZT(JIJ,JK) = ZT(JIJ,JK) + &
+ (ZW1 * ZLV(JIJ,JK) + ZW2 * ZLS(JIJ,JK)) / ZCPH(JIJ,JK)
+ ENDDO
+ ENDIF
+ ENDIF !TURBN%LSUBG_COND
+ENDDO
!
IF(PRESENT(POUT_RV)) POUT_RV=ZRV
IF(PRESENT(POUT_RC)) POUT_RC=ZRC
IF(PRESENT(POUT_RI)) POUT_RI=ZRI
-IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
+IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:)
!
!
!* 6. STORE THE BUDGET TERMS
! ----------------------
!
-if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
-
+IF(BUCONF%LBUDGET_TH) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), TRIM(HBUNAME), PTHS(:, :)*PRHODJ(:, :))
+IF(BUCONF%LBUDGET_RV) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), TRIM(HBUNAME), PRVS(:, :)*PRHODJ(:, :))
+IF(BUCONF%LBUDGET_RC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), TRIM(HBUNAME), PRCS(:, :)*PRHODJ(:, :))
+IF(BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), TRIM(HBUNAME), PRIS(:, :)*PRHODJ(:, :))
!------------------------------------------------------------------------------
!
!
+IF (LHOOK) CALL DR_HOOK('ICE_ADJUST',1,ZHOOK_HANDLE)
+!
+CONTAINS
+SUBROUTINE ITERATION(PRV_IN,PRC_IN,PRI_IN,PRV_OUT,PRC_OUT,PRI_OUT)
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRV_IN ! Water vapor m.r. to adjust in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC_IN ! Cloud water m.r. to adjust in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRI_IN ! Cloud ice m.r. to adjust in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRV_OUT ! Water vapor m.r. to adjust in output
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRC_OUT ! Cloud water m.r. to adjust in output
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRI_OUT ! Cloud ice m.r. to adjust in output
+!
+!* 2.4 compute the specific heat for moist air (Cph) at t+1
+DO JK=IKTB,IKTE
+ DO JIJ=IIJB,IIJE
+ SELECT CASE(KRR)
+ CASE(7)
+ ZCPH(JIJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JIJ,JK) &
+ + CST%XCL * (PRC_IN(JIJ,JK) + PRR(JIJ,JK)) &
+ + CST%XCI * (PRI_IN(JIJ,JK) + PRS(JIJ,JK) + PRG(JIJ,JK) + PRH(JIJ,JK))
+ CASE(6)
+ ZCPH(JIJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JIJ,JK) &
+ + CST%XCL * (PRC_IN(JIJ,JK) + PRR(JIJ,JK)) &
+ + CST%XCI * (PRI_IN(JIJ,JK) + PRS(JIJ,JK) + PRG(JIJ,JK))
+ CASE(5)
+ ZCPH(JIJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JIJ,JK) &
+ + CST%XCL * (PRC_IN(JIJ,JK) + PRR(JIJ,JK)) &
+ + CST%XCI * (PRI_IN(JIJ,JK) + PRS(JIJ,JK))
+ CASE(3)
+ ZCPH(JIJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JIJ,JK) &
+ + CST%XCL * (PRC_IN(JIJ,JK) + PRR(JIJ,JK))
+ CASE(2)
+ ZCPH(JIJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JIJ,JK) &
+ + CST%XCL * PRC_IN(JIJ,JK)
+ END SELECT
+ ENDDO
+ENDDO
+!
+IF ( TURBN%LSUBG_COND ) THEN
+ !
+ !* 3. SUBGRID CONDENSATION SCHEME
+ ! ---------------------------
+ !
+ ! PSRC= s'rci'/Sigma_s^2
+ ! ZT is INOUT
+ CALL CONDENSATION(D, CST, ICEP, NEB, TURBN, &
+ HFRAC_ICE,TURBN%CCONDENS, TURBN%CLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, PRV_IN, PRV_OUT, PRC_IN, PRC_OUT, PRI_IN, PRI_OUT, &
+ PRR, PRS, PRG, PSIGS, LMFCONV, PMFCONV, PCLDFR, &
+ PSRCS, .TRUE., TURBN%LSIGMAS,OCND2, LHGT_QS, &
+ PICLDFR, PWCLDFR, PSSIO, PSSIU, PIFR, PSIGQSAT, &
+ PLV=ZLV, PLS=ZLS, PCPH=ZCPH, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF,&
+ PICE_CLD_WGT=PICE_CLD_WGT)
+ELSE
+ !
+ !* 4. ALL OR NOTHING CONDENSATION SCHEME
+ ! FOR MIXED-PHASE CLOUD
+ ! -----------------------------------------------
+ !
+ ZSIGS(:,:)=0.
+ ZSIGQSAT(:)=0.
+ !We use ZSRCS because in Méso-NH, PSRCS can be a zero-length array in this case
+ !ZT is INOUT
+ CALL CONDENSATION(D, CST, ICEP, NEB, TURBN, &
+ HFRAC_ICE,TURBN%CCONDENS, TURBN%CLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, PRV_IN, PRV_OUT, PRC_IN, PRC_OUT, PRI_IN, PRI_OUT, &
+ PRR, PRS, PRG, ZSIGS, LMFCONV, PMFCONV, PCLDFR, &
+ ZSRCS, .TRUE., .TRUE., OCND2, LHGT_QS, &
+ PICLDFR, PWCLDFR, PSSIO, PSSIU, PIFR, ZSIGQSAT, &
+ PLV=ZLV, PLS=ZLS, PCPH=ZCPH, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF,&
+ PICE_CLD_WGT=PICE_CLD_WGT)
+ENDIF
+
+END SUBROUTINE ITERATION
+
END SUBROUTINE ICE_ADJUST
diff --git a/src/PHYEX/micro/ice_adjust_elec.f90 b/src/PHYEX/micro/ice_adjust_elec.f90
index 2aa614e7c1c9fa35ba8f9abf82bcef8fec468f94..5c8b704f97fc191e0dee9ec7d03e64b094a127af 100644
--- a/src/PHYEX/micro/ice_adjust_elec.f90
+++ b/src/PHYEX/micro/ice_adjust_elec.f90
@@ -173,9 +173,14 @@ USE MODD_ELEC_DESCR, ONLY : XRTMIN_ELEC, XQTMIN, XFC, XFI, XECHARGE
USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
USE MODD_PARAMETERS
USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN, XBI
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM
+USE MODD_NEB, ONLY: NEB
+USE MODD_TURB_n, ONLY: TURBN
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools_ll, only: GET_INDICE_ll
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
USE MODI_CONDENSATION
USE MODI_GET_HALO
@@ -263,6 +268,7 @@ REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
ZLV, & ! guess of the Lv at t+1
ZLS, & ! guess of the Ls at t+1
ZW1,ZW2,ZW3,ZW4,ZW5,ZW6,ZW7,& ! Work arrays for intermediate fields
+ ZW1_IN, ZW2_IN, ZW3_IN, ZDUM, &
ZCND ! CND=(T-T00)/(T0-T00) cf sc doc and TAO etal (89)
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: ZWE1, &
@@ -273,7 +279,8 @@ REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
ZADD ! ratio (0 or 1) of ZION_NUMBER
! to add to positive
! or negative ion number
-!
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2)) :: ZSIGQSAT2D
+ !
INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
@@ -283,6 +290,8 @@ INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
!
LOGICAL :: LPRETREATMENT, LNEW_ADJUST
!
+TYPE(DIMPHYEX_t) :: D
+!
!-------------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
@@ -294,6 +303,7 @@ IKU = SIZE(PEXNREF,3)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = IKU - JPVEXT
+CALL FILL_DIMPHYEX(D, IIU, IJU, IKU)
!
ZEPS = XMV / XMD
!
@@ -368,14 +378,20 @@ DO JITER = 1, ITERMAX
!
!* 3.1 compute condensate, cloud fraction
!
- ! ZW3=water vapor ZW1=rc (INOUT) ZW2=ri (INOUT) PSRC= s'rci'/Sigma_s^2
- ZW3 = PRVS * PTSTEP; ZW1 = PRCS * PTSTEP; ZW2 = PRIS * PTSTEP
+ ! ZW3=water vapor ZW1=rc (OUT) ZW2=ri (OUT) PSRC= s'rci'/Sigma_s^2
+ ! ZW3_IN/ZW2_IN/ZW1_IN (IN)
+ ZW3_IN = PRVS * PTSTEP; ZW1_IN = PRCS * PTSTEP; ZW2_IN = PRIS * PTSTEP
+ ZW3=ZW3_IN; ZW2=ZW2_IN; ZW1=ZW1_IN
+ ZSIGQSAT2D(:,:)=PSIGQSAT
ZW4 = 1. ! PRODREF is not used if HL variables are not present
!
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, 'T', 'CB02', 'CB', &
- PPABST, PZZ, ZW4, ZT, ZW3, ZW1, ZW2, PRSS*PTSTEP, PRGS*PTSTEP, &
- PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., &
- OSIGMAS, PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ CALL CONDENSATION(D, CST, RAIN_ICE_PARAM, NEB, TURBN, &
+ &'T', 'CB02', 'CB', &
+ &PPABST, PZZ, ZW4, ZT, ZW3_IN, ZW3, ZW1_IN, ZW1, ZW2_IN, ZW2, &
+ &PRRS*PTSTEP, PRSS*PTSTEP, PRGS*PTSTEP, PSIGS, .FALSE., PMFCONV, PCLDFR, PSRCS, .FALSE., &
+ &OSIGMAS, .FALSE., .FALSE., &
+ &ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, ZSIGQSAT2D, &
+ &ZLV, ZLS, ZCPH)
!
!* 3.2 compute the variation of mixing ratio
!
diff --git a/src/PHYEX/micro/ini_ice_c1r3.f90 b/src/PHYEX/micro/ini_ice_c1r3.f90
index b9117305dff2e766cefbfc7c30c7572f111c97b2..3c4c6e266751e09f8aa78e26667b9c3d77ce2bf4 100644
--- a/src/PHYEX/micro/ini_ice_c1r3.f90
+++ b/src/PHYEX/micro/ini_ice_c1r3.f90
@@ -114,12 +114,12 @@ USE MODD_RAIN_ICE_DESCR, ONLY : XFVELOS
!
USE MODI_GAMMA
USE MODI_GAMMA_INC
-USE MODI_READ_XKER_RACCS
-USE MODI_READ_XKER_RDRYG
-USE MODI_READ_XKER_SDRYG
-USE MODI_RRCOLSS
-USE MODI_RSCOLRG
-USE MODI_RZCOLX
+USE MODE_READ_XKER_RACCS, ONLY: READ_XKER_RACCS
+USE MODE_READ_XKER_RDRYG, ONLY: READ_XKER_RDRYG
+USE MODE_READ_XKER_SDRYG, ONLY: READ_XKER_SDRYG
+USE MODE_RRCOLSS, ONLY: RRCOLSS
+USE MODE_RSCOLRG, ONLY: RSCOLRG
+USE MODE_RZCOLX, ONLY: RZCOLX
!
!
IMPLICIT NONE
diff --git a/src/PHYEX/micro/ini_lima_cold_mixed.f90 b/src/PHYEX/micro/ini_lima_cold_mixed.f90
index d757a9fd64c5244858a855aac1d7f6afb17e7f20..c06c292124caf83cf1a3854f60f0b4eb44d5f95a 100644
--- a/src/PHYEX/micro/ini_lima_cold_mixed.f90
+++ b/src/PHYEX/micro/ini_lima_cold_mixed.f90
@@ -65,11 +65,11 @@ use mode_msg
USE MODI_LIMA_FUNCTIONS
USE MODI_GAMMA
USE MODI_GAMMA_INC
-USE MODI_RRCOLSS
+USE MODE_RRCOLSS, ONLY: RRCOLSS
+USE MODE_RZCOLX, ONLY: RZCOLX
+USE MODE_RSCOLRG, ONLY: RSCOLRG
USE MODI_NRCOLSS
-USE MODI_RZCOLX
USE MODI_NZCOLX
-USE MODI_RSCOLRG
USE MODI_NSCOLRG
USE MODI_LIMA_READ_XKER_RACCS
USE MODI_LIMA_READ_XKER_SDRYG
diff --git a/src/PHYEX/micro/ini_neb.f90 b/src/PHYEX/micro/ini_neb.f90
index 6cb0efab69e3f7011d4f08a9e9abfa43ed6be5d2..0a36664e96fdd44e8fd287d9bd48bb39af288a15 100644
--- a/src/PHYEX/micro/ini_neb.f90
+++ b/src/PHYEX/micro/ini_neb.f90
@@ -2,18 +2,6 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! ######spl
- MODULE MODI_INI_NEB
-! #####################
-!
-INTERFACE
-!
-SUBROUTINE INI_NEB
-END SUBROUTINE INI_NEB
-!
-END INTERFACE
-!
-END MODULE MODI_INI_NEB
! ######spl
SUBROUTINE INI_NEB
! #######################
@@ -65,6 +53,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! 1. SETTING THE NUMERICAL VALUES
!
IF (LHOOK) CALL DR_HOOK('INI_NEB',0,ZHOOK_HANDLE)
+!
+CALL NEB_ASSOCIATE()
+!
!Freezing between 0 and -20. Other possibilities are 0/-40 or -5/-25
XTMAXMIX = 273.16
XTMINMIX = 253.16
diff --git a/src/PHYEX/micro/ini_param_elec.f90 b/src/PHYEX/micro/ini_param_elec.f90
index 02a8b1578cfe2608304c04ccd8d8ebff6fd9025d..4b889da2e9ea859f05d5d6303ac3778b0161ca32 100644
--- a/src/PHYEX/micro/ini_param_elec.f90
+++ b/src/PHYEX/micro/ini_param_elec.f90
@@ -107,9 +107,9 @@ USE MODD_VAR_ll
USE MODE_IO_FIELD_READ, only: IO_Field_read
!
USE MODI_MOMG
-USE MODI_RRCOLSS
-USE MODI_RSCOLRG
-USE MODI_RZCOLX
+USE MODE_RRCOLSS, ONLY: RRCOLSS
+USE MODE_RSCOLRG, ONLY: RSCOLRG
+USE MODE_RZCOLX, ONLY: RZCOLX
USE MODI_VQZCOLX
!
IMPLICIT NONE
diff --git a/src/PHYEX/micro/ini_rain_ice.f90 b/src/PHYEX/micro/ini_rain_ice.f90
index c20b57f38a29c7031fedf1993b1572b0ef04e307..38f8fed026c66cf7102942d0cb5d9ed0d25fc317 100644
--- a/src/PHYEX/micro/ini_rain_ice.f90
+++ b/src/PHYEX/micro/ini_rain_ice.f90
@@ -3,29 +3,6 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_INI_RAIN_ICE
-! ########################
-!
-INTERFACE
- SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
-!
-INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
-INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
- ! integration for rain
- ! sedimendation
-!
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-!
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
-!
-END SUBROUTINE INI_RAIN_ICE
-!
-END INTERFACE
-!
-END MODULE MODI_INI_RAIN_ICE
! ######spl
SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
! ###########################################################
@@ -119,15 +96,18 @@ USE MODD_REF
!
USE MODI_GAMMA
USE MODI_GAMMA_INC
-USE MODI_RRCOLSS
-USE MODI_RZCOLX
-USE MODI_RSCOLRG
-USE MODI_READ_XKER_RACCS
-USE MODI_READ_XKER_SDRYG
-USE MODI_READ_XKER_RDRYG
-USE MODI_READ_XKER_SWETH
-USE MODI_READ_XKER_GWETH
-USE MODI_READ_XKER_RWETH
+USE MODE_RRCOLSS, ONLY: RRCOLSS
+USE MODE_RZCOLX, ONLY: RZCOLX
+USE MODE_RSCOLRG, ONLY: RSCOLRG
+USE MODE_READ_XKER_RACCS, ONLY: READ_XKER_RACCS
+USE MODE_READ_XKER_SDRYG, ONLY: READ_XKER_SDRYG
+USE MODE_READ_XKER_RDRYG, ONLY: READ_XKER_RDRYG
+USE MODE_READ_XKER_SWETH, ONLY: READ_XKER_SWETH
+USE MODE_READ_XKER_GWETH, ONLY: READ_XKER_GWETH
+USE MODE_READ_XKER_RWETH, ONLY: READ_XKER_RWETH
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
@@ -192,7 +172,13 @@ REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN
REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN
REAL :: PWETLBDAS_MAX,PWETLBDAG_MAX,PWETLBDAS_MIN,PWETLBDAG_MIN
REAL :: PWETLBDAR_MAX,PWETLBDAH_MAX,PWETLBDAR_MIN,PWETLBDAH_MIN
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
+!
+IF(.NOT.ASSOCIATED(XCEXVT)) CALL RAIN_ICE_DESCR_ASSOCIATE()
+IF(.NOT.ASSOCIATED(XFSEDC)) CALL RAIN_ICE_PARAM_ASSOCIATE()
!
!
!* 0. FUNCTION STATEMENTS
@@ -213,7 +199,7 @@ IF (CSEDIM == 'SPLI' .AND. .NOT. LRED ) THEN
ZVTRMAX = 40.
ELSE IF (HCLOUD == 'ICE3') THEN
ZVTRMAX = 10.
- END IF
+ END IF
END IF
!
!* 1.2 Compute the number of small time step integration
@@ -227,13 +213,27 @@ IF (CSEDIM == 'SPLI' .AND. .NOT. LRED ) THEN
END DO SPLIT
END IF
!
-IF (ALLOCATED(XRTMIN)) THEN ! In case of nesting microphysics constants of
+IF (ASSOCIATED(XRTMIN)) THEN ! In case of nesting microphysics constants of
! MODD_RAIN_ICE_PARAM are computed only once,
! but if INI_RAIN_ICE has been called already
! one must change the XRTMIN size.
- DEALLOCATE(XRTMIN)
+ CALL RAIN_ICE_DESCR_DEALLOCATE()
END IF
!
+IF (HCLOUD == 'ICE4') THEN
+ CALL RAIN_ICE_DESCR_ALLOCATE(7)
+ELSE IF (HCLOUD == 'ICE3') THEN
+ CALL RAIN_ICE_DESCR_ALLOCATE(6)
+END IF
+!
+XRTMIN(1) = 1.0E-20
+XRTMIN(2) = 1.0E-20
+XRTMIN(3) = 1.0E-20
+XRTMIN(4) = 1.0E-20
+XRTMIN(5) = 1.0E-15
+XRTMIN(6) = 1.0E-15
+IF (HCLOUD == 'ICE4') XRTMIN(7) = 1.0E-15
+!
!-------------------------------------------------------------------------------
!
!* 2. CHARACTERISTICS OF THE SPECIES
@@ -299,23 +299,23 @@ XF2I = 0.14
XAS = 0.02
XBS = 1.9
IF (LSNOW_T) THEN
-!Cas Gamma generalisee
-XCS = 11.52
-XDS = 0.39
-XFVELOS =0.097
-!Cas MP
-!XCS = 13.2
-!XDS = 0.423
-!XFVELOS = 25.14
+ !Cas Gamma generalisee
+ XCS = 11.52
+ XDS = 0.39
+ XFVELOS =0.097
+ !Cas MP
+ !XCS = 13.2
+ !XDS = 0.423
+ !XFVELOS = 25.14
ELSE
-XCS = 5.
-XDS = 0.27
-XFVELOS = 0.
+ XCS = 5.1
+ XDS = 0.27
+ XFVELOS = 0.
END IF
!
IF (.NOT. LSNOW_T) THEN
-XCCS = 5.0
-XCXS = 1.0
+ XCCS = 5.0
+ XCXS = 1.0
END IF
!
XF0S = 0.86
@@ -424,7 +424,10 @@ XLBR = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR)
XLBEXI = 1.0/(-XBI)
XLBI = ( XAI*MOMG(XALPHAI,XNUI,XBI) )**(-XLBEXI)
!
+#if defined(REPRO48) || defined(REPRO55)
+#else
XNS = 1.0/(XAS*MOMG(XALPHAS,XNUS,XBS))
+#endif
XLBEXS = 1.0/(XCXS-XBS)
XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
!
@@ -439,22 +442,12 @@ XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH)
XLBDAS_MAX = 100000.0
!
ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
+#if defined(REPRO48) || defined(REPRO55)
+IF(XCCS>0. .AND. XCXS>0. )XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS)
+#else
XLBDAS_MAX = 1.E6
XLBDAS_MIN = 1000.
-!
-IF (HCLOUD == 'ICE4') THEN
- ALLOCATE( XRTMIN(7) )
-ELSE IF (HCLOUD == 'ICE3') THEN
- ALLOCATE( XRTMIN(6) )
-END IF
-!
-XRTMIN(1) = 1.0E-20
-XRTMIN(2) = 1.0E-20
-XRTMIN(3) = 1.0E-20
-XRTMIN(4) = 1.0E-20
-XRTMIN(5) = 1.0E-15
-XRTMIN(6) = 1.0E-15
-IF (HCLOUD == 'ICE4') XRTMIN(7) = 1.0E-15
+#endif
!
XCONC_SEA=1E8 ! 100/cm3
XCONC_LAND=3E8 ! 300/cm3
@@ -507,6 +500,11 @@ XEXCSEDI =-0.9324*3.0
WRITE (KLUOUT,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI =',XFSEDI
!
!
+#if defined(REPRO48) || defined(REPRO55)
+XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
+XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
+ (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
+#else
IF (LRED) THEN
XEXSEDS = -XDS-XBS
XFSEDS = XCS*MOMG(XALPHAS,XNUS,XBS+XDS)/(MOMG(XALPHAS,XNUS,XBS)) &
@@ -516,6 +514,7 @@ ELSE
XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
(XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
END IF
+#endif
!
XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG)
XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* &
@@ -588,20 +587,37 @@ XSCFAC = (0.63**(1./3.))*SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63
X0DEPI = (4.0*XPI)*XC1I*XF0I*MOMG(XALPHAI,XNUI,1.)
X2DEPI = (4.0*XPI)*XC1I*XF2I*XC_I*MOMG(XALPHAI,XNUI,XDI+2.0)
!
+#if defined(REPRO48) || defined(REPRO55)
+X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.)
+X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
+XEX0DEPS = XCXS-1.0
+XEX1DEPS = XCXS-0.5*(XDS+3.0)
+XRDEPSRED = 1.0
+#else
X0DEPS = XNS*(4.0*XPI)*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.)
X1DEPS = XNS*(4.0*XPI)*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
XEX0DEPS = -1.0
XEX1DEPS = -0.5*(XDS+3.0)
+#endif
!
X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.)
X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5)
XEX0DEPG = XCXG-1.0
XEX1DEPG = XCXG-0.5*(XDG+3.0)
+XRDEPGRED = 1.0
!
X0DEPH = (4.0*XPI)*XCCH*XC1H*XF0H*MOMG(XALPHAH,XNUH,1.)
X1DEPH = (4.0*XPI)*XCCH*XC1H*XF1H*SQRT(XCH)*MOMG(XALPHAH,XNUH,0.5*XDH+1.5)
XEX0DEPH = XCXH-1.0
XEX1DEPH = XCXH-0.5*(XDH+3.0)
+
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=KLUOUT,FMT='(" factors sublimation snow/groupel")')
+ WRITE(UNIT=KLUOUT,FMT='(" mod sublim snow =",E13.6)') XRDEPSRED
+ WRITE(UNIT=KLUOUT,FMT='(" mod sublim graupel =",E13.6)') XRDEPGRED
+END IF
+
!
!* 5.3 Constants for pristine ice autoconversion
!
@@ -631,8 +647,13 @@ END IF
!
XCOLIS = 0.25 ! Collection efficiency of I+S
XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency
+#if defined(REPRO48) || defined(REPRO55)
+XFIAGGS = (XPI/4.0)*XCOLIS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXIAGGS = XCXS-XDS-2.0
+#else
XFIAGGS = XNS*(XPI/4.0)*XCOLIS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
XEXIAGGS = -XDS - 2.0 ! GAMMGEN LH_EXTENDED
+#endif
!
GFLAG = .TRUE.
IF (GFLAG) THEN
@@ -683,15 +704,28 @@ XEX1EVAR = -1.0-0.5*(XDR+3.0)
!
XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989)
XCOLCS = 1.0
+#if defined(REPRO48) || defined(REPRO55)
+XEXCRIMSS= XCXS-XDS-2.0
+XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+#else
XEXCRIMSS= -XDS-2.0
XCRIMSS = XNS * (XPI/4.0)*XCOLCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+#endif
XEXCRIMSG= XEXCRIMSS
XCRIMSG = XCRIMSS
+#if defined(REPRO48) || defined(REPRO55)
+XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS)
+XEXSRIMCG= XCXS-XBS
+XSRIMCG2 = XCCS*XAG*MOMG(XALPHAS,XNUS,XBG)
+XSRIMCG3 = XFRACM90
+XEXSRIMCG2=XCXS-XBG
+#else
XSRIMCG = XNS*XAS*MOMG(XALPHAS,XNUS,XBS)
XEXSRIMCG = -XBS
XSRIMCG2 = XNS*XAG*MOMG(XALPHAS,XNUS,XBG)
XSRIMCG3 = XFRACM90
XEXSRIMCG2=XBS-XBG
+#endif
!
GFLAG = .TRUE.
IF (GFLAG) THEN
@@ -705,9 +739,9 @@ XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
!
-IF( .NOT.ALLOCATED(XGAMINC_RIM1) ) ALLOCATE( XGAMINC_RIM1(NGAMINC) )
-IF( .NOT.ALLOCATED(XGAMINC_RIM2) ) ALLOCATE( XGAMINC_RIM2(NGAMINC) )
-IF( .NOT.ALLOCATED(XGAMINC_RIM4) ) ALLOCATE( XGAMINC_RIM4(NGAMINC) )
+IF( .NOT.ASSOCIATED(XGAMINC_RIM1) ) CALL RAIN_ICE_PARAM_ALLOCATE('XGAMINC_RIM1', NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM2) ) CALL RAIN_ICE_PARAM_ALLOCATE('XGAMINC_RIM2', NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM4) ) CALL RAIN_ICE_PARAM_ALLOCATE('XGAMINC_RIM4', NGAMINC)
!
DO J1=1,NGAMINC
ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
@@ -721,13 +755,21 @@ XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) )
!
!* 7.2 Constants for the accretion of raindrops onto aggregates
!
+#if defined(REPRO48) || defined(REPRO55)
+XFRACCSS = ((XPI**2)/24.0)*XCCS*XCCR*XRHOLW*(ZRHO00**XCEXVT)
+#else
XFRACCSS = XNS*((XPI**2)/24.0)*XCCR*XRHOLW*(ZRHO00**XCEXVT)
+#endif
!
XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.)
XLBRACCS2 = 2.*MOMG(XALPHAS,XNUS,1.)*MOMG(XALPHAR,XNUR,4.)
XLBRACCS3 = MOMG(XALPHAR,XNUR,5.)
!
+#if defined(REPRO48) || defined(REPRO55)
+XFSACCRG = (XPI/4.0)*XAS*XCCS*XCCR*(ZRHO00**XCEXVT)
+#else
XFSACCRG = XNS*(XPI/4.0)*XAS*XCCR*(ZRHO00**XCEXVT)
+#endif
!
XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS)
XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
@@ -757,9 +799,9 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZESR = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
!
-IF( .NOT.ALLOCATED(XKER_RACCSS) ) ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_RACCS ) ) ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_SACCRG) ) ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_RACCSS) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RACCSS', NACCLBDAS,NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_RACCS ) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RACCS', NACCLBDAS,NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_SACCRG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SACCRG', NACCLBDAR,NACCLBDAS)
!
CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
@@ -920,7 +962,11 @@ XCOLSG = 0.01 ! Collection efficiency of S+G
XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
WRITE (KLUOUT, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
WRITE (KLUOUT, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
+#if defined(REPRO48) || defined(REPRO55)
+XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT)
+#else
XFSDRYG = XNS*(XPI/4.0)*XCOLSG*XCCG*XAS*(ZRHO00**XCEXVT)
+#endif
!
XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS)
XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
@@ -968,7 +1014,7 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
!
-IF( .NOT.ALLOCATED(XKER_SDRYG) ) ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SDRYG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SDRYG', NDRYLBDAG,NDRYLBDAS)
!
CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
@@ -1035,7 +1081,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_RDRYG) ) ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+IF( .NOT.ASSOCIATED(XKER_RDRYG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RDRYG', NDRYLBDAG,NDRYLBDAR)
!
CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
@@ -1095,6 +1141,26 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
PFDINFTY,XKER_RDRYG )
WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RDRYG")')
END IF
+
+! 8.2.6 Constants for possible modifying some processes related to
+! graupeln in XFRMIN(1:8), IN - concentration in XFRMIN(9) and Kogan
+! autoconversion in XFRMIN(10:11). May be used for e.g. ensemble spread
+ XFRMIN(1:6)=0.
+ XFRMIN(7:9)=1.
+ XFRMIN(10) =10.
+ XFRMIN(11) =1.
+ XFRMIN(12) =100. !0 in suparar
+ XFRMIN(13) =1.0E-15
+ XFRMIN(14) =120.
+ XFRMIN(15) =1.0E-4
+ XFRMIN(16:20)=0.
+ XFRMIN(21:22)=1.
+ XFRMIN(23)=0.5
+ XFRMIN(24)=1.5
+ XFRMIN(25)=30.
+ XFRMIN(26:38)=0.
+ XFRMIN(39)=0.25
+ XFRMIN(40)=0.15
!
!
!-------------------------------------------------------------------------------
@@ -1116,8 +1182,11 @@ XFWETH = (XPI/4.0)*XCCH*XCH*(ZRHO00**XCEXVT)*MOMG(XALPHAH,XNUH,XDH+2.0)
!
XCOLSH = 0.01 ! Collection efficiency of S+H
XCOLEXSH = 0.1 ! Temperature factor of the S+H collection efficiency
-!XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT)
+#if defined(REPRO48) || defined(REPRO55)
+XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT)
+#else
XFSWETH = XNS*(XPI/4.0)*XCCH*XAS*(ZRHO00**XCEXVT) ! Wurtz
+#endif
!
XLBSWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAS,XNUS,XBS)
XLBSWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
@@ -1174,7 +1243,7 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
!
-IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SWETH', NWETLBDAH,NWETLBDAS)
!
CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
@@ -1241,7 +1310,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+IF( .NOT.ASSOCIATED(XKER_GWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_GWETH', NWETLBDAH,NWETLBDAG)
!
CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
@@ -1307,7 +1376,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEHR = 1.0 ! distributions when computing the kernel XKER_RWETH
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_RWETH) ) ALLOCATE( XKER_RWETH(NWETLBDAH,NWETLBDAR) )
+IF( .NOT.ASSOCIATED(XKER_RWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RWETH', NWETLBDAH,NWETLBDAR)
!
CALL READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
@@ -1413,6 +1482,7 @@ IF (GFLAG) THEN
WRITE(UNIT=KLUOUT,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
XALPHAH,XNUH
END IF
+IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',1,ZHOOK_HANDLE)
CONTAINS
!
!------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/ini_rain_ice_elec.f90 b/src/PHYEX/micro/ini_rain_ice_elec.f90
index 7c1eaf591957ce9b2d99915b2c79d7a1c584c5e9..f926dc064811621ab57deddb76b4bbbbbed435f0 100644
--- a/src/PHYEX/micro/ini_rain_ice_elec.f90
+++ b/src/PHYEX/micro/ini_rain_ice_elec.f90
@@ -106,14 +106,14 @@ USE MODD_ELEC_DESCR, ONLY : XFS
USE MODI_MOMG
USE MODI_GAMMA
USE MODI_GAMMA_INC
-USE MODI_RRCOLSS
-USE MODI_RZCOLX
-USE MODI_RSCOLRG
-USE MODI_READ_XKER_RACCS
-USE MODI_READ_XKER_SDRYG
-USE MODI_READ_XKER_RDRYG
-USE MODI_READ_XKER_SWETH
-USE MODI_READ_XKER_GWETH
+USE MODE_RRCOLSS, ONLY: RRCOLSS
+USE MODE_RZCOLX, ONLY: RZCOLX
+USE MODE_RSCOLRG, ONLY: RSCOLRG
+USE MODE_READ_XKER_RACCS, ONLY: READ_XKER_RACCS
+USE MODE_READ_XKER_SDRYG, ONLY: READ_XKER_SDRYG
+USE MODE_READ_XKER_RDRYG, ONLY: READ_XKER_RDRYG
+USE MODE_READ_XKER_SWETH, ONLY: READ_XKER_SWETH
+USE MODE_READ_XKER_GWETH, ONLY: READ_XKER_GWETH
!
IMPLICIT NONE
!
@@ -164,7 +164,7 @@ REAL :: PALPHAR, PALPHAS, PALPHAG, PALPHAH
REAL :: PNUR, PNUS, PNUG, PNUH
REAL :: PBR, PBS, PBG, PBH
REAL :: PCR, PCS, PCG, PCH
-REAL :: PDR, PDS, PFVELOS, PDG, PDH
+REAL :: PDR, PDS, PDG, PDH
REAL :: PESR, PEGS, PEGR, PEHS, PEHG
REAL :: PACCLBDAS_MAX, PACCLBDAR_MAX, PACCLBDAS_MIN, PACCLBDAR_MIN
REAL :: PDRYLBDAG_MAX, PDRYLBDAS_MAX, PDRYLBDAG_MIN, PDRYLBDAS_MIN
@@ -172,6 +172,9 @@ REAL :: PDRYLBDAR_MAX, PDRYLBDAR_MIN
REAL :: PWETLBDAS_MAX, PWETLBDAG_MAX, PWETLBDAS_MIN, PWETLBDAG_MIN
REAL :: PWETLBDAH_MAX, PWETLBDAH_MIN
!
+IF(.NOT.ASSOCIATED(XCEXVT)) CALL RAIN_ICE_DESCR_ASSOCIATE()
+IF(.NOT.ASSOCIATED(XFSEDC)) CALL RAIN_ICE_PARAM_ASSOCIATE()
+!
!-------------------------------------------------------------------------------
!
!* 0. FUNCTION STATEMENTS
@@ -205,13 +208,27 @@ IF (CSEDIM == 'SPLI') THEN
END DO SPLIT
END IF
!
-IF (ALLOCATED(XRTMIN)) THEN ! In case of nesting microphysics constants of
+IF (ASSOCIATED(XRTMIN)) THEN ! In case of nesting microphysics constants of
! MODD_RAIN_ICE_PARAM are computed only once,
! but if INI_RAIN_ICE has been called already
! one must change the XRTMIN size.
- DEALLOCATE(XRTMIN)
+ CALL RAIN_ICE_DESCR_DEALLOCATE()
END IF
!
+IF (HCLOUD == 'ICE4') THEN
+ CALL RAIN_ICE_DESCR_ALLOCATE(7)
+ELSE IF (HCLOUD == 'ICE3') THEN
+ CALL RAIN_ICE_DESCR_ALLOCATE(6)
+END IF
+!
+XRTMIN(1) = 1.0E-20
+XRTMIN(2) = 1.0E-20
+XRTMIN(3) = 1.0E-20
+XRTMIN(4) = 1.0E-20
+XRTMIN(5) = 1.0E-15
+XRTMIN(6) = 1.0E-15
+IF (HCLOUD == 'ICE4') XRTMIN(7) = 1.0E-15
+!
!-------------------------------------------------------------------------------
!
!* 2. CHARACTERISTICS OF THE SPECIES
@@ -366,8 +383,8 @@ XLBR = (XAR * XCCR * MOMG(XALPHAR,XNUR,XBR))**(-XLBEXR)
XLBEXI = 1.0 / (-XBI)
XLBI = (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XLBEXI)
!
-XLBEXS = 1.0/(XCXS-XBS)
-XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
+XLBEXS = 1.0 / (XCXS - XBS)
+XLBS = (XAS * XCCS * MOMG(XALPHAS,XNUS,XBS))**(-XLBEXS)
!
XLBEXG = 1.0 / (XCXG - XBG)
XLBG = (XAG * XCCG * MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG)
@@ -384,20 +401,6 @@ XLBDAG_MAX = 100000.0
ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
XLBDAS_MAX = (ZCONC_MAX / XCCS)**(1./XCXS)
!
-IF (HCLOUD == 'ICE4') THEN
- ALLOCATE( XRTMIN(7) )
-ELSE IF (HCLOUD == 'ICE3') THEN
- ALLOCATE( XRTMIN(6) )
-END IF
-!
-XRTMIN(1) = 1.0E-20
-XRTMIN(2) = 1.0E-20
-XRTMIN(3) = 1.0E-20
-XRTMIN(4) = 1.0E-20
-XRTMIN(5) = 1.0E-15
-XRTMIN(6) = 1.0E-15
-IF (HCLOUD == 'ICE4') XRTMIN(7) = 1.0E-15
-!
XCONC_SEA = 1.E8 ! 100/cm3
XCONC_LAND = 3.E8 ! 300/cm3
XCONC_URBAN = 5.E8 ! 500/cm3
@@ -442,18 +445,17 @@ XFSEDI = 3.89745E11 * MOMG(XALPHAI,XNUI,3.285) * &
XEXCSEDI =-0.9324 * 3.0
WRITE (KLUOUT,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI =',XFSEDI
!
+XEXSEDS = (XBS + XDS - XCXS) / (XBS - XCXS)
+XFSEDS = XCS * XAS * XCCS * MOMG(XALPHAS,XNUS,XBS+XDS) * &
+ (XAS * XCCS * MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS) * (ZRHO00)**XCEXVT
!
-XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
-XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
- (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
-!
-XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG)
-XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* &
- (XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG)*(ZRHO00)**XCEXVT
+XEXSEDG = (XBG + XDG - XCXG) / (XBG - XCXG)
+XFSEDG = XCG * XAG * XCCG * MOMG(XALPHAG,XNUG,XBG+XDG) * &
+ (XAG * XCCG * MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG) * (ZRHO00)**XCEXVT
!
-XEXSEDH = (XBH+XDH-XCXH)/(XBH-XCXH)
-XFSEDH = XCH*XAH*XCCH*MOMG(XALPHAH,XNUH,XBH+XDH)* &
- (XAH*XCCH*MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH)*(ZRHO00)**XCEXVT
+XEXSEDH = (XBH + XDH - XCXH) / (XBH - XCXH)
+XFSEDH = XCH * XAH * XCCH * MOMG(XALPHAH,XNUH,XBH+XDH) * &
+ (XAH * XCCH * MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH) * (ZRHO00)**XCEXVT
!
!
!-------------------------------------------------------------------------------
@@ -625,9 +627,9 @@ XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
!
-IF( .NOT.ALLOCATED(XGAMINC_RIM1) ) ALLOCATE( XGAMINC_RIM1(NGAMINC) )
-IF( .NOT.ALLOCATED(XGAMINC_RIM2) ) ALLOCATE( XGAMINC_RIM2(NGAMINC) )
-IF( .NOT.ALLOCATED(XGAMINC_RIM3) ) ALLOCATE( XGAMINC_RIM3(NGAMINC) )
+IF( .NOT.ASSOCIATED(XGAMINC_RIM1) ) CALL RAIN_ICE_PARAM_ALLOCATE('XGAMINC_RIM1',NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM2) ) CALL RAIN_ICE_PARAM_ALLOCATE('XGAMINC_RIM2',NGAMINC)
+IF( .NOT.ALLOCATED(XGAMINC_RIM3) ) ALLOCATE(XGAMINC_RIM3(NGAMINC))
!
DO J1 = 1, NGAMINC
ZBOUND = XGAMINC_BOUND_MIN * ZRATE**(J1-1)
@@ -679,12 +681,12 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZESR = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
!
-IF( .NOT.ALLOCATED(XKER_RACCSS) ) ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_RACCS ) ) ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_SACCRG) ) ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_RACCSS) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RACCSS',NACCLBDAS,NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_RACCS ) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RACCS',NACCLBDAS,NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_SACCRG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SACCRG',NACCLBDAR,NACCLBDAS)
!
CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,XFVELOS,PCR,PDR, &
PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
PFDINFTY )
IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
@@ -765,7 +767,7 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("END IF")')
ELSE
CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,XFVELOS,PCR,PDR, &
PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
WRITE(UNIT=KLUOUT,FMT='(" Read XKER_RACCSS")')
@@ -822,7 +824,9 @@ XCOLIG = 0.01 ! Collection efficiency of I+G
XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
WRITE (KLUOUT, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
WRITE (KLUOUT, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
-XFIDRYG = (XPI/4.0)*XCOLIG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+XFIDRYG = (XPI / 4.0) * XCOLIG * XCCG * XCG * (ZRHO00**XCEXVT) * &
+ MOMG(XALPHAG,XNUG,XDG+2.0)
!
GFLAG = .TRUE.
IF (GFLAG) THEN
@@ -890,10 +894,10 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
!
-IF( .NOT.ALLOCATED(XKER_SDRYG) ) ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SDRYG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SDRYG',NDRYLBDAG,NDRYLBDAS)
!
CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,XFVELOS, &
PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
PFDINFTY )
IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
@@ -945,7 +949,7 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("END IF")')
ELSE
CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,XFVELOS, &
PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
PFDINFTY,XKER_SDRYG )
WRITE(UNIT=KLUOUT,FMT='(" Read XKER_SDRYG")')
@@ -956,7 +960,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_RDRYG) ) ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+IF( .NOT.ASSOCIATED(XKER_RDRYG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RDRYG',NDRYLBDAG,NDRYLBDAR)
!
CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
@@ -1074,10 +1078,10 @@ IND = 50 ! Interval number, collection efficiency and infinite diameter
ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
!
-IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SWETH',NWETLBDAH,NWETLBDAS)
!
CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,XFVELOS, &
PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
PFDINFTY )
IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
@@ -1129,7 +1133,7 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("END IF")')
ELSE
CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,XFVELOS, &
PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
PFDINFTY,XKER_SWETH )
WRITE(UNIT=KLUOUT,FMT='(" Read XKER_SWETH")')
@@ -1140,7 +1144,7 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
ZFDINFTY = 20.0
!
-IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+IF( .NOT.ASSOCIATED(XKER_GWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_GWETH',NWETLBDAH,NWETLBDAG)
!
CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
diff --git a/src/PHYEX/micro/ini_snow.f90 b/src/PHYEX/micro/ini_snow.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c61f54a0d762adf2110157acc003e05d11335e4f
--- /dev/null
+++ b/src/PHYEX/micro/ini_snow.f90
@@ -0,0 +1,163 @@
+! ######spl
+ SUBROUTINE INI_SNOW ( KLUOUT )
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! ###########################################################
+!
+!!**** *INI_SNOW * - re-initialize the constants based on snow-size distubutio
+!! cold microphysical schemes.
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to reinitialize the constants for snow used to
+!! resolve the mixed phase microphysical scheme.
+!! EXTERNAL
+!! --------
+!! GAMMA : gamma function
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XPI !
+!! XP00 ! Reference pressure
+!! XRD ! Gaz constant for dry air
+!! XRHOLW ! Liquid water density
+!! Module MODD_REF
+!! XTHVREFZ ! Reference virtual pot.temp. without orography
+!! Module MODD_PARAMETERS
+!! JPVEXT !
+!! Module MODD_RAIN_ICE_DESCR
+!! Module MODD_RAIN_ICE_PARAM
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine INI_RAIN_ICE )
+!!
+!! ORIGINAL AUTHOR (from ini_rain_ice)
+!! --------------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 2018-02
+!! Karl-Ivar Ivarsson
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE
+USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM
+!
+USE MODI_GAMMA
+USE MODI_GAMMA_INC
+USE MODE_RRCOLSS
+USE MODE_RZCOLX
+USE MODE_RSCOLRG
+USE MODE_READ_XKER_RACCS
+USE MODE_READ_XKER_SDRYG
+USE MODE_READ_XKER_RDRYG
+USE MODE_READ_XKER_SWETH
+USE MODE_READ_XKER_GWETH
+
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+!* 0.2 Declarations of local variables :
+!
+REAL :: ZRHO00 ! Surface reference air density
+
+REAL :: ZCONC_MAX ! Maximal concentration for snow
+
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
+
+
+XCCS = XFRMIN(16)
+XCXS = XFRMIN(17)
+ZRHO00 = XP00/(XRD*300.0)
+! recalculate ini_rain_ice stuff:
+
+! 3.4 Constants for shape parameter
+XLBEXS = 1.0/(XCXS-XBS)
+XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
+ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
+IF(XCCS>0. .AND. XCXS>0. )XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS)
+
+! 4.2 Constants for sedimentation
+XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
+
+XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
+ (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
+
+! 5.2 Constants for vapor deposition on ice
+X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.)
+X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
+XEX0DEPS = XCXS-1.0
+XEX1DEPS = XCXS-0.5*(XDS+3.0)
+
+! 5.4 Constants for snow aggregation
+XFIAGGS = (XPI/4.0)*XCOLIS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXIAGGS = XCXS-XDS-2.0
+
+! 7.1 Constants for the riming of the aggregates
+XEXCRIMSS= XCXS-XDS-2.0
+XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXCRIMSG= XEXCRIMSS
+XCRIMSG = XCRIMSS
+XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS)
+XEXSRIMCG= XCXS-XBS
+
+! 7.2 Constants for the accretion of raindrops onto aggregates
+
+XFRACCSS = ((XPI**2)/24.0)*XCCS*XCCR*XRHOLW*(ZRHO00**XCEXVT)
+
+XFSACCRG = (XPI/4.0)*XAS*XCCS*XCCR*(ZRHO00**XCEXVT)
+
+! 8.2.3 Constants for the aggregate collection by the graupeln
+XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT)
+
+! 9.2.2 Constants for the aggregate collection by the hailstones
+XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT)
+
+WRITE(UNIT=KLUOUT,FMT='(" updated snow concentration:C=",E13.6," x=",E13.6)') &
+ XCCS,XCXS
+
+IF (LHOOK) CALL DR_HOOK('INI_SNOW',1,ZHOOK_HANDLE)
+
+CONTAINS
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION MOMG(PALPHA,PNU,PP) RESULT (PMOMG)
+!
+! auxiliary routine used to compute the Pth moment order of the generalized
+! gamma law
+!
+ USE MODI_GAMMA
+!
+ IMPLICIT NONE
+!
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+!
+!------------------------------------------------------------------------------
+!
+!
+ PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
+!
+ END FUNCTION MOMG
+!
+!-------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE INI_SNOW
diff --git a/src/PHYEX/micro/ini_tiwmx.f90 b/src/PHYEX/micro/ini_tiwmx.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2e3209a38d5bd88f21ac0fa68d98172da3692d99
--- /dev/null
+++ b/src/PHYEX/micro/ini_tiwmx.f90
@@ -0,0 +1,55 @@
+SUBROUTINE INI_TIWMX
+ USE PARKIND1, ONLY : JPRB
+ USE MODD_CST, ONLY : XALPW,XBETAW,XGAMW,XALPI,XBETAI,XGAMI, &
+ & XTT,XRV,XLVTT,XLSTT
+! Include function definitions
+ USE MODE_TIWMX_FUN, ONLY : ESATW,DESDTW,ESATI,DESDTI,AA2,AA2W,AM3,AF3,BB3,BB3W,REDIN
+! Only the tables, _NOT_ the functions!
+ USE MODE_TIWMX, ONLY : XNDEGR,NSTART,NSTOP,ESTABW,DESTABW,ESTABI,DESTABI, &
+ & A2TAB,BB3TAB,AM3TAB,AF3TAB,A2WTAB,BB3WTAB,REDINTAB
+ USE YOMHOOK, ONLY : LHOOK, DR_HOOK
+ IMPLICIT NONE
+
+ INTEGER :: JK
+ REAL :: ZTEMP
+
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ IF (LHOOK) CALL DR_HOOK('INI_TIWMX',0,ZHOOK_HANDLE)
+
+ DO JK=NSTART,NSTOP
+ ZTEMP = REAL(JK)/XNDEGR
+
+ ESTABW(JK) = ESATW(ZTEMP)
+ DESTABW(JK) = DESDTW(ZTEMP)
+
+ ESTABI(JK) = ESATI(ZTEMP)
+ DESTABI(JK) = DESDTI(ZTEMP)
+
+! Functions for ice crystals or water droplets:
+ A2TAB(JK) = AA2(ZTEMP)
+ A2WTAB(JK) = AA2W(ZTEMP)
+ AM3TAB(JK) = AM3(ZTEMP)
+ AF3TAB(JK) = AF3(ZTEMP)
+ BB3TAB(JK) = BB3(ZTEMP)
+ BB3WTAB(JK) = BB3W(ZTEMP)
+ REDINTAB(JK) = REDIN(ZTEMP)
+
+ IF (ZTEMP.GT.273.15) THEN
+! Avoid ice calculation above freezing level:
+ ESTABI(JK) = ESATW(ZTEMP)
+ DESTABI(JK) = DESDTW(ZTEMP)
+
+! Functions for ice crystal growth:
+ A2TAB(JK) = AA2(ZTEMP)
+ A2WTAB(JK) = AA2W(ZTEMP)
+ AM3TAB(JK) = 0.
+ AF3TAB(JK) = 0.
+ BB3TAB(JK) = BB3(ZTEMP)
+ BB3WTAB(JK) = BB3W(ZTEMP)
+ ENDIF
+ END DO
+
+ IF (LHOOK) CALL DR_HOOK('INI_TIWMX',1,ZHOOK_HANDLE)
+
+END SUBROUTINE INI_TIWMX
diff --git a/src/PHYEX/micro/lima_adjust_split.f90 b/src/PHYEX/micro/lima_adjust_split.f90
index 3ddcc4049d622e5c529c5a5868c0283affc2cd5a..2b07f24bd486b334074c1c651e7b6475bd2e4bff 100644
--- a/src/PHYEX/micro/lima_adjust_split.f90
+++ b/src/PHYEX/micro/lima_adjust_split.f90
@@ -9,7 +9,7 @@
!
INTERFACE
!
- SUBROUTINE LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
+ SUBROUTINE LIMA_ADJUST_SPLIT(D, KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, &
PPABST, PPABSTT, PZZ, PDTHRAD, PW_NU, &
@@ -18,7 +18,9 @@ INTERFACE
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, only: NSV_LIMA_BEG
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -70,7 +72,7 @@ END INTERFACE
END MODULE MODI_LIMA_ADJUST_SPLIT
!
! ###########################################################################
- SUBROUTINE LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
+ SUBROUTINE LIMA_ADJUST_SPLIT(D, KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, &
PPABST, PPABSTT, PZZ, PDTHRAD, PW_NU, &
@@ -165,6 +167,10 @@ USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
USE MODD_PARAM_LIMA_WARM
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM
+USE MODD_NEB, ONLY: NEB
+USE MODD_TURB_n, ONLY: TURBN
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
@@ -181,6 +187,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -275,12 +282,13 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
ZLV, & ! guess of the Lv at t+1
ZLS, & ! guess of the Ls at t+1
ZMASK,&
- ZRV, ZRV2, &
- ZRC, ZRC2, &
- ZRI, &
+ ZRV, ZRV2,ZRV_IN, &
+ ZRC, ZRC2,ZRC_IN, &
+ ZRI, ZRI_IN, &
Z_SIGS, Z_SRCS, &
ZW_MF, &
ZCND, ZS, ZVEC1
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2)) :: ZSIGQSAT2D, ZDUM
!
INTEGER, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: IVEC1
!
@@ -303,7 +311,6 @@ INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
!
TYPE(TFIELDDATA) :: TZFIELD
LOGICAL :: G_SIGMAS, GUSERI
-REAL :: Z_SIGQSAT
!
!-------------------------------------------------------------------------------
!
@@ -495,6 +502,9 @@ DO JITER =1,ITERMAX
ZRC=PRCS*PTSTEP
ZRV2=PRVT
ZRC2=PRCT
+ ZRV_IN=ZRV
+ ZRC_IN=ZRC
+ ZRI_IN=0.
IF (NMOM_I.EQ.1) THEN
ZRI=PRIS*PTSTEP
GUSERI=.TRUE.
@@ -505,19 +515,21 @@ DO JITER =1,ITERMAX
IF (OSUBG_COND) THEN
Z_SIGS=PSIGS
G_SIGMAS=OSIGMAS
- Z_SIGQSAT=PSIGQSAT
+ ZSIGQSAT2D(:,:)=PSIGQSAT
ELSE
Z_SIGS=0.
G_SIGMAS=.TRUE.
- Z_SIGQSAT=0.
+ ZSIGQSAT2D(:,:)=0.
END IF
IF (LADJ) THEN
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'S', &
- HCONDENS, HLAMBDA3, &
- PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRSS*PTSTEP, PRGS*PTSTEP, &
- Z_SIGS, PMFCONV, PCLDFR, Z_SRCS, GUSERI, G_SIGMAS, &
- Z_SIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ CALL CONDENSATION(D, CST, RAIN_ICE_PARAM, NEB, TURBN, &
+ 'S', HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV_IN, ZRV, ZRC_IN, ZRC, ZRI_IN, ZRI, &
+ PRRS*PTSTEP,PRSS*PTSTEP, PRGS*PTSTEP, &
+ Z_SIGS, .FALSE., PMFCONV, PCLDFR, Z_SRCS, GUSERI, G_SIGMAS, .FALSE., .FALSE.,&
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ ZSIGQSAT2D, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
END IF
IF (OSUBG_COND .AND. NMOM_C.GE.2 .AND. LACTI) THEN
PSRCS=Z_SRCS
diff --git a/src/PHYEX/micro/lima_ice_snow_deposition.f90 b/src/PHYEX/micro/lima_ice_snow_deposition.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4d92b528ac9aabb0224e61ae9de0c23a5b50f0fb
--- /dev/null
+++ b/src/PHYEX/micro/lima_ice_snow_deposition.f90
@@ -0,0 +1,230 @@
+!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! #####################
+ MODULE MODI_LIMA_ICE_SNOW_DEPOSITION
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_ICE_SNOW_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PRST, PCIT, PLBDI, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS, &
+ P_RI_CNVS, P_CI_CNVS, &
+ PA_TH, PA_RV, PA_RI, PA_CI, PA_RS )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+!
+END SUBROUTINE LIMA_ICE_SNOW_DEPOSITION
+END INTERFACE
+END MODULE MODI_LIMA_ICE_SNOW_DEPOSITION
+!
+! ##########################################################################
+SUBROUTINE LIMA_ICE_SNOW_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PRST, PCIT, PLBDI, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS, &
+ P_RI_CNVS, P_CI_CNVS, &
+ PA_TH, PA_RV, PA_RI, PA_CI, PA_RS )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for slow cold processes :
+!! - conversion of snow to ice
+!! - deposition of vapor on snow
+!! - conversion of ice to snow (Harrington 1995)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS
+USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
+ XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+ XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
+ XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XDICNVS_LIM, XLBDAICNVS_LIM, &
+ XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
+ XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
+REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMICRO ! Computations only where necessary
+REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX ! Work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+P_RI_CNVI(:) = 0.
+P_CI_CNVI(:) = 0.
+P_TH_DEPS(:) = 0.
+P_RS_DEPS(:) = 0.
+P_RI_CNVS(:) = 0.
+P_CI_CNVS(:) = 0.
+!
+! Physical limitations
+!
+!
+! Looking for regions where computations are necessary
+!
+GMICRO(:) = .FALSE.
+GMICRO(:) = LDCOMPUTE(:) .AND. &
+ (PRIT(:)>XRTMIN(4) .OR. &
+ PRST(:)>XRTMIN(5))
+!
+!
+WHERE( GMICRO )
+!
+!* 2.1 Conversion of snow to r_i: RSCNVI
+! ----------------------------------------
+!
+!
+ ZZW2(:) = 0.0
+ ZZW(:) = 0.0
+ WHERE ( PLBDS(:)<XLBDASCNVI_MAX .AND. (PRST(:)>XRTMIN(5)) &
+ .AND. (PSSI(:)<0.0) )
+ ZZW(:) = (PLBDS(:)*XDSCNVI_LIM)**(XALPHAS)
+ ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XCCS*PLBDS(:)**XCXS)/PRHODREF(:) * (ZZW(:)**XNUS) * EXP(-ZZW(:))
+!
+ ZZW(:) = ( XR0DEPSI+XR1DEPSI*PCJ(:) )*ZZX(:)
+!
+ ZZW2(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*PCJ(:) )/( XR0DEPSI+XR1DEPSI*PCJ(:) )
+ END WHERE
+!
+ P_RI_CNVI(:) = ZZW(:)
+ P_CI_CNVI(:) = ZZW2(:)
+!
+ PA_RI(:) = PA_RI(:) + P_RI_CNVI(:)
+ PA_CI(:) = PA_CI(:) + P_CI_CNVI(:)
+ PA_RS(:) = PA_RS(:) - P_RI_CNVI(:)
+!
+!
+!* 2.2 Deposition of water vapor on r_s: RVDEPS
+! -----------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (PRST(:)>XRTMIN(5)) )
+ ZZW(:) = ( PSSI(:)/(PAI(:))/PRHODREF(:) ) * &
+ ( X0DEPS*PLBDS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS )
+ ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:)))
+ END WHERE
+!
+ P_RS_DEPS(:) = ZZW(:)
+ P_TH_DEPS(:) = P_RS_DEPS(:) * PLSFACT(:)
+!
+ PA_TH(:) = PA_TH(:) + P_TH_DEPS(:)
+ PA_RV(:) = PA_RV(:) - P_RS_DEPS(:)
+ PA_RS(:) = PA_RS(:) + P_RS_DEPS(:)
+!
+!
+!* 2.3 Conversion of pristine ice to r_s: RICNVS
+! ------------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ ZZW2(:) = 0.0
+ WHERE ( (PLBDI(:)<XLBDAICNVS_LIM) .AND. (PCIT(:)>XCTMIN(4)) &
+ .AND. (PSSI(:)>0.0) )
+ ZZW(:) = (PLBDI(:)*XDICNVS_LIM)**(XALPHAI)
+ ZZX(:) = ( PSSI(:)/PAI(:) )*PCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:))
+!
+ ZZW(:) = ( XR0DEPIS + XR1DEPIS*PCJ(:) )*ZZX(:)
+!
+ ZZW2(:) = ZZW(:) * (XC0DEPIS+XC1DEPIS*PCJ(:)) / (XR0DEPIS+XR1DEPIS*PCJ(:))
+ END WHERE
+!
+P_RI_CNVS(:) = - ZZW(:)
+P_CI_CNVS(:) = - ZZW2(:)
+!
+PA_RI(:) = PA_RI(:) + P_RI_CNVS(:)
+PA_CI(:) = PA_CI(:) + P_CI_CNVS(:)
+PA_RS(:) = PA_RS(:) - P_RI_CNVS(:)
+!
+!
+END WHERE
+!
+!
+END SUBROUTINE LIMA_ICE_SNOW_DEPOSITION
diff --git a/src/PHYEX/micro/modd_fields_address.f90 b/src/PHYEX/micro/modd_fields_address.f90
new file mode 100644
index 0000000000000000000000000000000000000000..322b9957ea830dde6c34b2108f5a385d036deb16
--- /dev/null
+++ b/src/PHYEX/micro/modd_fields_address.f90
@@ -0,0 +1,47 @@
+! ######spl
+ MODULE MODD_FIELDS_ADDRESS
+! ######################
+!
+!!**** *MODD_FIELDS_ADDRESS* - declaration of fields adress in arrays, as parameter variables
+!!
+!! PURPOSE
+!! -------
+! To share fields adress in arrays
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Ryad El Khatib *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24-Aug-2021
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+! Pointer of fields in microphysic species arrays. Microphysics species are
+! usually counted as KRR=6 or KRR=7. The extra "zero" adress for potential
+! temperature is a trick to improve vectorization when all these fields needs
+! the same treatement.
+INTEGER, PARAMETER :: & ! pointer of fields in microphysic species arrays :
+ & ITH=0, & ! Potential temperature
+ & IRV=1, & ! Water vapor
+ & IRC=2, & ! Cloud water
+ & IRR=3, & ! Rain water
+ & IRI=4, & ! Pristine ice
+ & IRS=5, & ! Snow/aggregate
+ & IRG=6, & ! Graupel
+ & IRH=7 ! Hail
+!
+END MODULE MODD_FIELDS_ADDRESS
diff --git a/src/PHYEX/micro/modd_neb.f90 b/src/PHYEX/micro/modd_neb.f90
index 984059f4388bbec0b3a1b22a256d50c78aa6d0a9..ebca8d22354bb6009ad39ce5a5ba7abe5440485b 100644
--- a/src/PHYEX/micro/modd_neb.f90
+++ b/src/PHYEX/micro/modd_neb.f90
@@ -36,8 +36,21 @@
!
IMPLICIT NONE
!
-REAL,SAVE :: XTMINMIX ! minimum temperature of mixed phase
-REAL,SAVE :: XTMAXMIX ! maximum temperature of mixed phase
+TYPE NEB_t
+ REAL :: XTMINMIX ! minimum temperature of mixed phase
+ REAL :: XTMAXMIX ! maximum temperature of mixed phase
+END TYPE NEB_t
+
+TYPE(NEB_t), SAVE, TARGET :: NEB
+
+REAL, POINTER :: XTMINMIX=>NULL(), &
+ XTMAXMIX=>NULL()
!
+CONTAINS
+SUBROUTINE NEB_ASSOCIATE()
+ IMPLICIT NONE
+ XTMINMIX => NEB%XTMINMIX
+ XTMAXMIX => NEB%XTMAXMIX
+END SUBROUTINE NEB_ASSOCIATE
!
END MODULE MODD_NEB
diff --git a/src/PHYEX/micro/modd_param_ice.f90 b/src/PHYEX/micro/modd_param_ice.f90
index ade107121eeb6c60d406147a6a09d104b67b59f6..0ce2390e82aaf1e1f0d3eade38cf81cce5809452 100644
--- a/src/PHYEX/micro/modd_param_ice.f90
+++ b/src/PHYEX/micro/modd_param_ice.f90
@@ -41,44 +41,119 @@
!
IMPLICIT NONE
!
-LOGICAL, SAVE :: LWARM ! When .TRUE. activates the formation of rain by
+TYPE PARAM_ICE_t
+LOGICAL :: LWARM ! When .TRUE. activates the formation of rain by
! the warm microphysical processes
-LOGICAL, SAVE :: LSEDIC ! TRUE to enable the droplet sedimentation
-LOGICAL, SAVE :: LDEPOSC ! TRUE to enable cloud droplet deposition
-REAL, SAVE :: XVDEPOSC ! Droplet deposition velocity
+LOGICAL :: LSEDIC ! TRUE to enable the droplet sedimentation
+LOGICAL :: LDEPOSC ! TRUE to enable cloud droplet deposition
+REAL :: XVDEPOSC ! Droplet deposition velocity
!
-CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE ! Pristine ice type PLAT, COLU or BURO
-CHARACTER(LEN=4), SAVE :: CSEDIM ! Sedimentation calculation mode
+CHARACTER(LEN=4) :: CPRISTINE_ICE ! Pristine ice type PLAT, COLU or BURO
+CHARACTER(LEN=4) :: CSEDIM ! Sedimentation calculation mode
!
-LOGICAL, SAVE :: LRED ! To use modified ICE3/ICE4 to reduce time step dependency
-LOGICAL, SAVE :: LFEEDBACKT ! When .TRUE. feed back on temperature is taken into account
-LOGICAL, SAVE :: LEVLIMIT ! When .TRUE. water vapour pressure is limited by saturation
-LOGICAL, SAVE :: LNULLWETG ! When .TRUE. graupel wet growth is activated with null rate (to allow water shedding)
-LOGICAL, SAVE :: LWETGPOST ! When .TRUE. graupel wet growth is activated with positive temperature (to allow water shedding)
-LOGICAL, SAVE :: LNULLWETH ! Same as LNULLWETG but for hail
-LOGICAL, SAVE :: LWETHPOST ! Same as LWETGPOST but for hail
-CHARACTER(LEN=4), SAVE :: CSNOWRIMING ! OLD or M90 for Murakami 1990 formulation
-REAL, SAVE :: XFRACM90 ! Fraction used for the Murakami 1990 formulation
-INTEGER, SAVE :: NMAXITER ! Maximum number of iterations for mixing ratio or time splitting
-REAL, SAVE :: XMRSTEP ! maximum mixing ratio step for mixing ratio splitting
-LOGICAL, SAVE :: LCONVHG ! TRUE to allow the conversion from hail to graupel
-LOGICAL, SAVE :: LCRFLIMIT !True to limit rain contact freezing to possible heat exchange
+LOGICAL :: LRED ! To use modified ICE3/ICE4 to reduce time step dependency
+LOGICAL :: LFEEDBACKT ! When .TRUE. feed back on temperature is taken into account
+LOGICAL :: LEVLIMIT ! When .TRUE. water vapour pressure is limited by saturation
+LOGICAL :: LNULLWETG ! When .TRUE. graupel wet growth is activated with null rate (to allow water shedding)
+LOGICAL :: LWETGPOST ! When .TRUE. graupel wet growth is activated with positive temperature (to allow water shedding)
+LOGICAL :: LNULLWETH ! Same as LNULLWETG but for hail
+LOGICAL :: LWETHPOST ! Same as LWETGPOST but for hail
+CHARACTER(LEN=4) :: CSNOWRIMING ! OLD or M90 for Murakami 1990 formulation
+REAL :: XFRACM90 ! Fraction used for the Murakami 1990 formulation
+INTEGER :: NMAXITER ! Maximum number of iterations for mixing ratio or time splitting
+REAL :: XMRSTEP ! maximum mixing ratio step for mixing ratio splitting
+LOGICAL :: LCONVHG ! TRUE to allow the conversion from hail to graupel
+LOGICAL :: LCRFLIMIT !True to limit rain contact freezing to possible heat exchange
!
-REAL, SAVE :: XTSTEP_TS ! Approximative time step for time-splitting (0 for no time-splitting)
+REAL :: XTSTEP_TS ! Approximative time step for time-splitting (0 for no time-splitting)
!
-CHARACTER(len=80), SAVE :: CSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
-CHARACTER(len=80), SAVE :: CSUBG_RR_EVAP ! subgrid rr evaporation
-CHARACTER(len=80), SAVE :: CSUBG_PR_PDF ! pdf for subgrid precipitation
+CHARACTER(LEN=80) :: CSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
+CHARACTER(LEN=80) :: CSUBG_RR_EVAP ! subgrid rr evaporation
+CHARACTER(LEN=80) :: CSUBG_PR_PDF ! pdf for subgrid precipitation
!
-LOGICAL, SAVE :: LADJ_BEFORE ! must we perform an adjustment before rain_ice call
-LOGICAL, SAVE :: LADJ_AFTER ! must we perform an adjustment after rain_ice call
-CHARACTER(len=1), SAVE :: CFRAC_ICE_ADJUST ! ice fraction for adjustments
-CHARACTER(len=1), SAVE :: CFRAC_ICE_SHALLOW_MF ! ice fraction for shallow_mf
-LOGICAL, SAVE :: LSEDIM_AFTER ! sedimentation done before (.FALSE.) or after (.TRUE.) microphysics
+LOGICAL :: LADJ_BEFORE ! must we perform an adjustment before rain_ice call
+LOGICAL :: LADJ_AFTER ! must we perform an adjustment after rain_ice call
+CHARACTER(LEN=1) :: CFRAC_ICE_ADJUST ! ice fraction for adjustments
+CHARACTER(LEN=1) :: CFRAC_ICE_SHALLOW_MF ! ice fraction for shallow_mf
+LOGICAL :: LSEDIM_AFTER ! sedimentation done before (.FALSE.) or after (.TRUE.) microphysics
!
-REAL, SAVE :: XSPLIT_MAXCFL ! Maximum CFL number allowed for SPLIT scheme
+REAL :: XSPLIT_MAXCFL ! Maximum CFL number allowed for SPLIT scheme
+LOGICAL :: LSNOW_T ! Snow parameterization from Wurtz (2021)
+END TYPE PARAM_ICE_t
+!
+TYPE(PARAM_ICE_t), SAVE, TARGET :: PARAM_ICE
+!
+LOGICAL, POINTER :: LWARM => NULL(), &
+ LSEDIC => NULL(), &
+ LDEPOSC => NULL(), &
+ LRED => NULL(), &
+ LFEEDBACKT => NULL(), &
+ LEVLIMIT => NULL(), &
+ LNULLWETG => NULL(), &
+ LWETGPOST => NULL(), &
+ LNULLWETH => NULL(), &
+ LWETHPOST => NULL(), &
+ LCONVHG => NULL(), &
+ LCRFLIMIT => NULL(), &
+ LADJ_BEFORE => NULL(), &
+ LADJ_AFTER => NULL(), &
+ LSEDIM_AFTER => NULL(),&
+ LSNOW_T => NULL()
+
+REAL, POINTER :: XVDEPOSC => NULL(), &
+ XFRACM90 => NULL(), &
+ XMRSTEP => NULL(), &
+ XTSTEP_TS => NULL(), &
+ XSPLIT_MAXCFL => NULL()
+
+INTEGER, POINTER :: NMAXITER => NULL()
+
+CHARACTER(LEN=1), POINTER :: CFRAC_ICE_ADJUST => NULL()
+CHARACTER(LEN=1), POINTER :: CFRAC_ICE_SHALLOW_MF => NULL()
+CHARACTER(LEN=4), POINTER :: CPRISTINE_ICE => NULL()
+CHARACTER(LEN=4), POINTER :: CSEDIM => NULL()
+CHARACTER(LEN=4), POINTER :: CSNOWRIMING => NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_RC_RR_ACCR => NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_RR_EVAP => NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_PR_PDF => NULL()
!
-LOGICAL,SAVE :: LSNOW_T ! Snow parameterization from Wurtz (2021)
!-------------------------------------------------------------------------------
!
+CONTAINS
+SUBROUTINE PARAM_ICE_ASSOCIATE()
+ IMPLICIT NONE
+ LWARM => PARAM_ICE%LWARM
+ LSEDIC => PARAM_ICE%LSEDIC
+ LDEPOSC => PARAM_ICE%LDEPOSC
+ LRED => PARAM_ICE%LRED
+ LFEEDBACKT => PARAM_ICE%LFEEDBACKT
+ LEVLIMIT => PARAM_ICE%LEVLIMIT
+ LNULLWETG => PARAM_ICE%LNULLWETG
+ LWETGPOST => PARAM_ICE%LWETGPOST
+ LNULLWETH => PARAM_ICE%LNULLWETH
+ LWETHPOST => PARAM_ICE%LWETHPOST
+ LCONVHG => PARAM_ICE%LCONVHG
+ LCRFLIMIT => PARAM_ICE%LCRFLIMIT
+ LADJ_BEFORE => PARAM_ICE%LADJ_BEFORE
+ LADJ_AFTER => PARAM_ICE%LADJ_AFTER
+ LSEDIM_AFTER => PARAM_ICE%LSEDIM_AFTER
+ LSNOW_T => PARAM_ICE%LSNOW_T
+ !
+ XVDEPOSC => PARAM_ICE%XVDEPOSC
+ XFRACM90 => PARAM_ICE%XFRACM90
+ XMRSTEP => PARAM_ICE%XMRSTEP
+ XTSTEP_TS => PARAM_ICE%XTSTEP_TS
+ XSPLIT_MAXCFL => PARAM_ICE%XSPLIT_MAXCFL
+ !
+ NMAXITER => PARAM_ICE%NMAXITER
+ !
+ CFRAC_ICE_ADJUST => PARAM_ICE%CFRAC_ICE_ADJUST
+ CFRAC_ICE_SHALLOW_MF => PARAM_ICE%CFRAC_ICE_SHALLOW_MF
+ CPRISTINE_ICE => PARAM_ICE%CPRISTINE_ICE
+ CSEDIM => PARAM_ICE%CSEDIM
+ CSNOWRIMING => PARAM_ICE%CSNOWRIMING
+ CSUBG_RC_RR_ACCR => PARAM_ICE%CSUBG_RC_RR_ACCR
+ CSUBG_RR_EVAP => PARAM_ICE%CSUBG_RR_EVAP
+ CSUBG_PR_PDF => PARAM_ICE%CSUBG_PR_PDF
+END SUBROUTINE PARAM_ICE_ASSOCIATE
END MODULE MODD_PARAM_ICE
diff --git a/src/PHYEX/micro/modd_rain_ice_descr.f90 b/src/PHYEX/micro/modd_rain_ice_descr.f90
index 6487e6e6db57f2a6fa14cee4f933cb081958b86b..a7b8113de349c3a565fde4d35868393d618d8890 100644
--- a/src/PHYEX/micro/modd_rain_ice_descr.f90
+++ b/src/PHYEX/micro/modd_rain_ice_descr.f90
@@ -2,12 +2,6 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/10/16 14:23:23
-!-----------------------------------------------------------------
! ##########################
MODULE MODD_RAIN_ICE_DESCR
! ##########################
@@ -30,26 +24,26 @@
!
! and
!
-! XALPHAx, XNUx : Generalized GAMMA law
-! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
+! XALPHAx, XNUx : Generalized GAMMA law
+! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
! distribution law
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
-!! None
+!! None
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (MODD_RAIN_ICE_DESCR)
-!!
+!!
!! AUTHOR
!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! J.-P. Pinty *Laboratoire d'Aerologie*
!!
!! MODIFICATIONS
!! -------------
-!! Original 04/12/95
+!! Original 04/12/95
!! J.-P. Pinty 29/11/02 add ICE4
!! C. LAC 26/01/2012 : suppression de XCONC qui n'était pas utilisé
!!
@@ -58,33 +52,221 @@
!* 0. DECLARATIONS
! ------------
!
-IMPLICIT NONE
-REAL,SAVE :: XCEXVT ! air density fall speed correction
-!
-REAL,SAVE :: XAC,XBC,XCC,XDC ! Cloud droplet charact.
-REAL,SAVE :: XAR,XBR,XCR,XDR,XCCR ,XF0R,XF1R,XC1R ! Raindrop charact.
-REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
-REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
-REAL,SAVE :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
-REAL,SAVE :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
+IMPLICIT NONE
+TYPE RAIN_ICE_DESCR_t
+REAL :: XCEXVT ! air density fall speed correction
!
-REAL,SAVE :: XALPHAC,XNUC,XALPHAC2,XNUC2, XLBEXC ! Cloud droplet distribution parameters
-REAL,DIMENSION(2), SAVE :: XLBC ! Cloud droplet distribution parameters
-REAL,SAVE :: XALPHAR,XNUR,XLBEXR,XLBR ! Raindrop distribution parameters
-REAL,SAVE :: XALPHAI,XNUI,XLBEXI,XLBI ! Cloud ice distribution parameters
-REAL,SAVE :: XALPHAS,XNUS,XLBEXS,XLBS,XNS ! Snow/agg. distribution parameters
-REAL,SAVE :: XALPHAG,XNUG,XLBEXG,XLBG ! Graupel distribution parameters
-REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
+REAL :: XAC,XBC,XCC,XDC ! Cloud droplet charact.
+REAL :: XAR,XBR,XCR,XDR,XCCR ,XF0R,XF1R,XC1R ! Raindrop charact.
+REAL :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
+REAL :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
+REAL :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
+REAL :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
!
-REAL,SAVE :: XFVELOS ! factor for snow fall speed after Thompson (2008)
-REAL,SAVE :: XTRANS_MP_GAMMAS ! coefficient to convert lambdas for gamma function
+REAL :: XALPHAC,XNUC,XALPHAC2,XNUC2, XLBEXC ! Cloud droplet distribution parameters
+REAL,DIMENSION(2) :: XLBC ! Cloud droplet distribution parameters
+REAL :: XALPHAR,XNUR,XLBEXR,XLBR ! Raindrop distribution parameters
+REAL :: XALPHAI,XNUI,XLBEXI,XLBI ! Cloud ice distribution parameters
+REAL :: XALPHAS,XNUS,XLBEXS,XLBS,XNS ! Snow/agg. distribution parameters
+REAL :: XALPHAG,XNUG,XLBEXG,XLBG ! Graupel distribution parameters
+REAL :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
!
-REAL,SAVE :: XLBDAR_MAX,XLBDAS_MIN,XLBDAS_MAX,XLBDAG_MAX ! Max values allowed for the shape
+REAL :: XFVELOS ! factor for snow fall speed after Thompson (2008)
+REAL :: XTRANS_MP_GAMMAS ! coefficient to convert lambdas for gamma function
+REAL :: XLBDAR_MAX,XLBDAS_MIN,XLBDAS_MAX,XLBDAG_MAX ! Max values allowed for the shape
! parameters (rain,snow,graupeln)
!
-REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values allowed for the mixing ratios
-REAL,SAVE :: XCONC_SEA ! Diagnostic concentration of droplets over sea
-REAL,SAVE :: XCONC_LAND ! Diagnostic concentration of droplets over land
-REAL,SAVE :: XCONC_URBAN ! Diagnostic concentration of droplets over urban area
+REAL,DIMENSION(:),ALLOCATABLE :: XRTMIN ! Min values allowed for the mixing ratios
+REAL :: XCONC_SEA ! Diagnostic concentration of droplets over sea
+REAL :: XCONC_LAND ! Diagnostic concentration of droplets over land
+REAL :: XCONC_URBAN ! Diagnostic concentration of droplets over urban area
+END TYPE RAIN_ICE_DESCR_t
+!
+TYPE(RAIN_ICE_DESCR_t), SAVE, TARGET :: RAIN_ICE_DESCR
+!
+REAL,DIMENSION(:),POINTER :: XLBC=>NULL(), XRTMIN=>NULL()
+REAL, POINTER :: XCEXVT => NULL(), &
+ XAC => NULL(), &
+ XBC => NULL(), &
+ XCC => NULL(), &
+ XDC => NULL(), &
+ XAR => NULL(), &
+ XBR => NULL(), &
+ XCR => NULL(), &
+ XDR => NULL(), &
+ XCCR => NULL(), &
+ XF0R => NULL(), &
+ XF1R => NULL(), &
+ XC1R => NULL(), &
+ XAI => NULL(), &
+ XBI => NULL(), &
+ XC_I => NULL(), &
+ XDI => NULL(), &
+ XF0I => NULL(), &
+ XF2I => NULL(), &
+ XC1I => NULL(), &
+ XAS => NULL(), &
+ XBS => NULL(), &
+ XCS => NULL(), &
+ XDS => NULL(), &
+ XCCS => NULL(), &
+ XCXS => NULL(), &
+ XF0S => NULL(), &
+ XF1S => NULL(), &
+ XC1S => NULL(), &
+ XAG => NULL(), &
+ XBG => NULL(), &
+ XCG => NULL(), &
+ XDG => NULL(), &
+ XCCG => NULL(), &
+ XCXG => NULL(), &
+ XF0G => NULL(), &
+ XF1G => NULL(), &
+ XC1G => NULL(), &
+ XAH => NULL(), &
+ XBH => NULL(), &
+ XCH => NULL(), &
+ XDH => NULL(), &
+ XCCH => NULL(), &
+ XCXH => NULL(), &
+ XF0H => NULL(), &
+ XF1H => NULL(), &
+ XC1H => NULL(), &
+ XALPHAC => NULL(), &
+ XNUC => NULL(), &
+ XALPHAC2 => NULL(), &
+ XNUC2 => NULL(), &
+ XLBEXC => NULL(), &
+ XALPHAR => NULL(), &
+ XNUR => NULL(), &
+ XLBEXR => NULL(), &
+ XLBR => NULL(), &
+ XALPHAI => NULL(), &
+ XNUI => NULL(), &
+ XLBEXI => NULL(), &
+ XLBI => NULL(), &
+ XALPHAS => NULL(), &
+ XNUS => NULL(), &
+ XNS => NULL(), &
+ XLBEXS => NULL(), &
+ XLBS => NULL(), &
+ XALPHAG => NULL(), &
+ XNUG => NULL(), &
+ XLBEXG => NULL(), &
+ XLBG => NULL(), &
+ XALPHAH => NULL(), &
+ XNUH => NULL(), &
+ XLBEXH => NULL(), &
+ XLBH => NULL(), &
+ XLBDAR_MAX => NULL(), &
+ XLBDAS_MAX => NULL(), &
+ XLBDAG_MAX => NULL(), &
+ XCONC_SEA => NULL(), &
+ XCONC_LAND => NULL(), &
+ XCONC_URBAN => NULL(), &
+ XFVELOS => NULL(), &
+ XTRANS_MP_GAMMAS => NULL(), &
+ XLBDAS_MIN => NULL()
+!
+CONTAINS
+SUBROUTINE RAIN_ICE_DESCR_ASSOCIATE()
+ IMPLICIT NONE
+ XCEXVT => RAIN_ICE_DESCR%XCEXVT
+ XAC => RAIN_ICE_DESCR%XAC
+ XBC => RAIN_ICE_DESCR%XBC
+ XCC => RAIN_ICE_DESCR%XCC
+ XDC => RAIN_ICE_DESCR%XDC
+ XAR => RAIN_ICE_DESCR%XAR
+ XBR => RAIN_ICE_DESCR%XBR
+ XCR => RAIN_ICE_DESCR%XCR
+ XDR => RAIN_ICE_DESCR%XDR
+ XCCR => RAIN_ICE_DESCR%XCCR
+ XF0R => RAIN_ICE_DESCR%XF0R
+ XF1R => RAIN_ICE_DESCR%XF1R
+ XC1R => RAIN_ICE_DESCR%XC1R
+ XAI => RAIN_ICE_DESCR%XAI
+ XBI => RAIN_ICE_DESCR%XBI
+ XC_I => RAIN_ICE_DESCR%XC_I
+ XDI => RAIN_ICE_DESCR%XDI
+ XF0I => RAIN_ICE_DESCR%XF0I
+ XF2I => RAIN_ICE_DESCR%XF2I
+ XC1I => RAIN_ICE_DESCR%XC1I
+ XAS => RAIN_ICE_DESCR%XAS
+ XBS => RAIN_ICE_DESCR%XBS
+ XCS => RAIN_ICE_DESCR%XCS
+ XDS => RAIN_ICE_DESCR%XDS
+ XCCS => RAIN_ICE_DESCR%XCCS
+ XCXS => RAIN_ICE_DESCR%XCXS
+ XF0S => RAIN_ICE_DESCR%XF0S
+ XF1S => RAIN_ICE_DESCR%XF1S
+ XC1S => RAIN_ICE_DESCR%XC1S
+ XAG => RAIN_ICE_DESCR%XAG
+ XBG => RAIN_ICE_DESCR%XBG
+ XCG => RAIN_ICE_DESCR%XCG
+ XDG => RAIN_ICE_DESCR%XDG
+ XCCG => RAIN_ICE_DESCR%XCCG
+ XCXG => RAIN_ICE_DESCR%XCXG
+ XF0G => RAIN_ICE_DESCR%XF0G
+ XF1G => RAIN_ICE_DESCR%XF1G
+ XC1G => RAIN_ICE_DESCR%XC1G
+ XAH => RAIN_ICE_DESCR%XAH
+ XBH => RAIN_ICE_DESCR%XBH
+ XCH => RAIN_ICE_DESCR%XCH
+ XDH => RAIN_ICE_DESCR%XDH
+ XCCH => RAIN_ICE_DESCR%XCCH
+ XCXH => RAIN_ICE_DESCR%XCXH
+ XF0H => RAIN_ICE_DESCR%XF0H
+ XF1H => RAIN_ICE_DESCR%XF1H
+ XC1H => RAIN_ICE_DESCR%XC1H
+ XALPHAC => RAIN_ICE_DESCR%XALPHAC
+ XNUC => RAIN_ICE_DESCR%XNUC
+ XALPHAC2 => RAIN_ICE_DESCR%XALPHAC2
+ XNUC2 => RAIN_ICE_DESCR%XNUC2
+ XLBEXC => RAIN_ICE_DESCR%XLBEXC
+ XALPHAR => RAIN_ICE_DESCR%XALPHAR
+ XNUR => RAIN_ICE_DESCR%XNUR
+ XLBEXR => RAIN_ICE_DESCR%XLBEXR
+ XLBR => RAIN_ICE_DESCR%XLBR
+ XALPHAI => RAIN_ICE_DESCR%XALPHAI
+ XNUI => RAIN_ICE_DESCR%XNUI
+ XLBEXI => RAIN_ICE_DESCR%XLBEXI
+ XLBI => RAIN_ICE_DESCR%XLBI
+ XALPHAS => RAIN_ICE_DESCR%XALPHAS
+ XNUS => RAIN_ICE_DESCR%XNUS
+ XLBEXS => RAIN_ICE_DESCR%XLBEXS
+ XLBS => RAIN_ICE_DESCR%XLBS
+ XALPHAG => RAIN_ICE_DESCR%XALPHAG
+ XNUG => RAIN_ICE_DESCR%XNUG
+ XLBEXG => RAIN_ICE_DESCR%XLBEXG
+ XLBG => RAIN_ICE_DESCR%XLBG
+ XALPHAH => RAIN_ICE_DESCR%XALPHAH
+ XNUH => RAIN_ICE_DESCR%XNUH
+ XLBEXH => RAIN_ICE_DESCR%XLBEXH
+ XLBH => RAIN_ICE_DESCR%XLBH
+ XLBDAR_MAX => RAIN_ICE_DESCR%XLBDAR_MAX
+ XLBDAS_MAX => RAIN_ICE_DESCR%XLBDAS_MAX
+ XLBDAG_MAX => RAIN_ICE_DESCR%XLBDAG_MAX
+ XCONC_SEA => RAIN_ICE_DESCR%XCONC_SEA
+ XCONC_LAND => RAIN_ICE_DESCR%XCONC_LAND
+ XCONC_URBAN => RAIN_ICE_DESCR%XCONC_URBAN
+ XNS => RAIN_ICE_DESCR%XNS
+ XFVELOS => RAIN_ICE_DESCR%XFVELOS
+ XTRANS_MP_GAMMAS => RAIN_ICE_DESCR%XTRANS_MP_GAMMAS
+ XLBDAS_MIN => RAIN_ICE_DESCR%XLBDAS_MIN
+END SUBROUTINE
+!
+SUBROUTINE RAIN_ICE_DESCR_ALLOCATE(KRR)
+ IMPLICIT NONE
+ INTEGER, INTENT(IN) :: KRR
+ ALLOCATE(RAIN_ICE_DESCR%XRTMIN(KRR))
+ XRTMIN=>RAIN_ICE_DESCR%XRTMIN
+ XLBC=>RAIN_ICE_DESCR%XLBC
+END SUBROUTINE RAIN_ICE_DESCR_ALLOCATE
+!
+SUBROUTINE RAIN_ICE_DESCR_DEALLOCATE()
+ IMPLICIT NONE
+ XRTMIN=>NULL()
+ DEALLOCATE(RAIN_ICE_DESCR%XRTMIN)
+END SUBROUTINE RAIN_ICE_DESCR_DEALLOCATE
!
-END MODULE MODD_RAIN_ICE_DESCR
+END MODULE MODD_RAIN_ICE_DESCR
diff --git a/src/PHYEX/micro/modd_rain_ice_param.f90 b/src/PHYEX/micro/modd_rain_ice_param.f90
index 434c4bc761d351bc6756fbdd6b5026d1a38141a3..40acb8f56888d5193c2fc09e7acc36993814beb2 100644
--- a/src/PHYEX/micro/modd_rain_ice_param.f90
+++ b/src/PHYEX/micro/modd_rain_ice_param.f90
@@ -39,39 +39,43 @@
! ------------
!
IMPLICIT NONE
-REAL,DIMENSION(2),SAVE :: XFSEDC ! Constants for sedimentation fluxes of C
-REAL,SAVE :: XFSEDR,XEXSEDR, & ! Constants for sedimentation
+!
+TYPE RAIN_ICE_PARAM_t
+REAL,DIMENSION(2) :: XFSEDC ! Constants for sedimentation fluxes of C
+REAL :: XFSEDR,XEXSEDR, & ! Constants for sedimentation
XFSEDI,XEXCSEDI,XEXRSEDI, & ! fluxes of R, I, S and G
XFSEDS,XEXSEDS, &
XFSEDG,XEXSEDG
!
-REAL,SAVE :: XNU10,XALPHA1,XBETA1, & ! Constants for heterogeneous
+REAL :: XNU10,XALPHA1,XBETA1, & ! Constants for heterogeneous
XNU20,XALPHA2,XBETA2, & ! ice nucleation : HEN
XMNU0 ! mass of nucleated ice crystal
!
-REAL,SAVE :: XALPHA3,XBETA3, & ! Constants for homogeneous
+REAL :: XALPHA3,XBETA3, & ! Constants for homogeneous
XHON ! ice nucleation : HON
!
-REAL,SAVE :: XSCFAC, & ! Constants for raindrop
+REAL :: XSCFAC, & ! Constants for raindrop
X0EVAR,X1EVAR,XEX0EVAR,XEX1EVAR, & ! evaporation: EVA and for
X0DEPI,X2DEPI, & ! deposition : DEP on I,
X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS, & ! on S and
- X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! on G
+ XRDEPSRED,&
+ X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG, & ! on G
+ XRDEPGRED
!
-REAL,SAVE :: XTIMAUTI,XTEXAUTI,XCRIAUTI, & ! Constants for pristine ice
+REAL :: XTIMAUTI,XTEXAUTI,XCRIAUTI, & ! Constants for pristine ice
XT0CRIAUTI,XACRIAUTI,XBCRIAUTI ! autoconversion : AUT
!
-REAL,SAVE :: XCOLIS,XCOLEXIS, & ! Constants for snow
+REAL :: XCOLIS,XCOLEXIS, & ! Constants for snow
XFIAGGS, & ! aggregation : AGG
XEXIAGGS
!
-REAL,SAVE :: XTIMAUTC, & ! Constants for cloud droplet
+REAL :: XTIMAUTC, & ! Constants for cloud droplet
XCRIAUTC ! autoconversion : AUT
!
-REAL,SAVE :: XFCACCR, & ! Constants for cloud droplet
+REAL :: XFCACCR, & ! Constants for cloud droplet
XEXCACCR ! accretion on raindrops : ACC
!
-REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
+REAL :: XDCSLIM,XCOLCS, & ! Constants for the riming of
XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
XEXCRIMSG,XCRIMSG, & !
XEXSRIMCG,XSRIMCG, & !
@@ -81,13 +85,13 @@ REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM
XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of
! the tab. incomplete Gamma law
-INTEGER,SAVE :: NGAMINC ! Number of tab. Lbda_s
-REAL, DIMENSION(:), SAVE, ALLOCATABLE &
+INTEGER :: NGAMINC ! Number of tab. Lbda_s
+REAL, DIMENSION(:), ALLOCATABLE &
:: XGAMINC_RIM1, & ! Tab. incomplete Gamma funct.
XGAMINC_RIM2, & ! for XDS+2 and for XBS
XGAMINC_RIM4 ! and for 2+XDS+XBS-XBG
!
-REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
+REAL :: XFRACCSS, & ! Constants for the accretion
XLBRACCS1,XLBRACCS2,XLBRACCS3, & ! raindrops onto the aggregates
XFSACCRG, & ! ACC (processes RACCSS and
XLBSACCR1,XLBSACCR2,XLBSACCR3, & ! SACCRG)
@@ -99,22 +103,22 @@ REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
! XKER_RACCSS and XKER_SACCRG
! tables
-INTEGER,SAVE :: NACCLBDAS, & ! Number of Lbda_s values and
+INTEGER :: NACCLBDAS, & ! Number of Lbda_s values and
NACCLBDAR ! of Lbda_r values in the
! XKER_RACCSS and XKER_SACCRG
! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL,DIMENSION(:,:), ALLOCATABLE &
:: XKER_RACCSS, & ! Normalized kernel for RACCSS
XKER_RACCS, & ! Normalized kernel for RACCS
XKER_SACCRG ! Normalized kernel for SACCRG
-REAL,SAVE :: XFSCVMG ! Melting-conversion factor of
+REAL :: XFSCVMG ! Melting-conversion factor of
! the aggregates
!
-REAL,SAVE :: XCOLIR, & ! Constants for rain contact
+REAL :: XCOLIR, & ! Constants for rain contact
XEXRCFRI,XRCFRI, & ! freezing : CFR
XEXICFRR,XICFRR !
!
-REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
+REAL :: XFCDRYG, & ! Constants for the dry growth
XCOLIG,XCOLEXIG,XFIDRYG, & ! of the graupeln : DRY
XFIDRYG2, XEXFIDRYG, &
XCOLSG,XCOLEXSG,XFSDRYG, & ! processes RCDRYG
@@ -131,27 +135,27 @@ REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
! tables
-INTEGER,SAVE :: NDRYLBDAR, & ! Number of Lbda_r,
+INTEGER :: NDRYLBDAR, & ! Number of Lbda_r,
NDRYLBDAS, & ! of Lbda_s and
NDRYLBDAG ! of Lbda_g values in
! the XKER_SDRYG and XKER_RDRYG
! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL,DIMENSION(:,:), ALLOCATABLE &
:: XKER_SDRYG, & ! Normalized kernel for SDRYG
XKER_RDRYG ! Normalized kernel for RDRYG
!
! addition of Hail category
!
-REAL,SAVE :: XFSEDH,XEXSEDH ! Constants for sedimentation
+REAL :: XFSEDH,XEXSEDH ! Constants for sedimentation
!
!
-REAL,SAVE :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
+REAL :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
!
-REAL,SAVE :: XCOLIH, XCOLEXIH, & ! Constants for the dry growth
+REAL :: XCOLIH, XCOLEXIH, & ! Constants for the dry growth
& XCOLSH, XCOLEXSH, & ! of the hail
& XCOLGH, XCOLEXGH !
!
-REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
+REAL :: XFWETH,XFSWETH, & ! Constants for the wet growth
XLBSWETH1,XLBSWETH2,XLBSWETH3, & ! of the hailstones : WET
XFGWETH, & ! processes RSWETH
XLBGWETH1,XLBGWETH2,XLBGWETH3, & ! RGWETH
@@ -170,15 +174,439 @@ REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
XWETINTP1R,XWETINTP2R, & ! and Lbda_h in
XWETINTP1H,XWETINTP2H ! the XKER_SWETH, XKER_GWETH
! and XKER_RWETH tables
-INTEGER,SAVE :: NWETLBDAS, & ! Number of Lbda_s,
+INTEGER :: NWETLBDAS, & ! Number of Lbda_s,
NWETLBDAG, & ! of Lbda_g,
NWETLBDAR, & ! of Lbda_r and
NWETLBDAH ! of Lbda_h values in
! the XKER_SWETH, XKER_GWETH
! and XKER_RWETH tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL,DIMENSION(:,:), ALLOCATABLE &
:: XKER_SWETH, & ! Normalized kernel for SWETH
XKER_GWETH, & ! Normalized kernel for GWETH
XKER_RWETH ! Normalized kernel for RWETH
+REAL, DIMENSION(40) :: XFRMIN ! Parmeters to modify melt and growth of graupels etc.
+END TYPE RAIN_ICE_PARAM_t
+!
+TYPE(RAIN_ICE_PARAM_t), SAVE, TARGET :: RAIN_ICE_PARAM
+!
+REAL,DIMENSION(:),POINTER :: XFSEDC => NULL()
+REAL,DIMENSION(:),POINTER :: XFRMIN => NULL()
+
+REAL,POINTER :: XFSEDR => NULL(), &
+ XEXSEDR => NULL(), &
+ XFSEDI => NULL(), &
+ XEXCSEDI => NULL(), &
+ XEXRSEDI => NULL(), &
+ XFSEDS => NULL(), &
+ XEXSEDS => NULL(), &
+ XFSEDG => NULL(), &
+ XEXSEDG => NULL(), &
+ XNU10 => NULL(), &
+ XALPHA1 => NULL(), &
+ XBETA1 => NULL(), &
+ XNU20 => NULL(), &
+ XALPHA2 => NULL(), &
+ XBETA2 => NULL(), &
+ XMNU0 => NULL(), &
+ XALPHA3 => NULL(), &
+ XBETA3 => NULL(), &
+ XHON => NULL(), &
+ XSCFAC => NULL(), &
+ X0EVAR => NULL(), &
+ X1EVAR => NULL(), &
+ XEX0EVAR => NULL(), &
+ XEX1EVAR => NULL(), &
+ X0DEPI => NULL(), &
+ X2DEPI => NULL(), &
+ X0DEPS => NULL(), &
+ X1DEPS => NULL(), &
+ XEX0DEPS => NULL(), &
+ XEX1DEPS => NULL(), &
+ XRDEPSRED => NULL(), &
+ X0DEPG => NULL(), &
+ X1DEPG => NULL(), &
+ XEX0DEPG => NULL(), &
+ XEX1DEPG => NULL(), &
+ XRDEPGRED => NULL(), &
+ XTIMAUTI => NULL(), &
+ XTEXAUTI => NULL(), &
+ XCRIAUTI => NULL(), &
+ XT0CRIAUTI => NULL(), &
+ XACRIAUTI => NULL(), &
+ XBCRIAUTI => NULL(), &
+ XCOLIS => NULL(), &
+ XCOLEXIS => NULL(), &
+ XFIAGGS => NULL(), &
+ XEXIAGGS => NULL(), &
+ XTIMAUTC => NULL(), &
+ XCRIAUTC => NULL(), &
+ XFCACCR => NULL(), &
+ XEXCACCR => NULL(), &
+ XDCSLIM => NULL(), &
+ XCOLCS => NULL(), &
+ XEXCRIMSS => NULL(), &
+ XCRIMSS => NULL(), &
+ XEXCRIMSG => NULL(), &
+ XCRIMSG => NULL(), &
+ XEXSRIMCG => NULL(), &
+ XSRIMCG => NULL(), &
+ XEXSRIMCG2 => NULL(), &
+ XSRIMCG2 => NULL(), &
+ XSRIMCG3 => NULL(), &
+ XGAMINC_BOUND_MIN => NULL(), &
+ XGAMINC_BOUND_MAX => NULL(), &
+ XRIMINTP1 => NULL(), &
+ XRIMINTP2 => NULL(), &
+ XFRACCSS => NULL(), &
+ XLBRACCS1 => NULL(), &
+ XLBRACCS2 => NULL(), &
+ XLBRACCS3 => NULL(), &
+ XFSACCRG => NULL(), &
+ XLBSACCR1 => NULL(), &
+ XLBSACCR2 => NULL(), &
+ XLBSACCR3 => NULL(), &
+ XACCLBDAS_MIN => NULL(), &
+ XACCLBDAS_MAX => NULL(), &
+ XACCLBDAR_MIN => NULL(), &
+ XACCLBDAR_MAX => NULL(), &
+ XACCINTP1S => NULL(), &
+ XACCINTP2S => NULL(), &
+ XACCINTP1R => NULL(), &
+ XACCINTP2R => NULL(), &
+ XFSCVMG => NULL(), &
+ XCOLIR => NULL(), &
+ XEXRCFRI => NULL(), &
+ XRCFRI => NULL(), &
+ XEXICFRR => NULL(), &
+ XICFRR => NULL(), &
+ XFCDRYG => NULL(), &
+ XCOLIG => NULL(), &
+ XCOLEXIG => NULL(), &
+ XFIDRYG => NULL(), &
+ XFIDRYG2 => NULL(), &
+ XEXFIDRYG => NULL(), &
+ XCOLSG => NULL(), &
+ XCOLEXSG => NULL(), &
+ XFSDRYG => NULL(), &
+ XLBSDRYG1 => NULL(), &
+ XLBSDRYG2 => NULL(), &
+ XLBSDRYG3 => NULL(), &
+ XFRDRYG => NULL(), &
+ XLBRDRYG1 => NULL(), &
+ XLBRDRYG2 => NULL(), &
+ XLBRDRYG3 => NULL(), &
+ XDRYLBDAR_MIN => NULL(), &
+ XDRYLBDAR_MAX => NULL(), &
+ XDRYLBDAS_MIN => NULL(), &
+ XDRYLBDAS_MAX => NULL(), &
+ XDRYLBDAG_MIN => NULL(), &
+ XDRYLBDAG_MAX => NULL(), &
+ XDRYINTP1R => NULL(), &
+ XDRYINTP2R => NULL(), &
+ XDRYINTP1S => NULL(), &
+ XDRYINTP2S => NULL(), &
+ XDRYINTP1G => NULL(), &
+ XDRYINTP2G => NULL(), &
+ XFSEDH => NULL(), &
+ XEXSEDH => NULL(), &
+ X0DEPH => NULL(), &
+ X1DEPH => NULL(), &
+ XEX0DEPH => NULL(), &
+ XEX1DEPH => NULL(), &
+ XCOLIH => NULL(), &
+ XCOLEXIH => NULL(), &
+ XCOLSH => NULL(), &
+ XCOLEXSH => NULL(), &
+ XCOLGH => NULL(), &
+ XCOLEXGH => NULL(), &
+ XFWETH => NULL(), &
+ XFSWETH => NULL(), &
+ XLBSWETH1 => NULL(), &
+ XLBSWETH2 => NULL(), &
+ XLBSWETH3 => NULL(), &
+ XFGWETH => NULL(), &
+ XLBGWETH1 => NULL(), &
+ XLBGWETH2 => NULL(), &
+ XLBGWETH3 => NULL(), &
+ XFRWETH => NULL(), &
+ XLBRWETH1 => NULL(), &
+ XLBRWETH2 => NULL(), &
+ XLBRWETH3 => NULL(), &
+ XWETLBDAS_MIN => NULL(), &
+ XWETLBDAS_MAX => NULL(), &
+ XWETLBDAG_MIN => NULL(), &
+ XWETLBDAG_MAX => NULL(), &
+ XWETLBDAR_MIN => NULL(), &
+ XWETLBDAR_MAX => NULL(), &
+ XWETLBDAH_MIN => NULL(), &
+ XWETLBDAH_MAX => NULL(), &
+ XWETINTP1S => NULL(), &
+ XWETINTP2S => NULL(), &
+ XWETINTP1G => NULL(), &
+ XWETINTP2G => NULL(), &
+ XWETINTP1R => NULL(), &
+ XWETINTP2R => NULL(), &
+ XWETINTP1H => NULL(), &
+ XWETINTP2H => NULL()
+
+INTEGER, POINTER :: NGAMINC => NULL(), &
+ NACCLBDAS => NULL(), &
+ NACCLBDAR => NULL(), &
+ NDRYLBDAR => NULL(), &
+ NDRYLBDAS => NULL(), &
+ NDRYLBDAG => NULL(), &
+ NWETLBDAS => NULL(), &
+ NWETLBDAG => NULL(), &
+ NWETLBDAR => NULL(), &
+ NWETLBDAH => NULL()
+
+REAL, DIMENSION(:), POINTER :: XGAMINC_RIM1 => NULL(), &
+ XGAMINC_RIM2 => NULL(), &
+ XGAMINC_RIM4 => NULL()
+
+REAL,DIMENSION(:,:), POINTER :: XKER_RACCSS => NULL(), &
+ XKER_RACCS => NULL(), &
+ XKER_SACCRG => NULL(), &
+ XKER_SDRYG => NULL(), &
+ XKER_RDRYG => NULL(), &
+ XKER_SWETH => NULL(), &
+ XKER_GWETH => NULL(), &
+ XKER_RWETH => NULL()
+CONTAINS
+SUBROUTINE RAIN_ICE_PARAM_ASSOCIATE()
+ IMPLICIT NONE
+ XFSEDC => RAIN_ICE_PARAM%XFSEDC
+ XFRMIN => RAIN_ICE_PARAM%XFRMIN
+ !
+ XFSEDR => RAIN_ICE_PARAM%XFSEDR
+ XEXSEDR => RAIN_ICE_PARAM%XEXSEDR
+ XFSEDI => RAIN_ICE_PARAM%XFSEDI
+ XEXCSEDI => RAIN_ICE_PARAM%XEXCSEDI
+ XEXRSEDI => RAIN_ICE_PARAM%XEXRSEDI
+ XFSEDS => RAIN_ICE_PARAM%XFSEDS
+ XEXSEDS => RAIN_ICE_PARAM%XEXSEDS
+ XFSEDG => RAIN_ICE_PARAM%XFSEDG
+ XEXSEDG => RAIN_ICE_PARAM%XEXSEDG
+ XNU10 => RAIN_ICE_PARAM%XNU10
+ XALPHA1 => RAIN_ICE_PARAM%XALPHA1
+ XBETA1 => RAIN_ICE_PARAM%XBETA1
+ XNU20 => RAIN_ICE_PARAM%XNU20
+ XALPHA2 => RAIN_ICE_PARAM%XALPHA2
+ XBETA2 => RAIN_ICE_PARAM%XBETA2
+ XMNU0 => RAIN_ICE_PARAM%XMNU0
+ XALPHA3 => RAIN_ICE_PARAM%XALPHA3
+ XBETA3 => RAIN_ICE_PARAM%XBETA3
+ XHON => RAIN_ICE_PARAM%XHON
+ XSCFAC => RAIN_ICE_PARAM%XSCFAC
+ X0EVAR => RAIN_ICE_PARAM%X0EVAR
+ X1EVAR => RAIN_ICE_PARAM%X1EVAR
+ XEX0EVAR => RAIN_ICE_PARAM%XEX0EVAR
+ XEX1EVAR => RAIN_ICE_PARAM%XEX1EVAR
+ X0DEPI => RAIN_ICE_PARAM%X0DEPI
+ X2DEPI => RAIN_ICE_PARAM%X2DEPI
+ X0DEPS => RAIN_ICE_PARAM%X0DEPS
+ X1DEPS => RAIN_ICE_PARAM%X1DEPS
+ XEX0DEPS => RAIN_ICE_PARAM%XEX0DEPS
+ XEX1DEPS => RAIN_ICE_PARAM%XEX1DEPS
+ XRDEPSRED => RAIN_ICE_PARAM%XRDEPSRED
+ X0DEPG => RAIN_ICE_PARAM%X0DEPG
+ X1DEPG => RAIN_ICE_PARAM%X1DEPG
+ XEX0DEPG => RAIN_ICE_PARAM%XEX0DEPG
+ XEX1DEPG => RAIN_ICE_PARAM%XEX1DEPG
+ XRDEPGRED => RAIN_ICE_PARAM%XRDEPGRED
+ XTIMAUTI => RAIN_ICE_PARAM%XTIMAUTI
+ XTEXAUTI => RAIN_ICE_PARAM%XTEXAUTI
+ XCRIAUTI => RAIN_ICE_PARAM%XCRIAUTI
+ XT0CRIAUTI => RAIN_ICE_PARAM%XT0CRIAUTI
+ XACRIAUTI => RAIN_ICE_PARAM%XACRIAUTI
+ XBCRIAUTI => RAIN_ICE_PARAM%XBCRIAUTI
+ XCOLIS => RAIN_ICE_PARAM%XCOLIS
+ XCOLEXIS => RAIN_ICE_PARAM%XCOLEXIS
+ XFIAGGS => RAIN_ICE_PARAM%XFIAGGS
+ XEXIAGGS => RAIN_ICE_PARAM%XEXIAGGS
+ XTIMAUTC => RAIN_ICE_PARAM%XTIMAUTC
+ XCRIAUTC => RAIN_ICE_PARAM%XCRIAUTC
+ XFCACCR => RAIN_ICE_PARAM%XFCACCR
+ XEXCACCR => RAIN_ICE_PARAM%XEXCACCR
+ XDCSLIM => RAIN_ICE_PARAM%XDCSLIM
+ XCOLCS => RAIN_ICE_PARAM%XCOLCS
+ XEXCRIMSS => RAIN_ICE_PARAM%XEXCRIMSS
+ XCRIMSS => RAIN_ICE_PARAM%XCRIMSS
+ XEXCRIMSG => RAIN_ICE_PARAM%XEXCRIMSG
+ XCRIMSG => RAIN_ICE_PARAM%XCRIMSG
+ XEXSRIMCG => RAIN_ICE_PARAM%XEXSRIMCG
+ XSRIMCG => RAIN_ICE_PARAM%XSRIMCG
+ XEXSRIMCG2 => RAIN_ICE_PARAM%XEXSRIMCG2
+ XSRIMCG2 => RAIN_ICE_PARAM%XSRIMCG2
+ XSRIMCG3 => RAIN_ICE_PARAM%XSRIMCG3
+ XGAMINC_BOUND_MIN => RAIN_ICE_PARAM%XGAMINC_BOUND_MIN
+ XGAMINC_BOUND_MAX => RAIN_ICE_PARAM%XGAMINC_BOUND_MAX
+ XRIMINTP1 => RAIN_ICE_PARAM%XRIMINTP1
+ XRIMINTP2 => RAIN_ICE_PARAM%XRIMINTP2
+ XFRACCSS => RAIN_ICE_PARAM%XFRACCSS
+ XLBRACCS1 => RAIN_ICE_PARAM%XLBRACCS1
+ XLBRACCS2 => RAIN_ICE_PARAM%XLBRACCS2
+ XLBRACCS3 => RAIN_ICE_PARAM%XLBRACCS3
+ XFSACCRG => RAIN_ICE_PARAM%XFSACCRG
+ XLBSACCR1 => RAIN_ICE_PARAM%XLBSACCR1
+ XLBSACCR2 => RAIN_ICE_PARAM%XLBSACCR2
+ XLBSACCR3 => RAIN_ICE_PARAM%XLBSACCR3
+ XACCLBDAS_MIN => RAIN_ICE_PARAM%XACCLBDAS_MIN
+ XACCLBDAS_MAX => RAIN_ICE_PARAM%XACCLBDAS_MAX
+ XACCLBDAR_MIN => RAIN_ICE_PARAM%XACCLBDAR_MIN
+ XACCLBDAR_MAX => RAIN_ICE_PARAM%XACCLBDAR_MAX
+ XACCINTP1S => RAIN_ICE_PARAM%XACCINTP1S
+ XACCINTP2S => RAIN_ICE_PARAM%XACCINTP2S
+ XACCINTP1R => RAIN_ICE_PARAM%XACCINTP1R
+ XACCINTP2R => RAIN_ICE_PARAM%XACCINTP2R
+ XFSCVMG => RAIN_ICE_PARAM%XFSCVMG
+ XCOLIR => RAIN_ICE_PARAM%XCOLIR
+ XEXRCFRI => RAIN_ICE_PARAM%XEXRCFRI
+ XRCFRI => RAIN_ICE_PARAM%XRCFRI
+ XEXICFRR => RAIN_ICE_PARAM%XEXICFRR
+ XICFRR => RAIN_ICE_PARAM%XICFRR
+ XFCDRYG => RAIN_ICE_PARAM%XFCDRYG
+ XCOLIG => RAIN_ICE_PARAM%XCOLIG
+ XCOLEXIG => RAIN_ICE_PARAM%XCOLEXIG
+ XFIDRYG => RAIN_ICE_PARAM%XFIDRYG
+ XFIDRYG2 => RAIN_ICE_PARAM%XFIDRYG2
+ XEXFIDRYG => RAIN_ICE_PARAM%XEXFIDRYG
+ XCOLSG => RAIN_ICE_PARAM%XCOLSG
+ XCOLEXSG => RAIN_ICE_PARAM%XCOLEXSG
+ XFSDRYG => RAIN_ICE_PARAM%XFSDRYG
+ XLBSDRYG1 => RAIN_ICE_PARAM%XLBSDRYG1
+ XLBSDRYG2 => RAIN_ICE_PARAM%XLBSDRYG2
+ XLBSDRYG3 => RAIN_ICE_PARAM%XLBSDRYG3
+ XFRDRYG => RAIN_ICE_PARAM%XFRDRYG
+ XLBRDRYG1 => RAIN_ICE_PARAM%XLBRDRYG1
+ XLBRDRYG2 => RAIN_ICE_PARAM%XLBRDRYG2
+ XLBRDRYG3 => RAIN_ICE_PARAM%XLBRDRYG3
+ XDRYLBDAR_MIN => RAIN_ICE_PARAM%XDRYLBDAR_MIN
+ XDRYLBDAR_MAX => RAIN_ICE_PARAM%XDRYLBDAR_MAX
+ XDRYLBDAS_MIN => RAIN_ICE_PARAM%XDRYLBDAS_MIN
+ XDRYLBDAS_MAX => RAIN_ICE_PARAM%XDRYLBDAS_MAX
+ XDRYLBDAG_MIN => RAIN_ICE_PARAM%XDRYLBDAG_MIN
+ XDRYLBDAG_MAX => RAIN_ICE_PARAM%XDRYLBDAG_MAX
+ XDRYINTP1R => RAIN_ICE_PARAM%XDRYINTP1R
+ XDRYINTP2R => RAIN_ICE_PARAM%XDRYINTP2R
+ XDRYINTP1S => RAIN_ICE_PARAM%XDRYINTP1S
+ XDRYINTP2S => RAIN_ICE_PARAM%XDRYINTP2S
+ XDRYINTP1G => RAIN_ICE_PARAM%XDRYINTP1G
+ XDRYINTP2G => RAIN_ICE_PARAM%XDRYINTP2G
+ XFSEDH => RAIN_ICE_PARAM%XFSEDH
+ XEXSEDH => RAIN_ICE_PARAM%XEXSEDH
+ X0DEPH => RAIN_ICE_PARAM%X0DEPH
+ X1DEPH => RAIN_ICE_PARAM%X1DEPH
+ XEX0DEPH => RAIN_ICE_PARAM%XEX0DEPH
+ XEX1DEPH => RAIN_ICE_PARAM%XEX1DEPH
+ XCOLIH => RAIN_ICE_PARAM%XCOLIH
+ XCOLEXIH => RAIN_ICE_PARAM%XCOLEXIH
+ XCOLSH => RAIN_ICE_PARAM%XCOLSH
+ XCOLEXSH => RAIN_ICE_PARAM%XCOLEXSH
+ XCOLGH => RAIN_ICE_PARAM%XCOLGH
+ XCOLEXGH => RAIN_ICE_PARAM%XCOLEXGH
+ XFWETH => RAIN_ICE_PARAM%XFWETH
+ XFSWETH => RAIN_ICE_PARAM%XFSWETH
+ XLBSWETH1 => RAIN_ICE_PARAM%XLBSWETH1
+ XLBSWETH2 => RAIN_ICE_PARAM%XLBSWETH2
+ XLBSWETH3 => RAIN_ICE_PARAM%XLBSWETH3
+ XFGWETH => RAIN_ICE_PARAM%XFGWETH
+ XLBGWETH1 => RAIN_ICE_PARAM%XLBGWETH1
+ XLBGWETH2 => RAIN_ICE_PARAM%XLBGWETH2
+ XLBGWETH3 => RAIN_ICE_PARAM%XLBGWETH3
+ XFRWETH => RAIN_ICE_PARAM%XFRWETH
+ XLBRWETH1 => RAIN_ICE_PARAM%XLBRWETH1
+ XLBRWETH2 => RAIN_ICE_PARAM%XLBRWETH2
+ XLBRWETH3 => RAIN_ICE_PARAM%XLBRWETH3
+ XWETLBDAS_MIN => RAIN_ICE_PARAM%XWETLBDAS_MIN
+ XWETLBDAS_MAX => RAIN_ICE_PARAM%XWETLBDAS_MAX
+ XWETLBDAG_MIN => RAIN_ICE_PARAM%XWETLBDAG_MIN
+ XWETLBDAG_MAX => RAIN_ICE_PARAM%XWETLBDAG_MAX
+ XWETLBDAR_MIN => RAIN_ICE_PARAM%XWETLBDAR_MIN
+ XWETLBDAR_MAX => RAIN_ICE_PARAM%XWETLBDAR_MAX
+ XWETLBDAH_MIN => RAIN_ICE_PARAM%XWETLBDAH_MIN
+ XWETLBDAH_MAX => RAIN_ICE_PARAM%XWETLBDAH_MAX
+ XWETINTP1S => RAIN_ICE_PARAM%XWETINTP1S
+ XWETINTP2S => RAIN_ICE_PARAM%XWETINTP2S
+ XWETINTP1G => RAIN_ICE_PARAM%XWETINTP1G
+ XWETINTP2G => RAIN_ICE_PARAM%XWETINTP2G
+ XWETINTP1R => RAIN_ICE_PARAM%XWETINTP1R
+ XWETINTP2R => RAIN_ICE_PARAM%XWETINTP2R
+ XWETINTP1H => RAIN_ICE_PARAM%XWETINTP1H
+ XWETINTP2H => RAIN_ICE_PARAM%XWETINTP2H
+ !
+ NGAMINC => RAIN_ICE_PARAM%NGAMINC
+ NACCLBDAS => RAIN_ICE_PARAM%NACCLBDAS
+ NACCLBDAR => RAIN_ICE_PARAM%NACCLBDAR
+ NDRYLBDAR => RAIN_ICE_PARAM%NDRYLBDAR
+ NDRYLBDAS => RAIN_ICE_PARAM%NDRYLBDAS
+ NDRYLBDAG => RAIN_ICE_PARAM%NDRYLBDAG
+ NWETLBDAS => RAIN_ICE_PARAM%NWETLBDAS
+ NWETLBDAG => RAIN_ICE_PARAM%NWETLBDAG
+ NWETLBDAR => RAIN_ICE_PARAM%NWETLBDAR
+ NWETLBDAH => RAIN_ICE_PARAM%NWETLBDAH
+END SUBROUTINE RAIN_ICE_PARAM_ASSOCIATE
!
+SUBROUTINE RAIN_ICE_PARAM_ALLOCATE(HNAME, KDIM1, KDIM2)
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ INTEGER, INTENT(IN) :: KDIM1
+ INTEGER, OPTIONAL, INTENT(IN) :: KDIM2
+
+ SELECT CASE(TRIM(HNAME))
+ !1D arrays
+ CASE('XGAMINC_RIM1')
+ ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM1(KDIM1))
+ XGAMINC_RIM1 => RAIN_ICE_PARAM%XGAMINC_RIM1
+ CASE('XGAMINC_RIM2')
+ ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM2(KDIM1))
+ XGAMINC_RIM2 => RAIN_ICE_PARAM%XGAMINC_RIM2
+ CASE('XGAMINC_RIM4')
+ ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM4(KDIM1))
+ XGAMINC_RIM4 => RAIN_ICE_PARAM%XGAMINC_RIM4
+ !
+ !2D arrays
+ CASE('XKER_RACCSS')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_RACCSS(KDIM1, KDIM2))
+ XKER_RACCSS=> RAIN_ICE_PARAM%XKER_RACCSS
+ CASE('XKER_RACCS')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_RACCS(KDIM1, KDIM2))
+ XKER_RACCS=> RAIN_ICE_PARAM%XKER_RACCS
+ CASE('XKER_SACCRG')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_SACCRG(KDIM1, KDIM2))
+ XKER_SACCRG=> RAIN_ICE_PARAM%XKER_SACCRG
+ CASE('XKER_SDRYG')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_SDRYG(KDIM1, KDIM2))
+ XKER_SDRYG=> RAIN_ICE_PARAM%XKER_SDRYG
+ CASE('XKER_RDRYG')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_RDRYG(KDIM1, KDIM2))
+ XKER_RDRYG=> RAIN_ICE_PARAM%XKER_RDRYG
+ CASE('XKER_SWETH')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_SWETH(KDIM1, KDIM2))
+ XKER_SWETH=> RAIN_ICE_PARAM%XKER_SWETH
+ CASE('XKER_GWETH')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_GWETH(KDIM1, KDIM2))
+ XKER_GWETH=> RAIN_ICE_PARAM%XKER_GWETH
+ CASE('XKER_RWETH')
+ ALLOCATE(RAIN_ICE_PARAM%XKER_RWETH(KDIM1, KDIM2))
+ XKER_RWETH=> RAIN_ICE_PARAM%XKER_RWETH
+ END SELECT
+END SUBROUTINE RAIN_ICE_PARAM_ALLOCATE
+SUBROUTINE RAIN_ICE_PARAM_DEALLOCATE()
+ IMPLICIT NONE
+ XGAMINC_RIM1=>NULL()
+ DEALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM1)
+ XGAMINC_RIM2=>NULL()
+ DEALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM2)
+ XKER_RACCSS=>NULL()
+ DEALLOCATE(RAIN_ICE_PARAM%XKER_RACCSS)
+ XKER_RACCS=>NULL()
+ DEALLOCATE(RAIN_ICE_PARAM%XKER_RACCS)
+ XKER_SACCRG=>NULL()
+ DEALLOCATE(RAIN_ICE_PARAM%XKER_SACCRG)
+ XKER_SDRYG=>NULL()
+ DEALLOCATE(RAIN_ICE_PARAM%XKER_SDRYG)
+ XKER_RDRYG=>NULL()
+ DEALLOCATE(RAIN_ICE_PARAM%XKER_RDRYG)
+END SUBROUTINE RAIN_ICE_PARAM_DEALLOCATE
END MODULE MODD_RAIN_ICE_PARAM
diff --git a/src/PHYEX/micro/mode_ice4_compute_pdf.f90 b/src/PHYEX/micro/mode_ice4_compute_pdf.f90
index bc465eb65ef522324dea8c19d986f578bdab5518..7ccb88c1274867edbcff476743ebf920ea8dc2cc 100644
--- a/src/PHYEX/micro/mode_ice4_compute_pdf.f90
+++ b/src/PHYEX/micro/mode_ice4_compute_pdf.f90
@@ -3,38 +3,10 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_COMPUTE_PDF
-INTERFACE
-SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
- PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
+MODULE MODE_ICE4_COMPUTE_PDF
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
-CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
-CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
- ! note that PCF = PHLC_HCF + PHLC_LCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
- ! note that PRC = PHLC_HRC + PHLC_LRC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HCF !
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LCF
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HRI !
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LRI !
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction
-END SUBROUTINE ICE4_COMPUTE_PDF
-END INTERFACE
-END MODULE MODI_ICE4_COMPUTE_PDF
-SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+CONTAINS
+SUBROUTINE ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
@@ -56,9 +28,11 @@ SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
! ------------
!
!
-USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC,XBCRIAUTI,XACRIAUTI,XCRIAUTI
-USE MODD_CST, ONLY : XTT
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
USE MODE_MSG
!
@@ -66,9 +40,12 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
INTEGER, INTENT(IN) :: KSIZE
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method for cloud water
-CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method for cloud water
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method for cloud ice
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
@@ -76,11 +53,12 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+!Note for INTENT STATUS: in 'ADJU' case the PHL?_??? variables must be able to "cross" the subroutine untouched
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
! note that PCF = PHLC_HCF + PHLC_LCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
! note that PRC = PHLC_HRC + PHLC_LRC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HCF
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LCF
@@ -97,20 +75,25 @@ REAL, DIMENSION(KSIZE) :: ZRCRAUTC, & !RC value to begin rain formation =XC
ZHLC_HRCLOCAL, & !HLCLOUDS : LWC that is High LWC local in HCF
! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
! = PHLC_HRC/HCF+ PHLC_LRC/LCF
- ZSUMRC, ZSUMRI
+ ZSUMRC, ZSUMRI
REAL :: ZCOEFFRCM
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: JI
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ICE4_COMPUTE_PDF', 0, ZHOOK_HANDLE)!
+
!Cloud water split between high and low content part is done according to autoconversion option
-ZRCRAUTC(:)=XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
+ZRCRAUTC(:)=ICEP%XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
IF(HSUBG_AUCV_RC=='NONE') THEN
!Cloud water is entirely in low or high part
+ !$mnh_expand_where(JI=1:KSIZE)
WHERE(PRCT(:)>ZRCRAUTC(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PRCT(:)>XRTMIN(2))
+ ELSEWHERE(PRCT(:)>ICED%XRTMIN(2))
PHLC_HCF(:)=0.
PHLC_LCF(:)=1.
PHLC_HRC(:)=0.
@@ -121,15 +104,17 @@ IF(HSUBG_AUCV_RC=='NONE') THEN
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
END WHERE
+ !$mnh_end_expand_where(JI=1:KSIZE)
ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
!Cloud water is only in the cloudy part and entirely in low or high part
+ !$mnh_expand_where(JI=1:KSIZE)
WHERE(PCF(:)>0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:))
PHLC_HCF(:)=PCF(:)
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>XRTMIN(2))
+ ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>ICED%XRTMIN(2))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.0
@@ -140,15 +125,18 @@ ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
END WHERE
+ !$mnh_end_expand_where(JI=1:KSIZE)
ELSEIF(HSUBG_AUCV_RC=='ADJU') THEN
+ !$mnh_expand_where(JI=1:KSIZE)
ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
- WHERE(ZSUMRC .GT. 0.)
+ WHERE(ZSUMRC(:) .GT. 0.)
PHLC_LRC(:)=PHLC_LRC(:)*PRCT(:)/ZSUMRC(:)
PHLC_HRC(:)=PHLC_HRC(:)*PRCT(:)/ZSUMRC(:)
ELSEWHERE
PHLC_LRC(:)=0.
PHLC_HRC(:)=0.
- ENDWHERE
+ ENDWHERE
+ !$mnh_end_expand_where(JI=1:KSIZE)
ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
!Cloud water is split between high and low part according to a PDF
! 'HLCRECTPDF' : rectangular PDF form
@@ -158,13 +146,13 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
! 'SIGM' : Redelsperger and Sommeria (1986)
IF(HSUBG_PR_PDF=='SIGM') THEN
! Redelsperger and Sommeria (1986) but organised according to Turner (2011, 2012)
+ !$mnh_expand_where(JI=1:KSIZE)
WHERE (PRCT(:)>ZRCRAUTC(:)+PSIGMA_RC(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. &
- & PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
+ ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ &
&(2.*PSIGMA_RC(:))
PHLC_LCF(:)=MAX(0., PCF(:)-PHLC_HCF(:))
@@ -172,7 +160,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
&(PRCT(:)+PSIGMA_RC(:)+ZRCRAUTC(:))/ &
&(4.*PSIGMA_RC(:))
PHLC_LRC(:)=MAX(0., PRCT(:)-PHLC_HRC(:))
- ELSEWHERE(PRCT(:)>XRTMIN(2) .AND. PCF(:)>0.)
+ ELSEWHERE(PRCT(:)>ICED%XRTMIN(2) .AND. PCF(:)>0.)
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.
@@ -183,9 +171,10 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
END WHERE
- ! Turner (2011, 2012)
+ !$mnh_end_expand_where(JI=1:KSIZE)
ELSEIF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF' .OR. &
&HSUBG_PR_PDF=='HLCTRIANGPDF' .OR. HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
+ ! Turner (2011, 2012)
! Calculate maximum value r_cM from PDF forms
IF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF') THEN
ZCOEFFRCM=2.
@@ -194,6 +183,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
ZCOEFFRCM=4.
END IF
+ !$mnh_expand_where(JI=1:KSIZE)
WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0.)
ZHLC_RCMAX(:)=ZCOEFFRCM*PRCT(:)/PCF(:)
END WHERE
@@ -240,13 +230,13 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
WHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
! Calculate final values for LCF and HCF:
PHLC_LCF(:)=PCF(:) &
- *(ZHLC_HRCLOCAL- &
+ *(ZHLC_HRCLOCAL(:)- &
(PRCT(:) / PCF(:))) &
- / (ZHLC_HRCLOCAL-ZHLC_LRCLOCAL)
+ / (ZHLC_HRCLOCAL(:)-ZHLC_LRCLOCAL(:))
PHLC_HCF(:)=MAX(0., PCF(:)-PHLC_LCF(:))
!
! Calculate final values for LRC and HRC:
- PHLC_LRC(:)=ZHLC_LRCLOCAL*PHLC_LCF(:)
+ PHLC_LRC(:)=ZHLC_LRCLOCAL(:)*PHLC_LCF(:)
PHLC_HRC(:)=MAX(0., PRCT(:)-PHLC_LRC(:))
ELSEWHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).LE.ZRCRAUTC(:))
! Put all available cloud water and his fraction in the low part
@@ -260,23 +250,27 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
PHLC_LRC(:)=0.
PHLC_HRC(:)=0.
END WHERE
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_PR_PDF case')
- ENDIF
+ !$mnh_end_expand_where(JI=1:KSIZE)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_PR_PDF case')
+ ENDIF
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_AUCV case')
ENDIF
!
!Ice water split between high and low content part is done according to autoconversion option
-ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI)) ! Autoconversion ri threshold
+!$mnh_expand_where(JI=1:KSIZE)
+ ZCRIAUTI(:)=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(PT(:)-CST%XTT)+ICEP%XBCRIAUTI)) ! Autoconversion ri threshold
+!$mnh_end_expand_where(JI=1:KSIZE)
IF(HSUBG_AUCV_RI=='NONE') THEN
+ !$mnh_expand_where(JI=1:KSIZE)
!Cloud water is entirely in low or high part
WHERE(PRIT(:)>ZCRIAUTI(:))
PHLI_HCF(:)=1.
PHLI_LCF(:)=0.
PHLI_HRI(:)=PRIT(:)
PHLI_LRI(:)=0.
- ELSEWHERE(PRIT(:)>XRTMIN(2))
+ ELSEWHERE(PRIT(:)>ICED%XRTMIN(4))
PHLI_HCF(:)=0.
PHLI_LCF(:)=1.
PHLI_HRI(:)=0.
@@ -287,14 +281,16 @@ IF(HSUBG_AUCV_RI=='NONE') THEN
PHLI_HRI(:)=0.
PHLI_LRI(:)=0.
END WHERE
+ !$mnh_end_expand_where(JI=1:KSIZE)
ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
!Cloud water is only in the cloudy part and entirely in low or high part
+ !$mnh_expand_where(JI=1:KSIZE)
WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:))
PHLI_HCF(:)=PCF(:)
PHLI_LCF(:)=0.
PHLI_HRI(:)=PRIT(:)
PHLI_LRI(:)=0.
- ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>XRTMIN(2))
+ ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>ICED%XRTMIN(4))
PHLI_HCF(:)=0.
PHLI_LCF(:)=PCF(:)
PHLI_HRI(:)=0.0
@@ -305,20 +301,31 @@ ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
PHLI_HRI(:)=0.
PHLI_LRI(:)=0.
END WHERE
+ !$mnh_end_expand_where(JI=1:KSIZE)
ELSEIF(HSUBG_AUCV_RI=='ADJU') THEN
+ !$mnh_expand_where(JI=1:KSIZE)
ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
- WHERE(ZSUMRI .GT. 0.)
+ WHERE(ZSUMRI(:) .GT. 0.)
PHLI_LRI(:)=PHLI_LRI(:)*PRIT(:)/ZSUMRI(:)
PHLI_HRI(:)=PHLI_HRI(:)*PRIT(:)/ZSUMRI(:)
ELSEWHERE
PHLI_LRI(:)=0.
PHLI_HRI(:)=0.
ENDWHERE
+ !$mnh_end_expand_where(JI=1:KSIZE)
ELSE
!wrong HSUBG_AUCV_RI case
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'ICE4_COMPUTE_PDF', 'wrong HSUBG_AUCV_RI case' )
ENDIF
!
-PRF=MAX(PHLC_HCF,PHLI_HCF)
+!$mnh_expand_where(JI=1:KSIZE)
+#ifdef REPRO48
+ PRF(:)=PHLC_HCF(:)
+#else
+ PRF(:)=MAX(PHLC_HCF(:),PHLI_HCF(:))
+#endif
+!$mnh_end_expand_where(JI=1:KSIZE)
!
+IF (LHOOK) CALL DR_HOOK('ICE4_COMPUTE_PDF', 1, ZHOOK_HANDLE)
END SUBROUTINE ICE4_COMPUTE_PDF
+END MODULE MODE_ICE4_COMPUTE_PDF
diff --git a/src/PHYEX/micro/mode_ice4_fast_rg.f90 b/src/PHYEX/micro/mode_ice4_fast_rg.f90
index 0f7dea2179ad05277f16065f54b35c893dbb4deb..a3457b89e99265cb6324ac53302a3616e871d308 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rg.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rg.f90
@@ -2,84 +2,19 @@
!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_ICE4_FAST_RG
-INTERFACE
-SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, PCIT, &
- &PLBDAR, PLBDAS, PLBDAG, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- &PRGSI, PRGSI_MR, &
- &PWETG, &
- &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
- &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
- &PRG_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
+MODULE MODE_ICE4_FAST_RG
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
-END SUBROUTINE ICE4_FAST_RG
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RG
-SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
+CONTAINS
+SUBROUTINE ICE4_FAST_RG(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, PCIT, &
&PLBDAR, PLBDAS, PLBDAG, &
&PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
&PRGSI, PRGSI_MR, &
- &PWETG, &
+ &LDWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
- &PRG_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
+ &PRG_TEND)
!!
!!** PURPOSE
!! -------
@@ -94,140 +29,119 @@ SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
!!
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
- XEPSILO
-USE MODD_PARAM_ICE, ONLY: LCRFLIMIT,LEVLIMIT,LNULLWETG,LWETGPOST
-USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXG,XCXS,XDG,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: NDRYLBDAG,NDRYLBDAR,NDRYLBDAS,X0DEPG,X1DEPG,XCOLEXIG,XCOLEXSG,XCOLIG,XCOLSG,XDRYINTP1G, &
- XDRYINTP1R,XDRYINTP1S,XDRYINTP2G,XDRYINTP2R,XDRYINTP2S,XEX0DEPG,XEX1DEPG,XEXICFRR, &
- XEXRCFRI,XFCDRYG,XFIDRYG,XFRDRYG,XFSDRYG,XICFRR,XKER_RDRYG,XKER_SDRYG,XLBRDRYG1, &
- XLBRDRYG2,XLBRDRYG3,XLBSDRYG1,XLBSDRYG2,XLBSDRYG3,XRCFRI
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KPROMA,KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
+LOGICAL, DIMENSION(KPROMA), INTENT(OUT) :: LDWETG ! .TRUE. where graupel grows in wet mode
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCWETG ! Graupel wet growth
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIWETG ! Graupel wet growth
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRWETG ! Graupel wet growth
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSWETG ! Graupel wet growth
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCDRYG ! Graupel dry growth
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIDRYG ! Graupel dry growth
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRDRYG ! Graupel dry growth
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
+REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
!
!* 0.2 declaration of local variables
!
INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6, &
& IFREEZ1=7, IFREEZ2=8
-!
-LOGICAL, DIMENSION(KSIZE) :: GDRY
-INTEGER, DIMENSION(KSIZE) :: I1
-REAL, DIMENSION(KSIZE) :: ZDRY, ZDRYG, ZMASK
+LOGICAL, DIMENSION(KPROMA) :: GDRY, LLDRYG
+INTEGER, DIMENSION(KPROMA) :: I1
INTEGER :: IGDRY
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, &
- ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
- ZRWETG_INIT !Initial wet growth rate of the graupeln
+REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
+REAL, DIMENSION(KPROMA) :: ZZW, &
+ ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
+ ZRWETG_INIT !Initial wet growth rate of the graupeln
+REAL :: ZZW0D
INTEGER :: JJ, JL
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RG', 0, ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
!* 6.1 rain contact freezing
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRICFRRG(JL)=ZMASK(JL) * PRICFRRG(JL)
- PRRCFRIG(JL)=ZMASK(JL) * PRRCFRIG(JL)
- PRICFRR(JL)=ZMASK(JL) * PRICFRR(JL)
- ENDDO
-ELSE
- PRICFRRG(:)=0.
- PRRCFRIG(:)=0.
- WHERE(ZMASK(:)==1.)
- PRICFRRG(:) = XICFRR*PRIT(:) & ! RICFRRG
- *PLBDAR(:)**XEXICFRR &
- *PRHODREF(:)**(-XCEXVT)
- PRRCFRIG(:) = XRCFRI*PCIT(:) & ! RRCFRIG
- * PLBDAR(:)**XEXRCFRI &
- * PRHODREF(:)**(-XCEXVT-1.)
- END WHERE
-
- IF(LCRFLIMIT) THEN
- DO JL=1, KSIZE
- !Comparison between heat to be released (to freeze rain) and heat sink (rain and ice temperature change)
- !ZZW is the proportion of process that can take place
- ZZW(JL)=(1.-ZMASK(JL)) + & ! 1. outside of mask
- ZMASK(JL) * MAX(0., MIN(1., (PRICFRRG(JL)*XCI+PRRCFRIG(JL)*XCL)*(XTT-PT(JL)) / &
- MAX(1.E-20, XLVTT*PRRCFRIG(JL))))
- ENDDO
+ IF(PRIT(JL)>ICED%XRTMIN(4) .AND. PRRT(JL)>ICED%XRTMIN(3) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRICFRRG(JL) = ICEP%XICFRR*PRIT(JL) & ! RICFRRG
+ *PLBDAR(JL)**ICEP%XEXICFRR &
+ *PRHODREF(JL)**(-ICED%XCEXVT)
+ PRRCFRIG(JL) = ICEP%XRCFRI*PCIT(JL) & ! RRCFRIG
+ * PLBDAR(JL)**ICEP%XEXRCFRI &
+ * PRHODREF(JL)**(-ICED%XCEXVT-1.)
+ IF(PARAMI%LCRFLIMIT) THEN
+ !Comparison between heat to be released (to freeze rain) and heat sink (rain and ice temperature change)
+ !ZZW0D is the proportion of process that can take place
+ ZZW0D=MAX(0., MIN(1., (PRICFRRG(JL)*CST%XCI+PRRCFRIG(JL)*CST%XCL)*(CST%XTT-PT(JL)) / &
+ MAX(1.E-20, CST%XLVTT*PRRCFRIG(JL))))
+ PRRCFRIG(JL) = ZZW0D * PRRCFRIG(JL) !Part of rain that can be freezed
+ PRICFRR(JL) = (1.-ZZW0D) * PRICFRRG(JL) !Part of collected pristine ice converted to rain
+ PRICFRRG(JL) = ZZW0D * PRICFRRG(JL) !Part of collected pristine ice that lead to graupel
+ ELSE
+ PRICFRR(JL) = 0.
+ ENDIF
+ ENDIF
ELSE
- ZZW(:)=1.
+ PRICFRRG(JL)=0.
+ PRRCFRIG(JL)=0.
+ PRICFRR(JL)=0.
ENDIF
- DO JL=1, KSIZE
- PRRCFRIG(JL) = ZZW(JL) * PRRCFRIG(JL) !Part of rain that can be freezed
- PRICFRR(JL) = (1.-ZZW(JL)) * PRICFRRG(JL) !Part of collected pristine ice converted to rain
- PRICFRRG(JL) = ZZW(JL) * PRICFRRG(JL) !Part of collected pristine ice that lead to graupel
- ENDDO
-ENDIF
-DO JL=1, KSIZE
- PA_RI(JL) = PA_RI(JL) - PRICFRRG(JL) - PRICFRR(JL)
- PA_RR(JL) = PA_RR(JL) - PRRCFRIG(JL) + PRICFRR(JL)
- PA_RG(JL) = PA_RG(JL) + PRICFRRG(JL) + PRRCFRIG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRRCFRIG(JL) - PRICFRR(JL))*(PLSFACT(JL)-PLVFACT(JL))
ENDDO
!
!
@@ -235,67 +149,41 @@ ENDDO
!
! Wet and dry collection of rc and ri on graupel
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*PRG_TEND(JL, IRCDRYG)
- ENDDO
-ELSE
- ZZW(:)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
- END WHERE
- DO JL=1, KSIZE
- PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*XFCDRYG * PRCT(JL) * ZZW(JL)
- ENDDO
-ENDIF
+ IF(PRGT(JL)>ICED%XRTMIN(6) .AND. PRCT(JL)>ICED%XRTMIN(2) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRG_TEND(JL, IRCDRYG)=PLBDAG(JL)**(ICED%XCXG-ICED%XDG-2.) * PRHODREF(JL)**(-ICED%XCEXVT)
+ PRG_TEND(JL, IRCDRYG)=ICEP%XFCDRYG * PRCT(JL) * PRG_TEND(JL, IRCDRYG)
+ ENDIF
+ ELSE
+ PRG_TEND(JL, IRCDRYG)=0.
+ ENDIF
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
- &PCOMPUTE(JL)
+ IF(PRGT(JL)>ICED%XRTMIN(6) .AND. PRIT(JL)>ICED%XRTMIN(4) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRG_TEND(JL, IRIDRYG)=PLBDAG(JL)**(ICED%XCXG-ICED%XDG-2.) * PRHODREF(JL)**(-ICED%XCEXVT)
+ PRG_TEND(JL, IRIDRYG)=ICEP%XFIDRYG*EXP(ICEP%XCOLEXIG*(PT(JL)-CST%XTT))*PRIT(JL)*PRG_TEND(JL, IRIDRYG)
+ PRG_TEND(JL, IRIWETG)=PRG_TEND(JL, IRIDRYG) / (ICEP%XCOLIG*EXP(ICEP%XCOLEXIG*(PT(JL)-CST%XTT)))
+ ENDIF
+ ELSE
+ PRG_TEND(JL, IRIDRYG)=0.
+ PRG_TEND(JL, IRIWETG)=0.
+ ENDIF
ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IRIDRYG)=ZMASK(JL) * PRG_TEND(JL, IRIDRYG)
- PRG_TEND(JL, IRIWETG)=ZMASK(JL) * PRG_TEND(JL, IRIWETG)
- ENDDO
-ELSE
- PRG_TEND(:, IRIDRYG)=0.
- PRG_TEND(:, IRIWETG)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
- PRG_TEND(:, IRIDRYG)=XFIDRYG*EXP(XCOLEXIG*(PT(:)-XTT))*PRIT(:)*ZZW(:)
- PRG_TEND(:, IRIWETG)=PRG_TEND(:, IRIDRYG) / (XCOLIG*EXP(XCOLEXIG*(PT(:)-XTT)))
- END WHERE
-ENDIF
! Wet and dry collection of rs on graupel (6.2.1)
IGDRY = 0
-DO JJ = 1, SIZE(GDRY)
- ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JJ)
- IF (ZDRY(JJ)>0) THEN
+DO JL = 1, KSIZE
+ IF (PRST(JL)>ICED%XRTMIN(5) .AND. PRGT(JL)>ICED%XRTMIN(6) .AND. LDCOMPUTE(JL)) THEN
IGDRY = IGDRY + 1
- I1(IGDRY) = JJ
- GDRY(JJ) = .TRUE.
+ I1(IGDRY) = JL
+ GDRY(JL) = .TRUE.
ELSE
- GDRY(JJ) = .FALSE.
+ GDRY(JL) = .FALSE.
+ PRG_TEND(JL, IRSDRYG)=0.
+ PRG_TEND(JL, IRSWETG)=0.
END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IRSDRYG)=ZDRY(JL) * PRG_TEND(JL, IRSDRYG)
- PRG_TEND(JL, IRSWETG)=ZDRY(JL) * PRG_TEND(JL, IRSWETG)
- ENDDO
-ELSE
- PRG_TEND(:, IRSDRYG)=0.
- PRG_TEND(:, IRSWETG)=0.
+ENDDO
+IF(.NOT. LDSOFT) THEN
IF(IGDRY>0)THEN
!
!* 6.2.3 select the (PLBDAG,PLBDAS) couplet
@@ -309,13 +197,13 @@ ELSE
! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
! tabulate the SDRYG-kernel
!
- ZVEC1(1:IGDRY)=MAX(1.00001, MIN(REAL(NDRYLBDAG)-0.00001, &
- XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
+ ZVEC1(1:IGDRY)=MAX(1.00001, MIN(REAL(ICEP%NDRYLBDAG)-0.00001, &
+ ICEP%XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+ICEP%XDRYINTP2G))
IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY) )
ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
!
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
- XDRYINTP1S*LOG(ZVEC2(1:IGDRY))+XDRYINTP2S))
+ ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(ICEP%NDRYLBDAS)-0.00001, &
+ ICEP%XDRYINTP1S*LOG(ZVEC2(1:IGDRY))+ICEP%XDRYINTP2S))
IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
!
@@ -323,11 +211,11 @@ ELSE
! SDRYG-kernel
!
DO JJ=1, IGDRY
- ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ ZVEC3(JJ) = ( ICEP%XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* ZVEC1(JJ) &
- - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ - ( ICEP%XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
ZZW(:) = 0.
@@ -335,41 +223,40 @@ ELSE
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
!
- WHERE(GDRY(:))
- PRG_TEND(:, IRSWETG)=XFSDRYG*ZZW(:) & ! RSDRYG
- / XCOLSG &
- *(PRST(:))*( PLBDAG(:)**XCXG ) &
- *(PRHODREF(:)**(-XCEXVT)) &
- *( XLBSDRYG1/( PLBDAG(:)**2 ) + & ! Il s'agit de moments (?)
- XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + &
- XLBSDRYG3/( PLBDAS(:)**2))
- PRG_TEND(:, IRSDRYG)=PRG_TEND(:, IRSWETG)*XCOLSG*EXP(XCOLEXSG*(PT(:)-XTT))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GDRY(1:KSIZE))
+ PRG_TEND(1:KSIZE, IRSWETG)=ICEP%XFSDRYG*ZZW(1:KSIZE) & ! RSDRYG
+ / ICEP%XCOLSG &
+#if defined(REPRO48) || defined(REPRO55)
+ *(PLBDAS(1:KSIZE)**(ICED%XCXS-ICED%XBS))*( PLBDAG(1:KSIZE)**ICED%XCXG ) &
+ *(PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.)) &
+#else
+ *(PRST(1:KSIZE))*( PLBDAG(1:KSIZE)**ICED%XCXG ) &
+ *(PRHODREF(1:KSIZE)**(-ICED%XCEXVT)) &
+#endif
+ *( ICEP%XLBSDRYG1/( PLBDAG(1:KSIZE)**2 ) + &
+ ICEP%XLBSDRYG2/( PLBDAG(1:KSIZE) * PLBDAS(1:KSIZE) ) + &
+ ICEP%XLBSDRYG3/( PLBDAS(1:KSIZE)**2))
+ PRG_TEND(1:KSIZE, IRSDRYG)=PRG_TEND(1:KSIZE, IRSWETG)*ICEP%XCOLSG*EXP(ICEP%XCOLEXSG*(PT(1:KSIZE)-CST%XTT))
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ENDIF
ENDIF
!
!* 6.2.6 accretion of raindrops on the graupeln
!
IGDRY = 0
-DO JJ = 1, SIZE(GDRY)
- ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JJ)
- IF (ZDRY(JJ)>0) THEN
+DO JL = 1, KSIZE
+ IF (PRRT(JL)>ICED%XRTMIN(3) .AND. PRGT(JL)>ICED%XRTMIN(6) .AND. LDCOMPUTE(JL)) THEN
IGDRY = IGDRY + 1
- I1(IGDRY) = JJ
- GDRY(JJ) = .TRUE.
+ I1(IGDRY) = JL
+ GDRY(JL) = .TRUE.
ELSE
- GDRY(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IRRDRYG)=ZDRY(JL) * PRG_TEND(JL, IRRDRYG)
- ENDDO
-ELSE
- PRG_TEND(:, IRRDRYG)=0.
+ GDRY(JL) = .FALSE.
+ PRG_TEND(JL, IRRDRYG)=0.
+ ENDIF
+ENDDO
+IF(.NOT. LDSOFT) THEN
!
IF(IGDRY>0) THEN
!
@@ -378,19 +265,19 @@ ELSE
DO JJ = 1, IGDRY
ZVEC1(JJ) = PLBDAG(I1(JJ))
ZVEC2(JJ) = PLBDAR(I1(JJ))
- END DO
+ ENDDO
!
!* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
! tabulate the RDRYG-kernel
!
- ZVEC1(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
- XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
+ ZVEC1(1:IGDRY)=MAX(1.00001, MIN( REAL(ICEP%NDRYLBDAG)-0.00001, &
+ ICEP%XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+ICEP%XDRYINTP2G))
IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY))
ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
!
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
- XDRYINTP1R*LOG(ZVEC2(1:IGDRY))+XDRYINTP2R))
+ ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(ICEP%NDRYLBDAR)-0.00001, &
+ ICEP%XDRYINTP1R*LOG(ZVEC2(1:IGDRY))+ICEP%XDRYINTP2R))
IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
!
@@ -398,11 +285,11 @@ ELSE
! RDRYG-kernel
!
DO JJ=1, IGDRY
- ZVEC3(JJ)= ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ ZVEC3(JJ)= ( ICEP%XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* ZVEC1(JJ) &
- - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ - ( ICEP%XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
ZZW(:) = 0.
@@ -410,14 +297,16 @@ ELSE
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
!
- WHERE(GDRY(:))
- PRG_TEND(:, IRRDRYG) = XFRDRYG*ZZW(:) & ! RRDRYG
- *( PLBDAR(:)**(-4) )*( PLBDAG(:)**XCXG ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRDRYG1/( PLBDAG(:)**2 ) + &
- XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + &
- XLBRDRYG3/( PLBDAR(:)**2) )
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GDRY(1:KSIZE))
+ PRG_TEND(1:KSIZE, IRRDRYG) = ICEP%XFRDRYG*ZZW(1:KSIZE) & ! RRDRYG
+ *( PLBDAR(1:KSIZE)**(-4) )*( PLBDAG(1:KSIZE)**ICED%XCXG ) &
+ *( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+ *( ICEP%XLBRDRYG1/( PLBDAG(1:KSIZE)**2 ) + &
+ ICEP%XLBRDRYG2/( PLBDAG(1:KSIZE) * PLBDAR(1:KSIZE) ) + &
+ ICEP%XLBRDRYG3/( PLBDAR(1:KSIZE)**2) )
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ENDIF
ENDIF
@@ -426,158 +315,130 @@ DO JL=1, KSIZE
&PRG_TEND(JL, IRSDRYG)+PRG_TEND(JL, IRRDRYG)
ENDDO
-!Freezing rate
+!Freezing rate and growth mode
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRG_TEND(JL, IFREEZ1)
- PRG_TEND(JL, IFREEZ2)=ZMASK(JL) * PRG_TEND(JL, IFREEZ2)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRG_TEND(:, IFREEZ1)=MIN(PRG_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
- END WHERE
- ENDIF
- PRG_TEND(:, IFREEZ2)=0.
- WHERE(ZMASK(:)==1.)
- PRG_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-PRG_TEND(:, IFREEZ1))/(XRV*PT(:)) )
- PRG_TEND(:, IFREEZ1)=PRG_TEND(:, IFREEZ1)* ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )/ &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- PRG_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- !We must agregate, at least, the cold species
- ZRWETG_INIT(JL)=ZMASK(JL) * MAX(PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG), &
- &MAX(0., PRG_TEND(JL, IFREEZ1) + &
- &PRG_TEND(JL, IFREEZ2) * ( &
- &PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG) )))
-ENDDO
+ IF(PRGT(JL)>ICED%XRTMIN(6) .AND. LDCOMPUTE(JL)) THEN
+ !Freezing rate
+ IF(.NOT. LDSOFT) THEN
+ PRG_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(CST%XEPSILO+PRVT(JL)) ! Vapor pressure
+ IF(PARAMI%LEVLIMIT) THEN
+ PRG_TEND(JL, IFREEZ1)=MIN(PRG_TEND(JL, IFREEZ1), EXP(CST%XALPI-CST%XBETAI/PT(JL)-CST%XGAMI*ALOG(PT(JL)))) ! min(ev, es_i(T))
+ ENDIF
+ PRG_TEND(JL, IFREEZ1)=PKA(JL)*(CST%XTT-PT(JL)) + &
+ (PDV(JL)*(CST%XLVTT+(CST%XCPV-CST%XCL)*(PT(JL)-CST%XTT)) &
+ *(CST%XESTT-PRG_TEND(JL, IFREEZ1))/(CST%XRV*PT(JL)) )
+ PRG_TEND(JL, IFREEZ1)=PRG_TEND(JL, IFREEZ1)* ( ICEP%X0DEPG* PLBDAG(JL)**ICEP%XEX0DEPG + &
+ ICEP%X1DEPG*PCJ(JL)*PLBDAG(JL)**ICEP%XEX1DEPG )/ &
+ ( PRHODREF(JL)*(CST%XLMTT-CST%XCL*(CST%XTT-PT(JL))) )
+ PRG_TEND(JL, IFREEZ2)=(PRHODREF(JL)*(CST%XLMTT+(CST%XCI-CST%XCL)*(CST%XTT-PT(JL))) ) / &
+ ( PRHODREF(JL)*(CST%XLMTT-CST%XCL*(CST%XTT-PT(JL))) )
+ ENDIF
+ ZRWETG_INIT(JL)=MAX(PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG), &
+ &MAX(0., PRG_TEND(JL, IFREEZ1) + &
+ & PRG_TEND(JL, IFREEZ2) * (PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG))))
-!Growth mode
-DO JL=1, KSIZE
- PWETG(JL) = ZMASK(JL) * & !
- & MAX(0., SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
- &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
-ENDDO
-IF(LNULLWETG) THEN
- DO JL=1, KSIZE
- PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRDRYG_INIT(JL)))
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRWETG_INIT(JL)))
- ENDDO
-ENDIF
-IF(.NOT. LWETGPOST) THEN
- DO JL=1, KSIZE
- PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., PT(JL)-XTT))
- ENDDO
-ENDIF
-DO JL=1, KSIZE
- ZDRYG(JL) = ZMASK(JL) * & !
- & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
- & MAX(0., -SIGN(1., 1.E-20-ZRDRYG_INIT(JL))) * & ! WHERE(ZRDRYG_INIT(:)>0.)
- & MAX(0., -SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
- &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ !Growth mode
+ LDWETG(JL)=MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))<= &
+ &MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG))
+
+ IF(PARAMI%LNULLWETG) THEN
+ LDWETG(JL) = LDWETG(JL) .AND. ZRDRYG_INIT(JL)>0.
+ ELSE
+ LDWETG(JL) = LDWETG(JL) .AND. ZRWETG_INIT(JL)>0.
+ ENDIF
+ IF(.NOT. PARAMI%LWETGPOST) THEN
+ LDWETG(JL) = LDWETG(JL) .AND. PT(JL)<CST%XTT
+ ENDIF
+
+#ifdef REPRO48
+ LLDRYG(JL)=PT(JL)<CST%XTT .AND. ZRDRYG_INIT(JL)>0. .AND. &
+#else
+ LLDRYG(JL)=PT(JL)<CST%XTT .AND. ZRDRYG_INIT(JL)>1.E-20 .AND. &
+#endif
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))>&
+ &MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG))
+ ELSE
+ PRG_TEND(JL, IFREEZ1)=0.
+ PRG_TEND(JL, IFREEZ2)=0.
+ ZRWETG_INIT(JL)=0.
+ LDWETG(JL)=.FALSE.
+ LLDRYG(JL)=.FALSE.
+ ENDIF
ENDDO
! Part of ZRWETG to be converted into hail
! Graupel can be produced by other processes instantaneously (inducing a mixing ratio change, PRGSI_MR) or
! as a tendency (PRWETGH)
-PRWETGH(:)=0.
-PRWETGH_MR(:)=0.
IF(KRR==7) THEN
- WHERE(PWETG(:)==1.)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(LDWETG(1:KSIZE))
!assume a linear percent of conversion of produced graupel into hail
- PRWETGH(:)=(MAX(0., PRGSI(:)+PRICFRRG(:)+PRRCFRIG(:))+ZRWETG_INIT(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
- PRWETGH_MR(:)=MAX(0., PRGSI_MR(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
+ PRWETGH(1:KSIZE)=(MAX(0., PRGSI(1:KSIZE)+PRICFRRG(1:KSIZE)+PRRCFRIG(1:KSIZE))+ZRWETG_INIT(1:KSIZE))*&
+ &ZRDRYG_INIT(1:KSIZE)/(ZRWETG_INIT(1:KSIZE)+ZRDRYG_INIT(1:KSIZE))
+ PRWETGH_MR(1:KSIZE)=MAX(0., PRGSI_MR(1:KSIZE))*ZRDRYG_INIT(1:KSIZE)/(ZRWETG_INIT(1:KSIZE)+ZRDRYG_INIT(1:KSIZE))
+ ELSEWHERE
+ PRWETGH(1:KSIZE)=0.
+ PRWETGH_MR(1:KSIZE)=0.
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
+ELSE
+ PRWETGH(:)=0.
+ PRWETGH_MR(:)=0.
ENDIF
DO JL=1, KSIZE
!Aggregated minus collected
- PRRWETG(JL)=-PWETG(JL) * (PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG)+&
- &PRG_TEND(JL, IRCDRYG)-ZRWETG_INIT(JL))
- PRCWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRCDRYG)
- PRIWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRIWETG)
- PRSWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRSWETG)
-
- PRCDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRCDRYG)
- PRRDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRRDRYG)
- PRIDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRIDRYG)
- PRSDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRSDRYG)
+ IF(LDWETG(JL)) THEN
+ PRRWETG(JL)=-(PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG)+&
+ &PRG_TEND(JL, IRCDRYG)-ZRWETG_INIT(JL))
+ PRCWETG(JL)=PRG_TEND(JL, IRCDRYG)
+ PRIWETG(JL)=PRG_TEND(JL, IRIWETG)
+ PRSWETG(JL)=PRG_TEND(JL, IRSWETG)
+ ELSE
+ PRRWETG(JL)=0.
+ PRCWETG(JL)=0.
+ PRIWETG(JL)=0.
+ PRSWETG(JL)=0.
+ ENDIF
- PA_RC(JL) = PA_RC(JL) - PRCWETG(JL)
- PA_RI(JL) = PA_RI(JL) - PRIWETG(JL)
- PA_RS(JL) = PA_RS(JL) - PRSWETG(JL)
- PA_RG(JL) = PA_RG(JL) + PRCWETG(JL) + PRIWETG(JL) + PRSWETG(JL) + PRRWETG(JL)
- PA_RR(JL) = PA_RR(JL) - PRRWETG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRCWETG(JL) + PRRWETG(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA_RG(JL) = PA_RG(JL) - PRWETGH(JL)
- PA_RH(JL) = PA_RH(JL) + PRWETGH(JL)
- PB_RG(JL) = PB_RG(JL) - PRWETGH_MR(JL)
- PB_RH(JL) = PB_RH(JL) + PRWETGH_MR(JL)
- PA_RC(JL) = PA_RC(JL) - PRCDRYG(JL)
- PA_RI(JL) = PA_RI(JL) - PRIDRYG(JL)
- PA_RS(JL) = PA_RS(JL) - PRSDRYG(JL)
- PA_RR(JL) = PA_RR(JL) - PRRDRYG(JL)
- PA_RG(JL) = PA_RG(JL) + PRCDRYG(JL) + PRIDRYG(JL) + PRSDRYG(JL) + PRRDRYG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRCDRYG(JL)+PRRDRYG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ IF(LLDRYG(JL)) THEN
+ PRCDRYG(JL)=PRG_TEND(JL, IRCDRYG)
+ PRRDRYG(JL)=PRG_TEND(JL, IRRDRYG)
+ PRIDRYG(JL)=PRG_TEND(JL, IRIDRYG)
+ PRSDRYG(JL)=PRG_TEND(JL, IRSDRYG)
+ ELSE
+ PRCDRYG(JL)=0.
+ PRRDRYG(JL)=0.
+ PRIDRYG(JL)=0.
+ PRSDRYG(JL)=0.
+ ENDIF
ENDDO
!
!* 6.5 Melting of the graupeln
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRGMLTR(JL)=ZMASK(JL) * PRGMLTR(JL)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRGMLTR(JL)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRGMLTR(:)=MIN(PRGMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
- END WHERE
+ IF(PRGT(JL)>ICED%XRTMIN(6) .AND. PT(JL)>CST%XTT .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRGMLTR(JL)=PRVT(JL)*PPRES(JL)/(CST%XEPSILO+PRVT(JL)) ! Vapor pressure
+ IF(PARAMI%LEVLIMIT) THEN
+ PRGMLTR(JL)=MIN(PRGMLTR(JL), EXP(CST%XALPW-CST%XBETAW/PT(JL)-CST%XGAMW*ALOG(PT(JL)))) ! min(ev, es_w(T))
+ ENDIF
+ PRGMLTR(JL)=PKA(JL)*(CST%XTT-PT(JL)) + &
+ PDV(JL)*(CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( PT(JL) - CST%XTT )) &
+ *(CST%XESTT-PRGMLTR(JL))/(CST%XRV*PT(JL))
+ PRGMLTR(JL)=MAX(0., (-PRGMLTR(JL)* &
+ (ICEP%X0DEPG* PLBDAG(JL)**ICEP%XEX0DEPG + &
+ ICEP%X1DEPG*PCJ(JL)*PLBDAG(JL)**ICEP%XEX1DEPG) - &
+ (PRG_TEND(JL, IRCDRYG)+PRG_TEND(JL, IRRDRYG)) * &
+ (PRHODREF(JL)*CST%XCL*(CST%XTT-PT(JL)))) / &
+ ( PRHODREF(JL)*CST%XLMTT ) )
+ ENDIF
+ ELSE
+ PRGMLTR(JL)=0.
ENDIF
- DO JL=1, KSIZE
- PRGMLTR(JL)=ZMASK(JL) * (PKA(JL)*(XTT-PT(JL)) + &
- ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
- *(XESTT-PRGMLTR(JL))/(XRV*PT(JL)) ))
- ENDDO
- WHERE(ZMASK(:)==1.)
- !
- ! compute RGMLTR
- !
- PRGMLTR(:) = MAX( 0.0,( -PRGMLTR(:) * &
- ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - &
- ( PRG_TEND(:, IRCDRYG)+PRG_TEND(:, IRRDRYG) ) * &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) + PRGMLTR(JL)
- PA_RG(JL) = PA_RG(JL) - PRGMLTR(JL)
- PA_TH(JL) = PA_TH(JL) - PRGMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
ENDDO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RG', 1, ZHOOK_HANDLE)
+
END SUBROUTINE ICE4_FAST_RG
+END MODULE MODE_ICE4_FAST_RG
diff --git a/src/PHYEX/micro/mode_ice4_fast_rh.f90 b/src/PHYEX/micro/mode_ice4_fast_rh.f90
index a21c85f19308cffede426f7b2510f52ef5cd447a..3d13263d73a3d9d3da053943622cc70cc540113b 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rh.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rh.f90
@@ -2,74 +2,17 @@
!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_ICE4_FAST_RH
-INTERFACE
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
+MODULE MODE_ICE4_FAST_RH
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-END SUBROUTINE ICE4_FAST_RH
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RH
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
+CONTAINS
+SUBROUTINE ICE4_FAST_RH(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
&PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
&PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
+ &PRH_TEND)
!!
!!** PURPOSE
!! -------
@@ -84,152 +27,126 @@ SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
!!
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
-USE MODD_PARAM_ICE, ONLY: LCONVHG,LEVLIMIT,LNULLWETH,LWETHPOST
-USE MODD_RAIN_ICE_DESCR, ONLY: XBG,XBS,XCEXVT,XCXG,XCXH,XCXS,XDH,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG,NWETLBDAH,NWETLBDAR,NWETLBDAS,X0DEPH,X1DEPH,XCOLEXGH,XCOLEXIH,XCOLGH,XCOLIH,XCOLEXSH, &
- XCOLSH,XEX0DEPH,XEX1DEPH,XFGWETH,XFRWETH,XFSWETH,XFWETH,XKER_GWETH,XKER_RWETH,XKER_SWETH, &
- XLBGWETH1,XLBGWETH2,XLBGWETH3,XLBRWETH1,XLBRWETH2,XLBRWETH3,XLBSWETH1,XLBSWETH2,XLBSWETH3, &
- XWETINTP1G,XWETINTP1H,XWETINTP1R,XWETINTP1S,XWETINTP2G,XWETINTP2H,XWETINTP2R,XWETINTP2S
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
!
-USE MODE_MPPDB
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDWETG ! .TRUE. where graupel grows in wet mode
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRRT ! Rain m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
+REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
!
!* 0.2 declaration of local variables
!
INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
& IFREEZ1=9, IFREEZ2=10
-!
-LOGICAL, DIMENSION(KSIZE) :: GWET
-REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
-INTEGER :: IHAIL, IGWET
-INTEGER, DIMENSION(KSIZE) :: I1
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, &
- ZRDRYH_INIT, ZRWETH_INIT, &
- ZRDRYHG
+LOGICAL, DIMENSION(KPROMA) :: GWET
+INTEGER :: IGWET
+INTEGER, DIMENSION(KPROMA) :: I1
+REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
+REAL, DIMENSION(KPROMA) :: ZZW, &
+ ZRDRYH_INIT, ZRWETH_INIT, &
+ ZRDRYHG
INTEGER :: JJ, JL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+LOGICAL, DIMENSION(KPROMA) :: LLWETH, LLDRYH
!
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RH',0,ZHOOK_HANDLE)
!
!
!* 7.2 compute the Wet and Dry growth of hail
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRCWETH)=ZMASK(JL) * PRH_TEND(JL, IRCWETH)
- ENDDO
-ELSE
- PRH_TEND(:, IRCWETH)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
- &PCOMPUTE(JL)
+ IF(PRHT(JL)>ICED%XRTMIN(7) .AND. PRCT(JL)>ICED%XRTMIN(2) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRH_TEND(JL, IRCWETH)=PLBDAH(JL)**(ICED%XCXH-ICED%XDH-2.0) * PRHODREF(JL)**(-ICED%XCEXVT)
+ PRH_TEND(JL, IRCWETH)=ICEP%XFWETH * PRCT(JL) * PRH_TEND(JL, IRCWETH)
+ ENDIF
+ ELSE
+ PRH_TEND(JL, IRCWETH)=0.
+ ENDIF
+
+ IF(PRHT(JL)>ICED%XRTMIN(7) .AND. PRIT(JL)>ICED%XRTMIN(4) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRH_TEND(JL, IRIWETH)=PLBDAH(JL)**(ICED%XCXH-ICED%XDH-2.0) * PRHODREF(JL)**(-ICED%XCEXVT)
+ PRH_TEND(JL, IRIWETH)=ICEP%XFWETH * PRIT(JL) * PRH_TEND(JL, IRIWETH) ! RIWETH
+ PRH_TEND(JL, IRIDRYH)=PRH_TEND(JL, IRIWETH)*(ICEP%XCOLIH*EXP(ICEP%XCOLEXIH*(PT(JL)-CST%XTT))) ! RIDRYH
+ ENDIF
+ ELSE
+ PRH_TEND(JL, IRIWETH)=0.
+ PRH_TEND(JL, IRIDRYH)=0.
+ ENDIF
ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRIWETH)=ZMASK(JL) * PRH_TEND(JL, IRIWETH)
- PRH_TEND(JL, IRIDRYH)=ZMASK(JL) * PRH_TEND(JL, IRIDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRIWETH)=0.
- PRH_TEND(:, IRIDRYH)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH
- PRH_TEND(:, IRIDRYH)=PRH_TEND(:, IRIWETH)*(XCOLIH*EXP(XCOLEXIH*(PT(:)-XTT))) ! RIDRYH
- END WHERE
-ENDIF
!
!* 7.2.1 accretion of aggregates on the hailstones
!
IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
+DO JL = 1, KSIZE
+ IF (PRHT(JL)>ICED%XRTMIN(7) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
+ I1(IGWET) = JL
+ GWET(JL) = .TRUE.
ELSE
- GWET(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRSWETH)=ZWET(JL) * PRH_TEND(JL, IRSWETH)
- PRH_TEND(JL, IRSDRYH)=ZWET(JL) * PRH_TEND(JL, IRSDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRSWETH)=0.
- PRH_TEND(:, IRSDRYH)=0.
+ GWET(JL) = .FALSE.
+ PRH_TEND(JL, IRSWETH)=0.
+ PRH_TEND(JL, IRSDRYH)=0.
+ ENDIF
+ENDDO
+IF(.NOT. LDSOFT) THEN
IF(IGWET>0)THEN
!
!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
@@ -237,19 +154,19 @@ ELSE
DO JJ = 1, IGWET
ZVEC1(JJ) = PLBDAH(I1(JJ))
ZVEC2(JJ) = PLBDAS(I1(JJ))
- END DO
+ ENDDO
!
!* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
! tabulate the SWETH-kernel
!
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(ICEP%NWETLBDAH)-0.00001, &
+ ICEP%XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + ICEP%XWETINTP2H ) )
IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
!
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
- XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(ICEP%NWETLBDAS)-0.00001, &
+ ICEP%XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + ICEP%XWETINTP2S ) )
IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
!
@@ -257,11 +174,11 @@ ELSE
! SWETH-kernel
!
DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ ZVEC3(JJ) = ( ICEP%XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* ZVEC1(JJ) &
- - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ - ( ICEP%XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
ZZW(:) = 0.
@@ -269,42 +186,40 @@ ELSE
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
!
- WHERE(GWET(:))
- PRH_TEND(:, IRSWETH)=XFSWETH*ZZW(:) &
- *( PRST(:))*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT) ) &
- *( XLBSWETH1/( PLBDAH(:)**2 ) + &
- XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + &
- XLBSWETH3/( PLBDAS(:)**2) )
- PRH_TEND(:, IRSDRYH)=PRH_TEND(:, IRSWETH)*(XCOLSH*EXP(XCOLEXSH*(PT(:)-XTT)))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GWET(1:KSIZE))
+ PRH_TEND(1:KSIZE, IRSWETH)=ICEP%XFSWETH*ZZW(1:KSIZE) & ! RSWETH
+#if defined(REPRO48) || defined(REPRO55)
+ *( PLBDAS(1:KSIZE)**(ICED%XCXS-ICED%XBS) )*( PLBDAH(1:KSIZE)**ICED%XCXH ) &
+ *( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+#else
+ *( PRST(1:KSIZE))*( PLBDAH(1:KSIZE)**ICED%XCXH ) &
+ *( PRHODREF(1:KSIZE)**(-ICED%XCEXVT) ) &
+#endif
+ *( ICEP%XLBSWETH1/( PLBDAH(1:KSIZE)**2 ) + &
+ ICEP%XLBSWETH2/( PLBDAH(1:KSIZE) * PLBDAS(1:KSIZE) ) + &
+ ICEP%XLBSWETH3/( PLBDAS(1:KSIZE)**2) )
+ PRH_TEND(1:KSIZE, IRSDRYH)=PRH_TEND(1:KSIZE, IRSWETH)*(ICEP%XCOLSH*EXP(ICEP%XCOLEXSH*(PT(1:KSIZE)-CST%XTT)))
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ENDIF
ENDIF
!
!* 7.2.6 accretion of graupeln on the hailstones
!
IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
+DO JL = 1, KSIZE
+ IF (PRHT(JL)>ICED%XRTMIN(7) .AND. PRGT(JL)>ICED%XRTMIN(6) .AND. LDCOMPUTE(JL)) THEN
IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
+ I1(IGWET) = JL
+ GWET(JL) = .TRUE.
ELSE
- GWET(JJ) = .FALSE.
+ GWET(JL) = .FALSE.
+ PRH_TEND(JL, IRGWETH)=0.
+ PRH_TEND(JL, IRGDRYH)=0.
END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRGWETH)=ZWET(JL) * PRH_TEND(JL, IRGWETH)
- PRH_TEND(JL, IRGDRYH)=ZWET(JL) * PRH_TEND(JL, IRGDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRGWETH)=0.
- PRH_TEND(:, IRGDRYH)=0.
+ENDDO
+IF(.NOT. LDSOFT) THEN
IF(IGWET>0)THEN
!
!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
@@ -318,13 +233,13 @@ ELSE
! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
! tabulate the GWETH-kernel
!
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(ICEP%NWETLBDAG)-0.00001, &
+ ICEP%XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + ICEP%XWETINTP2H ) )
IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
!
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
- XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(ICEP%NWETLBDAG)-0.00001, &
+ ICEP%XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + ICEP%XWETINTP2G ) )
IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
!
@@ -332,11 +247,11 @@ ELSE
! GWETH-kernel
!
DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ ZVEC3(JJ) = ( ICEP%XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* ZVEC1(JJ) &
- - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ - ( ICEP%XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
ZZW(:) = 0.
@@ -344,44 +259,38 @@ ELSE
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
!
- WHERE(GWET(:))
- PRH_TEND(:, IRGWETH)=XFGWETH*ZZW(:) & ! RGWETH
- *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBGWETH1/( PLBDAH(:)**2 ) + &
- XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + &
- XLBGWETH3/( PLBDAG(:)**2) )
- PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GWET(1:KSIZE))
+ PRH_TEND(1:KSIZE, IRGWETH)=ICEP%XFGWETH*ZZW(1:KSIZE) & ! RGWETH
+ *( PLBDAG(1:KSIZE)**(ICED%XCXG-ICED%XBG) )*( PLBDAH(1:KSIZE)**ICED%XCXH ) &
+ *( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+ *( ICEP%XLBGWETH1/( PLBDAH(1:KSIZE)**2 ) + &
+ ICEP%XLBGWETH2/( PLBDAH(1:KSIZE) * PLBDAG(1:KSIZE) ) + &
+ ICEP%XLBGWETH3/( PLBDAG(1:KSIZE)**2) )
+ PRH_TEND(1:KSIZE, IRGDRYH)=PRH_TEND(1:KSIZE, IRGWETH)
END WHERE
!When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same
- WHERE(GWET(:) .AND. .NOT. PWETG(:)==1.)
- PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT)))
+ WHERE(GWET(1:KSIZE) .AND. .NOT. LDWETG(1:KSIZE))
+ PRH_TEND(1:KSIZE, IRGDRYH)=PRH_TEND(1:KSIZE, IRGDRYH)*(ICEP%XCOLGH*EXP(ICEP%XCOLEXGH*(PT(1:KSIZE)-CST%XTT)))
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
END IF
ENDIF
!
!* 7.2.11 accretion of raindrops on the hailstones
!
IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
+DO JL = 1, KSIZE
+ IF (PRHT(JL)>ICED%XRTMIN(7) .AND. PRRT(JL)>ICED%XRTMIN(3) .AND. LDCOMPUTE(JL)) THEN
IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
+ I1(IGWET) = JL
+ GWET(JL) = .TRUE.
ELSE
- GWET(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRRWETH)=ZWET(JL) * PRH_TEND(JL, IRRWETH)
- ENDDO
-ELSE
- PRH_TEND(:, IRRWETH)=0.
+ GWET(JL) = .FALSE.
+ PRH_TEND(JL, IRRWETH)=0.
+ ENDIF
+ENDDO
+IF(.NOT. LDSOFT) THEN
IF(IGWET>0)THEN
!
!* 7.2.12 select the (PLBDAH,PLBDAR) couplet
@@ -389,19 +298,19 @@ ELSE
DO JJ = 1, IGWET
ZVEC1(JJ) = PLBDAH(I1(JJ))
ZVEC2(JJ) = PLBDAR(I1(JJ))
- END DO
+ ENDDO
!
!* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
! tabulate the RWETH-kernel
!
- ZVEC1(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
- XWETINTP1H*LOG(ZVEC1(1:IGWET))+XWETINTP2H))
+ ZVEC1(1:IGWET)=MAX(1.00001, MIN( REAL(ICEP%NWETLBDAH)-0.00001, &
+ ICEP%XWETINTP1H*LOG(ZVEC1(1:IGWET))+ICEP%XWETINTP2H))
IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET))
ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-REAL(IVEC1(1:IGWET))
!
- ZVEC2(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAR)-0.00001, &
- XWETINTP1R*LOG(ZVEC2(1:IGWET))+XWETINTP2R))
+ ZVEC2(1:IGWET)=MAX(1.00001, MIN( REAL(ICEP%NWETLBDAR)-0.00001, &
+ ICEP%XWETINTP1R*LOG(ZVEC2(1:IGWET))+ICEP%XWETINTP2R))
IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET))
ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-REAL(IVEC2(1:IGWET))
!
@@ -409,11 +318,11 @@ ELSE
! RWETH-kernel
!
DO JJ=1, IGWET
- ZVEC3(JJ)= ( XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ ZVEC3(JJ)= ( ICEP%XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* ZVEC1(JJ) &
- - ( XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ - ( ICEP%XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
ZZW(:) = 0.
@@ -421,14 +330,16 @@ ELSE
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
!
- WHERE(GWET(:))
- PRH_TEND(:, IRRWETH) = XFRWETH*ZZW(:) & ! RRWETH
- *( PLBDAR(:)**(-4) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRWETH1/( PLBDAH(:)**2 ) + &
- XLBRWETH2/( PLBDAH(:) * PLBDAR(:) ) + &
- XLBRWETH3/( PLBDAR(:)**2) )
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GWET(1:KSIZE))
+ PRH_TEND(1:KSIZE, IRRWETH) = ICEP%XFRWETH*ZZW(1:KSIZE) & ! RRWETH
+ *( PLBDAR(1:KSIZE)**(-4) )*( PLBDAH(1:KSIZE)**ICED%XCXH ) &
+ *( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+ *( ICEP%XLBRWETH1/( PLBDAH(1:KSIZE)**2 ) + &
+ ICEP%XLBRWETH2/( PLBDAH(1:KSIZE) * PLBDAR(1:KSIZE) ) + &
+ ICEP%XLBRWETH3/( PLBDAR(1:KSIZE)**2) )
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ENDIF
ENDIF
!
@@ -438,157 +349,132 @@ DO JL=1, KSIZE
ENDDO
!
!* 7.3 compute the Wet growth of hail
-!
-DO JL=1, KSIZE
- ZHAIL(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IFREEZ1)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ1)
- PRH_TEND(JL, IFREEZ2)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ2)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZHAIL(:)==1.)
- PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
- END WHERE
- ENDIF
- PRH_TEND(:, IFREEZ2)=0.
- WHERE(ZHAIL(:)==1.)
- PRH_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-PRH_TEND(:, IFREEZ1))/(XRV*PT(:)) )
- PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH )/ &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- PRH_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- !We must agregate, at least, the cold species
- ZRWETH_INIT(JL)=ZHAIL(JL) * MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
- &MAX(0., PRH_TEND(JL, IFREEZ1) + &
- &PRH_TEND(JL, IFREEZ2) * ( &
- &PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH) )))
-ENDDO
-!
+! and
!* 7.4 Select Wet or Dry case
!
-!Wet case
DO JL=1, KSIZE
- ZWETH(JL) = ZHAIL(JL) * &
- & MAX(0., SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH)) - &
- &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))))
-ENDDO
-IF(LNULLWETH) THEN
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) ! WHERE(ZRDRYH_INIT(:)>0.)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRWETH_INIT(JL))) ! WHERE(ZRWETH_INIT(:)>0.)
- ENDDO
-ENDIF
-IF(.NOT. LWETHPOST) THEN
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
- ENDDO
-ENDIF
-DO JL=1, KSIZE
- ZDRYH(JL) = ZHAIL(JL) * &
- & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
- & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
- & MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
- &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
+ IF(PRHT(JL)>ICED%XRTMIN(7) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(CST%XEPSILO+PRVT(JL)) ! Vapor pressure
+ IF(PARAMI%LEVLIMIT) THEN
+ PRH_TEND(JL, IFREEZ1)=MIN(PRH_TEND(JL, IFREEZ1), EXP(CST%XALPI-CST%XBETAI/PT(JL)-CST%XGAMI*ALOG(PT(JL)))) ! min(ev, es_i(T))
+ ENDIF
+ PRH_TEND(JL, IFREEZ1)=PKA(JL)*(CST%XTT-PT(JL)) + &
+ (PDV(JL)*(CST%XLVTT+(CST%XCPV-CST%XCL)*(PT(JL)-CST%XTT)) &
+ *(CST%XESTT-PRH_TEND(JL, IFREEZ1))/(CST%XRV*PT(JL)))
+ PRH_TEND(JL, IFREEZ1)=PRH_TEND(JL, IFREEZ1)* (ICEP%X0DEPH* PLBDAH(JL)**ICEP%XEX0DEPH + &
+ ICEP%X1DEPH*PCJ(JL)*PLBDAH(JL)**ICEP%XEX1DEPH)/ &
+ (PRHODREF(JL)*(CST%XLMTT-CST%XCL*(CST%XTT-PT(JL))))
+ PRH_TEND(JL, IFREEZ2)=(PRHODREF(JL)*(CST%XLMTT+(CST%XCI-CST%XCL)*(CST%XTT-PT(JL)))) / &
+ (PRHODREF(JL)*(CST%XLMTT-CST%XCL*(CST%XTT-PT(JL))))
+ ENDIF
+
+ !We must agregate, at least, the cold species
+ ZRWETH_INIT(JL)=MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
+ &MAX(0., PRH_TEND(JL, IFREEZ1) + &
+ &PRH_TEND(JL, IFREEZ2)*(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH))))
+
+ !Wet case
+ LLWETH(JL)=MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))<= &
+ MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH))
+ IF(PARAMI%LNULLWETH) THEN
+ LLWETH(JL) = LLWETH(JL) .AND. ZRDRYH_INIT(JL)>0.
+ ELSE
+ LLWETH(JL) = LLWETH(JL) .AND. ZRWETH_INIT(JL)>0.
+ ENDIF
+ IF(.NOT. PARAMI%LWETHPOST) THEN
+ LLWETH(JL) = LLWETH(JL) .AND. PT(JL)<CST%XTT
+ ENDIF
+
+ !Dry case
+#ifdef REPRO48
+ LLDRYH(JL)=PT(JL)<CST%XTT .AND. ZRDRYH_INIT(JL)>0. .AND. &
+#else
+ LLDRYH(JL)=PT(JL)<CST%XTT .AND. ZRDRYH_INIT(JL)>1.E-20 .AND. &
+#endif
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))>&
+ &MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH))
+
+ ELSE
+ PRH_TEND(JL, IFREEZ1)=0.
+ PRH_TEND(JL, IFREEZ2)=0.
+ ZRWETH_INIT(JL)=0.
+ LLWETH(JL)=.FALSE.
+ LLDRYH(JL)=.FALSE.
+ ENDIF
ENDDO
-!
-ZRDRYHG(:)=0.
-IF(LCONVHG)THEN
- WHERE(ZDRYH(:)==1.)
- ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:))
+
+IF(PARAMI%LCONVHG)THEN
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(LLDRYH(1:KSIZE))
+ ZRDRYHG(1:KSIZE)=ZRDRYH_INIT(1:KSIZE)*ZRWETH_INIT(1:KSIZE)/(ZRDRYH_INIT(1:KSIZE)+ZRWETH_INIT(1:KSIZE))
+ ELSEWHERE
+ ZRDRYHG(1:KSIZE)=0.
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
+ELSE
+ ZRDRYHG(:)=0.
ENDIF
-DO JL=1, KSIZE
- PRCWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRCWETH)
- PRIWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRIWETH)
- PRSWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRSWETH)
- PRGWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRGWETH)
- !Collected minus aggregated
- PRRWETH(JL) = ZWETH(JL) * (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
- PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
- PRH_TEND(JL, IRCWETH))
- PRCDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRCWETH)
- PRIDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRIDRYH)
- PRSDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRSDRYH)
- PRRDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRRWETH)
- PRGDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRGDRYH)
- PRDRYHG(JL) = ZDRYH(JL) * ZRDRYHG(JL)
+DO JL=1, KSIZE
+ IF(LLWETH(JL)) THEN
+ PRCWETH(JL) = PRH_TEND(JL, IRCWETH)
+ PRIWETH(JL) = PRH_TEND(JL, IRIWETH)
+ PRSWETH(JL) = PRH_TEND(JL, IRSWETH)
+ PRGWETH(JL) = PRH_TEND(JL, IRGWETH)
+ !Collected minus aggregated
+ PRRWETH(JL) = (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
+ PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
+ PRH_TEND(JL, IRCWETH))
+ ELSE
+ PRCWETH(JL) = 0.
+ PRIWETH(JL) = 0.
+ PRSWETH(JL) = 0.
+ PRGWETH(JL) = 0.
+ PRRWETH(JL) = 0.
+ ENDIF
- PA_RC(JL) = PA_RC(JL) - PRCWETH(JL)
- PA_RI(JL) = PA_RI(JL) - PRIWETH(JL)
- PA_RS(JL) = PA_RS(JL) - PRSWETH(JL)
- PA_RG(JL) = PA_RG(JL) - PRGWETH(JL)
- PA_RH(JL) = PA_RH(JL) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
- PA_RR(JL) = PA_RR(JL) - PRRWETH(JL)
- PA_TH(JL) = PA_TH(JL) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA_RC(JL) = PA_RC(JL) - PRCDRYH(JL)
- PA_RI(JL) = PA_RI(JL) - PRIDRYH(JL)
- PA_RS(JL) = PA_RS(JL) - PRSDRYH(JL)
- PA_RR(JL) = PA_RR(JL) - PRRDRYH(JL)
- PA_RG(JL) = PA_RG(JL) - PRGDRYH(JL) + PRDRYHG(JL)
- PA_RH(JL) = PA_RH(JL) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
- &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ IF(LLDRYH(JL)) THEN
+ PRCDRYH(JL) = PRH_TEND(JL, IRCWETH)
+ PRIDRYH(JL) = PRH_TEND(JL, IRIDRYH)
+ PRSDRYH(JL) = PRH_TEND(JL, IRSDRYH)
+ PRRDRYH(JL) = PRH_TEND(JL, IRRWETH)
+ PRGDRYH(JL) = PRH_TEND(JL, IRGDRYH)
+ PRDRYHG(JL) = ZRDRYHG(JL)
+ ELSE
+ PRCDRYH(JL) = 0.
+ PRIDRYH(JL) = 0.
+ PRSDRYH(JL) = 0.
+ PRRDRYH(JL) = 0.
+ PRGDRYH(JL) = 0.
+ PRDRYHG(JL) = 0.
+ ENDIF
ENDDO
!
!* 7.5 Melting of the hailstones
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRHMLTR(JL)=ZMASK(JL)*PRHMLTR(JL)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRHMLTR(JL) = ZMASK(JL)* PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
- END WHERE
+ IF(PRHT(JL)>ICED%XRTMIN(7) .AND. PT(JL)>CST%XTT .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRHMLTR(JL) = PRVT(JL)*PPRES(JL)/(CST%XEPSILO+PRVT(JL)) ! Vapor pressure
+ IF(PARAMI%LEVLIMIT) THEN
+ PRHMLTR(JL)=MIN(PRHMLTR(JL), EXP(CST%XALPW-CST%XBETAW/PT(JL)-CST%XGAMW*ALOG(PT(JL)))) ! min(ev, es_w(T))
+ ENDIF
+ PRHMLTR(JL) = PKA(JL)*(CST%XTT-PT(JL)) + &
+ PDV(JL)*(CST%XLVTT + (CST%XCPV - CST%XCL) * (PT(JL) - CST%XTT)) &
+ *(CST%XESTT-PRHMLTR(JL))/(CST%XRV*PT(JL))
+ PRHMLTR(JL) = MAX(0., (-PRHMLTR(JL) * (ICEP%X0DEPH* PLBDAH(JL)**ICEP%XEX0DEPH + &
+ ICEP%X1DEPH*PCJ(JL)*PLBDAH(JL)**ICEP%XEX1DEPH) - &
+ (PRH_TEND(JL, IRCWETH)+PRH_TEND(JL, IRRWETH)) * &
+ (PRHODREF(JL)*CST%XCL*(CST%XTT-PT(JL)))) / &
+ (PRHODREF(JL)*CST%XLMTT))
+ ENDIF
+ ELSE
+ PRHMLTR(JL)=0.
ENDIF
- DO JL=1, KSIZE
- PRHMLTR(JL) = ZMASK(JL)* (PKA(JL)*(XTT-PT(JL)) + &
- ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
- *(XESTT-PRHMLTR(JL))/(XRV*PT(JL)) ))
- ENDDO
- WHERE(ZMASK(:)==1.)
- !
- ! compute RHMLTR
- !
- PRHMLTR(:) = MAX( 0.0,( -PRHMLTR(:) * &
- ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - &
- ( PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRRWETH) )* &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- END WHERE
-END IF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) + PRHMLTR(JL)
- PA_RH(JL) = PA_RH(JL) - PRHMLTR(JL)
- PA_TH(JL) = PA_TH(JL) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
ENDDO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RH', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_FAST_RH
+END MODULE MODE_ICE4_FAST_RH
diff --git a/src/PHYEX/micro/mode_ice4_fast_ri.f90 b/src/PHYEX/micro/mode_ice4_fast_ri.f90
index bbe45f579d904a4eb0ec8bba282b81fe8835501d..abd41bdce2a1db4fef6343c43eaf4612020537e7 100644
--- a/src/PHYEX/micro/mode_ice4_fast_ri.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_ri.f90
@@ -3,51 +3,15 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-------------------------------------------------------------------------------
-MODULE MODI_ICE4_FAST_RI
-INTERFACE
-SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
- &PRHODREF, PLVFACT, PLSFACT, &
- &PAI, PCJ, PCIT, &
- &PSSI, &
- &PRCT, PRIT, &
- &PRCBERI, PA_TH, PA_RC, PA_RI)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR
-!
+MODULE MODE_ICE4_FAST_RI
IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI ! Bergeron-Findeisen effect
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-END SUBROUTINE ICE4_FAST_RI
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RI
-SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
+CONTAINS
+SUBROUTINE ICE4_FAST_RI(ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&PAI, PCJ, PCIT, &
&PSSI, &
&PRCT, PRIT, &
- &PRCBERI, PA_TH, PA_RC, PA_RI)
+ &PRCBERI)
!!
!!** PURPOSE
!! -------
@@ -59,71 +23,68 @@ SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
!!
!! MODIFICATIONS
!! -------------
+!! S. Riette, 11/2021: loop instead of array syntax
!!
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_RAIN_ICE_DESCR, ONLY: XDI,XLBEXI,XLBI,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPI,X2DEPI
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCIT ! Pristine ice conc. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI ! Bergeron-Findeisen effect
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PAI ! Thermodynamical function
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PSSI ! Supersaturation over ice
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCBERI ! Bergeron-Findeisen effect
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(KSIZE) :: ZMASK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JL
!
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RI',0,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., -PSSI(JL))) * & ! PSSI(:)>0.
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
- &MAX(0., -SIGN(1., 1.E-20-PCIT(JL))) * & ! PCIT(:)>0.
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCBERI(JL) = PRCBERI(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRCBERI(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCBERI(:) = MIN(1.E8, XLBI*(PRHODREF(:)*PRIT(:)/PCIT(:))**XLBEXI) ! Lbda_i
- PRCBERI(:) = ( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
- ( X0DEPI/PRCBERI(:) + X2DEPI*PCJ(:)*PCJ(:)/PRCBERI(:)**(XDI+2.0) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RC(JL) = PA_RC(JL) - PRCBERI(JL)
- PA_RI(JL) = PA_RI(JL) + PRCBERI(JL)
- PA_TH(JL) = PA_TH(JL) + PRCBERI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ IF(PSSI(JL)>0. .AND. PRCT(JL)>ICED%XRTMIN(2) .AND. PRIT(JL)>ICED%XRTMIN(4) &
+#ifdef REPRO48
+ .AND. PCIT(JL)>0. .AND. LDCOMPUTE(JL)) THEN
+#else
+ .AND. PCIT(JL)>1.E-20 .AND. LDCOMPUTE(JL)) THEN
+#endif
+ IF(.NOT. LDSOFT) THEN
+ PRCBERI(JL) = MIN(1.E8, ICED%XLBI*(PRHODREF(JL)*PRIT(JL)/PCIT(JL))**ICED%XLBEXI) ! Lbda_i
+ PRCBERI(JL) = ( PSSI(JL) / (PRHODREF(JL)*PAI(JL)) ) * PCIT(JL) * &
+ ( ICEP%X0DEPI/PRCBERI(JL) + ICEP%X2DEPI*PCJ(JL)*PCJ(JL)/PRCBERI(JL)**(ICED%XDI+2.0) )
+ ENDIF
+ ELSE
+ PRCBERI(JL) = 0.
+ ENDIF
ENDDO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RI', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_FAST_RI
+END MODULE MODE_ICE4_FAST_RI
diff --git a/src/PHYEX/micro/mode_ice4_fast_rs.f90 b/src/PHYEX/micro/mode_ice4_fast_rs.f90
index a4492a4b2bf13010ca8b1f8f43bfc9b1c7d64d4d..6655b2061604da1a8fc9f135b27728317ad0ba93 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rs.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rs.f90
@@ -1,58 +1,11 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-MODULE MODI_ICE4_FAST_RS
-INTERFACE
-SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAR, PLBDAS, &
- &PT, PRVT, PRCT, PRRT, PRST, &
- &PRIAGGS, &
- &PRCRIMSS, PRCRIMSG, PRSRIMCG, &
- &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
- &PRCMLTSR, &
- &PRS_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG)
+MODULE MODE_ICE4_FAST_RS
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-END SUBROUTINE ICE4_FAST_RS
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RS
-SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
+CONTAINS
+SUBROUTINE ICE4_FAST_RS(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAR, PLBDAS, &
@@ -61,8 +14,7 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
&PRCRIMSS, PRCRIMSG, PRSRIMCG, &
&PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
&PRCMLTSR, &
- &PRS_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG)
+ &PRS_TEND)
!!
!!** PURPOSE
!! -------
@@ -77,166 +29,158 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
!!
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
- XEPSILO
-USE MODD_PARAM_ICE, ONLY: LEVLIMIT, CSNOWRIMING
-USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXS,XRTMIN,XALPHAS,XNUS,XFVELOS
-USE MODD_RAIN_ICE_PARAM, ONLY: NACCLBDAR,NACCLBDAS,NGAMINC,X0DEPS,X1DEPS,XACCINTP1R,XACCINTP1S,XACCINTP2R,XACCINTP2S, &
- XCRIMSG,XCRIMSS,XEX0DEPS,XEX1DEPS,XEXCRIMSG,XEXCRIMSS,XEXSRIMCG,XEXSRIMCG2,XFRACCSS, &
- XFSACCRG,XFSCVMG,XGAMINC_RIM1,XGAMINC_RIM1,XGAMINC_RIM2,XGAMINC_RIM4,XKER_RACCS, &
- XKER_RACCSS,XKER_SACCRG,XLBRACCS1,XLBRACCS2,XLBRACCS3,XLBSACCR1,XLBSACCR2,XLBSACCR3, &
- XRIMINTP1,XRIMINTP2,XSRIMCG,XSRIMCG2,XSRIMCG3
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRACCSS ! Rain accretion onto the aggregates
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRACCSG ! Rain accretion onto the aggregates
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
+REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
!
!* 0.2 declaration of local variables
!
INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6, &
& IFREEZ1=7, IFREEZ2=8
-!
-REAL, DIMENSION(KSIZE) :: ZRIM, ZACC, ZMASK
-LOGICAL, DIMENSION(KSIZE) :: GRIM, GACC
+LOGICAL, DIMENSION(KPROMA) :: GRIM, GACC
INTEGER :: IGRIM, IGACC
-INTEGER, DIMENSION(KSIZE) :: I1
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
+INTEGER, DIMENSION(KPROMA) :: I1
+REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
+REAL, DIMENSION(KPROMA) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
INTEGER :: JJ, JL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RS', 0, ZHOOK_HANDLE)
+!
+!
!-------------------------------------------------------------------------------
!
!
!* 5.0 maximum freezing rate
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRS_TEND(JL, IFREEZ1)
- PRS_TEND(JL, IFREEZ2)=ZMASK(JL) * PRS_TEND(JL, IFREEZ2)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRS_TEND(:, IFREEZ1)=MIN(PRS_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
- END WHERE
+ IF(PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRS_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(CST%XEPSILO+PRVT(JL)) ! Vapor pressure
+ IF(PARAMI%LEVLIMIT) THEN
+ PRS_TEND(JL, IFREEZ1)=MIN(PRS_TEND(JL, IFREEZ1), EXP(CST%XALPI-CST%XBETAI/PT(JL)-CST%XGAMI*ALOG(PT(JL)))) ! min(ev, es_i(T))
+ ENDIF
+ PRS_TEND(JL, IFREEZ1)=PKA(JL)*(CST%XTT-PT(JL)) + &
+ &(PDV(JL)*(CST%XLVTT+(CST%XCPV-CST%XCL)*(PT(JL)-CST%XTT)) &
+ &*(CST%XESTT-PRS_TEND(JL, IFREEZ1))/(CST%XRV*PT(JL)) )
+#if defined(REPRO48) || defined(REPRO55)
+ PRS_TEND(JL, IFREEZ1)=PRS_TEND(JL, IFREEZ1)* (ICEP%X0DEPS* PLBDAS(JL)**ICEP%XEX0DEPS + &
+ & ICEP%X1DEPS*PCJ(JL)*PLBDAS(JL)**ICEP%XEX1DEPS )/ &
+#else
+ PRS_TEND(JL, IFREEZ1)=PRS_TEND(JL, IFREEZ1)* PRST(JL) *(ICEP%X0DEPS* PLBDAS(JL)**ICEP%XEX0DEPS + &
+ & ICEP%X1DEPS*PCJ(JL)*PLBDAS(JL)**(ICED%XBS+ICEP%XEX1DEPS )* &
+ (1+0.5*(ICED%XFVELOS/PLBDAS(JL))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEX1DEPS/ICED%XALPHAS))/ &
+#endif
+ &(PRHODREF(JL)*(CST%XLMTT-CST%XCL*(CST%XTT-PT(JL))))
+ PRS_TEND(JL, IFREEZ2)=(PRHODREF(JL)*(CST%XLMTT+(CST%XCI-CST%XCL)*(CST%XTT-PT(JL))) ) / &
+ &(PRHODREF(JL)*(CST%XLMTT-CST%XCL*(CST%XTT-PT(JL))))
+ ENDIF
+ !We must agregate, at least, the cold species
+ !And we are only interested by the freezing rate of liquid species
+ ZFREEZ_RATE(JL)=MAX(0., MAX(0., PRS_TEND(JL, IFREEZ1) + &
+ &PRS_TEND(JL, IFREEZ2) * PRIAGGS(JL)) - &
+ PRIAGGS(JL))
+ ELSE
+ PRS_TEND(JL, IFREEZ1)=0.
+ PRS_TEND(JL, IFREEZ2)=0.
+ ZFREEZ_RATE(JL)=0.
ENDIF
- PRS_TEND(:, IFREEZ2)=0.
- WHERE(ZMASK(:)==1.)
- PRS_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-PRS_TEND(:, IFREEZ1))/(XRV*PT(:)) )
- PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* PRST(:) * ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
- X1DEPS*PCJ(:)*PLBDAS(:) **(XBS+XEX1DEPS)* &
- (1+0.5*(XFVELOS/PLBDAS(:))**XALPHAS)**(-XNUS+XEX1DEPS/XALPHAS))/ &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- PRS_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- !We must agregate, at least, the cold species
- !And we are only interested by the freezing rate of liquid species
- ZFREEZ_RATE(JL)=ZMASK(JL) * MAX(0., MAX(0., PRS_TEND(JL, IFREEZ1) + &
- &PRS_TEND(JL, IFREEZ2) * PRIAGGS(JL)) - &
- PRIAGGS(JL))
ENDDO
!
!* 5.1 cloud droplet riming of the aggregates
!
IGRIM = 0
-DO JJ = 1, SIZE(GRIM)
- ZRIM(JJ)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JJ))) * & !WHERE(PRCT(:)>XRTMIN(2))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JJ)
- IF (ZRIM(JJ)>0) THEN
+DO JL=1, KSIZE
+ IF (PRCT(JL)>ICED%XRTMIN(2) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
IGRIM = IGRIM + 1
- I1(IGRIM) = JJ
- GRIM(JJ) = .TRUE.
+ I1(IGRIM) = JL
+ GRIM(JL) = .TRUE.
ELSE
- GRIM(JJ) = .FALSE.
- END IF
-END DO
+ GRIM(JL) = .FALSE.
+ PRS_TEND(JL, IRCRIMS)=0.
+ PRS_TEND(JL, IRCRIMSS)=0.
+ PRS_TEND(JL, IRSRIMCG)=0.
+ ENDIF
+ENDDO
!
! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0)
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRS_TEND(JL, IRCRIMS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMS)
- PRS_TEND(JL, IRCRIMSS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMSS)
- PRS_TEND(JL, IRSRIMCG)=ZRIM(JL) * PRS_TEND(JL, IRSRIMCG)
- ENDDO
-ELSE
- PRS_TEND(:, IRCRIMS)=0.
- PRS_TEND(:, IRCRIMSS)=0.
- PRS_TEND(:, IRSRIMCG)=0.
- !
+IF(.NOT. LDSOFT) THEN
IF(IGRIM>0) THEN
!
! 5.1.1 select the PLBDAS
!
DO JJ = 1, IGRIM
- ZVEC1(JJ) = (PLBDAS(I1(JJ))**XALPHAS + XFVELOS**XALPHAS)**(1./XALPHAS)
+#if defined(REPRO48) || defined(REPRO55)
+ ZVEC1(JJ) = PLBDAS(I1(JJ))
+#else
+ ZVEC1(JJ) = (PLBDAS(I1(JJ))**ICED%XALPHAS + ICED%XFVELOS**ICED%XALPHAS)**(1./ICED%XALPHAS)
+#endif
END DO
!
! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
! set of Lbda_s used to tabulate some moments of the incomplete
! gamma function
!
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
- XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ !$mnh_expand_where(JJ=1:IGRIM)
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(ICEP%NGAMINC)-0.00001, &
+ ICEP%XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + ICEP%XRIMINTP2 ) )
IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
!
! 5.1.3 perform the linear interpolation of the normalized
! "2+XDS"-moment of the incomplete gamma function
!
- ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - ICEP%XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ !$mnh_end_expand_where(JJ=1:IGRIM)
ZZW(:) = 0.
DO JJ = 1, IGRIM
ZZW(I1(JJ)) = ZVEC1(JJ)
@@ -244,26 +188,37 @@ ELSE
!
! 5.1.4 riming of the small sized aggregates
!
- WHERE (GRIM(:))
- PRS_TEND(:, IRCRIMSS) = XCRIMSS * ZZW(:) * PRCT(:) & ! RCRIMSS
- * PRST(:)*(1+(XFVELOS/PLBDAS(:))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) &
- * PRHODREF(:)**(-XCEXVT+1.) &
- * (PLBDAS(:)) ** (XEXCRIMSS+XBS)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE (GRIM(1:KSIZE))
+ PRS_TEND(1:KSIZE, IRCRIMSS) = ICEP%XCRIMSS * ZZW(1:KSIZE) * PRCT(1:KSIZE) & ! RCRIMSS
+#if defined(REPRO48) || defined(REPRO55)
+ * PLBDAS(1:KSIZE)**ICEP%XEXCRIMSS &
+ * PRHODREF(1:KSIZE)**(-ICED%XCEXVT)
+#else
+ * PRST(1:KSIZE)*(1+(ICED%XFVELOS/PLBDAS(1:KSIZE))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXCRIMSS/ICED%XALPHAS) &
+ * PRHODREF(1:KSIZE)**(-ICED%XCEXVT+1.) &
+ * (PLBDAS(1:KSIZE)) ** (ICEP%XEXCRIMSS+ICED%XBS)
+#endif
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
!
! 5.1.5 perform the linear interpolation of the normalized
! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2) and
! "XBG"-moment of the incomplete gamma function (XGAMINC_RIM4)
!
- ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ !$mnh_expand_where(JJ=1:IGRIM)
+ ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ !$mnh_end_expand_where(JJ=1:IGRIM)
ZZW(:) = 0.
DO JJ = 1, IGRIM
ZZW(I1(JJ)) = ZVEC1(JJ)
END DO
- ZVEC1(1:IGRIM) = XGAMINC_RIM4( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM4( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ !$mnh_expand_where(JJ=1:IGRIM)
+ ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM4( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - ICEP%XGAMINC_RIM4( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ !$mnh_end_expand_where(JJ=1:IGRIM)
ZZW2(:) = 0.
DO JJ = 1, IGRIM
ZZW2(I1(JJ)) = ZVEC1(JJ)
@@ -272,24 +227,40 @@ ELSE
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
!
- WHERE(GRIM(:))
- PRS_TEND(:, IRCRIMS) = XCRIMSG * PRCT(:) & ! RCRIMS
- * PRST(:)*(1+(XFVELOS/PLBDAS(:))**(XALPHAS))**(-XNUS+XEXCRIMSG/XALPHAS) &
- * PRHODREF(:)**(-XCEXVT+1.) &
- * PLBDAS(:)**(XBS+XEXCRIMSG)
- ZZW6(:) = PRS_TEND(:, IRCRIMS) - PRS_TEND(:, IRCRIMSS) ! RCRIMSG
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GRIM(1:KSIZE))
+ PRS_TEND(1:KSIZE, IRCRIMS)=ICEP%XCRIMSG * PRCT(1:KSIZE) & ! RCRIMS
+#if defined(REPRO48) || defined(REPRO55)
+ * PLBDAS(1:KSIZE)**ICEP%XEXCRIMSG &
+ * PRHODREF(1:KSIZE)**(-ICED%XCEXVT)
+#else
+ * PRST(1:KSIZE)*(1+(ICED%XFVELOS/PLBDAS(1:KSIZE))**(ICED%XALPHAS))**(-ICED%XNUS+ICEP%XEXCRIMSG/ICED%XALPHAS) &
+ * PRHODREF(1:KSIZE)**(-ICED%XCEXVT+1.) &
+ * PLBDAS(1:KSIZE)**(ICED%XBS+ICEP%XEXCRIMSG)
+#endif
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
- IF(CSNOWRIMING=='M90 ')THEN
+ IF(PARAMI%CSNOWRIMING=='M90 ')THEN
!Murakami 1990
- WHERE(GRIM(:))
- PRS_TEND(:, IRSRIMCG)=XSRIMCG * PRST(:)*PRHODREF(:)*PLBDAS(:)**(XEXSRIMCG+XBS)*(1.0-ZZW(:))
-
- PRS_TEND(:, IRSRIMCG)=ZZW6(:)*PRS_TEND(:, IRSRIMCG)/ &
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GRIM(1:KSIZE))
+ ZZW6(1:KSIZE) = PRS_TEND(1:KSIZE, IRCRIMS) - PRS_TEND(1:KSIZE, IRCRIMSS) ! RCRIMSG
+#if defined(REPRO48) || defined(REPRO55)
+ PRS_TEND(1:KSIZE, IRSRIMCG)=ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG*(1.0-ZZW(1:KSIZE))
+#else
+ PRS_TEND(1:KSIZE, IRSRIMCG)=ICEP%XSRIMCG * PRST(1:KSIZE)*PRHODREF(1:KSIZE)*PLBDAS(1:KSIZE)**(ICEP%XEXSRIMCG+ICED%XBS)*(1.0-ZZW(1:KSIZE))
+#endif
+ PRS_TEND(1:KSIZE, IRSRIMCG)=ZZW6(1:KSIZE)*PRS_TEND(1:KSIZE, IRSRIMCG)/ &
MAX(1.E-20, &
- XSRIMCG3*XSRIMCG2*PRST(:)*PRHODREF(:)*PLBDAS(:)**XEXSRIMCG2*(1.-ZZW2(:)) - &
- XSRIMCG3*PRS_TEND(:, IRSRIMCG))
+#if defined(REPRO48) || defined(REPRO55)
+ ICEP%XSRIMCG3*ICEP%XSRIMCG2*PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG2*(1.-ZZW2(1:KSIZE)) - &
+#else
+ ICEP%XSRIMCG3*ICEP%XSRIMCG2*PRST(1:KSIZE)*PRHODREF(1:KSIZE)*PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG2*(1.-ZZW2(1:KSIZE)) - &
+#endif
+ ICEP%XSRIMCG3*PRS_TEND(1:KSIZE, IRSRIMCG))
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ELSE
PRS_TEND(:, IRSRIMCG)=0.
END IF
@@ -298,50 +269,39 @@ ENDIF
!
DO JL=1, KSIZE
! More restrictive RIM mask to be used for riming by negative temperature only
- ZRIM(JL)=ZRIM(JL) * &
- &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
- PRCRIMSS(JL)=ZRIM(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRCRIMSS))
- ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSS(JL))
- ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
- PRCRIMSG(JL) = ZRIM(JL) * ZZW(JL) * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
- ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSG(JL))
- PRSRIMCG(JL) = ZRIM(JL) * ZZW(JL) * PRS_TEND(JL, IRSRIMCG)
-
- PRSRIMCG(JL) = PRSRIMCG(JL) * MAX(0., -SIGN(1., -PRCRIMSG(JL)))
- PRCRIMSG(JL)=MAX(0., PRCRIMSG(JL))
+ IF(GRIM(JL) .AND. PT(JL)<CST%XTT) THEN
+ PRCRIMSS(JL)=MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRCRIMSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
+ PRCRIMSG(JL) = ZZW(JL) * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSG(JL))
+ PRSRIMCG(JL) = ZZW(JL) * PRS_TEND(JL, IRSRIMCG)
- PA_RC(JL) = PA_RC(JL) - PRCRIMSS(JL)
- PA_RS(JL) = PA_RS(JL) + PRCRIMSS(JL)
- PA_TH(JL) = PA_TH(JL) + PRCRIMSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA_RC(JL) = PA_RC(JL) - PRCRIMSG(JL)
- PA_RS(JL) = PA_RS(JL) - PRSRIMCG(JL)
- PA_RG(JL) = PA_RG(JL) + PRCRIMSG(JL)+PRSRIMCG(JL)
- PA_TH(JL) = PA_TH(JL) + PRCRIMSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PRSRIMCG(JL) = PRSRIMCG(JL) * MAX(0., -SIGN(1., -PRCRIMSG(JL)))
+ PRCRIMSG(JL)=MAX(0., PRCRIMSG(JL))
+ ELSE
+ PRCRIMSS(JL)=0.
+ PRCRIMSG(JL)=0.
+ PRSRIMCG(JL)=0.
+ ENDIF
ENDDO
!
!* 5.2 rain accretion onto the aggregates
!
IGACC = 0
-DO JJ = 1, SIZE(GACC)
- ZACC(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & !WHERE(PRRT(:)>XRTMIN(3))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JJ)
- IF (ZACC(JJ)>0) THEN
+DO JL = 1, KSIZE
+ IF (PRRT(JL)>ICED%XRTMIN(3) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
IGACC = IGACC + 1
- I1(IGACC) = JJ
- GACC(JJ) = .TRUE.
+ I1(IGACC) = JL
+ GACC(JL) = .TRUE.
ELSE
- GACC(JJ) = .FALSE.
+ GACC(JL) = .FALSE.
+ PRS_TEND(JL, IRRACCS)=0.
+ PRS_TEND(JL, IRRACCSS)=0.
+ PRS_TEND(JL, IRSACCRG)=0.
END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRS_TEND(JL, IRRACCS)=ZACC(JL) * PRS_TEND(JL, IRRACCS)
- PRS_TEND(JL, IRRACCSS)=ZACC(JL) * PRS_TEND(JL, IRRACCSS)
- PRS_TEND(JL, IRSACCRG)=ZACC(JL) * PRS_TEND(JL, IRSACCRG)
- ENDDO
-ELSE
+ENDDO
+IF(.NOT. LDSOFT) THEN
PRS_TEND(:, IRRACCS)=0.
PRS_TEND(:, IRRACCSS)=0.
PRS_TEND(:, IRSACCRG)=0.
@@ -353,31 +313,33 @@ ELSE
DO JJ = 1, IGACC
ZVEC1(JJ) = PLBDAS(I1(JJ))
ZVEC2(JJ) = PLBDAR(I1(JJ))
- END DO
+ ENDDO
!
! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR
! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
! tabulate the RACCSS-kernel
!
- ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, &
- XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ !$mnh_expand_where(JJ=1:IGACC)
+ ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(ICEP%NACCLBDAS)-0.00001, &
+ ICEP%XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + ICEP%XACCINTP2S ) )
IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
!
- ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
- XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(ICEP%NACCLBDAR)-0.00001, &
+ ICEP%XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + ICEP%XACCINTP2R ) )
IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
+ !$mnh_end_expand_where(JJ=1:IGACC)
!
! 5.2.3 perform the bilinear interpolation of the normalized
! RACCSS-kernel
!
DO JJ = 1, IGACC
- ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ ZVEC3(JJ) = ( ICEP%XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* ZVEC1(JJ) &
- - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ - ( ICEP%XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
ZZW(:) = 0.
@@ -387,42 +349,50 @@ ELSE
!
! 5.2.4 raindrop accretion on the small sized aggregates
!
- WHERE(GACC(:))
- ZZW6(:) = & !! coef of RRACCS
- XFRACCSS*( PRST(:)*PLBDAS(:)**XBS )*( PRHODREF(:)**(-XCEXVT) ) &
- *( XLBRACCS1/((PLBDAS(:)**2) ) + &
- XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + &
- XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**4
- PRS_TEND(:, IRRACCSS) =ZZW(:)*ZZW6(:)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GACC(1:KSIZE))
+ ZZW6(1:KSIZE) = & !! coef of RRACCS
+#if defined(REPRO48) || defined(REPRO55)
+ ICEP%XFRACCSS*( PLBDAS(1:KSIZE)**ICED%XCXS )*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+#else
+ ICEP%XFRACCSS*( PRST(1:KSIZE)*PLBDAS(1:KSIZE)**ICED%XBS )*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT) ) &
+#endif
+ *( ICEP%XLBRACCS1/((PLBDAS(1:KSIZE)**2) ) + &
+ ICEP%XLBRACCS2/( PLBDAS(1:KSIZE) * PLBDAR(1:KSIZE) ) + &
+ ICEP%XLBRACCS3/( (PLBDAR(1:KSIZE)**2)) )/PLBDAR(1:KSIZE)**4
+ PRS_TEND(1:KSIZE, IRRACCSS) =ZZW(1:KSIZE)*ZZW6(1:KSIZE)
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
!
! 5.2.4b perform the bilinear interpolation of the normalized
! RACCS-kernel
!
DO JJ = 1, IGACC
- ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ ZVEC3(JJ) = ( ICEP%XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* ZVEC1(JJ) &
- - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ - ( ICEP%XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - ICEP%XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
ZZW(:) = 0.
DO JJ = 1, IGACC
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
- WHERE(GACC(:))
- PRS_TEND(:, IRRACCS) = ZZW(:)*ZZW6(:)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GACC(1:KSIZE))
+ PRS_TEND(1:KSIZE, IRRACCS) = ZZW(1:KSIZE)*ZZW6(1:KSIZE)
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
! 5.2.5 perform the bilinear interpolation of the normalized
! SACCRG-kernel
!
DO JJ = 1, IGACC
- ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ ZVEC3(JJ) = ( ICEP%XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - ICEP%XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* ZVEC2(JJ) &
- - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ - ( ICEP%XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - ICEP%XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* (ZVEC2(JJ) - 1.0)
END DO
ZZW(:) = 0.
@@ -433,99 +403,86 @@ ELSE
! 5.2.6 raindrop accretion-conversion of the large sized aggregates
! into graupeln
!
- WHERE(GACC(:))
- PRS_TEND(:, IRSACCRG) = XFSACCRG*ZZW(:)* & ! RSACCRG
- ( PRST(:))*( PRHODREF(:)**(-XCEXVT) ) &
- *( XLBSACCR1/((PLBDAR(:)**2) ) + &
- XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + &
- XLBSACCR3/( (PLBDAS(:)**2)) )/PLBDAR(:)
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GACC(1:KSIZE))
+ PRS_TEND(1:KSIZE, IRSACCRG) = ICEP%XFSACCRG*ZZW(1:KSIZE)* & ! RSACCRG
+#if defined(REPRO48) || defined(REPRO55)
+ ( PLBDAS(1:KSIZE)**(ICED%XCXS-ICED%XBS) )*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+#else
+ ( PRST(1:KSIZE))*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT) ) &
+#endif
+ *( ICEP%XLBSACCR1/((PLBDAR(1:KSIZE)**2) ) + &
+ ICEP%XLBSACCR2/( PLBDAR(1:KSIZE) * PLBDAS(1:KSIZE) ) + &
+ ICEP%XLBSACCR3/( (PLBDAS(1:KSIZE)**2)) )/PLBDAR(1:KSIZE)
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
ENDIF
ENDIF
!
DO JL=1, KSIZE
! More restrictive ACC mask to be used for accretion by negative temperature only
- ZACC(JL) = ZACC(JL) * &
- &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
- PRRACCSS(JL)=ZACC(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRRACCSS))
- ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRRACCSS(JL))
- ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))) ! proportion we are able to freeze
- PRRACCSG(JL)=ZACC(JL)*ZZW(JL) * MAX(0., PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))
- ZFREEZ_RATE(JL) = MAX(0., ZFREEZ_RATE(JL)-PRRACCSG(JL))
- PRSACCRG(JL)=ZACC(JL)*ZZW(JL) * PRS_TEND(JL, IRSACCRG)
-
- PRSACCRG(JL) = PRSACCRG(JL) * MAX(0., -SIGN(1., -PRRACCSG(JL)))
- PRRACCSG(JL)=MAX(0., PRRACCSG(JL))
+ IF(GACC(JL) .AND. PT(JL)<CST%XTT) THEN
+ PRRACCSS(JL)=MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRRACCSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRRACCSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))) ! proportion we are able to freeze
+ PRRACCSG(JL)=ZZW(JL) * MAX(0., PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))
+ ZFREEZ_RATE(JL) = MAX(0., ZFREEZ_RATE(JL)-PRRACCSG(JL))
+ PRSACCRG(JL)=ZZW(JL) * PRS_TEND(JL, IRSACCRG)
- PA_RR(JL) = PA_RR(JL) - PRRACCSS(JL)
- PA_RS(JL) = PA_RS(JL) + PRRACCSS(JL)
- PA_TH(JL) = PA_TH(JL) + PRRACCSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA_RR(JL) = PA_RR(JL) - PRRACCSG(JL)
- PA_RS(JL) = PA_RS(JL) - PRSACCRG(JL)
- PA_RG(JL) = PA_RG(JL) + PRRACCSG(JL)+PRSACCRG(JL)
- PA_TH(JL) = PA_TH(JL) + PRRACCSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PRSACCRG(JL) = PRSACCRG(JL) * MAX(0., -SIGN(1., -PRRACCSG(JL)))
+ PRRACCSG(JL)=MAX(0., PRRACCSG(JL))
+ ELSE
+ PRRACCSS(JL)=0.
+ PRRACCSG(JL)=0.
+ PRSACCRG(JL)=0.
+ ENDIF
ENDDO
!
!
!* 5.3 Conversion-Melting of the aggregates
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRSMLTG(JL)=ZMASK(JL)*PRSMLTG(JL)
- PRCMLTSR(JL)=ZMASK(JL)*PRCMLTSR(JL)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRSMLTG(JL)=ZMASK(JL)*PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRSMLTG(:)=MIN(PRSMLTG(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
- END WHERE
+ IF(PRST(JL)>ICED%XRTMIN(5) .AND. PT(JL)>CST%XTT .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRSMLTG(JL)=PRVT(JL)*PPRES(JL)/(CST%XEPSILO+PRVT(JL)) ! Vapor pressure
+ IF(PARAMI%LEVLIMIT) THEN
+ PRSMLTG(JL)=MIN(PRSMLTG(JL), EXP(CST%XALPW-CST%XBETAW/PT(JL)-CST%XGAMW*ALOG(PT(JL)))) ! min(ev, es_w(T))
+ ENDIF
+ PRSMLTG(JL)= PKA(JL)*(CST%XTT-PT(JL)) + &
+ &(PDV(JL)*(CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( PT(JL) - CST%XTT )) &
+ & *(CST%XESTT-PRSMLTG(JL))/(CST%XRV*PT(JL)) )
+ !
+ ! compute RSMLT
+ !
+ PRSMLTG(JL) = ICEP%XFSCVMG*MAX(0., (-PRSMLTG(JL) * &
+#if defined(REPRO48) || defined(REPRO55)
+ (ICEP%X0DEPS* PLBDAS(JL)**ICEP%XEX0DEPS + &
+ ICEP%X1DEPS*PCJ(JL)*PLBDAS(JL)**ICEP%XEX1DEPS) &
+#else
+ PRST(JL)*PRHODREF(JL) * &
+ (ICEP%X0DEPS* PLBDAS(JL)**(ICED%XBS+ICEP%XEX0DEPS) + &
+ ICEP%X1DEPS*PCJ(JL)*(1+0.5*(ICED%XFVELOS/PLBDAS(JL))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEX1DEPS/ICED%XALPHAS)*PLBDAS(JL)**(ICED%XBS+ICEP%XEX1DEPS)) &
+#endif
+ -(PRS_TEND(JL, IRCRIMS) + PRS_TEND(JL, IRRACCS)) * &
+ (PRHODREF(JL)*CST%XCL*(CST%XTT-PT(JL))) &
+ ) / (PRHODREF(JL)*CST%XLMTT))
+ !
+ ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+ ! because the graupeln produced by this process are still icy!!!
+ !
+ ! When T < XTT, rc is collected by snow (riming) to produce snow and graupel
+ ! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting)
+ ! To insure consistency when crossing T=XTT, rc collected with T>XTT must be transformed in rain.
+ ! rc cannot produce iced species with a positive temperature but is still collected with a good efficiency by snow
+ PRCMLTSR(JL) = PRS_TEND(JL, IRCRIMS) ! both species are liquid, no heat is exchanged
+ ENDIF
+ ELSE
+ PRSMLTG(JL)=0.
+ PRCMLTSR(JL)=0.
ENDIF
- DO JL=1, KSIZE
- PRSMLTG(JL)=ZMASK(JL)*( &
- & PKA(JL)*(XTT-PT(JL)) + &
- & ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
- & *(XESTT-PRSMLTG(JL))/(XRV*PT(JL)) ) &
- &)
- ENDDO
- PRCMLTSR(:) = 0.
- WHERE(ZMASK(:)==1.)
- !
- ! compute RSMLT
- !
- PRSMLTG(:) = XFSCVMG*MAX( 0.0,( -PRSMLTG(:) * &
- PRST(:)*PRHODREF(:) * &
- ( X0DEPS *PLBDAS(:)**(XBS+XEX0DEPS) + &
- X1DEPS*PCJ(:)*(1+0.5*(XFVELOS/PLBDAS(:))**XALPHAS)**(-XNUS+XEX1DEPS/XALPHAS)*PLBDAS(:)**(XBS+XEX1DEPS)) - &
- ( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS)) * &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- !
- ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
- ! because the graupeln produced by this process are still icy!!!
- !
- ! When T < XTT, rc is collected by snow (riming) to produce snow and graupel
- ! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting)
- ! To insure consistency when crossing T=XTT, rc collected with T>XTT must be transformed in rain.
- ! rc cannot produce iced species with a positive temperature but is still collected with a good efficiency by snow
- PRCMLTSR(:) = PRS_TEND(:, IRCRIMS) ! both species are liquid, no heat is exchanged
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
- ! because the graupeln produced by this process are still icy!!!
- PA_RS(JL) = PA_RS(JL) - PRSMLTG(JL)
- PA_RG(JL) = PA_RG(JL) + PRSMLTG(JL)
- PA_RC(JL) = PA_RC(JL) - PRCMLTSR(JL)
- PA_RR(JL) = PA_RR(JL) + PRCMLTSR(JL)
ENDDO
+IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RS', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_FAST_RS
+END MODULE MODE_ICE4_FAST_RS
diff --git a/src/PHYEX/micro/mode_ice4_nucleation.f90 b/src/PHYEX/micro/mode_ice4_nucleation.f90
index 98459b317087abc474b33d03a27b19c72245a490..3135a3a67a5588859110b0d52e796029b25e9e56 100644
--- a/src/PHYEX/micro/mode_ice4_nucleation.f90
+++ b/src/PHYEX/micro/mode_ice4_nucleation.f90
@@ -3,35 +3,13 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_NUCLEATION
-INTERFACE
-SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+MODULE MODE_ICE4_NUCLEATION
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
-END SUBROUTINE ICE4_NUCLEATION
-END INTERFACE
-END MODULE MODI_ICE4_NUCLEATION
-SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
+CONTAINS
+SUBROUTINE ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, KSIZE, ODCOMPUTE, &
PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
PRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+ PCIT, PRVHENI_MR)
!!
!!** PURPOSE
!! -------
@@ -44,24 +22,28 @@ SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
!! MODIFICATIONS
!! -------------
!!
+!! R. El Khatib 24-Aug-2021 Optimizations
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT,XEPSILO
-USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
-USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1,XALPHA2,XBETA1,XBETA2,XMNU0,XNU10,XNU20
-USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-!
-USE MODE_MPPDB
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: ODSOFT
LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
@@ -72,81 +54,103 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
!
!* 0.2 declaration of local variables
!
REAL, DIMENSION(KSIZE) :: ZW ! work array
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
-REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
- ZUSW, & ! Undersaturation over water
- ZSSI ! Supersaturation over ice
+REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+INTEGER :: JI
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 0, ZHOOK_HANDLE)!
!
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(ODCOMPUTE(:))
+ GNEGT(:)=PT(:)<CST%XTT .AND. PRVT(:)>ICED%XRTMIN(1)
+ELSEWHERE
+ GNEGT(:)=.FALSE.
+ENDWHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZUSW(:)=0.
+ZZW(:)=0.
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=ALOG(PT(:))
+ ZUSW(:)=EXP(CST%XALPW - CST%XBETAW/PT(:) - CST%XGAMW*ZZW(:)) ! es_w
+ ZZW(:)=EXP(CST%XALPI - CST%XBETAI/PT(:) - CST%XGAMI*ZZW(:)) ! es_i
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZSSI(:)=0.
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
+ ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (CST%XEPSILO*ZZW(:)) - 1.0
+ ! Supersaturation over ice
+ ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
+ ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+ !
+ !* 3.1 compute the heterogeneous nucleation source RVHENI
+ !
+ !* 3.1.1 compute the cloud ice concentration
+ !
+ ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
+ZZW(:)=0.
+DO JI=1,KSIZE
+ IF(GNEGT(JI)) THEN
+ IF(PT(JI)<CST%XTT-5.0 .AND. ZSSI(JI)>0.0) THEN
+ ZZW(JI)=ICEP%XNU20*EXP(ICEP%XALPHA2*ZSSI(JI)-ICEP%XBETA2)
+ ELSEIF(PT(JI)<=CST%XTT-2.0 .AND. PT(JI)>=CST%XTT-5.0 .AND. ZSSI(JI)>0.0) THEN
+ ZZW(JI)=MAX(ICEP%XNU20*EXP(-ICEP%XBETA2 ), &
+ ICEP%XNU10*EXP(-ICEP%XBETA1*(PT(JI)-CST%XTT))*(ZSSI(JI)/ZUSW(JI))**ICEP%XALPHA1)
+ ENDIF
+ ENDIF
+ENDDO
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ ZZW(:)=ZZW(:)-PCIT(:)
+ ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+
PRVHENI_MR(:)=0.
-IF(.NOT. ODSOFT) THEN
- GNEGT(:)=PT(:)<XTT .AND. PRVT>XRTMIN(1) .AND. ODCOMPUTE(:)
- PRVHENI_MR(:)=0.
- ZSSI(:)=0.
- ZUSW(:)=0.
- ZZW(:)=0.
- WHERE(GNEGT(:))
- ZZW(:)=ALOG(PT(:))
- ZUSW(:)=EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w
- ZZW(:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
- END WHERE
- WHERE(GNEGT(:))
- ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
- ! Supersaturation over ice
- ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
- ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
- ! Supersaturation of saturated water vapor over ice
- !
- !* 3.1 compute the heterogeneous nucleation source RVHENI
- !
- !* 3.1.1 compute the cloud ice concentration
- !
- ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
- END WHERE
- ZZW(:)=0.
- WHERE(GNEGT(:) .AND. PT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
- ZZW(:)=XNU20*EXP(XALPHA2*ZSSI(:)-XBETA2)
- ELSEWHERE(GNEGT(:) .AND. PT(:)<=XTT-2.0 .AND. PT(:)>=XTT-5.0 .AND. ZSSI(:)>0.0)
- ZZW(:)=MAX(XNU20*EXP(-XBETA2 ), &
- XNU10*EXP(-XBETA1*(PT(:)-XTT))*(ZSSI(:)/ZUSW(:))**XALPHA1)
- END WHERE
- WHERE(GNEGT(:))
- ZZW(:)=ZZW(:)-PCIT(:)
- ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
- END WHERE
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ !
+ !* 3.1.2 update the r_i and r_v mixing ratios
+ !
+ PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*ICEP%XMNU0/PRHODREF(:)
+ PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
+!Limitation due to 0 crossing of temperature
+IF(PARAMI%LFEEDBACKT) THEN
+ ZW(:)=0.
+ !$mnh_expand_where(JI=1:KSIZE)
WHERE(GNEGT(:))
- !
- !* 3.1.2 update the r_i and r_v mixing ratios
- !
- PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*XMNU0/PRHODREF(:)
- PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
+ ZW(:)=MIN(PRVHENI_MR(:), &
+ MAX(0., (CST%XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
+ MAX(PRVHENI_MR(:), 1.E-20)
END WHERE
- !Limitation due to 0 crossing of temperature
- IF(LFEEDBACKT) THEN
- ZW(:)=0.
- WHERE(GNEGT(:))
- ZW(:)=MIN(PRVHENI_MR(:), &
- MAX(0., (XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
- MAX(PRVHENI_MR(:), 1.E-20)
- END WHERE
- ELSE
- ZW(:)=1.
- ENDIF
PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
- PCIT(:)=MAX(ZZW(:)*ZW(:)+PCIT(:), PCIT(:))
- !
- PB_RI(:)=PB_RI(:) + PRVHENI_MR(:)
- PB_RV(:)=PB_RV(:) - PRVHENI_MR(:)
- PB_TH(:)=PB_TH(:) + PRVHENI_MR(:)*PLSFACT(:)
+ ZZW(:)=ZZW(:)*ZW(:)
+ !$mnh_end_expand_where(JI=1:KSIZE)
ENDIF
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE(GNEGT(:))
+ PCIT(:)=MAX(ZZW(:)+PCIT(:), PCIT(:))
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
!
+IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 1, ZHOOK_HANDLE)
END SUBROUTINE ICE4_NUCLEATION
+END MODULE MODE_ICE4_NUCLEATION
diff --git a/src/PHYEX/micro/mode_ice4_rainfr_vert.f90 b/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
index 6e817fe769601c4347a4e5fecc692bfe0ba17cc3..e432813b1424aad05eb1261d89cce1eb707da6fe 100644
--- a/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
+++ b/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
@@ -3,20 +3,10 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_RAINFR_VERT
-INTERFACE
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
+MODULE MODE_ICE4_RAINFR_VERT
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRS !Snow field
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRG !Graupel field
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL,INTENT(IN) :: PRH !Hail field
-END SUBROUTINE ICE4_RAINFR_VERT
-END INTERFACE
-END MODULE MODI_ICE4_RAINFR_VERT
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
+CONTAINS
+SUBROUTINE ICE4_RAINFR_VERT(D, ICED, PPRFR, PRR, PRS, PRG, PRH)
!!
!!** PURPOSE
!! -------
@@ -35,40 +25,55 @@ SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PP
!* 0. DECLARATIONS
! ------------
!
-USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR, ONLY : RAIN_ICE_DESCR_t
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRS !Snow field
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRG !Graupel field
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
!
+INTEGER :: IKB, IKE, IKL, IIE, IIB, IJB, IJE
!* 0.2 declaration of local variables
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JI, JJ, JK
LOGICAL :: MASK
!
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_RAINFR_VERT',0,ZHOOK_HANDLE)
+!
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
+IIB=D%NIB
+IIE=D%NIE
+IJB=D%NJB
+IJE=D%NJE
!
!-------------------------------------------------------------------------------
-DO JI = KIB,KIE
- DO JJ = KJB, KJE
- PPRFR(JI,JJ,KKE)=0.
- DO JK=KKE-KKL, KKB, -KKL
+DO JI = IIB,IIE
+ DO JJ = IJB, IJE
+ PPRFR(JI,JJ,IKE)=0.
+ DO JK=IKE-IKL, IKB, -IKL
IF(PRESENT(PRH)) THEN
- MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
- .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. XRTMIN(7)
+ MASK=PRR(JI,JJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. ICED%XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. ICED%XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. ICED%XRTMIN(7)
ELSE
- MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
- .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6)
+ MASK=PRR(JI,JJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. ICED%XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. ICED%XRTMIN(6)
END IF
IF (MASK) THEN
- PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+KKL))
+ PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+IKL))
IF (PPRFR(JI,JJ,JK)==0) THEN
PPRFR(JI,JJ,JK)=1.
END IF
@@ -79,5 +84,7 @@ DO JI = KIB,KIE
END DO
END DO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_RAINFR_VERT',1,ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_RAINFR_VERT
+END MODULE MODE_ICE4_RAINFR_VERT
diff --git a/src/PHYEX/micro/mode_ice4_rimltc.f90 b/src/PHYEX/micro/mode_ice4_rimltc.f90
index fc4e129862254befe7e652f40780aedbee481759..012add3b46b1313eda451dc2b12103694eaf7e63 100644
--- a/src/PHYEX/micro/mode_ice4_rimltc.f90
+++ b/src/PHYEX/micro/mode_ice4_rimltc.f90
@@ -3,35 +3,15 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_RIMLTC
-INTERFACE
-SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &PT, &
- &PTHT, PRIT, &
- &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+MODULE MODE_ICE4_RIMLTC
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Cloud ice at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
-END SUBROUTINE ICE4_RIMLTC
-END INTERFACE
-END MODULE MODI_ICE4_RIMLTC
-SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
+CONTAINS
+
+SUBROUTINE ICE4_RIMLTC(CST, PARAMI, KPROMA, KSIZE, LDCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
- &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+ &PRIMLTC_MR)
!!
!!** PURPOSE
!! -------
@@ -49,57 +29,50 @@ SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XTT
-USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Cloud ice at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRIT ! Cloud ice at t
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(KSIZE) :: ZMASK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JL
!
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_RIMLTC',0,ZHOOK_HANDLE)
!
!* 7.1 cloud ice melting
!
-PRIMLTC_MR(:)=0.
-IF(.NOT. LDSOFT) THEN
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., -PRIT(JL))) * & ! PRIT(:)>0.
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! PT(:)>XTT
- &PCOMPUTE(JL)
- PRIMLTC_MR(JL)=PRIT(JL) * ZMASK(JL)
- ENDDO
-
- IF(LFEEDBACKT) THEN
- !Limitation due to 0 crossing of temperature
- DO JL=1, KSIZE
- PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
- ENDDO
- ENDIF
-ENDIF
DO JL=1, KSIZE
- PB_RC(JL) = PB_RC(JL) + PRIMLTC_MR(JL)
- PB_RI(JL) = PB_RI(JL) - PRIMLTC_MR(JL)
- PB_TH(JL) = PB_TH(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ IF(PRIT(JL)>0. .AND. PT(JL)>CST%XTT .AND. LDCOMPUTE(JL)) THEN
+ PRIMLTC_MR(JL)=PRIT(JL)
+ IF(PARAMI%LFEEDBACKT) THEN
+ !Limitation due to 0 crossing of temperature
+ PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-CST%XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
+ ENDIF
+ ELSE
+ PRIMLTC_MR(JL)=0.
+ ENDIF
ENDDO
-!
+
+IF (LHOOK) CALL DR_HOOK('ICE4_RIMLTC', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_RIMLTC
+END MODULE MODE_ICE4_RIMLTC
diff --git a/src/PHYEX/micro/mode_ice4_rrhong.f90 b/src/PHYEX/micro/mode_ice4_rrhong.f90
index da26489475b841ca17b8fcd1d286bacc4aeafd38..ba318d1d69b7d5f1a11df9afed41818e92d57781 100644
--- a/src/PHYEX/micro/mode_ice4_rrhong.f90
+++ b/src/PHYEX/micro/mode_ice4_rrhong.f90
@@ -3,35 +3,14 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_RRHONG
-INTERFACE
-SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &PT, PRRT, &
- &PTHT, &
- &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+MODULE MODE_ICE4_RRHONG
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
-END SUBROUTINE ICE4_RRHONG
-END INTERFACE
-END MODULE MODI_ICE4_RRHONG
-SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
+CONTAINS
+SUBROUTINE ICE4_RRHONG(CST, PARAMI, ICED, KPROMA, KSIZE, LDCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
- &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+ &PRRHONG_MR)
!!
!!** PURPOSE
!! -------
@@ -49,57 +28,52 @@ SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XTT
-USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(KSIZE) :: ZMASK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JL
!
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_RRHONG',0,ZHOOK_HANDLE)
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
-PRRHONG_MR(:) = 0.
-IF(.NOT. LDSOFT) THEN
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
- PRRHONG_MR(JL)=PRRT(JL) * ZMASK(JL)
- ENDDO
- IF(LFEEDBACKT) THEN
- !Limitation due to -35 crossing of temperature
- DO JL=1, KSIZE
- PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
- ENDDO
- ENDIF
-ENDIF
DO JL=1, KSIZE
- PB_RG(JL) = PB_RG(JL) + PRRHONG_MR(JL)
- PB_RR(JL) = PB_RR(JL) - PRRHONG_MR(JL)
- PB_TH(JL) = PB_TH(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ IF(PT(JL)<CST%XTT-35.0 .AND. PRRT(JL)>ICED%XRTMIN(3) .AND. LDCOMPUTE(JL)) THEN
+ PRRHONG_MR(JL)=PRRT(JL)
+ IF(PARAMI%LFEEDBACKT) THEN
+ !Limitation due to -35 crossing of temperature
+ PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((CST%XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
+ ENDIF
+ ELSE
+ PRRHONG_MR(JL)=0.
+ ENDIF
ENDDO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_RRHONG', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_RRHONG
+END MODULE MODE_ICE4_RRHONG
diff --git a/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90 b/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
index d250ddc0e38953cbec90d1615655ba1eb291b313..865ed74004ea51dcc1a28356f2046e03a0413705 100644
--- a/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
+++ b/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
@@ -3,33 +3,14 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_RSRIMCG_OLD
-INTERFACE
-SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
- &PRHODREF, &
- &PLBDAS, &
- &PT, PRCT, PRST, &
- &PRSRIMCG_MR, PB_RS, PB_RG)
+MODULE MODE_ICE4_RSRIMCG_OLD
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
-END SUBROUTINE ICE4_RSRIMCG_OLD
-END INTERFACE
-END MODULE MODI_ICE4_RSRIMCG_OLD
-SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
+CONTAINS
+SUBROUTINE ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, &
&PRHODREF, &
&PLBDAS, &
&PT, PRCT, PRST, &
- &PRSRIMCG_MR, PB_RS, PB_RG)
+ &PRSRIMCG_MR)
!!
!!** PURPOSE
!! -------
@@ -44,43 +25,46 @@ SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
!!
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
-! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XTT
-USE MODD_PARAM_ICE, ONLY: CSNOWRIMING
-USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: NGAMINC,XEXSRIMCG,XGAMINC_RIM2,XRIMINTP1,XRIMINTP2,XSRIMCG
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(KSIZE) :: GRIM
+LOGICAL, DIMENSION(KPROMA) :: GRIM
INTEGER :: IGRIM
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2
-INTEGER, DIMENSION(KSIZE) :: IVEC2, IVEC1
-REAL, DIMENSION(KSIZE) :: ZZW
+REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2
+INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
+REAL, DIMENSION(KPROMA) :: ZZW
INTEGER :: JL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ICE4_RSRIMCG_OLD', 0, ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
@@ -88,16 +72,17 @@ INTEGER :: JL
!
PRSRIMCG_MR(:)=0.
!
-IF(.NOT. ODSOFT) THEN
+IF(.NOT. LDSOFT) THEN
IGRIM = 0
- GRIM(:) = .FALSE.
- DO JL = 1, SIZE(GRIM)
- IF ( PRCT(JL)>XRTMIN(2) .AND. PRST(JL)>XRTMIN(5) .AND. ODCOMPUTE(JL) .AND. PT(JL)<XTT ) THEN
+ DO JL = 1, KSIZE
+ IF(PRCT(JL)>ICED%XRTMIN(2) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL) .AND. PT(JL)<CST%XTT) THEN
IGRIM = IGRIM + 1
- IVEC1(IGRIM) = Jl
+ IVEC1(IGRIM) = JL
GRIM(JL) = .TRUE.
- END IF
- END DO
+ ELSE
+ GRIM(JL) = .FALSE.
+ ENDIF
+ ENDDO
!
IF(IGRIM>0) THEN
!
@@ -105,14 +90,14 @@ IF(.NOT. ODSOFT) THEN
!
DO JL = 1, IGRIM
ZVEC1(JL) = PLBDAS(IVEC1(JL))
- END DO
+ ENDDO
!
! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
! set of Lbda_s used to tabulate some moments of the incomplete
! gamma function
!
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
- XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN(REAL(ICEP%NGAMINC)-0.00001, &
+ ICEP%XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + ICEP%XRIMINTP2 ) )
IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
@@ -120,26 +105,32 @@ IF(.NOT. ODSOFT) THEN
! 5.1.5 perform the linear interpolation of the normalized
! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2)
!
- ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZVEC1(1:IGRIM) = ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - ICEP%XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
ZZW(:) = 0.
DO JL = 1, IGRIM
ZZW(IVEC1(JL)) = ZVEC1(JL)
- END DO
+ ENDDO
!
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
!
- WHERE(GRIM(:))
- PRSRIMCG_MR(:) = XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
- * (1.0 - ZZW(:) )*PRST(:)
- PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GRIM(1:KSIZE))
+ PRSRIMCG_MR(1:KSIZE) = ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG & ! RSRIMCG
+#if defined(REPRO48) || defined(REPRO55)
+ * (1.0 - ZZW(1:KSIZE) )/PRHODREF(1:KSIZE)
+#else
+ * (1.0 - ZZW(1:KSIZE) )*PRST(1:KSIZE)
+#endif
+ PRSRIMCG_MR(1:KSIZE)=MIN(PRST(1:KSIZE), PRSRIMCG_MR(1:KSIZE))
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
END IF
ENDIF
-PB_RS(:) = PB_RS(:) - PRSRIMCG_MR(:)
-PB_RG(:) = PB_RG(:) + PRSRIMCG_MR(:)
!
+IF (LHOOK) CALL DR_HOOK('ICE4_RSRIMCG_OLD', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_RSRIMCG_OLD
+END MODULE MODE_ICE4_RSRIMCG_OLD
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
index 0566388bf710dcac48ea8a178fad8fcf83e98d87..e7b90b3d4ae6dd7f2c3b4ba22908543ab8e152e1 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
@@ -3,60 +3,15 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_SEDIMENTATION_SPLIT
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT, &
- &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
+MODULE MODE_ICE4_SEDIMENTATION_SPLIT
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
-REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_SPLIT
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT, &
- &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+CONTAINS
+SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
+ &PTSTEP, KRR, PDZZ, &
+ &PRHODREF, PPABST, PTHT, PT, PRHODJ, &
+ &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
+ &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PSEA, PTOWN, &
&PINPRH, PRHT, PRHS, PFPR)
!!
!!** PURPOSE
@@ -71,7 +26,6 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB
!! MODIFICATIONS
!! -------------
!!
-! P. Wautelet 11/02/2019: dimensions of PINPRC and PINDEP not necessarily KIT,KJT
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!
@@ -79,66 +33,69 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XRHOLW
-USE MODD_PARAM_ICE, ONLY: XSPLIT_MAXCFL
-USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAC,XALPHAC2,XCONC_LAND,XCONC_SEA,XCONC_URBAN,XLBC,XNUC,XNUC2
-USE MODD_RAIN_ICE_PARAM, ONLY: XFSEDC
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
!
-USE MODE_MSG
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
!
-USE MODI_GAMMA
+USE MODI_GAMMA, ONLY: GAMMA
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+TYPE(DIMPHYEX_t), INTENT(IN) :: D !array dimensions
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
-REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PT ! Temperature at time t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 declaration of local variables
!
!
-INTEGER :: JI,JJ,JK
+INTEGER :: JI, JJ, JK
+INTEGER :: IKTB, IKTE, IKB, IKL, IIE, IIB, IJB, IJE
INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-LOGICAL :: GDEPOSC, GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
REAL :: ZINVTSTEP
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),KKTB:KKTE) :: ZW ! work array
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D, & ! droplet condensation
+REAL, DIMENSION(D%NIT, D%NJT) :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(D%NIT,D%NJT,D%NKTB:D%NKTE) :: ZW ! work array
+REAL, DIMENSION(D%NIT, D%NJT, D%NKT) :: ZCONC3D, & ! droplet condensation
& ZRAY, & ! Cloud Mean radius
& ZLBC, & ! XLBC weighted by sea fraction
& ZFSEDC, &
@@ -149,16 +106,23 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D,
& ZRST, &
& ZRGT, &
& ZRHT
-!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 0, ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
!
-GDEPOSC = ODEPOSC
-GSEDIC = OSEDIC
+GSEDIC = PARAMI%LSEDIC
IRR = KRR
!
+IKTB=D%NKTB
+IKTE=D%NKTE
+IIB=D%NIB
+IIE=D%NIE
+IJB=D%NJB
+IJE=D%NJE
+!
IF (PRESENT(PFPR)) THEN
GPRESENT_PFPR = .TRUE.
ELSE
@@ -182,26 +146,34 @@ END IF
!
IF (GSEDIC) THEN
ZRAY(:,:,:) = 0.
- ZLBC(:,:,:) = XLBC(1)
- ZFSEDC(:,:,:) = XFSEDC(1)
- ZCONC3D(:,:,:)= XCONC_LAND
- ZCONC_TMP(:,:)= XCONC_LAND
+ ZLBC(:,:,:) = ICED%XLBC(1)
+ ZFSEDC(:,:,:) = ICEP%XFSEDC(1)
+ ZCONC3D(:,:,:)= ICED%XCONC_LAND
+ ZCONC_TMP(:,:)= ICED%XCONC_LAND
IF (GPRESENT_PSEA) THEN
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
- DO JK=KKTB, KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ZCONC_TMP(JI,JJ)=PSEA(JI,JJ)*ICED%XCONC_SEA+(1.-PSEA(JI,JJ))*ICED%XCONC_LAND
+ ENDDO
+ ENDDO
+ DO JK=IKTB, IKTE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ZLBC(JI,JJ,JK) = PSEA(JI,JJ)*ICED%XLBC(2)+(1.-PSEA(JI,JJ))*ICED%XLBC(1)
+ ZFSEDC(JI,JJ,JK) = (PSEA(JI,JJ)*ICEP%XFSEDC(2)+(1.-PSEA(JI,JJ))*ICEP%XFSEDC(1))
+ ZFSEDC(JI,JJ,JK) = MAX(MIN(ICEP%XFSEDC(1),ICEP%XFSEDC(2)),ZFSEDC(JI,JJ,JK))
+ ZCONC3D(JI,JJ,JK)= (1.-PTOWN(JI,JJ))*ZCONC_TMP(JI,JJ)+PTOWN(JI,JJ)*ICED%XCONC_URBAN
+ ZRAY(JI,JJ,JK) = 0.5*((1.-PSEA(JI,JJ))*GAMMA(ICED%XNUC+1.0/ICED%XALPHAC)/(GAMMA(ICED%XNUC)) + &
+ & PSEA(JI,JJ)*GAMMA(ICED%XNUC2+1.0/ICED%XALPHAC2)/(GAMMA(ICED%XNUC2)))
+ ENDDO
+ ENDDO
+ END DO
ELSE
- ZCONC3D(:,:,:) = XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
- END IF
+ ZCONC3D(:,:,:) = ICED%XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(ICED%XNUC+1.0/ICED%XALPHAC)/(GAMMA(ICED%XNUC)))
+ END IF
ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(ICED%XLBC(1),ICED%XLBC(2)),ZLBC(:,:,:))
ENDIF
!
!* 2. compute the fluxes
@@ -210,62 +182,50 @@ ENDIF
! the precipitating fields are larger than a minimal value only !!!
! For optimization we consider each variable separately
!
-! External tendecies
-IF (GSEDIC) THEN
- ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
-ENDIF
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP
-ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP
-IF ( IRR == 7 ) THEN
- ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP
-END IF
-!
-! mr values inside the time-splitting loop
-ZRCT(:,:,:) = PRCT(:,:,:)
-ZRRT(:,:,:) = PRRT(:,:,:)
-ZRIT(:,:,:) = PRIT(:,:,:)
-ZRST(:,:,:) = PRST(:,:,:)
-ZRGT(:,:,:) = PRGT(:,:,:)
-IF (IRR==7) THEN
- ZRHT(:,:,:) = PRHT(:,:,:)
-END IF
-!
-ZW(:,:,KKTB:KKTE) =1./(PRHODREF(:,:,KKTB:KKTE)* PDZZ(:,:,KKTB:KKTE))
+DO JK=IKTB, IKTE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! External tendecies
+ IF (GSEDIC) THEN
+ ZPRCS(JI,JJ,JK) = PRCS(JI,JJ,JK)-PRCT(JI,JJ,JK)*ZINVTSTEP
+ ENDIF
+ ZPRRS(JI,JJ,JK) = PRRS(JI,JJ,JK)-PRRT(JI,JJ,JK)*ZINVTSTEP
+ ZPRIS(JI,JJ,JK) = PRIS(JI,JJ,JK)-PRIT(JI,JJ,JK)*ZINVTSTEP
+ ZPRSS(JI,JJ,JK) = PRSS(JI,JJ,JK)-PRST(JI,JJ,JK)*ZINVTSTEP
+ ZPRGS(JI,JJ,JK) = PRGS(JI,JJ,JK)-PRGT(JI,JJ,JK)*ZINVTSTEP
+ IF ( IRR == 7 ) THEN
+ ZPRHS(JI,JJ,JK) = PRHS(JI,JJ,JK)-PRHT(JI,JJ,JK)*ZINVTSTEP
+ END IF
+ !
+ ! mr values inside the time-splitting loop
+ ZRCT(JI,JJ,JK) = PRCT(JI,JJ,JK)
+ ZRRT(JI,JJ,JK) = PRRT(JI,JJ,JK)
+ ZRIT(JI,JJ,JK) = PRIT(JI,JJ,JK)
+ ZRST(JI,JJ,JK) = PRST(JI,JJ,JK)
+ ZRGT(JI,JJ,JK) = PRGT(JI,JJ,JK)
+ IF (IRR==7) THEN
+ ZRHT(JI,JJ,JK) = PRHT(JI,JJ,JK)
+ END IF
+ !
+ ZW(JI,JJ,JK) =1./(PRHODREF(JI,JJ,JK)* PDZZ(JI,JJ,JK))
+ ENDDO
+ ENDDO
+ENDDO
!
!
!* 2.1 for cloud
!
IF (GSEDIC) THEN
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &XSPLIT_MAXCFL, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&2, &
&ZRCT, PRCS, PINPRC, ZPRCS, &
&ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
ENDIF
!
-!
-!* 2.1bis DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
-!
-IF (GDEPOSC) THEN
- PINDEP (:,:) = 0.
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- IF (PRCS(JI,JJ,KKB)>0.) THEN
- PRCS(JI,JJ,KKB) = PRCS(JI,JJ,KKB) - PVDEPOSC * PRCT(JI,JJ,KKB) / PDZZ(JI,JJ,KKB)
- PINPRC(JI,JJ) = PINPRC(JI,JJ) + PVDEPOSC * PRCT(JI,JJ,KKB) * PRHODREF(JI,JJ,KKB) /XRHOLW
- PINDEP(JI,JJ) = PVDEPOSC * PRCT(JI,JJ,KKB) * PRHODREF(JI,JJ,KKB) /XRHOLW
- END IF
- END DO
- END DO
-END IF
-!
!* 2.2 for rain
!
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &XSPLIT_MAXCFL, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&3, &
&ZRRT, PRRS, PINPRR, ZPRRS, &
@@ -273,42 +233,39 @@ END IF
!
!* 2.3 for pristine ice
!
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &XSPLIT_MAXCFL, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&4, &
&ZRIT, PRIS, PINPRI, ZPRIS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
!
!* 2.4 for aggregates/snow
!
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &XSPLIT_MAXCFL, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&5, &
&ZRST, PRSS, PINPRS, ZPRSS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
!
!* 2.5 for graupeln
!
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &XSPLIT_MAXCFL, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&6, &
&ZRGT, PRGS, PINPRG, ZPRGS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
!
!* 2.6 for hail
!
IF (IRR==7) THEN
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &XSPLIT_MAXCFL, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&7, &
&ZRHT, PRHS, PINPRH, ZPRHS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 1, ZHOOK_HANDLE)
!
CONTAINS
!
@@ -316,58 +273,72 @@ CONTAINS
!-------------------------------------------------------------------------------
!
!
-SUBROUTINE INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT,KKB,KKTB,KKTE,KKT,KKL,KRR, &
- &PMAXCFL,PRHODREF,POORHODZ,PDZZ,PPABST,PTHT,PT,PTSTEP, &
- &KSPE,PRXT,PRXS,PINPRX,PPRXS, &
- &PRAY,PLBC,PFSEDC,PCONC3D,PFPR)
+SUBROUTINE INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ &PRHODREF, POORHODZ, PDZZ, PPABST,PTHT,PT,PTSTEP, &
+ &KSPE, PRXT, PRXS, PINPRX, PPRXS, &
+ &PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XCPD,XP00,XRD
-USE MODD_RAIN_ICE_DESCR, ONLY: XCC,XCEXVT,XDC,XLBEXC,XRTMIN,XALPHAS,XNUS,XBS,XFVELOS, &
- XLBDAS_MAX,XLBDAS_MIN,XLBEXS,XLBS,XTRANS_MP_GAMMAS
-USE MODD_RAIN_ICE_PARAM, ONLY: XEXCSEDI,XEXSEDG,XEXSEDH,XEXSEDR,XEXSEDS,XFSEDG,XFSEDH,XFSEDI,XFSEDR,XFSEDS
-USE MODD_PARAM_ICE, ONLY: LSNOW_T
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB,KIE,KIT, KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR
-REAL, INTENT(IN) :: PMAXCFL ! maximum CFL allowed
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KIT,KJT,KKTB:KKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+INTEGER, INTENT(IN) :: KRR
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(D%NIT,D%NJT,D%NKTB:D%NKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! layer thikness (m)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABST
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHT
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PT
REAL, INTENT(IN) :: PTSTEP ! total timestep
INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXT ! mr of specy X
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRX ! instant precip
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPRXS ! external tendencie
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
-REAL, DIMENSION(KIT,KJT,KKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRXT ! mr of specy X
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRX ! instant precip
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPRXS ! external tendencie
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 declaration of local variables
!
-character(len=10) :: yspe ! String for error message
+CHARACTER(LEN=10) :: YSPE ! String for error message
INTEGER :: IDX, ISEDIM
INTEGER :: JI, JJ, JK, JL
-INTEGER, DIMENSION(KIT*KJT*KKT) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER, DIMENSION(D%NIT*D%NJT*D%NKT) :: I1,I2,I3 ! Used to replace the COUNT
LOGICAL :: GPRESENT_PFPR
REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
REAL :: ZLBDA
REAL :: ZFSED, ZEXSED
-REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE
-REAL, DIMENSION(KIT, KJT) :: ZMAX_TSTEP ! Maximum CFL in column
-REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZREMAINT ! Remaining time until the timestep end
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) :: ZWSED ! Sedimentation fluxes
-!
+REAL :: ZMRCHANGE
+REAL, DIMENSION(D%NIT, D%NJT) :: ZMAX_TSTEP ! Maximum CFL in column
+REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN
+REAL, DIMENSION(D%NIT, D%NJT) :: ZREMAINT ! Remaining time until the timestep end
+REAL, DIMENSION(D%NIT, D%NJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
+INTEGER :: IKTB, IKTE, IKB, IKL, IIE, IIB, IJB, IJE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, ZHOOK_HANDLE)
+!
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKL=D%NKL
+IIB=D%NIB
+IIE=D%NIE
+IJB=D%NJB
+IJE=D%NJE
!-------------------------------------------------------------------------------
IF (KSPE<2 .OR. KSPE>7) CALL PRINT_MSG(NVERB_FATAL,'GEN','INTERNAL_SEDIM_SPLIT','invalid species (KSPE variable)')
!
@@ -379,15 +350,16 @@ END IF
!
PINPRX(:,:) = 0.
ZINVTSTEP=1./PTSTEP
-ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP
-ZREMAINT(:,:) = PTSTEP
+ZRSMIN(:) = ICED%XRTMIN(:) * ZINVTSTEP
+ZREMAINT(:,:) = 0.
+ZREMAINT(IIB:IIE,IJB:IJE) = PTSTEP
!
DO WHILE (ANY(ZREMAINT>0.))
ISEDIM = 0
- DO JK = KKTB,KKTE
- DO JJ = KJB,KJE
- DO JI = KIB,KIE
- IF( (PRXT (JI,JJ,JK)>XRTMIN(KSPE) .OR. &
+ DO JK = IKTB,IKTE
+ DO JJ = IJB,IJE
+ DO JI = IIB,IIE
+ IF( (PRXT (JI,JJ,JK)>ICED%XRTMIN(KSPE) .OR. &
PPRXS(JI,JJ,JK)>ZRSMIN(KSPE)) .AND. &
ZREMAINT(JI,JJ)>0. ) THEN
ISEDIM = ISEDIM + 1
@@ -414,16 +386,16 @@ DO WHILE (ANY(ZREMAINT>0.))
JI=I1(JL)
JJ=I2(JL)
JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
+ IF(PRXT(JI,JJ,JK)>ICED%XRTMIN(KSPE)) THEN
ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
- (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
- ZZWLBDC = ZZWLBDC**XLBEXC
+ &(PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
+ ZZWLBDC = ZZWLBDC**ICED%XLBEXC
ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
- ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
+ ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/CST%XP00)**(CST%XRD/CST%XCPD)
ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
- ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
- ZWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * &
- ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
+ ZZCC = ICED%XCC*(1.+1.26*ZZWLBDA/ZRAY)
+ ZWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT +1 ) * &
+ &ZZWLBDC**(-ICED%XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
ENDIF
ENDDO
ELSEIF(KSPE==4) THEN
@@ -433,13 +405,15 @@ DO WHILE (ANY(ZREMAINT>0.))
JI=I1(JL)
JJ=I2(JL)
JK=I3(JL)
- IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN
- ZWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * &
- & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H
+ IF(PRXT(JI, JJ, JK) .GT. MAX(ICED%XRTMIN(4), 1.0E-7)) THEN
+ ZWSED(JI, JJ, JK) = ICEP%XFSEDI * PRXT(JI, JJ, JK) * &
+ & PRHODREF(JI,JJ,JK)**(1.-ICED%XCEXVT) * & ! McF&H
& MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
+ & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**ICEP%XEXCSEDI
ENDIF
ENDDO
+#if defined(REPRO48) || defined(REPRO55)
+#else
ELSEIF(KSPE==5) THEN
! ******* for snow
ZWSED(:,:,:) = 0.
@@ -447,37 +421,44 @@ DO WHILE (ANY(ZREMAINT>0.))
JI=I1(JL)
JJ=I2(JL)
JK=I3(JL)
- IF(PRXT(JI,JJ,JK)> XRTMIN(KSPE)) THEN
- IF (LSNOW_T .AND. PT(JI,JJ,JK)>263.15) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*PT(JI,JJ,JK))),XLBDAS_MIN)*XTRANS_MP_GAMMAS
- ELSE IF (LSNOW_T) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX, 10**(6.226 -0.0106*PT(JI,JJ,JK))),XLBDAS_MIN)*XTRANS_MP_GAMMAS
+ IF(PRXT(JI,JJ,JK)> ICED%XRTMIN(KSPE)) THEN
+ IF (PARAMI%LSNOW_T .AND. PT(JI,JJ,JK)>263.15) THEN
+ ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*PT(JI,JJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ELSE IF (PARAMI%LSNOW_T) THEN
+ ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226 -0.0106*PT(JI,JJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
ELSE
- ZLBDA=MAX(MIN(XLBDAS_MAX, XLBS * ( PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK) )**XLBEXS),XLBDAS_MIN)
+ ZLBDA=MAX(MIN(ICED%XLBDAS_MAX, ICED%XLBS * ( PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK) )**ICED%XLBEXS),ICED%XLBDAS_MIN)
END IF
- ZWSED(JI, JJ, JK) = XFSEDS * &
+ ZWSED(JI, JJ, JK) = ICEP%XFSEDS * &
& PRXT(JI,JJ,JK)* &
- & PRHODREF(JI,JJ,JK)**(1-XCEXVT) * &
- & (1 + (XFVELOS/ZLBDA)**XALPHAS)** (-XNUS+XEXSEDS/XALPHAS) * &
- & ZLBDA ** (XBS+XEXSEDS)
+ & PRHODREF(JI,JJ,JK)**(1-ICED%XCEXVT) * &
+ & (1 + (ICED%XFVELOS/ZLBDA)**ICED%XALPHAS)** (-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS) * &
+ & ZLBDA ** (ICED%XBS+ICEP%XEXSEDS)
ENDIF
ENDDO
+#endif
ELSE
! ******* for other species
SELECT CASE(KSPE)
CASE(3)
- ZFSED=XFSEDR
- ZEXSED=XEXSEDR
+ ZFSED=ICEP%XFSEDR
+ ZEXSED=ICEP%XEXSEDR
+#if defined(REPRO48) || defined(REPRO55)
+ CASE(5)
+ ZFSED=ICEP%XFSEDS
+ ZEXSED=ICEP%XEXSEDS
+#else
+#endif
CASE(6)
- ZFSED=XFSEDG
- ZEXSED=XEXSEDG
+ ZFSED=ICEP%XFSEDG
+ ZEXSED=ICEP%XEXSEDG
CASE(7)
- ZFSED=XFSEDH
- ZEXSED=XEXSEDH
+ ZFSED=ICEP%XFSEDH
+ ZEXSED=ICEP%XEXSEDH
CASE DEFAULT
- write( yspe, '( I10 )' ) kspe
- call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
+ WRITE(YSPE, '( I10 )' ) KSPE
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//TRIM(YSPE) )
END SELECT
!
ZWSED(:,:,:) = 0.
@@ -485,9 +466,9 @@ DO WHILE (ANY(ZREMAINT>0.))
JI=I1(JL)
JJ=I2(JL)
JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
+ IF(PRXT(JI,JJ,JK)>ICED%XRTMIN(KSPE)) THEN
ZWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED &
- * PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
+ & * PRHODREF(JI, JJ, JK)**(ZEXSED-ICED%XCEXVT)
ENDIF
ENDDO
ENDIF
@@ -496,26 +477,36 @@ DO WHILE (ANY(ZREMAINT>0.))
JI=I1(JL)
JJ=I2(JL)
JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE) .AND. ZWSED(JI, JJ, JK)>1.E-20) THEN
- ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PMAXCFL * PRHODREF(JI, JJ, JK) * &
- PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / ZWSED(JI, JJ, JK))
+ IF(PRXT(JI,JJ,JK)>ICED%XRTMIN(KSPE) .AND. ZWSED(JI, JJ, JK)>1.E-20) THEN
+ ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PARAMI%XSPLIT_MAXCFL * PRHODREF(JI, JJ, JK) * &
+ & PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / ZWSED(JI, JJ, JK))
ENDIF
ENDDO
- ZREMAINT(:,:) = ZREMAINT(:,:) - ZMAX_TSTEP(:,:)
- DO JK = KKTB , KKTE
- ZMRCHANGE(:,:) = ZMAX_TSTEP(:,:) * POORHODZ(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:) + PPRXS(:,:,JK) * ZMAX_TSTEP(:,:)
- PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTSTEP
+
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ZREMAINT(JI,JJ) = ZREMAINT(JI,JJ) - ZMAX_TSTEP(JI,JJ)
+ PINPRX(JI,JJ) = PINPRX(JI,JJ) + ZWSED(JI,JJ,IKB) / CST%XRHOLW * (ZMAX_TSTEP(JI,JJ) * ZINVTSTEP)
+ ENDDO
ENDDO
- PINPRX(:,:) = PINPRX(:,:) + ZWSED(:,:,KKB) / XRHOLW * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
- IF (GPRESENT_PFPR) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,KSPE) = PFPR(:,:,JK,KSPE) + ZWSED(:,:,JK) * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
+
+ DO JK = IKTB , IKTE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ZMRCHANGE = ZMAX_TSTEP(JI,JJ) * POORHODZ(JI,JJ,JK)*(ZWSED(JI,JJ,JK+IKL)-ZWSED(JI,JJ,JK))
+ PRXT(JI,JJ,JK) = PRXT(JI,JJ,JK) + ZMRCHANGE + PPRXS(JI,JJ,JK) * ZMAX_TSTEP(JI,JJ)
+ PRXS(JI,JJ,JK) = PRXS(JI,JJ,JK) + ZMRCHANGE * ZINVTSTEP
+ IF (GPRESENT_PFPR) THEN
+ PFPR(JI,JJ,JK,KSPE) = PFPR(JI,JJ,JK,KSPE) + ZWSED(JI,JJ,JK) * (ZMAX_TSTEP(JI,JJ) * ZINVTSTEP)
+ ENDIF
+ ENDDO
ENDDO
- ENDIF
+ ENDDO
!
END DO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 1, ZHOOK_HANDLE)
END SUBROUTINE INTERNAL_SEDIM_SPLI
!
END SUBROUTINE ICE4_SEDIMENTATION_SPLIT
+END MODULE MODE_ICE4_SEDIMENTATION_SPLIT
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_split_momentum.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_split_momentum.f90
index 927eb8ba536c7a0c0d726272ee4acafd8594892a..498375058494a79d840b508deb57b099087ccab4 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_split_momentum.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_split_momentum.f90
@@ -3,57 +3,15 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, OMOMENTUM, &
- &PSEA, PTOWN, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PINPRH, PRHT, PRHS, PFPR)
+MODULE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: OMOMENTUM ! Switch to use momentum flux
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
+CONTAINS
SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, OMOMENTUM, &
- &PSEA, PTOWN, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, OMOMENTUM, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PSEA, PTOWN, &
&PINPRH, PRHT, PRHS, PFPR)
!!
!!** PURPOSE
@@ -95,8 +53,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time s
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
LOGICAL, INTENT(IN) :: OMOMENTUM ! Switch to use momentum flux
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
@@ -117,6 +73,8 @@ REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
@@ -173,16 +131,24 @@ IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
!
IF (OSEDIC) THEN
ZRAY(:,:,:) = 0.
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
-
- DO JK=KKTB, KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:)= XCONC_LAND
+ ZCONC_TMP(:,:)= XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
+ DO JK=KKTB, KKTE
+ ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
+ & PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ END IF
ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
ENDIF
@@ -194,12 +160,16 @@ ENDIF
! For optimization we consider each variable separately
!
! External tendecies
-IF (OSEDIC) ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
+IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
+ENDIF
ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP
ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP
ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP
ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP
-IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP
+IF ( KRR == 7 ) THEN
+ ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP
+END IF
!
! mr values inside the time-splitting loop
ZRCT(:,:,:) = PRCT(:,:,:)
@@ -207,7 +177,9 @@ ZRRT(:,:,:) = PRRT(:,:,:)
ZRIT(:,:,:) = PRIT(:,:,:)
ZRST(:,:,:) = PRST(:,:,:)
ZRGT(:,:,:) = PRGT(:,:,:)
-IF (KRR==7) ZRHT(:,:,:) = PRHT(:,:,:)
+IF (KRR==7) THEN
+ ZRHT(:,:,:) = PRHT(:,:,:)
+END IF
!
DO JK = KKTB , KKTE
ZW(:,:,JK) =1./(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
@@ -231,7 +203,7 @@ IF (OSEDIC) THEN
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&2, &
&ZRCT, PRCS, ZWSED, PINPRC, ZPRCS, ZMOMC, ZMOMC_EXT, &
&ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
@@ -255,7 +227,7 @@ DO WHILE (ANY(ZREMAINT>0.))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&3, &
&ZRRT, PRRS, ZWSED, PINPRR, ZPRRS, ZMOMR, ZMOMR_EXT, &
&PFPR=PFPR)
@@ -278,7 +250,7 @@ DO WHILE (ANY(ZREMAINT>0.))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&4, &
&ZRIT, PRIS, ZWSED, PINPRI, ZPRIS, ZMOMI, ZMOMI_EXT, PFPR=PFPR)
FIRST = .FALSE.
@@ -300,7 +272,7 @@ DO WHILE (ANY(ZREMAINT>0.))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&5, &
&ZRST, PRSS, ZWSED, PINPRS, ZPRSS, ZMOMS, ZMOMS_EXT, PFPR=PFPR)
FIRST = .FALSE.
@@ -322,7 +294,7 @@ DO WHILE (ANY(ZREMAINT>0.))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&6, &
&ZRGT, PRGS, ZWSED, PINPRG, ZPRGS, ZMOMG, ZMOMG_EXT, PFPR=PFPR)
FIRST = .FALSE.
@@ -345,7 +317,7 @@ IF (KRR==7) THEN
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&7, &
&ZRHT, PRHS, ZWSED, PINPRH, ZPRHS, ZMOMH, ZMOMH_EXT, PFPR=PFPR)
FIRST = .FALSE.
@@ -362,7 +334,7 @@ CONTAINS
SUBROUTINE INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, OCOMPUTE_MOM, &
&KSEDIM, LDSEDIM, I1, I2, I3, PMAXCFL, PREMAINT, &
- &PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, &
+ &PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PTSTEP, &
&KSPE, &
&PRXT, PRXS, PWSED, PINPRX, PPRXS, PMOM, PMOM_EXT, &
&PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
@@ -388,8 +360,6 @@ CONTAINS
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! layer thikness (m)
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
- REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
- REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
REAL, INTENT(IN) :: PTSTEP ! total timestep
INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
@@ -575,3 +545,5 @@ CONTAINS
END SUBROUTINE INTERNAL_SEDIM_SPLI
!
END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM
+!
+END MODULE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
index 891223920fd73ea2bbbeed059ce1669aeebd2d51..33e4e6e01e7ff5992ce919206038b62e0647a2e3 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
@@ -3,63 +3,16 @@
!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_ICE4_SEDIMENTATION_STAT
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- & PLBDAS, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT,&
- &PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
+MODULE MODE_ICE4_SEDIMENTATION_STAT
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
-REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_STAT
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_STAT
-SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
+CONTAINS
+SUBROUTINE ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- & PLBDAS, &
+ &PLBDAS, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, &
&PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
&PSEA, PTOWN, &
&PINPRH, PRHT, PRHS, PFPR)
@@ -77,6 +30,8 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB,
!!
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!! Ryad El Khatib 09-Oct-2019 Substantial re-write for optimization
+!! (outerunrolling, vectorization, memory cache saving, unrolling)
! P. Wautelet 21/01/2021: initialize untouched part of PFPR
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!
@@ -84,395 +39,434 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB,
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-
-USE MODE_MSG
-USE MODD_RAIN_ICE_DESCR
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODI_GAMMA, ONLY: GAMMA
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+TYPE(DIMPHYEX_t), INTENT(IN) :: D !array dimensions
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
-REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIT,D%NJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 declaration of local variables
!
-!
-INTEGER :: JK
-!
-REAL :: ZINVTSTEP
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW ! work array
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
- :: ZWSED ! sedimentation fluxes
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
-!
-!
+LOGICAL :: LLSEA_AND_TOWN
+INTEGER :: JRR, JI, JJ, JK, IKB, IKE,IKL, IIE, IIB, IJB, IJE, IKTB, IKTE
+INTEGER :: ISHIFT, IK, IKPLUS
+REAL :: ZQP, ZP1, ZINVTSTEP, ZGAC, ZGC, ZGAC2, ZGC2, ZRAYDEFO
+REAL, DIMENSION(D%NIT) :: ZWSEDW1, ZWSEDW2 ! sedimentation speed
+REAL, DIMENSION(D%NIT,D%NJT) :: ZTSORHODZ ! TimeStep Over (Rhodref times delta Z)
+REAL, DIMENSION(D%NIT,D%NJT,0:1,2:KRR) :: ZSED ! sedimentation flux array for each species and for above and current levels
+REAL :: FWSED1, FWSED2, PWSEDW, PWSEDWSUP, PINVTSTEP, PTSTEP1, PDZZ1, PRHODREF1, PRXT1
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+#if defined(REPRO48) || defined(REPRO55)
+! 5 multiplications + 1 division => cost = 7X
+FWSED1(PWSEDW,PTSTEP1,PDZZ1,PRHODREF1,PRXT1,PINVTSTEP)=MIN(1.,PWSEDW*PTSTEP1/PDZZ1 )*PRHODREF1*PDZZ1*PRXT1*PINVTSTEP
+#else
+! 5 multiplications only => cost = 5X
+FWSED1(PWSEDW,PTSTEP1,PDZZ1,PRHODREF1,PRXT1,PINVTSTEP)=MIN(PRHODREF1*PDZZ1*PRXT1*PINVTSTEP,PWSEDW*PRHODREF1*PRXT1)
+#endif
+
+FWSED2(PWSEDW,PTSTEP1,PDZZ1,PWSEDWSUP)=MAX(0.,1.-PDZZ1/(PTSTEP1*PWSEDW))*PWSEDWSUP
+
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT',0,ZHOOK_HANDLE)
+!
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
+IIB=D%NIB
+IIE=D%NIE
+IJB=D%NJB
+IJE=D%NJE
+IKTB=D%NKTB
+IKTE=D%NKTE
!
-ZINVTSTEP=1./PTSTEP
-
IF ( PRESENT( PFPR ) ) THEN
!Set to 0. to avoid undefined values (in files)
- PFPR(:, :, : KKTB - 1, :) = 0.
- PFPR(:, :, KKTE + 1 :, :) = 0.
+ PFPR(:, :, : IKTB, :) = 0.
+ PFPR(:, :, IKTE :, :) = 0.
END IF
+
!-------------------------------------------------------------------------------
!
!* 1. compute the fluxes
!
+ZINVTSTEP = 1./PTSTEP
+ZGAC=GAMMA(ICED%XNUC+1.0/ICED%XALPHAC)
+ZGC=GAMMA(ICED%XNUC)
+ZGAC2=GAMMA(ICED%XNUC2+1.0/ICED%XALPHAC2)
+ZGC2=GAMMA(ICED%XNUC2)
+ZRAYDEFO=MAX(1.,0.5*(ZGAC/ZGC))
+LLSEA_AND_TOWN=PRESENT(PSEA).AND.PRESENT(PTOWN)
+
!
-DO JK = KKTB , KKTE
- ZW(:,:,JK) =PTSTEP/(PRHODREF(:,:,JK)* PDZZ(:,:,JK) )
-END DO
-!
-!* 2.1 for cloud
+!* 2. compute the fluxes
!
-IF (OSEDIC) THEN
- CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &2, &
- &PLBDAS, &!Modif Wurtz
- &PRCT, PRCS, ZWSED, PSEA, PTOWN)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,2)=ZWSED(:,:,JK)
+! Start shift mechanism:
+ISHIFT=0
+CALL SHIFT
+
+! Initialize vertical loop
+DO JRR=2,KRR
+ ZSED(:,:,IKPLUS,JRR) = 0.
+ENDDO
+
+! calculation sedimentation flux
+DO JK = IKE , IKB, -1*IKL
+
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ZTSORHODZ(JI,JJ) =PTSTEP/(PRHODREF(JI,JJ,JK)*PDZZ(JI,JJ,JK))
ENDDO
- ENDIF
- PINPRC(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-ENDIF
-!
-!
-!* 2.1bis DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
-!
-IF (ODEPOSC) THEN
- GDEP(:,:) = .FALSE.
- GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
- WHERE (GDEP)
- PRCS(:,:,KKB) = PRCS(:,:,KKB) - PVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB)
- PINPRC(:,:) = PINPRC(:,:) + PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
- PINDEP(:,:) = PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
- END WHERE
-END IF
-!
-!* 2.2 for rain
-!
-CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &3, &
- &PLBDAS, &
- &PRRT, PRRS, ZWSED)
-IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,3)=ZWSED(:,:,JK)
- ENDDO
-ENDIF
-PINPRR(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-!
-!* 2.3 for pristine ice
-!
-CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &4, &
- &PLBDAS, &
- &PRIT, PRIS, ZWSED)
-IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,4)=ZWSED(:,:,JK)
- ENDDO
-ENDIF
-PINPRI(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-!
-!* 2.4 for aggregates/snow
-!
-CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &5, &
- &PLBDAS, &
- &PRST, PRSS, ZWSED)
-IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,5)=ZWSED(:,:,JK)
- ENDDO
-ENDIF
-PINPRS(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-!
-!* 2.5 for graupeln
-!
-CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &6, &
- &PLBDAS, &
- &PRGT, PRGS, ZWSED)
-IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,6)=ZWSED(:,:,JK)
ENDDO
-ENDIF
-PINPRG(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-!
-!* 2.6 for hail
!
-IF ( KRR == 7 ) THEN
- CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &7, &
- &PLBDAS, &
- &PRHT, PRHS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,7)=ZWSED(:,:,JK)
+ DO JRR=2,KRR
+
+ IF (JRR==2) THEN
+
+ !******* for cloud
+ IF (OSEDIC) THEN
+ CALL CLOUD(PRCT(:,:,JK))
+ ELSE
+ ZSED(:,:,IK,JRR)=0.
+ ENDIF
+
+ ELSEIF (JRR==3) THEN
+
+ !* 2.2 for rain
+ CALL OTHER_SPECIES(ICEP%XFSEDR,ICEP%XEXSEDR,PRRT(:,:,JK))
+
+ ELSEIF (JRR==4) THEN
+
+ CALL PRISTINE_ICE(PRIT(:,:,JK))
+
+ ELSEIF (JRR==5) THEN
+
+ !* 2.4 for aggregates/snow
+#ifdef REPRO48
+ CALL OTHER_SPECIES(ICEP%XFSEDS,ICEP%XEXSEDS,PRST(:,:,JK))
+#else
+ CALL SNOW(PRST(:,:,JK))
+#endif
+
+ ELSEIF (JRR==6) THEN
+
+ !* 2.5 for graupeln
+ CALL OTHER_SPECIES(ICEP%XFSEDG,ICEP%XEXSEDG,PRGT(:,:,JK))
+
+ ELSEIF (JRR==7) THEN
+
+ !* 2.6 for hail
+ IF (PRESENT(PRHT)) THEN
+ CALL OTHER_SPECIES(ICEP%XFSEDH,ICEP%XEXSEDH,PRHT(:,:,JK))
+ ENDIF
+
+ ENDIF
+
+ ENDDO ! JRR
+
+ ! Wrap-up
+
+ IF(PRESENT(PFPR)) THEN
+ DO JRR=2,KRR
+ PFPR(:,:,JK,JRR)=ZSED(:,:,IK,JRR)
ENDDO
ENDIF
- PINPRH(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-ENDIF
-!
-!
+
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ PRCS(JI,JJ,JK) = PRCS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,2)-ZSED(JI,JJ,IK,2))*ZINVTSTEP
+ PRRS(JI,JJ,JK) = PRRS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,3)-ZSED(JI,JJ,IK,3))*ZINVTSTEP
+ PRIS(JI,JJ,JK) = PRIS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,4)-ZSED(JI,JJ,IK,4))*ZINVTSTEP
+ PRSS(JI,JJ,JK) = PRSS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,5)-ZSED(JI,JJ,IK,5))*ZINVTSTEP
+ PRGS(JI,JJ,JK) = PRGS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,6)-ZSED(JI,JJ,IK,6))*ZINVTSTEP
+ IF (PRESENT(PRHS)) THEN
+ PRHS(JI,JJ,JK) = PRHS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,7)-ZSED(JI,JJ,IK,7))*ZINVTSTEP
+ ENDIF
+ ENDDO
+ ENDDO
+
+ IF (JK==IKB) THEN
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF(OSEDIC) PINPRC(JI,JJ) = ZSED(JI,JJ,IK,2)/CST%XRHOLW
+ PINPRR(JI,JJ) = ZSED(JI,JJ,IK,3)/CST%XRHOLW
+ PINPRI(JI,JJ) = ZSED(JI,JJ,IK,4)/CST%XRHOLW
+ PINPRS(JI,JJ) = ZSED(JI,JJ,IK,5)/CST%XRHOLW
+ PINPRG(JI,JJ) = ZSED(JI,JJ,IK,6)/CST%XRHOLW
+ IF (PRESENT(PINPRH)) THEN
+ PINPRH(JI,JJ) = ZSED(JI,JJ,IK,7)/CST%XRHOLW
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ! shift mechanism : current level now takes the place of previous one
+ CALL SHIFT
+
+ENDDO ! JK
+
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT',1,ZHOOK_HANDLE)
+
CONTAINS
- SUBROUTINE INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, PTSORHODZ, PPABST, PTHT, PTSTEP, &
- &KSPE, &
- &PLBDAS, &
- &PRXT, PRXS, PWSED, PSEA, PTOWN)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- use mode_tools, only: Countjv
-
- USE MODD_RAIN_ICE_DESCR
- USE MODD_RAIN_ICE_PARAM
-
- USE MODI_GAMMA
-
- IMPLICIT NONE
- !
- !* 0.1 Declarations of dummy arguments :
- !
- INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKT, KKE, KKTB, KKTE, KKL
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLBDAS ! lambda parameter for snow
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTSORHODZ ! TimeStep Over (Rhodref times delta Z)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
- REAL, INTENT(IN) :: PTSTEP
- INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRXT ! mr of specy X
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
- REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux
- REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
- REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
- !
- !* 0.2 declaration of local variables
- !
- !
- character(len=10) :: yspe ! String for error message
- INTEGER :: JK, JCOUNT, JL, JI, JJ
- INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
- :: ZWSEDW1, ZWSEDW2 ! sedimentation speed
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZQP
- REAL :: ZINVTSTEP, ZH, ZP1, ZP2, ZZWLBDA, ZZWLBDC, ZZCC
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: &
- ZRAY, & ! Cloud Mean radius
- ZLBC, & ! XLBC weighted by sea fraction
- ZFSEDC
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) &
- :: ZCONC_TMP ! Weighted concentration
- REAL :: ZFSED, ZEXSED
- !
- !-------------------------------------------------------------------------------
- !
- !
- !* 1. Parameters for cloud sedimentation
- !
- IF(KSPE==2) THEN
- ZRAY(:,:,:) = 0.
- ZLBC(:,:,:) = XLBC(1)
- ZFSEDC(:,:,:) = XFSEDC(1)
- ZCONC3D(:,:,:)= XCONC_LAND
- ZCONC_TMP(:,:)= XCONC_LAND
- IF (PRESENT(PSEA)) THEN
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
- DO JK=KKTB,KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
- ELSE
- ZCONC3D(:,:,:) = XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
- END IF
- ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
- ENDIF
- !
- !* 2. compute the fluxes
- !
- !
- ZINVTSTEP = 1./PTSTEP
- PWSED(:,:,:) = 0.
- ZWSEDW1(:,:,:) = 0.
- ZWSEDW2(:,:,:) = 0.
- ! calculation of ZP1, ZP2 and sedimentation flux
- DO JK = KKE , KKB, -1*KKL
- !estimation of q' taking into account incomming PWSED
- ZQP(:,:)=PWSED(:,:,JK+KKL)*PTSORHODZ(:,:,JK)
- JCOUNT=COUNTJV( (PRXT(:,:,JK) > XRTMIN(KSPE)) .OR. (ZQP(:,:) > XRTMIN(KSPE)) ,I1(:),I2(:))
- IF(KSPE==2) THEN
- !******* for cloud
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
+
+ SUBROUTINE CLOUD(PRXT)
+
+ REAL, INTENT(IN) :: PRXT(D%NIT,D%NJT) ! mr of specy X
+
+ REAL :: ZLBC ! XLBC weighted by sea fraction
+ REAL :: ZFSEDC
+ REAL :: ZCONC3D ! droplet condensation
+ REAL :: ZRAY ! Cloud Mean radius
+ REAL :: ZZWLBDA, ZZWLBDC, ZZCC
+
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:CLOUD',0,ZHOOK_HANDLE)
+
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ !estimation of q' taking into account incoming ZWSED from previous vertical level
+ ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ)
+ IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
+ IF (LLSEA_AND_TOWN) THEN
+ ZRAY = MAX(1.,0.5*((1.-PSEA(JI,JJ))*ZGAC/ZGC+PSEA(JI,JJ)*ZGAC2/ZGC2))
+ ZLBC = MAX(MIN(ICED%XLBC(1),ICED%XLBC(2)),(PSEA(JI,JJ)*ICED%XLBC(2)+(1.-PSEA(JI,JJ))*ICED%XLBC(1)) )
+ ZFSEDC = MAX(MIN(ICEP%XFSEDC(1),ICEP%XFSEDC(2)), (PSEA(JI,JJ)*ICEP%XFSEDC(2)+(1.-PSEA(JI,JJ))*ICEP%XFSEDC(1)) )
+ ZCONC3D= (1.-PTOWN(JI,JJ))*(PSEA(JI,JJ)*ICED%XCONC_SEA+(1.-PSEA(JI,JJ))*ICED%XCONC_LAND) + &
+ PTOWN(JI,JJ) *ICED%XCONC_URBAN
+ ELSE
+ ZRAY = ZRAYDEFO
+ ZLBC = ICED%XLBC(1)
+ ZFSEDC = ICEP%XFSEDC(1)
+ ZCONC3D= ICED%XCONC_LAND
+ ENDIF
!calculation of w
- IF(PRXT(JI,JJ,JK) > XRTMIN(KSPE)) THEN
+ IF(PRXT(JI,JJ) > ICED%XRTMIN(JRR)) THEN
ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
- ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
- &/(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)))**XLBEXC
- ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
- ZWSEDW1 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
- & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
+ ZZWLBDC=(ZLBC*ZCONC3D/(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ)))**ICED%XLBEXC
+ ZZCC=ICED%XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY) !! ZCC : Fall speed
+ ZWSEDW1(JI)=PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
+ ELSE
+ ZWSEDW1(JI)=0.
ENDIF
- IF ( ZQP(JI,JJ) > XRTMIN(KSPE) ) THEN
+ IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
- ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
- &/(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)))**XLBEXC
- ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
- ZWSEDW2 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
- & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
+ ZZWLBDC=(ZLBC*ZCONC3D/(PRHODREF(JI,JJ,JK)*ZQP))**ICED%XLBEXC
+ ZZCC=ICED%XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY) !! ZCC : Fall speed
+ ZWSEDW2(JI)=PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT ) * ZZWLBDC**(-ICED%XDC)*ZZCC*ZFSEDC
+ ELSE
+ ZWSEDW2(JI)=0.
ENDIF
- ENDDO
- ELSEIF(KSPE==4) THEN
- ! ******* for pristine ice
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
+ ELSE
+ ZWSEDW1(JI)=0.
+ ZWSEDW2(JI)=0.
+ ENDIF
+!- duplicated code -------------------------------------------------------------------------
+ IF (ZWSEDW2(JI) /= 0.) THEN
+ ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2(JI),PTSTEP,PDZZ(JI,JJ,JK),ZSED(JI,JJ,IKPLUS,JRR))
+ ELSE
+ ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP)
+ ENDIF
+!-------------------------------------------------------------------------------------------
+ ENDDO
+ ENDDO
+
+ !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:CLOUD',1,ZHOOK_HANDLE)
+
+ END SUBROUTINE CLOUD
+
+ SUBROUTINE PRISTINE_ICE(PRXT)
+
+ REAL, INTENT(IN) :: PRXT(D%NIT,D%NJT) ! mr of specy X
+
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:PRISTINE_ICE',0,ZHOOK_HANDLE)
+
+ ! ******* for pristine ice
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ)
+ IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
!calculation of w
- IF ( PRXT(JI,JJ,JK) > MAX(XRTMIN(KSPE),1.0E-7 ) ) THEN
- ZWSEDW1 (JI,JJ,JK)= XFSEDI * &
- & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & ! McF&H
+ IF ( PRXT(JI,JJ) > MAX(ICED%XRTMIN(JRR),1.0E-7 ) ) THEN
+ ZWSEDW1(JI)= ICEP%XFSEDI * &
+ & PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT) * & ! McF&H
& MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
+ & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ)) )**ICEP%XEXCSEDI
+ ELSE
+ ZWSEDW1(JI)=0.
ENDIF
- IF ( ZQP(JI,JJ) > MAX(XRTMIN(KSPE),1.0E-7 ) ) THEN
- ZWSEDW2 (JI,JJ,JK)= XFSEDI * &
- & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & ! McF&H
+ IF ( ZQP > MAX(ICED%XRTMIN(JRR),1.0E-7 ) ) THEN
+ ZWSEDW2(JI)= ICEP%XFSEDI * &
+ & PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT) * & ! McF&H
& MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) )**XEXCSEDI
+ & ALOG(PRHODREF(JI,JJ,JK)*ZQP) )**ICEP%XEXCSEDI
+ ELSE
+ ZWSEDW2(JI)=0.
ENDIF
- ENDDO
+ ELSE
+ ZWSEDW1(JI)=0.
+ ZWSEDW2(JI)=0.
+ ENDIF
+!- duplicated code -------------------------------------------------------------------------
+ IF (ZWSEDW2(JI) /= 0.) THEN
+ ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2(JI),PTSTEP,PDZZ(JI,JJ,JK),ZSED(JI,JJ,IKPLUS,JRR))
+ ELSE
+ ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP)
+ ENDIF
+!-------------------------------------------------------------------------------------------
+ ENDDO
+ ENDDO
- ELSEIF(KSPE==5) THEN
- ! ******* for snow
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
+ !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:PRISTINE_ICE',1,ZHOOK_HANDLE)
- IF(PRXT(JI,JJ,JK) > XRTMIN(KSPE)) THEN
- ZWSEDW1(JI,JJ,JK)= XFSEDS * &
- & PRHODREF(JI,JJ,JK)**(-XCEXVT) * &
- & (1+(XFVELOS/PLBDAS(JI,JJ,JK))**XALPHAS)**(-XNUS+XEXSEDS/XALPHAS) * &
- & PLBDAS(JI,JJ,JK)**(XBS+XEXSEDS)
- ENDIF
- IF ( ZQP(JI,JJ) > XRTMIN(KSPE)) THEN
- ZWSEDW2(JI,JJ,JK)= XFSEDS * &
- & PRHODREF(JI,JJ,JK)**(-XCEXVT) * &
- & (1+(XFVELOS/PLBDAS(JI,JJ,JK))**XALPHAS)**(-XNUS+XEXSEDS/XALPHAS) * &
- & PLBDAS(JI,JJ,JK)**(XBS+XEXSEDS)
+ END SUBROUTINE PRISTINE_ICE
- ENDIF
- ENDDO
+ SUBROUTINE SNOW(PRXT)
- ELSE
- ! ******* for other species
- IF(KSPE==3) THEN
- ZFSED=XFSEDR
- ZEXSED=XEXSEDR
- ELSEIF(KSPE==6) THEN
- ZFSED=XFSEDG
- ZEXSED=XEXSEDG
- ELSEIF(KSPE==7) THEN
- ZFSED=XFSEDH
- ZEXSED=XEXSEDH
+ REAL, INTENT(IN) :: PRXT(D%NIT,D%NJT) ! mr of specy X
+
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:SNOW',0,ZHOOK_HANDLE)
+
+ ! ******* for snow
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ)
+ IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
+ !calculation of w
+ IF ( PRXT(JI,JJ) > ICED%XRTMIN(JRR) ) THEN
+ ZWSEDW1(JI)= ICEP%XFSEDS * &
+ & PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT) * &
+ & (1+(ICED%XFVELOS/PLBDAS(JI,JJ,JK))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS)* &
+ & PLBDAS(JI,JJ,JK)**(ICED%XBS+ICEP%XEXSEDS)
+ ELSE
+ ZWSEDW1(JI)=0.
+ ENDIF
+ IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
+ ZWSEDW2(JI)= ICEP%XFSEDS * &
+ & PRHODREF(JI,JJ,JK)**(-ICED%XCEXVT) * &
+ & (1+(ICED%XFVELOS/PLBDAS(JI,JJ,JK))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS)* &
+ & PLBDAS(JI,JJ,JK)**(ICED%XBS+ICEP%XEXSEDS)
+ ELSE
+ ZWSEDW2(JI)=0.
+ ENDIF
ELSE
- write( yspe, '( I10 )' ) kspe
- call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_STAT', &
- 'no sedimentation parameter for KSPE='//trim(yspe) )
+ ZWSEDW1(JI)=0.
+ ZWSEDW2(JI)=0.
ENDIF
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
+!- duplicated code -------------------------------------------------------------------------
+ IF (ZWSEDW2(JI) /= 0.) THEN
+ ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2(JI),PTSTEP,PDZZ(JI,JJ,JK),ZSED(JI,JJ,IKPLUS,JRR))
+ ELSE
+ ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP)
+ ENDIF
+!-------------------------------------------------------------------------------------------
+ ENDDO
+ ENDDO
+
+ !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:SNOW',1,ZHOOK_HANDLE)
+
+ END SUBROUTINE SNOW
+
+ SUBROUTINE OTHER_SPECIES(PFSED,PEXSED,PRXT)
+
+ REAL, INTENT(IN) :: PFSED
+ REAL, INTENT(IN) :: PEXSED
+ REAL, INTENT(IN) :: PRXT(D%NIT,D%NJT) ! mr of specy X
+
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:OTHER_SPECIES',0,ZHOOK_HANDLE)
+
+ ! for all but cloud and pristine ice :
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ)
+ IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN
!calculation of w
- IF ( PRXT(JI,JJ,JK) > XRTMIN(KSPE) ) THEN
- ZWSEDW1 (JI,JJ,JK)= ZFSED *PRXT(JI,JJ,JK)**(ZEXSED-1)* &
- PRHODREF(JI,JJ,JK)**(ZEXSED-XCEXVT-1)
- ENDIF
- IF ( ZQP(JI,JJ) > XRTMIN(KSPE) ) THEN
- ZWSEDW2 (JI,JJ,JK)= ZFSED *ZQP(JI,JJ)**(ZEXSED-1)* &
- PRHODREF(JI,JJ,JK)**(ZEXSED-XCEXVT-1)
+ IF ( PRXT(JI,JJ) > ICED%XRTMIN(JRR) ) THEN
+ ZWSEDW1(JI)= PFSED *PRXT(JI,JJ)**(PEXSED-1)*PRHODREF(JI,JJ,JK)**(PEXSED-ICED%XCEXVT-1)
+ ELSE
+ ZWSEDW1(JI)=0.
ENDIF
- ENDDO
- ENDIF
- DO JJ = KJB, KJE
- DO JI = KIB, KIE
- ZH=PDZZ(JI,JJ,JK)
- ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
- IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
- ZP2 = MAX(0.,1 - ZH &
- & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ IF ( ZQP > ICED%XRTMIN(JRR) ) THEN
+ ZWSEDW2(JI)= PFSED *ZQP**(PEXSED-1)*PRHODREF(JI,JJ,JK)**(PEXSED-ICED%XCEXVT-1)
ELSE
- ZP2 = 0.
+ ZWSEDW2(JI)=0.
ENDIF
- PWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
- &ZH*PRXT(JI,JJ,JK)&
- &* ZINVTSTEP+ ZP2 * PWSED (JI,JJ,JK+KKL)
- ENDDO
+ ELSE
+ ZWSEDW1(JI)=0.
+ ZWSEDW2(JI)=0.
+ ENDIF
+!- duplicated code -------------------------------------------------------------------------
+ IF (ZWSEDW2(JI) /= 0.) THEN
+ ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP) &
+ & + FWSED2(ZWSEDW2(JI),PTSTEP,PDZZ(JI,JJ,JK),ZSED(JI,JJ,IKPLUS,JRR))
+ ELSE
+ ZSED(JI,JJ,IK,JRR)=FWSED1(ZWSEDW1(JI),PTSTEP,PDZZ(JI,JJ,JK),PRHODREF(JI,JJ,JK),PRXT(JI,JJ),ZINVTSTEP)
+ ENDIF
+!-------------------------------------------------------------------------------------------
ENDDO
ENDDO
- DO JK = KKTB , KKTE
- PRXS(:,:,JK) = PRXS(:,:,JK) + &
- & PTSORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))*ZINVTSTEP
- ENDDO
- END SUBROUTINE INTERNAL_SEDIM_STAT
- !
+
+ !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:OTHER_SPECIES',1,ZHOOK_HANDLE)
+
+ END SUBROUTINE OTHER_SPECIES
+
+ SUBROUTINE SHIFT
+
+ IKPLUS=ISHIFT
+ IK=1-ISHIFT
+ ISHIFT=1-ISHIFT
+
+ END SUBROUTINE SHIFT
END SUBROUTINE ICE4_SEDIMENTATION_STAT
+END MODULE MODE_ICE4_SEDIMENTATION_STAT
diff --git a/src/PHYEX/micro/mode_ice4_slow.f90 b/src/PHYEX/micro/mode_ice4_slow.f90
index e712f77405646e80b4373bcdf542173ed7e3f28b..e81b2f529a42743008a80a5c6a494b9f9b1941d2 100644
--- a/src/PHYEX/micro/mode_ice4_slow.f90
+++ b/src/PHYEX/micro/mode_ice4_slow.f90
@@ -2,57 +2,15 @@
!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_ICE4_SLOW
-INTERFACE
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT,&
- &PSSI, PLVFACT, PLSFACT, &
- &PRVT, PRCT, PRIT, PRST, PRGT,&
- &PLBDAS, PLBDAG,&
- &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
+MODULE MODE_ICE4_SLOW
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-END SUBROUTINE ICE4_SLOW
-END INTERFACE
-END MODULE MODI_ICE4_SLOW
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
+CONTAINS
+SUBROUTINE ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT, &
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT, &
&PLBDAS, PLBDAG, &
&PAI, PCJ, PHLI_HCF, PHLI_HRI,&
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
+ &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG)
!!
!!** PURPOSE
!! -------
@@ -65,59 +23,60 @@ SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
!! MODIFICATIONS
!! -------------
!!
+!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XTT
-USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN,XALPHAS,XNUS,XBS,XFVELOS
-USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPG,X0DEPS,X1DEPG,X1DEPS,XACRIAUTI,XALPHA3,XBCRIAUTI,XBETA3,XCOLEXIS,XCRIAUTI, &
- XEX0DEPG,XEX0DEPS,XEX1DEPG,XEX1DEPS,XEXIAGGS,XFIAGGS,XHON,XTEXAUTI,XTIMAUTI
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PSSI ! Supersaturation over ice
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRVT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PAI ! Thermodynamical function
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLI_HRI !
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(KSIZE) :: ZCRIAUTI, ZMASK
-REAL :: ZTIMAUTIC
-INTEGER :: JL
+REAL, DIMENSION(KPROMA) :: ZCRIAUTI
+REAL :: ZTIMAUTIC
+INTEGER :: JL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ICE4_SLOW', 0, ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
@@ -125,25 +84,14 @@ INTEGER :: JL
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCHONI(JL) = PRCHONI(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRCHONI(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCHONI(:) = MIN(1000.,XHON*PRHODREF(:)*PRCT(:) &
- *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ))
- ENDWHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RI(JL) = PA_RI(JL) + PRCHONI(JL)
- PA_RC(JL) = PA_RC(JL) - PRCHONI(JL)
- PA_TH(JL) = PA_TH(JL) + PRCHONI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ IF(PT(JL)<CST%XTT-35.0 .AND. PRCT(JL)>ICED%XRTMIN(2) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRCHONI(JL) = MIN(1000.,ICEP%XHON*PRHODREF(JL)*PRCT(JL) &
+ *EXP( ICEP%XALPHA3*(PT(JL)-CST%XTT)-ICEP%XBETA3 ))
+ ENDIF
+ ELSE
+ PRCHONI(JL) = 0.
+ ENDIF
ENDDO
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
@@ -152,7 +100,7 @@ ENDDO
!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
!
! ZZW(:) = 0.0
-! ZTIMAUTIC = SQRT( XTIMAUTI*XTIMAUTC )
+! ZTIMAUTIC = SQRT( ICEP%XTIMAUTI*ICEP%XTIMAUTC )
! WHERE ( (PRCT(:)>0.0) .AND. (PRIT(:)>0.0) .AND. (PRCS(:)>0.0) )
! ZZW(:) = MIN( PRCS(:),ZTIMAUTIC * MAX( SQRT( PRIT(:)*PRCT(:) ),0.0 ) )
! PRIS(:) = PRIS(:) + ZZW(:)
@@ -163,106 +111,81 @@ ENDDO
!* 3.4.3 compute the deposition on r_s: RVDEPS
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & !PRVT(:)>XRTMIN(1)
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !PRST(:)>XRTMIN(5)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRVDEPS(JL)=PRVDEPS(JL)*ZMASK(JL)
- ENDDO
-ELSE
- PRVDEPS(:) = 0.
- DO JL=1, KSIZE
- IF (ZMASK(JL)==1.) THEN
- PRVDEPS(JL) = ( PRST(JL)*PSSI(JL)/PAI(JL) ) * &
- ( X0DEPS*PLBDAS(JL)**(XBS+XEX0DEPS) + X1DEPS*PCJ(JL) * (1+0.5*(XFVELOS/PLBDAS(JL))**XALPHAS)**(-XNUS+XEX1DEPS/XALPHAS) &
- *(PLBDAS(JL))**(XBS+XEX1DEPS) )
- END IF
- END DO
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRVDEPS(JL)
- PA_RV(JL) = PA_RV(JL) - PRVDEPS(JL)
- PA_TH(JL) = PA_TH(JL) + PRVDEPS(JL)*PLSFACT(JL)
+ IF(PRVT(JL)>ICED%XRTMIN(1) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+#if defined(REPRO48) || defined(REPRO55)
+ PRVDEPS(JL) = ( PSSI(JL)/(PRHODREF(JL)*PAI(JL)) ) * &
+ ( ICEP%X0DEPS*PLBDAS(JL)**ICEP%XEX0DEPS + ICEP%X1DEPS*PCJ(JL)*PLBDAS(JL)**ICEP%XEX1DEPS )
+#else
+ PRVDEPS(JL) = ( PRST(JL)*(PSSI(JL)/PAI(JL)) ) * &
+ ( ICEP%X0DEPS*PLBDAS(JL)**(ICED%XBS+ICEP%XEX0DEPS) + ICEP%X1DEPS*PCJ(JL) * &
+ (1+0.5*(ICED%XFVELOS/PLBDAS(JL))**ICED%XALPHAS)**(-ICED%XNUS+ICEP%XEX1DEPS/ICED%XALPHAS) &
+ *(PLBDAS(JL))**(ICED%XBS+ICEP%XEX1DEPS) )
+#endif
+ ENDIF
+ ELSE
+ PRVDEPS(JL) = 0.
+ ENDIF
ENDDO
!
!* 3.4.4 compute the aggregation on r_s: RIAGGS
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! PRST(:)>XRTMIN(5)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRIAGGS(JL)=PRIAGGS(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRIAGGS(:) = 0.
- WHERE(ZMASK(:)==1)
- PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
- * PRIT(:) &
- * PRST(:) * (1+(XFVELOS/PLBDAS(:))**XALPHAS)**(-XNUS+XEXIAGGS/XALPHAS) &
- * PRHODREF(:)**(-XCEXVT+1.) &
- * ((PLBDAS(:))**(XBS+XEXIAGGS))
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRIAGGS(JL)
- PA_RI(JL) = PA_RI(JL) - PRIAGGS(JL)
+ IF(PRIT(JL)>ICED%XRTMIN(4) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRIAGGS(JL) = ICEP%XFIAGGS * EXP( ICEP%XCOLEXIS*(PT(JL)-CST%XTT) ) &
+ * PRIT(JL) &
+#if defined(REPRO48) || defined(REPRO55)
+ * PLBDAS(JL)**ICEP%XEXIAGGS &
+ * PRHODREF(JL)**(-ICED%XCEXVT)
+#else
+ * PRST(JL) * (1+(ICED%XFVELOS/PLBDAS(JL))**ICED%XALPHAS)**&
+ (-ICED%XNUS+ICEP%XEXIAGGS/ICED%XALPHAS) &
+ * PRHODREF(JL)**(-ICED%XCEXVT+1.) &
+ * ((PLBDAS(JL))**(ICED%XBS+ICEP%XEXIAGGS))
+#endif
+ ENDIF
+ ELSE
+ PRIAGGS(JL) = 0.
+ ENDIF
ENDDO
!
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PHLI_HRI(JL))) * & ! PHLI_HRI(:)>XRTMIN(4)
- &MAX(0., -SIGN(1., 1.E-20-PHLI_HCF(JL))) * & ! PHLI_HCF(:) .GT. 0.
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRIAUTS(JL) = PRIAUTS(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRIAUTS(:) = 0.
- !ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PT(:)-XTT)-3.5))
- ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
- WHERE(ZMASK(:)==1.)
- PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) &
- * MAX( PHLI_HRI(:)/PHLI_HCF(:)-ZCRIAUTI(:),0.0 )
- PRIAUTS(:) = PHLI_HCF(:)*PRIAUTS(:)
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRIAUTS(JL)
- PA_RI(JL) = PA_RI(JL) - PRIAUTS(JL)
+#ifdef REPRO48
+ !This was wrong because, with this formulation and in the LDSOFT case, PRIAUTS
+ !was not set to 0 when ri is inferior to the autoconversion threshold
+ IF(PRIT(JL)>ICED%XRTMIN(4) .AND. LDCOMPUTE(JL)) THEN
+#else
+ IF(PHLI_HRI(JL)>ICED%XRTMIN(4) .AND. LDCOMPUTE(JL)) THEN
+#endif
+ IF(.NOT. LDSOFT) THEN
+ !ZCRIAUTI(:)=MIN(ICEP%XCRIAUTI,10**(0.06*(PT(:)-CST%XTT)-3.5))
+ ZCRIAUTI(JL)=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(PT(JL)-CST%XTT)+ICEP%XBCRIAUTI))
+ PRIAUTS(JL) = ICEP%XTIMAUTI * EXP( ICEP%XTEXAUTI*(PT(JL)-CST%XTT) ) &
+ * MAX(PHLI_HRI(JL)-ZCRIAUTI(JL)*PHLI_HCF(JL), 0.)
+ ENDIF
+ ELSE
+ PRIAUTS(JL) = 0.
+ ENDIF
ENDDO
!
!* 3.4.6 compute the deposition on r_g: RVDEPG
!
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & ! PRVT(:)>XRTMIN(1)
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! PRGT(:)>XRTMIN(6)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRVDEPG(JL) = PRVDEPG(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRVDEPG(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRVDEPG(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
- ( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RG(JL) = PA_RG(JL) + PRVDEPG(JL)
- PA_RV(JL) = PA_RV(JL) - PRVDEPG(JL)
- PA_TH(JL) = PA_TH(JL) + PRVDEPG(JL)*PLSFACT(JL)
+ IF(PRVT(JL)>ICED%XRTMIN(1) .AND. PRGT(JL)>ICED%XRTMIN(6) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRVDEPG(JL) = ( PSSI(JL)/(PRHODREF(JL)*PAI(JL)) ) * &
+ ( ICEP%X0DEPG*PLBDAG(JL)**ICEP%XEX0DEPG + ICEP%X1DEPG*PCJ(JL)*PLBDAG(JL)**ICEP%XEX1DEPG )
+ ENDIF
+ ELSE
+ PRVDEPG(JL) = 0.
+ ENDIF
ENDDO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_SLOW', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_SLOW
+END MODULE MODE_ICE4_SLOW
diff --git a/src/PHYEX/micro/mode_ice4_tendencies.f90 b/src/PHYEX/micro/mode_ice4_tendencies.f90
index a80e037aab72dc9260224f09ad5d4453957573b3..d6eebfdf81ace36fcae6b31c221eedf33cadf132 100644
--- a/src/PHYEX/micro/mode_ice4_tendencies.f90
+++ b/src/PHYEX/micro/mode_ice4_tendencies.f90
@@ -3,150 +3,16 @@
!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_ICE4_TENDENCIES
-INTERFACE
-SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, ODSOFT, PCOMPUTE, &
- &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
- &PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
- &PPRES, PCF, PSIGMA_RC, &
- &PCIT, &
- &PT, PTHT, &
- &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PRCAUTR, PRCACCR, PRREVAV, &
- &PRCRIMSS, PRCRIMSG, PRSRIMCG, PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, PRCMLTSR, &
- &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
- &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRCBERI, &
- &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
- &PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
- &PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
- &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
- &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
+MODULE MODE_ICE4_TENDENCIES
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
-INTEGER, INTENT(IN) :: KRR
-LOGICAL, INTENT(IN) :: ODSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-LOGICAL, INTENT(IN) :: OWARM
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
-CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
-CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
-CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1
-INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
-INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PSSI
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RV
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RI
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RS
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
-END SUBROUTINE ICE4_TENDENCIES
-END INTERFACE
-END MODULE MODI_ICE4_TENDENCIES
-SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, ODSOFT, PCOMPUTE, &
- &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
- &PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
+CONTAINS
+SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
+ &KRR, ODSOFT, LDCOMPUTE, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ &PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
- &PT, PTHT, &
- &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
+ &PT, PVART, &
&PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PRCAUTR, PRCACCR, PRREVAV, &
@@ -157,10 +23,10 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
&PRCBERI, &
&PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
- &PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
- &PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
+ &PA, PB, &
&PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
- &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, &
+ &PRAINFR)
!!
!!** PURPOSE
!! -------
@@ -172,185 +38,165 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
!!
!! MODIFICATIONS
!! -------------
-!
+!!
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
-! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+!! R. El Khatib 24-Aug-2021 Optimizations
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XEPSILO,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT
-USE MODD_PARAM_ICE, ONLY: CSNOWRIMING,LSNOW_T
-USE MODD_RAIN_ICE_DESCR, ONLY: XLBDAS_MIN,XLBDAS_MAX,XLBEXG,XLBEXH,XLBEXR,XLBEXS,&
- XLBG,XLBH,XLBR,XLBS,XRTMIN,XTRANS_MP_GAMMAS
-USE MODD_RAIN_ICE_PARAM, ONLY: XSCFAC
-!
-USE MODI_ICE4_COMPUTE_PDF
-USE MODI_ICE4_FAST_RG
-USE MODI_ICE4_FAST_RH
-USE MODI_ICE4_FAST_RI
-USE MODI_ICE4_FAST_RS
-USE MODI_ICE4_NUCLEATION
-USE MODI_ICE4_RAINFR_VERT
-USE MODI_ICE4_RIMLTC
-USE MODI_ICE4_RRHONG
-USE MODI_ICE4_RSRIMCG_OLD
-USE MODI_ICE4_SLOW
-USE MODI_ICE4_WARM
+USE MODD_BUDGET, ONLY: TBUDGETCONF_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+!
+USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
+ & ITH, & ! Potential temperature
+ & IRV, & ! Water vapor
+ & IRC, & ! Cloud water
+ & IRR, & ! Rain water
+ & IRI, & ! Pristine ice
+ & IRS, & ! Snow/aggregate
+ & IRG, & ! Graupel
+ & IRH ! Hail
+!
+USE MODE_ICE4_RRHONG, ONLY: ICE4_RRHONG
+USE MODE_ICE4_RIMLTC, ONLY: ICE4_RIMLTC
+USE MODE_ICE4_RSRIMCG_OLD, ONLY: ICE4_RSRIMCG_OLD
+USE MODE_ICE4_COMPUTE_PDF, ONLY: ICE4_COMPUTE_PDF
+USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
+USE MODE_ICE4_SLOW, ONLY: ICE4_SLOW
+USE MODE_ICE4_WARM, ONLY: ICE4_WARM
+USE MODE_ICE4_FAST_RS, ONLY: ICE4_FAST_RS
+USE MODE_ICE4_FAST_RG, ONLY: ICE4_FAST_RG
+USE MODE_ICE4_FAST_RH, ONLY: ICE4_FAST_RH
+USE MODE_ICE4_FAST_RI, ONLY: ICE4_FAST_RI
+USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-LOGICAL, INTENT(IN) :: OWARM
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
-CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
-CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
-CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1
-INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
-INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PSSI
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RV
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RR
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RI
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RS
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RG
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PB_RH
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT
+INTEGER, DIMENSION(KPROMA), INTENT(IN) :: K1
+INTEGER, DIMENSION(KPROMA), INTENT(IN) :: K2
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PPRES
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCF
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PSIGMA_RC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PCIT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT
+REAL, DIMENSION(KPROMA,0:KRR), INTENT(IN) :: PVART
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRVHENI_MR
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRHONG_MR
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIMLTC_MR
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSRIMCG_MR
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCHONI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPS
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRIAGGS
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRIAUTS
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPG
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCAUTR
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCACCR
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCRIMSS
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCRIMSG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSRIMCG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRACCSS
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRACCSG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSACCRG
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRSMLTG
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCMLTSR
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRICFRRG
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRRCFRIG
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRICFRR
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCWETG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIWETG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRWETG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSWETG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCDRYG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIDRYG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRDRYG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSDRYG
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRWETGH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRWETGH_MR
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRGMLTR
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCWETH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIWETH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSWETH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRGWETH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRWETH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRCDRYH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIDRYH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSDRYH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRDRYH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRGDRYH
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRDRYHG
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRHMLTR
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCBERI
+REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRS_TEND
+REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRG_TEND
+REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PSSI
+REAL, DIMENSION(KPROMA,0:7), INTENT(OUT) :: PA
+REAL, DIMENSION(KPROMA,0:7), INTENT(OUT) :: PB
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LRI
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR ! Rain fraction
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(KSIZE) :: ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- & ZT, ZTHT, ZRHT, &
- & ZZW, &
+REAL, DIMENSION(KPROMA,0:KRR) :: ZVART
+REAL, DIMENSION(KPROMA) :: ZT, ZRAINFR, &
& ZKA, ZDV, ZAI, ZCJ, &
- & ZRF, &
& ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
& ZRGSI, ZRGSI_MR
-REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D, ZRST3D, ZRGT3D, ZRHT3D
-INTEGER :: JL
-REAL, DIMENSION(KSIZE) :: ZWETG ! 1. if graupel growths in wet mode, 0. otherwise
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRRT3D, ZRST3D, ZRGT3D, ZRHT3D
+INTEGER :: JL, JV
+LOGICAL, DIMENSION(KPROMA) :: LLWETG ! .TRUE. if graupel growths in wet mode
+REAL :: ZZW
+LOGICAL :: LLRFR
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('ICE4_TENDENCIES', 0, ZHOOK_HANDLE)
+
-PA_TH(:)=0.
-PA_RV(:)=0.
-PA_RC(:)=0.
-PA_RR(:)=0.
-PA_RI(:)=0.
-PA_RS(:)=0.
-PA_RG(:)=0.
-PA_RH(:)=0.
-PB_TH(:)=0.
-PB_RV(:)=0.
-PB_RC(:)=0.
-PB_RR(:)=0.
-PB_RI(:)=0.
-PB_RS(:)=0.
-PB_RG(:)=0.
-PB_RH(:)=0.
!
-DO JL=1, KSIZE
- ZRVT(JL)=PRVT(JL)
- ZRCT(JL)=PRCT(JL)
- ZRRT(JL)=PRRT(JL)
- ZRIT(JL)=PRIT(JL)
- ZRST(JL)=PRST(JL)
- ZRGT(JL)=PRGT(JL)
- ZTHT(JL)=PTHT(JL)
- ZRHT(JL)=PRHT(JL)
- ZT(JL)=PT(JL)
+ZT(:)=PT(:)
+DO JV=0,KRR
+ ZVART(:,JV)=PVART(:,JV)
+ PA(:,JV)=0.
+ PB(:,JV)=0.
ENDDO
+!
IF(ODSOFT) THEN
PRVHENI_MR(:)=0.
PRRHONG_MR(:)=0.
@@ -360,176 +206,186 @@ ELSE
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
! --------------------------------------
- CALL ICE4_NUCLEATION(KSIZE, ODSOFT, PCOMPUTE==1., &
- ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
- ZRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+ CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, KSIZE, LDCOMPUTE(:), &
+ ZVART(:,ITH), PPRES(:), PRHODREF(:), PEXN(:), PLSFACT(:), ZT(:), &
+ ZVART(:,IRV), &
+ PCIT(:), PRVHENI_MR(:))
DO JL=1, KSIZE
- ZRIT(JL)=ZRIT(JL) + PRVHENI_MR(JL)
- ZRVT(JL)=ZRVT(JL) - PRVHENI_MR(JL)
- ZTHT(JL)=ZTHT(JL) + PRVHENI_MR(JL)*PLSFACT(JL)
- ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ZVART(JL,ITH)=ZVART(JL,ITH) + PRVHENI_MR(JL)*PLSFACT(JL)
+ ZT(JL) = ZVART(JL,ITH) * PEXN(JL)
+ ZVART(JL,IRV)=ZVART(JL,IRV) - PRVHENI_MR(JL)
+ ZVART(JL,IRI)=ZVART(JL,IRI) + PRVHENI_MR(JL)
ENDDO
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
- CALL ICE4_RRHONG(KSIZE, ODSOFT, PCOMPUTE, &
+ CALL ICE4_RRHONG(CST, PARAMI, ICED, KPROMA, KSIZE, LDCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
- &ZT, ZRRT, &
- &ZTHT, &
- &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+ &ZT, ZVART(:,IRR), &
+ &ZVART(:,ITH), &
+ &PRRHONG_MR)
DO JL=1, KSIZE
- ZRGT(JL) = ZRGT(JL) + PRRHONG_MR(JL)
- ZRRT(JL) = ZRRT(JL) - PRRHONG_MR(JL)
- ZTHT(JL) = ZTHT(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRHONG))
- ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ZVART(JL,ITH) = ZVART(JL,ITH) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRHONG))
+ ZT(JL) = ZVART(JL,ITH) * PEXN(JL)
+ ZVART(JL,IRR) = ZVART(JL,IRR) - PRRHONG_MR(JL)
+ ZVART(JL,IRG) = ZVART(JL,IRG) + PRRHONG_MR(JL)
ENDDO
!
!* 7.1 cloud ice melting
!
- CALL ICE4_RIMLTC(KSIZE, ODSOFT, PCOMPUTE, &
+ CALL ICE4_RIMLTC(CST, PARAMI, KPROMA, KSIZE, LDCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&ZT, &
- &ZTHT, ZRIT, &
- &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+ &ZVART(:,ITH), ZVART(:,IRI), &
+ &PRIMLTC_MR)
DO JL=1, KSIZE
- ZRCT(JL) = ZRCT(JL) + PRIMLTC_MR(JL)
- ZRIT(JL) = ZRIT(JL) - PRIMLTC_MR(JL)
- ZTHT(JL) = ZTHT(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RIMLTC))
- ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ZVART(JL,ITH) = ZVART(JL,ITH) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RIMLTC))
+ ZT(JL) = ZVART(JL,ITH) * PEXN(JL)
+ ZVART(JL,IRC) = ZVART(JL,IRC) + PRIMLTC_MR(JL)
+ ZVART(JL,IRI) = ZVART(JL,IRI) - PRIMLTC_MR(JL)
ENDDO
!
! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
!
- IF(CSNOWRIMING=='OLD ') THEN
- ZLBDAS(:)=0.
- IF (LSNOW_T) THEN
- WHERE (ZRST(:)>XRTMIN(5) .AND. ZT(:)>263.15)
- ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZT(:))),XLBDAS_MIN)*XTRANS_MP_GAMMAS
- END WHERE
- WHERE (ZRST(:)>XRTMIN(5) .AND. ZT(:)<=263.15)
- ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZT(:))),XLBDAS_MIN)*XTRANS_MP_GAMMAS
- END WHERE
- ELSE
- WHERE (ZRST(:).GE.XRTMIN(5))
- ZLBDAS(:) = MAX(MIN(XLBDAS_MAX,XLBS*(PRHODREF(:)*ZRST(:))**XLBEXS),XLBDAS_MIN)
- END WHERE
- END IF
- CALL ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, PCOMPUTE==1., &
- &PRHODREF, &
- &ZLBDAS, &
- &ZT, ZRCT, ZRST, &
- &PRSRIMCG_MR, PB_RS, PB_RG)
- DO JL=1, KSIZE
- ZRST(JL) = ZRST(JL) - PRSRIMCG_MR(JL)
- ZRGT(JL) = ZRGT(JL) + PRSRIMCG_MR(JL)
- ENDDO
+ IF(PARAMI%CSNOWRIMING=='OLD ') THEN
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(ZVART(1:KSIZE,IRS)>0.)
+ ZLBDAS(1:KSIZE) = MIN(ICED%XLBDAS_MAX, ICED%XLBS*(PRHODREF(1:KSIZE)*MAX(ZVART(1:KSIZE,IRS), ICED%XRTMIN(5)))**ICED%XLBEXS)
+ ELSEWHERE
+ ZLBDAS(1:KSIZE)=0.
+ END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
+ CALL ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
+ &PRHODREF, &
+ &ZLBDAS, &
+ &ZT, ZVART(:,IRC), ZVART(:,IRS), &
+ &PRSRIMCG_MR)
+ DO JL=1, KSIZE
+ ZVART(JL,IRS) = ZVART(JL,IRS) - PRSRIMCG_MR(JL)
+ ZVART(JL,IRG) = ZVART(JL,IRG) + PRSRIMCG_MR(JL)
+ ENDDO
+ ELSE
+ PRSRIMCG_MR(:) = 0.
+ ENDIF
+
+ DO JL=1, KSIZE
+ PB(JL, ITH)=PB(JL, ITH) + PRVHENI_MR(JL)*PLSFACT(JL)
+ PB(JL, ITH)=PB(JL, ITH) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PB(JL, ITH)=PB(JL, ITH) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+
+ PB(JL, IRV)=PB(JL, IRV) - PRVHENI_MR(JL)
+
+ PB(JL, IRC)=PB(JL, IRC) + PRIMLTC_MR(JL)
+
+ PB(JL, IRR)=PB(JL, IRR) - PRRHONG_MR(JL)
+
+ PB(JL, IRI)=PB(JL, IRI) + PRVHENI_MR(JL)
+ PB(JL, IRI)=PB(JL, IRI) - PRIMLTC_MR(JL)
+
+ PB(JL, IRS)=PB(JL, IRS) - PRSRIMCG_MR(JL)
+
+ PB(JL, IRG)=PB(JL, IRG) + PRRHONG_MR(JL)
+ PB(JL, IRG)=PB(JL, IRG) + PRSRIMCG_MR(JL)
+ ENDDO
+ !
+ !* Derived fields
+ !
+ DO JL=1, KSIZE
+ ZZW = EXP(CST%XALPI-CST%XBETAI/ZT(JL)-CST%XGAMI*ALOG(ZT(JL)))
+ PSSI(JL) = ZVART(JL,IRV)*( PPRES(JL)-ZZW ) / ( CST%XEPSILO * ZZW ) - 1.0
+ ! Supersaturation over ice
+ ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-CST%XTT) ! k_a
+ ZDV(JL) = 0.211E-4*(ZT(JL)/CST%XTT)**1.94 * (CST%XP00/PPRES(JL)) ! D_v
+ ZAI(JL) = (CST%XLSTT+(CST%XCPV-CST%XCI)*(ZT(JL)-CST%XTT))**2 / (ZKA(JL)*CST%XRV*ZT(JL)**2) &
+ + ( CST%XRV*ZT(JL) ) / (ZDV(JL)*ZZW)
+ ZCJ(JL) = ICEP%XSCFAC*PRHODREF(JL)**0.3 / SQRT(1.718E-5+0.0049E-5*(ZT(JL)-CST%XTT))
+ ENDDO
+ENDIF ! ODSOFT
+!
+!Cloud water split between high and low content part is done here
+CALL ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, PARAMI%CSUBG_PR_PDF,&
+ PRHODREF, ZVART(:,IRC), ZVART(:,IRI), PCF, ZT, PSIGMA_RC, &
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRAINFR)
+LLRFR=PARAMI%CSUBG_RC_RR_ACCR=='PRFR' .OR. PARAMI%CSUBG_RR_EVAP=='PRFR'
+IF (LLRFR) THEN
+ !Diagnostic of precipitation fraction
+ PRAINFR(:,:) = 0.
+ ZRRT3D (:,:) = 0.
+ ZRST3D (:,:) = 0.
+ ZRGT3D (:,:) = 0.
+ ZRHT3D (:,:) = 0.
+ DO JL=1,KSIZE
+ PRAINFR(K1(JL), K2(JL)) = ZRAINFR(JL)
+ ZRRT3D (K1(JL), K2(JL)) = ZVART(JL,IRR)
+#ifndef REPRO48
+ ZRST3D (K1(JL), K2(JL)) = ZVART(JL,IRS)
+ ZRGT3D (K1(JL), K2(JL)) = ZVART(JL,IRG)
+#endif
+ END DO
+ IF (KRR==7) THEN
+ DO JL=1,KSIZE
+ ZRHT3D (K1(JL), K2(JL)) = ZVART(JL,IRH)
+ ENDDO
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR(:,:), &
+ &ZRRT3D(:,:), ZRST3D(:,:), ZRGT3D(:,:), ZRHT3D(:,:))
ELSE
- PRSRIMCG_MR(:) = 0.
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR(:,:), &
+ &ZRRT3D(:,:), ZRST3D(:,:), ZRGT3D(:,:))
ENDIF
+ DO JL=1,KSIZE
+ ZRAINFR(JL)=PRAINFR(K1(JL), K2(JL))
+ END DO
+ELSE
+ PRAINFR(:,:)=1.
+ ZRAINFR(:)=1.
ENDIF
!
-!* Derived fields
+!* compute the slope parameters
!
-IF(KSIZE>0) THEN
- IF(.NOT. ODSOFT) THEN
- ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:)))
- DO JL=1, KSIZE
- PSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( XEPSILO * ZZW(JL) ) - 1.0
- ! Supersaturation over ice
- ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-XTT) ! k_a
- ZDV(JL) = 0.211E-4*(ZT(JL)/XTT)**1.94 * (XP00/PPRES(JL)) ! D_v
- ZAI(JL) = (XLSTT+(XCPV-XCI)*(ZT(JL)-XTT))**2 / (ZKA(JL)*XRV*ZT(JL)**2) &
- + ( XRV*ZT(JL) ) / (ZDV(JL)*ZZW(JL))
- ZCJ(JL) = XSCFAC*PRHODREF(JL)**0.3 / SQRT(1.718E-5+0.0049E-5*(ZT(JL)-XTT))
- ENDDO
+DO JL=1, KSIZE
+ !ZLBDAR will be used when we consider rain diluted over the grid box
+ IF(ZVART(JL,IRR)>0.) THEN
+ ZLBDAR(JL)=ICED%XLBR*(PRHODREF(JL)*MAX(ZVART(JL,IRR), ICED%XRTMIN(3)))**ICED%XLBEXR
+ ELSE
+ ZLBDAR(JL)=0.
ENDIF
- !
- !Cloud water split between high and low content part is done here
- CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF,&
- PRHODREF, ZRCT, ZRIT, PCF, ZT, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC,&
- PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRF)
- IF(HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
- !Diagnostic of precipitation fraction
- PRAINFR(:,:,:) = 0.
- ZRRT3D (:,:,:) = 0.
- ZRST3D (:,:,:) = 0.
- ZRGT3D (:,:,:) = 0.
- ZRHT3D (:,:,:) = 0.
- DO JL=1,KSIZE
- PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRF(JL)
- ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT(JL)
- ZRST3D (K1(JL), K2(JL), K3(JL)) = ZRST(JL)
- ZRGT3D (K1(JL), K2(JL), K3(JL)) = ZRGT(JL)
- END DO
- IF (KRR==7) THEN
- DO JL=1,KSIZE
- ZRHT3D (K1(JL), K2(JL), K3(JL)) = ZRHT(JL)
- ENDDO
- CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), &
- &ZRRT3D(:,:,:), ZRST3D(:,:,:), ZRGT3D(:,:,:), ZRHT3D(:,:,:))
+ !ZLBDAR_RF is used when we consider rain concentrated in its fraction
+ IF(LLRFR) THEN
+ IF(ZVART(JL,IRR)>0. .AND. ZRAINFR(JL)>0.) THEN
+ ZLBDAR_RF(JL)=ICED%XLBR*(PRHODREF(JL)*MAX(ZVART(JL,IRR)/ZRAINFR(JL), ICED%XRTMIN(3)))**ICED%XLBEXR
ELSE
- CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), &
- &ZRRT3D(:,:,:), ZRST3D(:,:,:), ZRGT3D(:,:,:))
+ ZLBDAR_RF(JL)=0.
ENDIF
- DO JL=1,KSIZE
- ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL))
- END DO
ELSE
- PRAINFR(:,:,:)=1.
- ZRF(:)=1.
+ ZLBDAR_RF(JL)=ZLBDAR(JL)
ENDIF
- !
- !* compute the slope parameters
- !
- ZLBDAS(:)=0.
- IF (LSNOW_T) THEN
- WHERE (ZRST(:)>XRTMIN(5) .AND. ZT(:)>263.15)
- ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZT(:))),XLBDAS_MIN)*XTRANS_MP_GAMMAS
- END WHERE
- WHERE (ZRST(:)>XRTMIN(5) .AND. ZT(:)<=263.15)
- ZLBDAS(:) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZT(:))),XLBDAS_MIN)*XTRANS_MP_GAMMAS
- END WHERE
+ IF(ZVART(JL,IRS)>0.) THEN
+ ZLBDAS(JL)=MIN(ICED%XLBDAS_MAX, ICED%XLBS*(PRHODREF(JL)*MAX(ZVART(JL,IRS), ICED%XRTMIN(5)))**ICED%XLBEXS)
ELSE
- WHERE (ZRST(:).GE.XRTMIN(5))
- ZLBDAS(:) = MAX(MIN(XLBDAS_MAX,XLBS*(PRHODREF(:)*ZRST(:))**XLBEXS),XLBDAS_MIN)
- END WHERE
- END IF
- ZLBDAG(:)=0.
- WHERE(ZRGT(:)>0.)
- ZLBDAG(:) = XLBG*(PRHODREF(:)*MAX(ZRGT(:), XRTMIN(6)))**XLBEXG
- END WHERE
- !ZLBDAR will be used when we consider rain diluted over the grid box
- ZLBDAR(:)=0.
- WHERE(ZRRT(:)>0.)
- ZLBDAR(:) = XLBR*( PRHODREF(:)*MAX( ZRRT(:), XRTMIN(3)))**XLBEXR
- END WHERE
- !ZLBDAR_RF is used when we consider rain concentrated in its fraction
- IF (HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
- ZLBDAR_RF(:)=0.
- WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.)
- ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR
- END WHERE
+ ZLBDAS(JL)=0.
+ ENDIF
+ IF(ZVART(JL,IRG)>0.) THEN
+ ZLBDAG(JL)=ICED%XLBG*(PRHODREF(JL)*MAX(ZVART(JL,IRG), ICED%XRTMIN(6)))**ICED%XLBEXG
ELSE
- ZLBDAR_RF(:) = ZLBDAR(:)
+ ZLBDAG(JL)=0.
ENDIF
IF(KRR==7) THEN
- ZLBDAH(:)=0.
- WHERE(PRHT(:)>0.)
- ZLBDAH(:) = XLBH*(PRHODREF(:)*MAX(PRHT(:), XRTMIN(7)))**XLBEXH
- END WHERE
+ IF(ZVART(JL,IRH)>0.) THEN
+ ZLBDAH(JL)=ICED%XLBH*(PRHODREF(JL)*MAX(ZVART(JL,IRH), ICED%XRTMIN(7)))**ICED%XLBEXH
+ ELSE
+ ZLBDAH(JL)=0.
+ ENDIF
ENDIF
-ENDIF
+ENDDO
!
!
-CALL ICE4_SLOW(KSIZE, ODSOFT, PCOMPUTE, PRHODREF, ZT, &
+CALL ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, PRHODREF, ZT, &
&PSSI, PLVFACT, PLSFACT, &
- &ZRVT, ZRCT, ZRIT, ZRST, ZRGT, &
+ &ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRI), ZVART(:,IRS), ZVART(:,IRG), &
&ZLBDAS, ZLBDAG, &
&ZAI, ZCJ, PHLI_HCF, PHLI_HRI, &
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
+ &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG)
!
!-------------------------------------------------------------------------------
!
@@ -538,16 +394,16 @@ CALL ICE4_SLOW(KSIZE, ODSOFT, PCOMPUTE, PRHODREF, ZT, &
! --------------------------------------
!
!
-IF(OWARM) THEN ! Check if the formation of the raindrops by the slow
+IF(PARAMI%LWARM) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
- CALL ICE4_WARM(KSIZE, ODSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- &PRHODREF, PLVFACT, ZT, PPRES, ZTHT,&
+ CALL ICE4_WARM(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT,LDCOMPUTE, &
+ &PARAMI%CSUBG_RC_RR_ACCR, PARAMI%CSUBG_RR_EVAP, &
+ &PRHODREF, PLVFACT, ZT, PPRES, ZVART(:,ITH),&
&ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, &
&PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- &PCF, ZRF, &
- &ZRVT, ZRCT, ZRRT, &
- &PRCAUTR, PRCACCR, PRREVAV, &
- &PA_TH, PA_RV, PA_RC, PA_RR)
+ &PCF, ZRAINFR, &
+ &ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), &
+ &PRCAUTR, PRCACCR, PRREVAV)
ELSE
PRCAUTR(:)=0.
PRCACCR(:)=0.
@@ -560,17 +416,16 @@ END IF
!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
! ----------------------------------------------
!
-CALL ICE4_FAST_RS(KSIZE, ODSOFT, PCOMPUTE, &
+CALL ICE4_FAST_RS(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAR, ZLBDAS, &
- &ZT, ZRVT, ZRCT, ZRRT, ZRST, &
+ &ZT, ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), ZVART(:,IRS), &
&PRIAGGS, &
&PRCRIMSS, PRCRIMSG, PRSRIMCG, &
&PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
&PRCMLTSR, &
- &PRS_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG)
+ &PRS_TEND)
!
!-------------------------------------------------------------------------------
!
@@ -583,17 +438,16 @@ DO JL=1, KSIZE
& PRSACCRG(JL) + PRCRIMSG(JL) + PRSRIMCG(JL)
ZRGSI_MR(JL) = PRRHONG_MR(JL) + PRSRIMCG_MR(JL)
ENDDO
-CALL ICE4_FAST_RG(KSIZE, ODSOFT, PCOMPUTE, KRR, &
+CALL ICE4_FAST_RG(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, PCIT, &
&ZLBDAR, ZLBDAS, ZLBDAG, &
- &ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ &ZT, ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), ZVART(:,IRI), ZVART(:,IRS), ZVART(:,IRG), &
&ZRGSI, ZRGSI_MR(:), &
- &ZWETG, &
+ &LLWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
- &PRG_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
+ &PRG_TEND)
!
!-------------------------------------------------------------------------------
!
@@ -602,16 +456,15 @@ CALL ICE4_FAST_RG(KSIZE, ODSOFT, PCOMPUTE, KRR, &
! ----------------------------------------------
!
IF (KRR==7) THEN
- CALL ICE4_FAST_RH(KSIZE, ODSOFT, PCOMPUTE, ZWETG, &
+ CALL ICE4_FAST_RH(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, LLWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, &
- &ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, PRHT, &
+ &ZT, ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), ZVART(:,IRI), ZVART(:,IRS), ZVART(:,IRG), ZVART(:,IRH), &
&PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
-ELSE
+ &PRH_TEND)
+ELSEIF (BUCONF%LBU_ENABLE) THEN
PRCWETH(:)=0.
PRIWETH(:)=0.
PRSWETH(:)=0.
@@ -632,12 +485,126 @@ END IF
!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
! -------------------------------------------------------------
!
-CALL ICE4_FAST_RI(KSIZE, ODSOFT, PCOMPUTE, &
+CALL ICE4_FAST_RI(ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&ZAI, ZCJ, PCIT, &
&PSSI, &
- &ZRCT, ZRIT, &
- &PRCBERI, PA_TH, PA_RC, PA_RI)
+ &ZVART(:,IRC), ZVART(:,IRI), &
+ &PRCBERI)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 8. COMPUTES TOTAL TENDENCIES
+! -------------------------
+!
+DO JL=1, KSIZE
+ PA(JL, ITH) = PA(JL, ITH) + PRVDEPG(JL)*PLSFACT(JL)
+ PA(JL, ITH) = PA(JL, ITH) + PRCHONI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PRVDEPS(JL)*PLSFACT(JL)
+ PA(JL, ITH) = PA(JL, ITH) - PRREVAV(JL)*PLVFACT(JL)
+ PA(JL, ITH) = PA(JL, ITH) + PRCRIMSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PRCRIMSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PRRACCSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + PRRACCSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PRRCFRIG(JL) - PRICFRR(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PRCWETG(JL) + PRRWETG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PRCDRYG(JL)+PRRDRYG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) - PRGMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ IF (KRR==7) THEN
+ PA(JL, ITH) = PA(JL, ITH) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA(JL, ITH) = PA(JL, ITH) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ ENDIF
+ PA(JL, ITH) = PA(JL, ITH) + PRCBERI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+
+ PA(JL, IRV) = PA(JL, IRV) - PRVDEPG(JL)
+ PA(JL, IRV) = PA(JL, IRV) - PRVDEPS(JL)
+ PA(JL, IRV) = PA(JL, IRV) + PRREVAV(JL)
+
+ PA(JL, IRC) = PA(JL, IRC) - PRCHONI(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PRCAUTR(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PRCACCR(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PRCRIMSS(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PRCRIMSG(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PRCMLTSR(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PRCWETG(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PRCDRYG(JL)
+ IF (KRR==7) THEN
+ PA(JL, IRC) = PA(JL, IRC) - PRCWETH(JL)
+ PA(JL, IRC) = PA(JL, IRC) - PRCDRYH(JL)
+ ENDIF
+ PA(JL, IRC) = PA(JL, IRC) - PRCBERI(JL)
+
+ PA(JL, IRR) = PA(JL, IRR) + PRCAUTR(JL)
+ PA(JL, IRR) = PA(JL, IRR) + PRCACCR(JL)
+ PA(JL, IRR) = PA(JL, IRR) - PRREVAV(JL)
+ PA(JL, IRR) = PA(JL, IRR) - PRRACCSS(JL)
+ PA(JL, IRR) = PA(JL, IRR) - PRRACCSG(JL)
+ PA(JL, IRR) = PA(JL, IRR) + PRCMLTSR(JL)
+ PA(JL, IRR) = PA(JL, IRR) - PRRCFRIG(JL) + PRICFRR(JL)
+ PA(JL, IRR) = PA(JL, IRR) - PRRWETG(JL)
+ PA(JL, IRR) = PA(JL, IRR) - PRRDRYG(JL)
+ PA(JL, IRR) = PA(JL, IRR) + PRGMLTR(JL)
+ IF(KRR==7) THEN
+ PA(JL, IRR) = PA(JL, IRR) - PRRWETH(JL)
+ PA(JL, IRR) = PA(JL, IRR) - PRRDRYH(JL)
+ PA(JL, IRR) = PA(JL, IRR) + PRHMLTR(JL)
+ ENDIF
+
+ PA(JL, IRI) = PA(JL, IRI) + PRCHONI(JL)
+ PA(JL, IRI) = PA(JL, IRI) - PRIAGGS(JL)
+ PA(JL, IRI) = PA(JL, IRI) - PRIAUTS(JL)
+ PA(JL, IRI) = PA(JL, IRI) - PRICFRRG(JL) - PRICFRR(JL)
+ PA(JL, IRI) = PA(JL, IRI) - PRIWETG(JL)
+ PA(JL, IRI) = PA(JL, IRI) - PRIDRYG(JL)
+ IF (KRR==7) THEN
+ PA(JL, IRI) = PA(JL, IRI) - PRIWETH(JL)
+ PA(JL, IRI) = PA(JL, IRI) - PRIDRYH(JL)
+ ENDIF
+ PA(JL, IRI) = PA(JL, IRI) + PRCBERI(JL)
+
+ PA(JL, IRS) = PA(JL, IRS) + PRVDEPS(JL)
+ PA(JL, IRS) = PA(JL, IRS) + PRIAGGS(JL)
+ PA(JL, IRS) = PA(JL, IRS) + PRIAUTS(JL)
+ PA(JL, IRS) = PA(JL, IRS) + PRCRIMSS(JL)
+ PA(JL, IRS) = PA(JL, IRS) - PRSRIMCG(JL)
+ PA(JL, IRS) = PA(JL, IRS) + PRRACCSS(JL)
+ PA(JL, IRS) = PA(JL, IRS) - PRSACCRG(JL)
+ PA(JL, IRS) = PA(JL, IRS) - PRSMLTG(JL)
+ PA(JL, IRS) = PA(JL, IRS) - PRSWETG(JL)
+ PA(JL, IRS) = PA(JL, IRS) - PRSDRYG(JL)
+ IF (KRR==7) THEN
+ PA(JL, IRS) = PA(JL, IRS) - PRSWETH(JL)
+ PA(JL, IRS) = PA(JL, IRS) - PRSDRYH(JL)
+ ENDIF
+
+ PA(JL, IRG) = PA(JL, IRG) + PRVDEPG(JL)
+ PA(JL, IRG) = PA(JL, IRG) + PRCRIMSG(JL)+PRSRIMCG(JL)
+ PA(JL, IRG) = PA(JL, IRG) + PRRACCSG(JL)+PRSACCRG(JL)
+ PA(JL, IRG) = PA(JL, IRG) + PRSMLTG(JL)
+ PA(JL, IRG) = PA(JL, IRG) + PRICFRRG(JL) + PRRCFRIG(JL)
+ PA(JL, IRG) = PA(JL, IRG) + PRCWETG(JL) + PRIWETG(JL) + PRSWETG(JL) + PRRWETG(JL)
+ PA(JL, IRG) = PA(JL, IRG) - PRWETGH(JL)
+ PB(JL, IRG) = PB(JL, IRG) - PRWETGH_MR(JL)
+ PA(JL, IRG) = PA(JL, IRG) + PRCDRYG(JL) + PRIDRYG(JL) + PRSDRYG(JL) + PRRDRYG(JL)
+ PA(JL, IRG) = PA(JL, IRG) - PRGMLTR(JL)
+ IF (KRR==7) THEN
+ PA(JL, IRG) = PA(JL, IRG) - PRGWETH(JL)
+ PA(JL, IRG) = PA(JL, IRG) - PRGDRYH(JL) + PRDRYHG(JL)
+ ENDIF
+
+ IF (KRR==7) THEN
+ PA(JL, IRH) = PA(JL, IRH) + PRWETGH(JL)
+ PB(JL, IRH) = PB(JL, IRH) + PRWETGH_MR(JL)
+ PA(JL, IRH) = PA(JL, IRH) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
+ PA(JL, IRH) = PA(JL, IRH) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
+ &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
+ PA(JL, IRH) = PA(JL, IRH) - PRHMLTR(JL)
+ ENDIF
+ENDDO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_TENDENCIES', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_TENDENCIES
+END MODULE MODE_ICE4_TENDENCIES
diff --git a/src/PHYEX/micro/mode_ice4_warm.f90 b/src/PHYEX/micro/mode_ice4_warm.f90
index aa61b1dac3ee676c3ec2ecca6d2af30c1ec9b8a5..dddbfc42ee48700ca058f2689cf8d6797a093b77 100644
--- a/src/PHYEX/micro/mode_ice4_warm.f90
+++ b/src/PHYEX/micro/mode_ice4_warm.f90
@@ -3,59 +3,16 @@
!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_ICE4_WARM
-INTERFACE
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- PRHODREF, PLVFACT, PT, PPRES, PTHT, &
- PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
- PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- PCF, PRF, &
- PRVT, PRCT, PRRT, &
- PRCAUTR, PRCACCR, PRREVAV, &
- PA_TH, PA_RV, PA_RC, PA_RR)
+MODULE MODE_ICE4_WARM
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-END SUBROUTINE ICE4_WARM
-END INTERFACE
-END MODULE MODI_ICE4_WARM
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- PRHODREF, PLVFACT, PT, PPRES, PTHT, &
- PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
- PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- PCF, PRF, &
- PRVT, PRCT, PRRT, &
- PRCAUTR, PRCACCR, PRREVAV, &
- PA_TH, PA_RV, PA_RC, PA_RR)
+CONTAINS
+SUBROUTINE ICE4_WARM(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &PRHODREF, PLVFACT, PT, PPRES, PTHT, &
+ &PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
+ &PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
+ &PCF, PRF, &
+ &PRVT, PRCT, PRRT, &
+ &PRCAUTR, PRCACCR, PRREVAV)
!!
!!** PURPOSE
!! -------
@@ -68,62 +25,66 @@ SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
!! MODIFICATIONS
!! -------------
!!
+!! R. El Khatib 24-Aug-2021 Optimizations
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
-USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: X0EVAR,X1EVAR,XCRIAUTC,XEX0EVAR,XEX1EVAR,XEXCACCR,XFCACCR,XTIMAUTC
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
!
USE MODE_MSG
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KSIZE
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PPRES ! absolute pressure at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRF ! Rain fraction
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(KSIZE) :: ZZW2, ZZW3, ZZW4
-REAL, DIMENSION(KSIZE) :: ZUSW ! Undersaturation over water
-REAL, DIMENSION(KSIZE) :: ZTHLT ! Liquid potential temperature
-REAL, DIMENSION(KSIZE) :: ZMASK, ZMASK1, ZMASK2
+REAL :: ZZW2, ZZW3, ZZW4
+REAL, DIMENSION(KPROMA) :: ZUSW ! Undersaturation over water
+REAL, DIMENSION(KPROMA) :: ZTHLT ! Liquid potential temperature
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JL
+LOGICAL :: LMASK, LMASK1, LMASK2
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ICE4_WARM', 0, ZHOOK_HANDLE)
!
!
!-------------------------------------------------------------------------------
@@ -131,24 +92,23 @@ INTEGER :: JL
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCAUTR(JL)=PRCAUTR(JL)*ZMASK(JL)
- ENDDO
-ELSE
- PRCAUTR(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCAUTR(:) = XTIMAUTC*MAX(PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:), 0.0)
- PRCAUTR(:) = PHLC_HCF(:)*PRCAUTR(:)
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RC(JL) = PA_RC(JL) - PRCAUTR(JL)
- PA_RR(JL) = PA_RR(JL) + PRCAUTR(JL)
+#ifdef REPRO55
+ IF(PHLC_HRC(JL)>ICED%XRTMIN(2) .AND. PHLC_HCF(JL)>1.E-20 .AND. LDCOMPUTE(JL)) THEN
+#else
+ IF(PHLC_HRC(JL)>ICED%XRTMIN(2) .AND. PHLC_HCF(JL)>0. .AND. LDCOMPUTE(JL)) THEN
+#endif
+ IF(.NOT. LDSOFT) THEN
+#if defined(REPRO48) || defined(REPRO55)
+ PRCAUTR(JL) = ICEP%XTIMAUTC*MAX(PHLC_HRC(JL)/PHLC_HCF(JL) - ICEP%XCRIAUTC/PRHODREF(JL), 0.0)
+ PRCAUTR(JL) = PHLC_HCF(JL)*PRCAUTR(JL)
+#else
+ !HCF*autoconv(HRC/HCF) with simplification
+ PRCAUTR(JL) = ICEP%XTIMAUTC*MAX(PHLC_HRC(JL) - PHLC_HCF(JL)*ICEP%XCRIAUTC/PRHODREF(JL), 0.0)
+#endif
+ ENDIF
+ ELSE
+ PRCAUTR(JL) = 0.
+ ENDIF
ENDDO
!
!
@@ -157,160 +117,144 @@ ENDDO
IF (HSUBG_RC_RR_ACCR=='NONE') THEN
!CLoud water and rain are diluted over the grid box
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
+ IF(PRCT(JL)>ICED%XRTMIN(2) .AND. PRRT(JL)>ICED%XRTMIN(3) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRCACCR(JL) = ICEP%XFCACCR * PRCT(JL) &
+ & * PLBDAR(JL)**ICEP%XEXCACCR &
+ & * PRHODREF(JL)**(-ICED%XCEXVT)
+ ENDIF
+ ELSE
+ PRCACCR(JL) = 0.
+ ENDIF
ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCACCR(JL)=PRCACCR(JL) * ZMASK(JL)
- ENDDO
- ELSE
- PRCACCR(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCACCR(:) = XFCACCR * PRCT(:) &
- * PLBDAR(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT)
- END WHERE
- ENDIF
ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
!Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion
- !Rain is concnetrated over its fraction
+ !Rain is concentrated over its fraction
!Rain in high content area fraction: PHLC_HCF
!Rain in low content area fraction:
! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
! => min(PCF, PRF)-PHLC_HCF
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
- ZMASK1(JL)=ZMASK(JL) * &
- &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
- ZMASK2(JL)=ZMASK(JL) * &
- &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., 1.E-20-PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
+ LMASK = PRCT(JL)>ICED%XRTMIN(2) .AND. PRRT(JL)>ICED%XRTMIN(3) .AND. LDCOMPUTE(JL)
+#ifdef REPRO55
+ LMASK1 = LMASK .AND. PHLC_HRC(JL)>ICED%XRTMIN(2) .AND. PHLC_HCF(JL)>1.E-20
+#else
+ LMASK1 = LMASK .AND. PHLC_HRC(JL)>ICED%XRTMIN(2) .AND. PHLC_HCF(JL)>0.
+#endif
+#ifdef REPRO48
+ LMASK2 = LMASK .AND. PHLC_LRC(JL)>ICED%XRTMIN(2) .AND. PHLC_LCF(JL)>0.
+#else
+ LMASK2 = LMASK .AND. PHLC_LRC(JL)>ICED%XRTMIN(2) .AND. PHLC_LCF(JL)>1.E-20
+#endif
+ IF(LMASK1 .OR. LMASK2) THEN
+ IF(.NOT. LDSOFT) THEN
+ IF(LMASK1) THEN
+ !Accretion due to rain falling in high cloud content
+#if defined(REPRO48) || defined(REPRO55)
+ PRCACCR(JL) = ICEP%XFCACCR * ( PHLC_HRC(JL)/PHLC_HCF(JL) ) &
+ &*PLBDAR_RF(JL)**ICEP%XEXCACCR &
+ &*PRHODREF(JL)**(-ICED%XCEXVT) &
+ &*PHLC_HCF(JL)
+#else
+ !HCF*accretion(HRC/HCF) with simplification
+ PRCACCR(:) = ICEP%XFCACCR * PHLC_HRC(JL) &
+ &*PLBDAR_RF(JL)**ICEP%XEXCACCR &
+ &*PRHODREF(JL)**(-ICED%XCEXVT)
+#endif
+ ELSE
+ PRCACCR(JL)=0.
+ ENDIF
+ IF(LMASK2) THEN
+ !We add acrretion due to rain falling in low cloud content
+ PRCACCR(JL) = PRCACCR(JL) + ICEP%XFCACCR * ( PHLC_LRC(JL)/PHLC_LCF(JL) ) &
+ &*PLBDAR_RF(JL)**ICEP%XEXCACCR &
+ &*PRHODREF(JL)**(-ICED%XCEXVT) &
+ &*(MIN(PCF(JL), PRF(JL))-PHLC_HCF(JL))
+ ENDIF
+ ENDIF
+ ELSE
+ PRCACCR(JL)=0.
+ ENDIF
ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCACCR(JL)=PRCACCR(JL) * MIN(1., ZMASK1(JL)+ZMASK2(JL))
- ENDDO
- ELSE
- PRCACCR(:)=0.
- WHERE(ZMASK1(:)==1.)
- !Accretion due to rain falling in high cloud content
- PRCACCR(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
- * PLBDAR_RF(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT) &
- * PHLC_HCF
- END WHERE
- WHERE(ZMASK2(:)==1.)
- !We add acrretion due to rain falling in low cloud content
- PRCACCR(:) = PRCACCR(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
- * PLBDAR_RF(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT) &
- * (MIN(PCF(:), PRF(:))-PHLC_HCF(:))
- END WHERE
- ENDIF
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RC_RR_ACCR case')
ENDIF
-DO JL=1, KSIZE
- PA_RC(JL) = PA_RC(JL) - PRCACCR(JL)
- PA_RR(JL) = PA_RR(JL) + PRCACCR(JL)
-ENDDO
!
!* 4.4 compute the evaporation of r_r: RREVAV
!
IF (HSUBG_RR_EVAP=='NONE') THEN
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &MAX(0., SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)<=XRTMIN(2)
- &PCOMPUTE(JL)
+ IF(PRRT(JL)>ICED%XRTMIN(3) .AND. PRCT(JL)<=ICED%XRTMIN(2) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ PRREVAV(JL) = EXP(CST%XALPW - CST%XBETAW/PT(JL) - CST%XGAMW*ALOG(PT(JL))) ! es_w
+ ZUSW(JL) = 1. - PRVT(JL)*(PPRES(JL)-PRREVAV(JL)) / (CST%XEPSILO * PRREVAV(JL)) ! Undersaturation over water
+ PRREVAV(JL) = (CST%XLVTT+(CST%XCPV-CST%XCL)*(PT(JL)-CST%XTT) )**2 / (PKA(JL)*CST%XRV*PT(JL)**2) &
+ &+(CST%XRV*PT(JL)) / (PDV(JL)*PRREVAV(JL))
+ PRREVAV(JL) = (MAX(0.,ZUSW(JL) )/(PRHODREF(JL)*PRREVAV(JL)) ) * &
+ & (ICEP%X0EVAR*PLBDAR(JL)**ICEP%XEX0EVAR+ICEP%X1EVAR*PCJ(JL)*PLBDAR(JL)**ICEP%XEX1EVAR)
+ ENDIF
+ ELSE
+ PRREVAV(JL)=0.
+ ENDIF
ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
- ENDDO
- ELSE
- PRREVAV(:) = 0.
- !Evaporation only when there's no cloud (RC must be 0)
- WHERE(ZMASK(:)==1.)
- PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
- ! Undersaturation over water
- PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) &
- + ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
- PRREVAV(:) = ( MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) ) * &
- ( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR )
- END WHERE
- ENDIF
ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
- !Evaporation in clear sky part
- !With CLFR, rain is diluted over the grid box
- !With PRFR, rain is concentrated in its fraction
- !Use temperature and humidity in clear sky part like Bechtold et al. (1993)
- IF (HSUBG_RR_EVAP=='CLFR') THEN
- ZZW4(:)=1. !Precipitation fraction
- ZZW3(:)=PLBDAR(:)
- ELSE
- ZZW4(:)=PRF(:) !Precipitation fraction
- ZZW3(:)=PLBDAR_RF(:)
- ENDIF
-
!ATTENTION
!Il faudrait recalculer les variables PKA, PDV, PCJ en tenant compte de la température T^u
!Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
!et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
!On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
+
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &MAX(0., -SIGN(1., PCF(JL)-ZZW4(JL))) * & ! ZZW4(:) > PCF(:)
- &PCOMPUTE(JL)
+ !Evaporation in clear sky part
+ !With CLFR, rain is diluted over the grid box
+ !With PRFR, rain is concentrated in its fraction
+ !Use temperature and humidity in clear sky part like Bechtold et al. (1993)
+ IF (HSUBG_RR_EVAP=='CLFR') THEN
+ ZZW4=1. !Precipitation fraction
+ ZZW3=PLBDAR(JL)
+ ELSE
+ ZZW4=PRF(JL) !Precipitation fraction
+ ZZW3=PLBDAR_RF(JL)
+ ENDIF
+
+ IF(PRRT(JL)>ICED%XRTMIN(3) .AND. ZZW4>PCF(JL) .AND. LDCOMPUTE(JL)) THEN
+ IF(.NOT. LDSOFT) THEN
+ ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
+ ! Bechtold et al. 1993
+ !
+ ! T_l
+ ZTHLT(JL) = PTHT(JL) - CST%XLVTT*PTHT(JL)/CST%XCPD/PT(JL)*PRCT(JL)
+ !
+ ! T^u = T_l = theta_l * (T/theta)
+ ZZW2 = ZTHLT(JL) * PT(JL) / PTHT(JL)
+ !
+ ! es_w with new T^u
+ PRREVAV(JL) = EXP(CST%XALPW - CST%XBETAW/ZZW2 - CST%XGAMW*ALOG(ZZW2))
+ !
+ ! S, Undersaturation over water (with new theta^u)
+ ZUSW(JL) = 1.0 - PRVT(JL)*(PPRES(JL)-PRREVAV(JL)) / (CST%XEPSILO * PRREVAV(JL))
+ !
+ PRREVAV(JL) = (CST%XLVTT+(CST%XCPV-CST%XCL)*(ZZW2-CST%XTT))**2 / (PKA(JL)*CST%XRV*ZZW2**2) &
+ &+(CST%XRV*ZZW2) / (PDV(JL)*PRREVAV(JL))
+ !
+ PRREVAV(JL) = MAX(0., ZUSW(JL))/(PRHODREF(JL)*PRREVAV(JL)) * &
+ & (ICEP%X0EVAR*ZZW3**ICEP%XEX0EVAR+ICEP%X1EVAR*PCJ(JL)*ZZW3**ICEP%XEX1EVAR)
+ !
+ PRREVAV(JL) = PRREVAV(JL)*(ZZW4-PCF(JL))
+ ENDIF
+ ELSE
+ PRREVAV(JL)=0.
+ ENDIF
ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
- ENDDO
- ELSE
- PRREVAV(:) = 0.
- WHERE(ZMASK(:)==1)
- ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
- ! Bechtold et al. 1993
- !
- ! T_l
- ZTHLT(:) = PTHT(:) - XLVTT*PTHT(:)/XCPD/PT(:)*PRCT(:)
- !
- ! T^u = T_l = theta_l * (T/theta)
- ZZW2(:) = ZTHLT(:) * PT(:) / PTHT(:)
- !
- ! es_w with new T^u
- PRREVAV(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
- !
- ! S, Undersaturation over water (with new theta^u)
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
- !
- PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
- + ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) )
- !
- PRREVAV(:) = MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) * &
- ( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR )
- !
- PRREVAV(:) = PRREVAV(:)*(ZZW4(:)-PCF(:))
- END WHERE
- ENDIF
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RR_EVAP case')
END IF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) - PRREVAV(JL)
- PA_RV(JL) = PA_RV(JL) + PRREVAV(JL)
- PA_TH(JL) = PA_TH(JL) - PRREVAV(JL)*PLVFACT(JL)
-ENDDO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_WARM', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_WARM
+END MODULE MODE_ICE4_WARM
diff --git a/src/PHYEX/micro/mode_icecloud.f90 b/src/PHYEX/micro/mode_icecloud.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e05effa6e2f66def26ffba530cc9601c3348b921
--- /dev/null
+++ b/src/PHYEX/micro/mode_icecloud.f90
@@ -0,0 +1,209 @@
+MODULE MODE_ICECLOUD
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE ICECLOUD &
+! Input :
+ & ( D,PP,PZ,PDZ,PT,PR,PTSTEP,PPBLH,PWCLD,XW2D, &
+! Output :
+ & SIFRC,SSIO,SSIU,W2D,RSI)
+
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ USE MODD_CST,ONLY : XCPD,XCPV,XLVTT,XLSTT,XG,XRD,XEPSILO
+ USE MODE_TIWMX, ONLY: ESATW, ESATI
+ USE MODE_QSATMX_TAB, ONLY: QSATMX_TAB
+ IMPLICIT NONE
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! calculate subgridscale fraction of supersaturation with respect to ice.
+! Method:
+! Assume a linear distubution of relative humidity and let the variability
+! of humidity be a function of model level thickness.
+! (Also a function of of humidity itself in the boundary layer)
+! Interface: subroutine ICECLOUD is called
+! ------------ from subroutine 'rain_ice'
+!
+! variable type content
+! ======== ==== =======
+!
+! INPUT arguments (arguments d'entree)
+!----------------------------------------------
+! PP : pressure at model level (Pa)
+! PZ : model level height (m)
+! PDZ : model level thickness (m)
+! PT : temperature (K)
+! PR : model level humidity mixing ratio (kg/kg)
+! PTSTEP : timestep
+! PPBLH : plantetary layer height (m) (negative value means unknown)
+! PWCLD : water and / mixed phase cloud cover (negative means unknown)
+! XW2D : quota between ice crystal concentration between dry and wet
+! part of a gridbox
+
+! OUTPUT arguments (arguments d'sortie)
+!---------------------------------------------
+! SIFRC : subgridscale fraction with supersaturation with respect to ice.
+! SSIO : Super-saturation with respect to ice in the
+! supersaturated fraction
+! SSIU : Sub-saturation with respect to ice in the sub-saturated
+! fraction
+! W2D : Factor used to get consistncy between the mean value of
+! the gridbox and parts of the gridbox
+! RSI : Saturation mixing ratio over ice
+
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, INTENT(IN) :: PP(D%NIJT)
+REAL, INTENT(IN) :: PZ(D%NIJT)
+REAL, INTENT(IN) :: PDZ(D%NIJT)
+REAL, INTENT(IN) :: PT(D%NIJT)
+REAL, INTENT(IN) :: PR(D%NIJT)
+REAL, INTENT(IN) :: PTSTEP
+REAL, INTENT(IN) :: PPBLH
+REAL, INTENT(IN) :: PWCLD(D%NIJT)
+REAL, INTENT(IN) :: XW2D
+
+! OUTPUT arguments (arguments d'sortie)
+!---------------------------------------------
+REAL, INTENT(OUT) :: SIFRC(D%NIJT)
+REAL, INTENT(OUT) :: SSIO(D%NIJT)
+REAL, INTENT(OUT) :: SSIU(D%NIJT)
+REAL, INTENT(OUT) :: W2D(D%NIJT)
+REAL, INTENT(OUT) :: RSI(D%NIJT)
+
+! Working variables:
+REAL :: ZSIGMAX,ZSIGMAY,ZSIGMAZ,ZXDIST,ZYDIST,&
+ & ZRSW,ZRHW,ZRHIN,ZDRHDZ,ZZ,ZRHDIST,ZRHLIM, &
+ & ZRHDIF,ZWCLD,ZI2W,ZRHLIMICE,ZRHLIMINV,ZA,ZRHI,ZR
+INTEGER :: JIJ, IIJB, IIJE
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('ICECLOUD',0,ZHOOK_HANDLE)
+!
+IIJB=D%NIJB
+IIJE=D%NIJE
+!
+ZSIGMAX=3.E-4 ! assumed rh variation in x axis direction
+ZSIGMAY=ZSIGMAX ! assumed rh variation in y axis direction
+ZSIGMAZ=1.E-2
+
+!ZXDIST=DTHETA*110000.
+ZXDIST=2500.
+ ! gridsize in x axis (m) Avoid too low
+ ! since the model has a tendency to become
+ ! drier at high horizontal resolution
+ ! due to stronger vertical velocities.
+ZYDIST=ZXDIST ! gridsize in y axis (m)
+
+DO JIJ = IIJB, IIJE
+ ZR = MAX(0.,PR(JIJ)*PTSTEP)
+ SIFRC(JIJ) = 0.
+ ZA = ZR*PP(JIJ)/(XEPSILO + ZR)
+ ZRHW = ZA/ESATW(PT(JIJ))
+ RSI(JIJ) = QSATMX_TAB(PP(JIJ),PT(JIJ),1.)
+ ZRHI = ZA/ESATI(PT(JIJ))
+ ZI2W = ESATW(PT(JIJ))/ESATI(PT(JIJ))
+
+ SSIU(JIJ) = MIN(ZI2W,ZRHI)
+ SSIO(JIJ) = SSIU(JIJ)
+ W2D(JIJ) = 1.
+
+ IF (PT(JIJ)>273.1 .OR. ZR<=0. .OR. ESATI(PT(JIJ)) >= PP(JIJ)*0.5) THEN
+ SSIU(JIJ) = SSIU(JIJ) - 1.
+ SSIO(JIJ) = SSIU(JIJ)
+ IF(PWCLD(JIJ)>=0.) SIFRC(JIJ) = PWCLD(JIJ)
+ CYCLE
+ ENDIF
+
+
+ ZRHIN = MAX(0.05, MIN(1.,ZRHW))
+
+ ZDRHDZ=ZRHIN*XG /(PT(JIJ)*XRD)* &
+ & ( XEPSILO*XLVTT/(XCPD*PT(JIJ)) - 1.) ! correct
+! & ( ZEPSILO*XLSTT/(XCPD*PT) -1.) ! incorrect
+! more exact
+! assumed rh variation in the z axis (rh/m) in the pbl .
+! Also possible to just use
+! zdrhdz=4.2e-4_jprb ! rh/m !
+
+ ZZ=0.
+ IF(PPBLH < 0. )THEN ! Assume boundary layer height is not available
+ ZZ = MIN(1.,MAX(0.,PZ(JIJ)*0.001))
+ ELSE
+ IF(PZ(JIJ) > 35. .AND. PZ(JIJ) > PPBLH) ZZ = 1.
+ ENDIF
+
+! 1.6e-2 rh/m means variations is of order 0.5 for a 1km dept.
+! sigmaz=4e-2 ! EO 140 lev.
+
+
+! Compute rh-variation is x,y,z direction as approxmately
+! independent, exept for the z variation in the pbl, where rh is
+! assumed to be fairly constantly increasing with height
+
+ ZRHDIST = SQRT( ZXDIST*ZSIGMAX**2 + ZYDIST*ZSIGMAY**2 + &
+ & (1.-ZZ)* (PDZ(JIJ)*ZDRHDZ)**2 + ZZ*PDZ(JIJ)*ZSIGMAZ**2)
+! z-variation of rh in the pbl z-variation of rh outside the pbl
+! Safety for very coarse vertical resolution:
+ IF(ZZ > 0.1) ZRHDIST = ZRHDIST/(1.+ZRHDIST)
+
+!!!! Note ZRHDIST is with respect to water ! !!!!!!!!!!!!
+
+ ZRHLIM = MAX(0.5,MIN(0.99,1.-0.5*ZRHDIST))
+
+ IF(PWCLD(JIJ) < 0.)THEN
+ ! Assume water/mixed-phase cloud cover from e.g.
+ ! statistical cloud scheme is not available
+ ZRHDIF = (1. - ZRHW)/(1.0-ZRHLIM)
+ ZRHDIF = 1. - SQRT(MAX(0.,ZRHDIF))
+ ZWCLD = MIN(1.,MAX(ZRHDIF,0.0))
+ ELSE
+ ZWCLD = PWCLD(JIJ)
+! possible to backwards compute a critical relative humity consitent with
+! input cloudcover:
+! IF(PWCLD < 0.99 .AND. PWCLD > 0.01) ZRHLIM= 1. - (1.-ZRHW)/(1.-PWCLD)**2
+ ENDIF
+
+ SIFRC(JIJ) = ZWCLD
+
+! relation rhlim with respect to water to that of ice:
+!ZRHLIMICE = MAX(ZRHDMIN*ZI2W,1.+ ZI2W*( ZRHLIM - 1.))
+ ZRHLIMICE = 1.+ ZI2W*( ZRHLIM - 1.)
+
+ IF(ZRHLIM <= 0.999)THEN
+
+ ! compute a 1/(1-rhlim) constistant with lstmp(i,k):
+ ZRHLIMINV = 1./(1. - ZRHLIMICE)
+ ZRHDIF = (ZRHI - ZRHLIMICE)*ZRHLIMINV
+
+ IF(ZWCLD==0.)THEN
+ SIFRC(JIJ) = MIN(1.,0.5*MAX(0.,ZRHDIF))
+ ELSE
+ ZA = 1. - 1./ZI2W
+ SIFRC(JIJ) = MIN(1.,ZA*0.5/ (1. - ZRHLIM))
+ SIFRC(JIJ) = MIN(1.,ZWCLD + SIFRC(JIJ))
+ ENDIF
+ ENDIF
+
+ IF(SIFRC(JIJ) > 0.01) THEN
+ SSIU(JIJ) = SIFRC(JIJ) + ZRHLIMICE*(1.-SIFRC(JIJ))
+ SSIO(JIJ) = (ZRHI - (1.- SIFRC(JIJ))*SSIU(JIJ))/SIFRC(JIJ)
+ ELSE
+ SIFRC(JIJ) = 0.! to aviod mismatch with output variables
+ ZA = MIN(0.,ZRHI-ZRHLIMICE)
+ SSIU(JIJ) = MAX(0.,SIFRC(JIJ) + ZRHLIMICE*(1.-SIFRC(JIJ)) + 2.*ZA )
+ ENDIF
+ SSIO(JIJ) = MIN(ZI2W,SSIO(JIJ))
+ SSIU(JIJ) = MAX(0.,SSIU(JIJ))
+
+! Transform from relative humidity to degree of saturation:
+ SSIU(JIJ) = SSIU(JIJ) - 1.
+ SSIO(JIJ) = SSIO(JIJ) - 1.
+
+ IF (XW2D > 1.) W2D(JIJ) = 1./(1. - SIFRC(JIJ) + XW2D*SIFRC(JIJ))
+
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('ICECLOUD',1,ZHOOK_HANDLE)
+END SUBROUTINE ICECLOUD
+END MODULE MODE_ICECLOUD
diff --git a/src/PHYEX/micro/mode_qsatmx_tab.f90 b/src/PHYEX/micro/mode_qsatmx_tab.f90
new file mode 100644
index 0000000000000000000000000000000000000000..01d697b19bdeeb1cc011c4826e8c37da037cb944
--- /dev/null
+++ b/src/PHYEX/micro/mode_qsatmx_tab.f90
@@ -0,0 +1,27 @@
+MODULE MODE_QSATMX_TAB
+IMPLICIT NONE
+CONTAINS
+FUNCTION QSATMX_TAB(P,T,FICE)
+
+ USE PARKIND1, ONLY : JPRB
+ USE MODD_CST ,ONLY : XEPSILO
+ USE MODE_TIWMX, ONLY : ESATI,ESATW
+
+ IMPLICIT NONE
+
+ REAL :: QSATMX_TAB
+ REAL, INTENT(IN) :: P,T,FICE
+
+ REAL :: ZES
+
+ ZES = ESATI(T)*FICE + ESATW(T)*(1.-FICE)
+ IF(ZES >= P)THEN ! temp > boiling point, condensation not possible.
+ ! Then this function lacks physical meaning,
+ ! here set to one
+ QSATMX_TAB = 1.
+ ELSE
+ QSATMX_TAB = XEPSILO*ZES/(P-ZES) !r
+ ENDIF
+
+END FUNCTION QSATMX_TAB
+END MODULE MODE_QSATMX_TAB
diff --git a/src/PHYEX/micro/mode_read_xker_gweth.f90 b/src/PHYEX/micro/mode_read_xker_gweth.f90
index c8f3fe40d37d00848b9cb3abd23d3ae069a68607..c0e18f57e5bfad43bc9fe712abfcf7a5e2774595 100644
--- a/src/PHYEX/micro/mode_read_xker_gweth.f90
+++ b/src/PHYEX/micro/mode_read_xker_gweth.f90
@@ -2,50 +2,18 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 microph 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###########################
- MODULE MODI_READ_XKER_GWETH
+ MODULE MODE_READ_XKER_GWETH
! ###########################
-!
-INTERFACE
- SUBROUTINE READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
- PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
- PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
- PFDINFTY,PKER_GWETH )
-!
-INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAG
-REAL, INTENT(OUT) :: PALPHAH
-REAL, INTENT(OUT) :: PNUH
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PEHG
-REAL, INTENT(OUT) :: PBG
-REAL, INTENT(OUT) :: PCH
-REAL, INTENT(OUT) :: PDH
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PWETLBDAH_MAX
-REAL, INTENT(OUT) :: PWETLBDAG_MAX
-REAL, INTENT(OUT) :: PWETLBDAH_MIN
-REAL, INTENT(OUT) :: PWETLBDAG_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_GWETH
-!
-END SUBROUTINE
-!
-END INTERFACE
-!
-END MODULE MODI_READ_XKER_GWETH
-! ########################################################################
+IMPLICIT NONE
+CONTAINS
SUBROUTINE READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
PFDINFTY,PKER_GWETH )
+!DEC$ OPTIMIZE:0
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the graupel-hail wet growth process
@@ -81,6 +49,7 @@ END MODULE MODI_READ_XKER_GWETH
!! MODIFICATIONS
!! -------------
!! Original 19/04/97
+!! 14-Feb-2014 R. El Khatib optimise for compile time on Intel
!!
!-------------------------------------------------------------------------------
!
@@ -112,6 +81,8 @@ REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_GWETH
! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE_HAIL IF THE KERNELS ARE UPDATED#
! ########################################################################
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('READ_XKER_GWETH',0,ZHOOK_HANDLE)
KND= 50
KWETLBDAH= 40
KWETLBDAG= 40
@@ -1734,4 +1705,6 @@ IF( PRESENT(PKER_GWETH) ) THEN
PKER_GWETH( 40, 40) = 0.204855E-01
END IF
!
+IF (LHOOK) CALL DR_HOOK('READ_XKER_GWETH',1,ZHOOK_HANDLE)
END SUBROUTINE READ_XKER_GWETH
+END MODULE MODE_READ_XKER_GWETH
diff --git a/src/PHYEX/micro/mode_read_xker_raccs.f90 b/src/PHYEX/micro/mode_read_xker_raccs.f90
index c11834dd3c91c06bd16995c161b0b993f0fb512a..8ca45d9bfacfaee372868359d79a73fddbed233f 100644
--- a/src/PHYEX/micro/mode_read_xker_raccs.f90
+++ b/src/PHYEX/micro/mode_read_xker_raccs.f90
@@ -2,54 +2,18 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###########################
- MODULE MODI_READ_XKER_RACCS
+ MODULE MODE_READ_XKER_RACCS
! ###########################
-!
-INTERFACE
- SUBROUTINE READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
- PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
- PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
- PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
-!
-INTEGER, INTENT(OUT) :: KND,KACCLBDAS,KACCLBDAR
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PALPHAR
-REAL, INTENT(OUT) :: PNUR
-REAL, INTENT(OUT) :: PESR
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PBR
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PCR
-REAL, INTENT(OUT) :: PDR
-REAL, INTENT(OUT) :: PACCLBDAS_MAX
-REAL, INTENT(OUT) :: PACCLBDAR_MAX
-REAL, INTENT(OUT) :: PACCLBDAS_MIN
-REAL, INTENT(OUT) :: PACCLBDAR_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCSS
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RACCS
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SACCRG
-!
-END SUBROUTINE
-!
-END INTERFACE
-!
-END MODULE MODI_READ_XKER_RACCS
-! ##########################################################################
+IMPLICIT NONE
+CONTAINS
SUBROUTINE READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PFVELOS,PCR,PDR, &
PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN, &
PFDINFTY,PKER_RACCSS,PKER_RACCS,PKER_SACCRG )
+!DEC$ OPTIMIZE:0
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ##########################################################################
!
!!**** * * - initialize the kernels for the rain-snow accretion process
@@ -85,6 +49,7 @@ END MODULE MODI_READ_XKER_RACCS
!! MODIFICATIONS
!! -------------
!! Original 09/04/96
+!! 14-Feb-2014 R. El Khatib optimise for compile time on Intel
!!
!-------------------------------------------------------------------------------
!
@@ -120,6 +85,8 @@ REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SACCRG
! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
! ###################################################################
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('READ_XKER_RACCS',0,ZHOOK_HANDLE)
KND= 50
KACCLBDAS= 40
KACCLBDAR= 40
@@ -130,7 +97,7 @@ PNUR= 0.100000E+01
PESR= 0.100000E+01
PBS= 0.190000E+01
PBR= 0.300000E+01
-PCS= 0.500000E+01
+PCS= 0.510000E+01
PDS= 0.270000E+00
PFVELOS= 0.000000E+00
PCR= 0.842000E+03
@@ -142,1446 +109,1446 @@ PACCLBDAR_MIN= 0.100000E+04
PFDINFTY= 0.200000E+02
!
IF( PRESENT(PKER_RACCSS) ) THEN
- PKER_RACCSS( 1, 1) = 0.690959E+01
- PKER_RACCSS( 1, 2) = 0.567481E+01
- PKER_RACCSS( 1, 3) = 0.448901E+01
- PKER_RACCSS( 1, 4) = 0.342820E+01
- PKER_RACCSS( 1, 5) = 0.253043E+01
- PKER_RACCSS( 1, 6) = 0.181127E+01
- PKER_RACCSS( 1, 7) = 0.127656E+01
- PKER_RACCSS( 1, 8) = 0.930093E+00
- PKER_RACCSS( 1, 9) = 0.767456E+00
- PKER_RACCSS( 1, 10) = 0.764985E+00
- PKER_RACCSS( 1, 11) = 0.877850E+00
- PKER_RACCSS( 1, 12) = 0.105028E+01
- PKER_RACCSS( 1, 13) = 0.123545E+01
- PKER_RACCSS( 1, 14) = 0.140595E+01
- PKER_RACCSS( 1, 15) = 0.155229E+01
- PKER_RACCSS( 1, 16) = 0.167456E+01
- PKER_RACCSS( 1, 17) = 0.177591E+01
- PKER_RACCSS( 1, 18) = 0.185978E+01
- PKER_RACCSS( 1, 19) = 0.192918E+01
- PKER_RACCSS( 1, 20) = 0.198661E+01
- PKER_RACCSS( 1, 21) = 0.203413E+01
- PKER_RACCSS( 1, 22) = 0.207346E+01
- PKER_RACCSS( 1, 23) = 0.210601E+01
- PKER_RACCSS( 1, 24) = 0.213295E+01
- PKER_RACCSS( 1, 25) = 0.215525E+01
- PKER_RACCSS( 1, 26) = 0.217370E+01
- PKER_RACCSS( 1, 27) = 0.218898E+01
- PKER_RACCSS( 1, 28) = 0.220163E+01
- PKER_RACCSS( 1, 29) = 0.221209E+01
- PKER_RACCSS( 1, 30) = 0.222076E+01
- PKER_RACCSS( 1, 31) = 0.222793E+01
- PKER_RACCSS( 1, 32) = 0.223387E+01
- PKER_RACCSS( 1, 33) = 0.223878E+01
- PKER_RACCSS( 1, 34) = 0.224285E+01
- PKER_RACCSS( 1, 35) = 0.224622E+01
- PKER_RACCSS( 1, 36) = 0.224900E+01
- PKER_RACCSS( 1, 37) = 0.225131E+01
- PKER_RACCSS( 1, 38) = 0.225322E+01
- PKER_RACCSS( 1, 39) = 0.225480E+01
- PKER_RACCSS( 1, 40) = 0.225611E+01
- PKER_RACCSS( 2, 1) = 0.644313E+01
- PKER_RACCSS( 2, 2) = 0.548394E+01
- PKER_RACCSS( 2, 3) = 0.446057E+01
- PKER_RACCSS( 2, 4) = 0.348309E+01
- PKER_RACCSS( 2, 5) = 0.261733E+01
- PKER_RACCSS( 2, 6) = 0.189832E+01
- PKER_RACCSS( 2, 7) = 0.134358E+01
- PKER_RACCSS( 2, 8) = 0.961970E+00
- PKER_RACCSS( 2, 9) = 0.753053E+00
- PKER_RACCSS( 2, 10) = 0.703384E+00
- PKER_RACCSS( 2, 11) = 0.778340E+00
- PKER_RACCSS( 2, 12) = 0.926704E+00
- PKER_RACCSS( 2, 13) = 0.110037E+01
- PKER_RACCSS( 2, 14) = 0.126682E+01
- PKER_RACCSS( 2, 15) = 0.141220E+01
- PKER_RACCSS( 2, 16) = 0.153439E+01
- PKER_RACCSS( 2, 17) = 0.163583E+01
- PKER_RACCSS( 2, 18) = 0.171978E+01
- PKER_RACCSS( 2, 19) = 0.178924E+01
- PKER_RACCSS( 2, 20) = 0.184671E+01
- PKER_RACCSS( 2, 21) = 0.189427E+01
- PKER_RACCSS( 2, 22) = 0.193362E+01
- PKER_RACCSS( 2, 23) = 0.196619E+01
- PKER_RACCSS( 2, 24) = 0.199315E+01
- PKER_RACCSS( 2, 25) = 0.201546E+01
- PKER_RACCSS( 2, 26) = 0.203392E+01
- PKER_RACCSS( 2, 27) = 0.204920E+01
- PKER_RACCSS( 2, 28) = 0.206185E+01
- PKER_RACCSS( 2, 29) = 0.207232E+01
- PKER_RACCSS( 2, 30) = 0.208099E+01
- PKER_RACCSS( 2, 31) = 0.208817E+01
- PKER_RACCSS( 2, 32) = 0.209410E+01
- PKER_RACCSS( 2, 33) = 0.209902E+01
- PKER_RACCSS( 2, 34) = 0.210309E+01
- PKER_RACCSS( 2, 35) = 0.210646E+01
- PKER_RACCSS( 2, 36) = 0.210924E+01
- PKER_RACCSS( 2, 37) = 0.211155E+01
- PKER_RACCSS( 2, 38) = 0.211346E+01
- PKER_RACCSS( 2, 39) = 0.211504E+01
- PKER_RACCSS( 2, 40) = 0.211635E+01
- PKER_RACCSS( 3, 1) = 0.573795E+01
- PKER_RACCSS( 3, 2) = 0.511805E+01
- PKER_RACCSS( 3, 3) = 0.431910E+01
- PKER_RACCSS( 3, 4) = 0.347268E+01
- PKER_RACCSS( 3, 5) = 0.267152E+01
- PKER_RACCSS( 3, 6) = 0.197282E+01
- PKER_RACCSS( 3, 7) = 0.140982E+01
- PKER_RACCSS( 3, 8) = 0.100121E+01
- PKER_RACCSS( 3, 9) = 0.753860E+00
- PKER_RACCSS( 3, 10) = 0.660309E+00
- PKER_RACCSS( 3, 11) = 0.695906E+00
- PKER_RACCSS( 3, 12) = 0.816902E+00
- PKER_RACCSS( 3, 13) = 0.976130E+00
- PKER_RACCSS( 3, 14) = 0.113696E+01
- PKER_RACCSS( 3, 15) = 0.128080E+01
- PKER_RACCSS( 3, 16) = 0.140279E+01
- PKER_RACCSS( 3, 17) = 0.150431E+01
- PKER_RACCSS( 3, 18) = 0.158836E+01
- PKER_RACCSS( 3, 19) = 0.165789E+01
- PKER_RACCSS( 3, 20) = 0.171542E+01
- PKER_RACCSS( 3, 21) = 0.176302E+01
- PKER_RACCSS( 3, 22) = 0.180240E+01
- PKER_RACCSS( 3, 23) = 0.183499E+01
- PKER_RACCSS( 3, 24) = 0.186197E+01
- PKER_RACCSS( 3, 25) = 0.188429E+01
- PKER_RACCSS( 3, 26) = 0.190276E+01
- PKER_RACCSS( 3, 27) = 0.191805E+01
- PKER_RACCSS( 3, 28) = 0.193071E+01
- PKER_RACCSS( 3, 29) = 0.194118E+01
- PKER_RACCSS( 3, 30) = 0.194986E+01
- PKER_RACCSS( 3, 31) = 0.195703E+01
- PKER_RACCSS( 3, 32) = 0.196297E+01
- PKER_RACCSS( 3, 33) = 0.196789E+01
- PKER_RACCSS( 3, 34) = 0.197196E+01
- PKER_RACCSS( 3, 35) = 0.197533E+01
- PKER_RACCSS( 3, 36) = 0.197812E+01
- PKER_RACCSS( 3, 37) = 0.198043E+01
- PKER_RACCSS( 3, 38) = 0.198234E+01
- PKER_RACCSS( 3, 39) = 0.198392E+01
- PKER_RACCSS( 3, 40) = 0.198523E+01
- PKER_RACCSS( 4, 1) = 0.481286E+01
- PKER_RACCSS( 4, 2) = 0.455675E+01
- PKER_RACCSS( 4, 3) = 0.403407E+01
- PKER_RACCSS( 4, 4) = 0.336958E+01
- PKER_RACCSS( 4, 5) = 0.267295E+01
- PKER_RACCSS( 4, 6) = 0.202246E+01
- PKER_RACCSS( 4, 7) = 0.146909E+01
- PKER_RACCSS( 4, 8) = 0.104372E+01
- PKER_RACCSS( 4, 9) = 0.764198E+00
- PKER_RACCSS( 4, 10) = 0.631791E+00
- PKER_RACCSS( 4, 11) = 0.629058E+00
- PKER_RACCSS( 4, 12) = 0.720982E+00
- PKER_RACCSS( 4, 13) = 0.862867E+00
- PKER_RACCSS( 4, 14) = 0.101613E+01
- PKER_RACCSS( 4, 15) = 0.115766E+01
- PKER_RACCSS( 4, 16) = 0.127924E+01
- PKER_RACCSS( 4, 17) = 0.138081E+01
- PKER_RACCSS( 4, 18) = 0.146497E+01
- PKER_RACCSS( 4, 19) = 0.153460E+01
- PKER_RACCSS( 4, 20) = 0.159220E+01
- PKER_RACCSS( 4, 21) = 0.163984E+01
- PKER_RACCSS( 4, 22) = 0.167926E+01
- PKER_RACCSS( 4, 23) = 0.171188E+01
- PKER_RACCSS( 4, 24) = 0.173888E+01
- PKER_RACCSS( 4, 25) = 0.176121E+01
- PKER_RACCSS( 4, 26) = 0.177970E+01
- PKER_RACCSS( 4, 27) = 0.179500E+01
- PKER_RACCSS( 4, 28) = 0.180766E+01
- PKER_RACCSS( 4, 29) = 0.181814E+01
- PKER_RACCSS( 4, 30) = 0.182682E+01
- PKER_RACCSS( 4, 31) = 0.183400E+01
- PKER_RACCSS( 4, 32) = 0.183994E+01
- PKER_RACCSS( 4, 33) = 0.184486E+01
- PKER_RACCSS( 4, 34) = 0.184893E+01
- PKER_RACCSS( 4, 35) = 0.185230E+01
- PKER_RACCSS( 4, 36) = 0.185509E+01
- PKER_RACCSS( 4, 37) = 0.185740E+01
- PKER_RACCSS( 4, 38) = 0.185931E+01
- PKER_RACCSS( 4, 39) = 0.186089E+01
- PKER_RACCSS( 4, 40) = 0.186220E+01
- PKER_RACCSS( 5, 1) = 0.374607E+01
- PKER_RACCSS( 5, 2) = 0.381650E+01
- PKER_RACCSS( 5, 3) = 0.358955E+01
- PKER_RACCSS( 5, 4) = 0.314924E+01
- PKER_RACCSS( 5, 5) = 0.259876E+01
- PKER_RACCSS( 5, 6) = 0.203003E+01
- PKER_RACCSS( 5, 7) = 0.151044E+01
- PKER_RACCSS( 5, 8) = 0.108463E+01
- PKER_RACCSS( 5, 9) = 0.781881E+00
- PKER_RACCSS( 5, 10) = 0.614370E+00
- PKER_RACCSS( 5, 11) = 0.575301E+00
- PKER_RACCSS( 5, 12) = 0.637842E+00
- PKER_RACCSS( 5, 13) = 0.760479E+00
- PKER_RACCSS( 5, 14) = 0.904219E+00
- PKER_RACCSS( 5, 15) = 0.104241E+01
- PKER_RACCSS( 5, 16) = 0.116324E+01
- PKER_RACCSS( 5, 17) = 0.126482E+01
- PKER_RACCSS( 5, 18) = 0.134911E+01
- PKER_RACCSS( 5, 19) = 0.141885E+01
- PKER_RACCSS( 5, 20) = 0.147653E+01
- PKER_RACCSS( 5, 21) = 0.152423E+01
- PKER_RACCSS( 5, 22) = 0.156370E+01
- PKER_RACCSS( 5, 23) = 0.159635E+01
- PKER_RACCSS( 5, 24) = 0.162337E+01
- PKER_RACCSS( 5, 25) = 0.164573E+01
- PKER_RACCSS( 5, 26) = 0.166423E+01
- PKER_RACCSS( 5, 27) = 0.167954E+01
- PKER_RACCSS( 5, 28) = 0.169221E+01
- PKER_RACCSS( 5, 29) = 0.170270E+01
- PKER_RACCSS( 5, 30) = 0.171138E+01
- PKER_RACCSS( 5, 31) = 0.171856E+01
- PKER_RACCSS( 5, 32) = 0.172451E+01
- PKER_RACCSS( 5, 33) = 0.172943E+01
- PKER_RACCSS( 5, 34) = 0.173350E+01
- PKER_RACCSS( 5, 35) = 0.173687E+01
- PKER_RACCSS( 5, 36) = 0.173966E+01
- PKER_RACCSS( 5, 37) = 0.174197E+01
- PKER_RACCSS( 5, 38) = 0.174389E+01
- PKER_RACCSS( 5, 39) = 0.174547E+01
- PKER_RACCSS( 5, 40) = 0.174678E+01
- PKER_RACCSS( 6, 1) = 0.266518E+01
- PKER_RACCSS( 6, 2) = 0.296172E+01
- PKER_RACCSS( 6, 3) = 0.299965E+01
- PKER_RACCSS( 6, 4) = 0.279909E+01
- PKER_RACCSS( 6, 5) = 0.242925E+01
- PKER_RACCSS( 6, 6) = 0.197670E+01
- PKER_RACCSS( 6, 7) = 0.151879E+01
- PKER_RACCSS( 6, 8) = 0.111427E+01
- PKER_RACCSS( 6, 9) = 0.802814E+00
- PKER_RACCSS( 6, 10) = 0.607776E+00
- PKER_RACCSS( 6, 11) = 0.534157E+00
- PKER_RACCSS( 6, 12) = 0.565946E+00
- PKER_RACCSS( 6, 13) = 0.667842E+00
- PKER_RACCSS( 6, 14) = 0.800760E+00
- PKER_RACCSS( 6, 15) = 0.934666E+00
- PKER_RACCSS( 6, 16) = 0.105437E+01
- PKER_RACCSS( 6, 17) = 0.115586E+01
- PKER_RACCSS( 6, 18) = 0.124029E+01
- PKER_RACCSS( 6, 19) = 0.131016E+01
- PKER_RACCSS( 6, 20) = 0.136794E+01
- PKER_RACCSS( 6, 21) = 0.141572E+01
- PKER_RACCSS( 6, 22) = 0.145524E+01
- PKER_RACCSS( 6, 23) = 0.148793E+01
- PKER_RACCSS( 6, 24) = 0.151498E+01
- PKER_RACCSS( 6, 25) = 0.153736E+01
- PKER_RACCSS( 6, 26) = 0.155588E+01
- PKER_RACCSS( 6, 27) = 0.157120E+01
- PKER_RACCSS( 6, 28) = 0.158388E+01
- PKER_RACCSS( 6, 29) = 0.159438E+01
- PKER_RACCSS( 6, 30) = 0.160306E+01
- PKER_RACCSS( 6, 31) = 0.161025E+01
- PKER_RACCSS( 6, 32) = 0.161620E+01
- PKER_RACCSS( 6, 33) = 0.162112E+01
- PKER_RACCSS( 6, 34) = 0.162520E+01
- PKER_RACCSS( 6, 35) = 0.162857E+01
- PKER_RACCSS( 6, 36) = 0.163136E+01
- PKER_RACCSS( 6, 37) = 0.163368E+01
- PKER_RACCSS( 6, 38) = 0.163559E+01
- PKER_RACCSS( 6, 39) = 0.163717E+01
- PKER_RACCSS( 6, 40) = 0.163848E+01
- PKER_RACCSS( 7, 1) = 0.190769E+01
- PKER_RACCSS( 7, 2) = 0.229809E+01
- PKER_RACCSS( 7, 3) = 0.231829E+01
- PKER_RACCSS( 7, 4) = 0.233168E+01
- PKER_RACCSS( 7, 5) = 0.215483E+01
- PKER_RACCSS( 7, 6) = 0.184641E+01
- PKER_RACCSS( 7, 7) = 0.147928E+01
- PKER_RACCSS( 7, 8) = 0.111943E+01
- PKER_RACCSS( 7, 9) = 0.817697E+00
- PKER_RACCSS( 7, 10) = 0.608172E+00
- PKER_RACCSS( 7, 11) = 0.505946E+00
- PKER_RACCSS( 7, 12) = 0.506193E+00
- PKER_RACCSS( 7, 13) = 0.584167E+00
- PKER_RACCSS( 7, 14) = 0.703639E+00
- PKER_RACCSS( 7, 15) = 0.832379E+00
- PKER_RACCSS( 7, 16) = 0.951052E+00
- PKER_RACCSS( 7, 17) = 0.105287E+01
- PKER_RACCSS( 7, 18) = 0.113779E+01
- PKER_RACCSS( 7, 19) = 0.120800E+01
- PKER_RACCSS( 7, 20) = 0.126597E+01
- PKER_RACCSS( 7, 21) = 0.131385E+01
- PKER_RACCSS( 7, 22) = 0.135343E+01
- PKER_RACCSS( 7, 23) = 0.138617E+01
- PKER_RACCSS( 7, 24) = 0.141326E+01
- PKER_RACCSS( 7, 25) = 0.143566E+01
- PKER_RACCSS( 7, 26) = 0.145420E+01
- PKER_RACCSS( 7, 27) = 0.146954E+01
- PKER_RACCSS( 7, 28) = 0.148224E+01
- PKER_RACCSS( 7, 29) = 0.149274E+01
- PKER_RACCSS( 7, 30) = 0.150143E+01
- PKER_RACCSS( 7, 31) = 0.150863E+01
- PKER_RACCSS( 7, 32) = 0.151458E+01
- PKER_RACCSS( 7, 33) = 0.151951E+01
- PKER_RACCSS( 7, 34) = 0.152359E+01
- PKER_RACCSS( 7, 35) = 0.152696E+01
- PKER_RACCSS( 7, 36) = 0.152975E+01
- PKER_RACCSS( 7, 37) = 0.153207E+01
- PKER_RACCSS( 7, 38) = 0.153398E+01
- PKER_RACCSS( 7, 39) = 0.153557E+01
- PKER_RACCSS( 7, 40) = 0.153688E+01
- PKER_RACCSS( 8, 1) = 0.245385E+01
- PKER_RACCSS( 8, 2) = 0.234012E+01
- PKER_RACCSS( 8, 3) = 0.230602E+01
- PKER_RACCSS( 8, 4) = 0.224183E+01
- PKER_RACCSS( 8, 5) = 0.208614E+01
- PKER_RACCSS( 8, 6) = 0.183109E+01
- PKER_RACCSS( 8, 7) = 0.151043E+01
- PKER_RACCSS( 8, 8) = 0.117425E+01
- PKER_RACCSS( 8, 9) = 0.872225E+00
- PKER_RACCSS( 8, 10) = 0.643228E+00
- PKER_RACCSS( 8, 11) = 0.509769E+00
- PKER_RACCSS( 8, 12) = 0.475368E+00
- PKER_RACCSS( 8, 13) = 0.523601E+00
- PKER_RACCSS( 8, 14) = 0.623040E+00
- PKER_RACCSS( 8, 15) = 0.741772E+00
- PKER_RACCSS( 8, 16) = 0.856619E+00
- PKER_RACCSS( 8, 17) = 0.957307E+00
- PKER_RACCSS( 8, 18) = 0.104196E+01
- PKER_RACCSS( 8, 19) = 0.111217E+01
- PKER_RACCSS( 8, 20) = 0.117022E+01
- PKER_RACCSS( 8, 21) = 0.121820E+01
- PKER_RACCSS( 8, 22) = 0.125786E+01
- PKER_RACCSS( 8, 23) = 0.129066E+01
- PKER_RACCSS( 8, 24) = 0.131779E+01
- PKER_RACCSS( 8, 25) = 0.134023E+01
- PKER_RACCSS( 8, 26) = 0.135879E+01
- PKER_RACCSS( 8, 27) = 0.137415E+01
- PKER_RACCSS( 8, 28) = 0.138686E+01
- PKER_RACCSS( 8, 29) = 0.139737E+01
- PKER_RACCSS( 8, 30) = 0.140607E+01
- PKER_RACCSS( 8, 31) = 0.141327E+01
- PKER_RACCSS( 8, 32) = 0.141923E+01
- PKER_RACCSS( 8, 33) = 0.142417E+01
- PKER_RACCSS( 8, 34) = 0.142825E+01
- PKER_RACCSS( 8, 35) = 0.143162E+01
- PKER_RACCSS( 8, 36) = 0.143442E+01
- PKER_RACCSS( 8, 37) = 0.143673E+01
- PKER_RACCSS( 8, 38) = 0.143865E+01
- PKER_RACCSS( 8, 39) = 0.144023E+01
- PKER_RACCSS( 8, 40) = 0.144155E+01
- PKER_RACCSS( 9, 1) = 0.224922E+01
- PKER_RACCSS( 9, 2) = 0.196699E+01
- PKER_RACCSS( 9, 3) = 0.185079E+01
- PKER_RACCSS( 9, 4) = 0.179999E+01
- PKER_RACCSS( 9, 5) = 0.172760E+01
- PKER_RACCSS( 9, 6) = 0.158533E+01
- PKER_RACCSS( 9, 7) = 0.136998E+01
- PKER_RACCSS( 9, 8) = 0.111090E+01
- PKER_RACCSS( 9, 9) = 0.851195E+00
- PKER_RACCSS( 9, 10) = 0.633967E+00
- PKER_RACCSS( 9, 11) = 0.490795E+00
- PKER_RACCSS( 9, 12) = 0.436162E+00
- PKER_RACCSS( 9, 13) = 0.463010E+00
- PKER_RACCSS( 9, 14) = 0.546483E+00
- PKER_RACCSS( 9, 15) = 0.656045E+00
- PKER_RACCSS( 9, 16) = 0.767183E+00
- PKER_RACCSS( 9, 17) = 0.866936E+00
- PKER_RACCSS( 9, 18) = 0.951616E+00
- PKER_RACCSS( 9, 19) = 0.102203E+01
- PKER_RACCSS( 9, 20) = 0.108025E+01
- PKER_RACCSS( 9, 21) = 0.112837E+01
- PKER_RACCSS( 9, 22) = 0.116813E+01
- PKER_RACCSS( 9, 23) = 0.120100E+01
- PKER_RACCSS( 9, 24) = 0.122818E+01
- PKER_RACCSS( 9, 25) = 0.125066E+01
- PKER_RACCSS( 9, 26) = 0.126925E+01
- PKER_RACCSS( 9, 27) = 0.128464E+01
- PKER_RACCSS( 9, 28) = 0.129736E+01
- PKER_RACCSS( 9, 29) = 0.130789E+01
- PKER_RACCSS( 9, 30) = 0.131660E+01
- PKER_RACCSS( 9, 31) = 0.132381E+01
- PKER_RACCSS( 9, 32) = 0.132977E+01
- PKER_RACCSS( 9, 33) = 0.133471E+01
- PKER_RACCSS( 9, 34) = 0.133879E+01
- PKER_RACCSS( 9, 35) = 0.134218E+01
- PKER_RACCSS( 9, 36) = 0.134497E+01
- PKER_RACCSS( 9, 37) = 0.134729E+01
- PKER_RACCSS( 9, 38) = 0.134921E+01
- PKER_RACCSS( 9, 39) = 0.135079E+01
- PKER_RACCSS( 9, 40) = 0.135210E+01
- PKER_RACCSS( 10, 1) = 0.267448E+01
- PKER_RACCSS( 10, 2) = 0.211116E+01
- PKER_RACCSS( 10, 3) = 0.179597E+01
- PKER_RACCSS( 10, 4) = 0.164129E+01
- PKER_RACCSS( 10, 5) = 0.155202E+01
- PKER_RACCSS( 10, 6) = 0.145102E+01
- PKER_RACCSS( 10, 7) = 0.129802E+01
- PKER_RACCSS( 10, 8) = 0.100198E+01
- PKER_RACCSS( 10, 9) = 0.798805E+00
- PKER_RACCSS( 10, 10) = 0.609306E+00
- PKER_RACCSS( 10, 11) = 0.468300E+00
- PKER_RACCSS( 10, 12) = 0.397888E+00
- PKER_RACCSS( 10, 13) = 0.402202E+00
- PKER_RACCSS( 10, 14) = 0.465769E+00
- PKER_RACCSS( 10, 15) = 0.561832E+00
- PKER_RACCSS( 10, 16) = 0.665528E+00
- PKER_RACCSS( 10, 17) = 0.762100E+00
- PKER_RACCSS( 10, 18) = 0.846900E+00
- PKER_RACCSS( 10, 19) = 0.920272E+00
- PKER_RACCSS( 10, 20) = 0.983415E+00
- PKER_RACCSS( 10, 21) = 0.103686E+01
- PKER_RACCSS( 10, 22) = 0.108076E+01
- PKER_RACCSS( 10, 23) = 0.111588E+01
- PKER_RACCSS( 10, 24) = 0.114389E+01
- PKER_RACCSS( 10, 25) = 0.116657E+01
- PKER_RACCSS( 10, 26) = 0.118522E+01
- PKER_RACCSS( 10, 27) = 0.120063E+01
- PKER_RACCSS( 10, 28) = 0.121338E+01
- PKER_RACCSS( 10, 29) = 0.122392E+01
- PKER_RACCSS( 10, 30) = 0.123264E+01
- PKER_RACCSS( 10, 31) = 0.123986E+01
- PKER_RACCSS( 10, 32) = 0.124583E+01
- PKER_RACCSS( 10, 33) = 0.125077E+01
- PKER_RACCSS( 10, 34) = 0.125486E+01
- PKER_RACCSS( 10, 35) = 0.125825E+01
- PKER_RACCSS( 10, 36) = 0.126105E+01
- PKER_RACCSS( 10, 37) = 0.126337E+01
- PKER_RACCSS( 10, 38) = 0.126529E+01
- PKER_RACCSS( 10, 39) = 0.126687E+01
- PKER_RACCSS( 10, 40) = 0.126819E+01
- PKER_RACCSS( 11, 1) = 0.438960E+01
- PKER_RACCSS( 11, 2) = 0.330822E+01
- PKER_RACCSS( 11, 3) = 0.253769E+01
- PKER_RACCSS( 11, 4) = 0.202024E+01
- PKER_RACCSS( 11, 5) = 0.168344E+01
- PKER_RACCSS( 11, 6) = 0.144904E+01
- PKER_RACCSS( 11, 7) = 0.125098E+01
- PKER_RACCSS( 11, 8) = 0.105254E+01
- PKER_RACCSS( 11, 9) = 0.847033E+00
- PKER_RACCSS( 11, 10) = 0.652528E+00
- PKER_RACCSS( 11, 11) = 0.496269E+00
- PKER_RACCSS( 11, 12) = 0.402314E+00
- PKER_RACCSS( 11, 13) = 0.381083E+00
- PKER_RACCSS( 11, 14) = 0.423713E+00
- PKER_RACCSS( 11, 15) = 0.507376E+00
- PKER_RACCSS( 11, 16) = 0.606481E+00
- PKER_RACCSS( 11, 17) = 0.702446E+00
- PKER_RACCSS( 11, 18) = 0.786685E+00
- PKER_RACCSS( 11, 19) = 0.857512E+00
- PKER_RACCSS( 11, 20) = 0.916202E+00
- PKER_RACCSS( 11, 21) = 0.964675E+00
- PKER_RACCSS( 11, 22) = 0.100470E+01
- PKER_RACCSS( 11, 23) = 0.103777E+01
- PKER_RACCSS( 11, 24) = 0.106509E+01
- PKER_RACCSS( 11, 25) = 0.108768E+01
- PKER_RACCSS( 11, 26) = 0.110635E+01
- PKER_RACCSS( 11, 27) = 0.112179E+01
- PKER_RACCSS( 11, 28) = 0.113456E+01
- PKER_RACCSS( 11, 29) = 0.114512E+01
- PKER_RACCSS( 11, 30) = 0.115386E+01
- PKER_RACCSS( 11, 31) = 0.116109E+01
- PKER_RACCSS( 11, 32) = 0.116707E+01
- PKER_RACCSS( 11, 33) = 0.117202E+01
- PKER_RACCSS( 11, 34) = 0.117612E+01
- PKER_RACCSS( 11, 35) = 0.117950E+01
- PKER_RACCSS( 11, 36) = 0.118231E+01
- PKER_RACCSS( 11, 37) = 0.118463E+01
- PKER_RACCSS( 11, 38) = 0.118655E+01
- PKER_RACCSS( 11, 39) = 0.118814E+01
- PKER_RACCSS( 11, 40) = 0.118945E+01
- PKER_RACCSS( 12, 1) = 0.644490E+01
- PKER_RACCSS( 12, 2) = 0.489285E+01
- PKER_RACCSS( 12, 3) = 0.369924E+01
- PKER_RACCSS( 12, 4) = 0.281547E+01
- PKER_RACCSS( 12, 5) = 0.218470E+01
- PKER_RACCSS( 12, 6) = 0.174091E+01
- PKER_RACCSS( 12, 7) = 0.141563E+01
- PKER_RACCSS( 12, 8) = 0.115240E+01
- PKER_RACCSS( 12, 9) = 0.918598E+00
- PKER_RACCSS( 12, 10) = 0.708473E+00
- PKER_RACCSS( 12, 11) = 0.534315E+00
- PKER_RACCSS( 12, 12) = 0.415659E+00
- PKER_RACCSS( 12, 13) = 0.365242E+00
- PKER_RACCSS( 12, 14) = 0.381199E+00
- PKER_RACCSS( 12, 15) = 0.446240E+00
- PKER_RACCSS( 12, 16) = 0.535561E+00
- PKER_RACCSS( 12, 17) = 0.627939E+00
- PKER_RACCSS( 12, 18) = 0.711443E+00
- PKER_RACCSS( 12, 19) = 0.782423E+00
- PKER_RACCSS( 12, 20) = 0.841400E+00
- PKER_RACCSS( 12, 21) = 0.890112E+00
- PKER_RACCSS( 12, 22) = 0.930317E+00
- PKER_RACCSS( 12, 23) = 0.963511E+00
- PKER_RACCSS( 12, 24) = 0.990930E+00
- PKER_RACCSS( 12, 25) = 0.101359E+01
- PKER_RACCSS( 12, 26) = 0.103231E+01
- PKER_RACCSS( 12, 27) = 0.104779E+01
- PKER_RACCSS( 12, 28) = 0.106059E+01
- PKER_RACCSS( 12, 29) = 0.107118E+01
- PKER_RACCSS( 12, 30) = 0.107993E+01
- PKER_RACCSS( 12, 31) = 0.108718E+01
- PKER_RACCSS( 12, 32) = 0.109317E+01
- PKER_RACCSS( 12, 33) = 0.109812E+01
- PKER_RACCSS( 12, 34) = 0.110223E+01
- PKER_RACCSS( 12, 35) = 0.110562E+01
- PKER_RACCSS( 12, 36) = 0.110843E+01
- PKER_RACCSS( 12, 37) = 0.111075E+01
- PKER_RACCSS( 12, 38) = 0.111267E+01
- PKER_RACCSS( 12, 39) = 0.111426E+01
- PKER_RACCSS( 12, 40) = 0.111558E+01
- PKER_RACCSS( 13, 1) = 0.821375E+01
- PKER_RACCSS( 13, 2) = 0.634241E+01
- PKER_RACCSS( 13, 3) = 0.484767E+01
- PKER_RACCSS( 13, 4) = 0.368088E+01
- PKER_RACCSS( 13, 5) = 0.279551E+01
- PKER_RACCSS( 13, 6) = 0.214135E+01
- PKER_RACCSS( 13, 7) = 0.166134E+01
- PKER_RACCSS( 13, 8) = 0.129978E+01
- PKER_RACCSS( 13, 9) = 0.101149E+01
- PKER_RACCSS( 13, 10) = 0.771525E+00
- PKER_RACCSS( 13, 11) = 0.575508E+00
- PKER_RACCSS( 13, 12) = 0.433638E+00
- PKER_RACCSS( 13, 13) = 0.356966E+00
- PKER_RACCSS( 13, 14) = 0.347546E+00
- PKER_RACCSS( 13, 15) = 0.392971E+00
- PKER_RACCSS( 13, 16) = 0.470881E+00
- PKER_RACCSS( 13, 17) = 0.558403E+00
- PKER_RACCSS( 13, 18) = 0.640646E+00
- PKER_RACCSS( 13, 19) = 0.711672E+00
- PKER_RACCSS( 13, 20) = 0.770965E+00
- PKER_RACCSS( 13, 21) = 0.819964E+00
- PKER_RACCSS( 13, 22) = 0.860385E+00
- PKER_RACCSS( 13, 23) = 0.893737E+00
- PKER_RACCSS( 13, 24) = 0.921271E+00
- PKER_RACCSS( 13, 25) = 0.944012E+00
- PKER_RACCSS( 13, 26) = 0.962802E+00
- PKER_RACCSS( 13, 27) = 0.978330E+00
- PKER_RACCSS( 13, 28) = 0.991167E+00
- PKER_RACCSS( 13, 29) = 0.100178E+01
- PKER_RACCSS( 13, 30) = 0.101056E+01
- PKER_RACCSS( 13, 31) = 0.101782E+01
- PKER_RACCSS( 13, 32) = 0.102382E+01
- PKER_RACCSS( 13, 33) = 0.102879E+01
- PKER_RACCSS( 13, 34) = 0.103290E+01
- PKER_RACCSS( 13, 35) = 0.103629E+01
- PKER_RACCSS( 13, 36) = 0.103911E+01
- PKER_RACCSS( 13, 37) = 0.104143E+01
- PKER_RACCSS( 13, 38) = 0.104336E+01
- PKER_RACCSS( 13, 39) = 0.104495E+01
- PKER_RACCSS( 13, 40) = 0.104627E+01
- PKER_RACCSS( 14, 1) = 0.962196E+01
- PKER_RACCSS( 14, 2) = 0.754772E+01
- PKER_RACCSS( 14, 3) = 0.585746E+01
- PKER_RACCSS( 14, 4) = 0.449802E+01
- PKER_RACCSS( 14, 5) = 0.342464E+01
- PKER_RACCSS( 14, 6) = 0.259558E+01
- PKER_RACCSS( 14, 7) = 0.196723E+01
- PKER_RACCSS( 14, 8) = 0.149396E+01
- PKER_RACCSS( 14, 9) = 0.113139E+01
- PKER_RACCSS( 14, 10) = 0.846874E+00
- PKER_RACCSS( 14, 11) = 0.622517E+00
- PKER_RACCSS( 14, 12) = 0.456965E+00
- PKER_RACCSS( 14, 13) = 0.355975E+00
- PKER_RACCSS( 14, 14) = 0.322342E+00
- PKER_RACCSS( 14, 15) = 0.347961E+00
- PKER_RACCSS( 14, 16) = 0.412683E+00
- PKER_RACCSS( 14, 17) = 0.493853E+00
- PKER_RACCSS( 14, 18) = 0.574086E+00
- PKER_RACCSS( 14, 19) = 0.644958E+00
- PKER_RACCSS( 14, 20) = 0.704578E+00
- PKER_RACCSS( 14, 21) = 0.753918E+00
- PKER_RACCSS( 14, 22) = 0.794601E+00
- PKER_RACCSS( 14, 23) = 0.828145E+00
- PKER_RACCSS( 14, 24) = 0.855821E+00
- PKER_RACCSS( 14, 25) = 0.878666E+00
- PKER_RACCSS( 14, 26) = 0.897532E+00
- PKER_RACCSS( 14, 27) = 0.913119E+00
- PKER_RACCSS( 14, 28) = 0.925999E+00
- PKER_RACCSS( 14, 29) = 0.936646E+00
- PKER_RACCSS( 14, 30) = 0.945448E+00
- PKER_RACCSS( 14, 31) = 0.952726E+00
- PKER_RACCSS( 14, 32) = 0.958745E+00
- PKER_RACCSS( 14, 33) = 0.963723E+00
- PKER_RACCSS( 14, 34) = 0.967840E+00
- PKER_RACCSS( 14, 35) = 0.971246E+00
- PKER_RACCSS( 14, 36) = 0.974064E+00
- PKER_RACCSS( 14, 37) = 0.976395E+00
- PKER_RACCSS( 14, 38) = 0.978324E+00
- PKER_RACCSS( 14, 39) = 0.979920E+00
- PKER_RACCSS( 14, 40) = 0.981240E+00
- PKER_RACCSS( 15, 1) = 0.106868E+02
- PKER_RACCSS( 15, 2) = 0.848836E+01
- PKER_RACCSS( 15, 3) = 0.667864E+01
- PKER_RACCSS( 15, 4) = 0.519913E+01
- PKER_RACCSS( 15, 5) = 0.400248E+01
- PKER_RACCSS( 15, 6) = 0.304893E+01
- PKER_RACCSS( 15, 7) = 0.230190E+01
- PKER_RACCSS( 15, 8) = 0.172540E+01
- PKER_RACCSS( 15, 9) = 0.128305E+01
- PKER_RACCSS( 15, 10) = 0.942921E+00
- PKER_RACCSS( 15, 11) = 0.681546E+00
- PKER_RACCSS( 15, 12) = 0.488662E+00
- PKER_RACCSS( 15, 13) = 0.363243E+00
- PKER_RACCSS( 15, 14) = 0.305913E+00
- PKER_RACCSS( 15, 15) = 0.310773E+00
- PKER_RACCSS( 15, 16) = 0.361021E+00
- PKER_RACCSS( 15, 17) = 0.434334E+00
- PKER_RACCSS( 15, 18) = 0.511636E+00
- PKER_RACCSS( 15, 19) = 0.582017E+00
- PKER_RACCSS( 15, 20) = 0.641937E+00
- PKER_RACCSS( 15, 21) = 0.691670E+00
- PKER_RACCSS( 15, 22) = 0.732672E+00
- PKER_RACCSS( 15, 23) = 0.766451E+00
- PKER_RACCSS( 15, 24) = 0.794298E+00
- PKER_RACCSS( 15, 25) = 0.817269E+00
- PKER_RACCSS( 15, 26) = 0.836230E+00
- PKER_RACCSS( 15, 27) = 0.851886E+00
- PKER_RACCSS( 15, 28) = 0.864819E+00
- PKER_RACCSS( 15, 29) = 0.875505E+00
- PKER_RACCSS( 15, 30) = 0.884338E+00
- PKER_RACCSS( 15, 31) = 0.891639E+00
- PKER_RACCSS( 15, 32) = 0.897676E+00
- PKER_RACCSS( 15, 33) = 0.902668E+00
- PKER_RACCSS( 15, 34) = 0.906796E+00
- PKER_RACCSS( 15, 35) = 0.910210E+00
- PKER_RACCSS( 15, 36) = 0.913035E+00
- PKER_RACCSS( 15, 37) = 0.915371E+00
- PKER_RACCSS( 15, 38) = 0.917303E+00
- PKER_RACCSS( 15, 39) = 0.918902E+00
- PKER_RACCSS( 15, 40) = 0.920225E+00
- PKER_RACCSS( 16, 1) = 0.118104E+02
- PKER_RACCSS( 16, 2) = 0.948935E+01
- PKER_RACCSS( 16, 3) = 0.756843E+01
- PKER_RACCSS( 16, 4) = 0.598312E+01
- PKER_RACCSS( 16, 5) = 0.468129E+01
- PKER_RACCSS( 16, 6) = 0.362054E+01
- PKER_RACCSS( 16, 7) = 0.276532E+01
- PKER_RACCSS( 16, 8) = 0.208437E+01
- PKER_RACCSS( 16, 9) = 0.154817E+01
- PKER_RACCSS( 16, 10) = 0.112992E+01
- PKER_RACCSS( 16, 11) = 0.807462E+00
- PKER_RACCSS( 16, 12) = 0.566759E+00
- PKER_RACCSS( 16, 13) = 0.401588E+00
- PKER_RACCSS( 16, 14) = 0.310627E+00
- PKER_RACCSS( 16, 15) = 0.287758E+00
- PKER_RACCSS( 16, 16) = 0.318300E+00
- PKER_RACCSS( 16, 17) = 0.380539E+00
- PKER_RACCSS( 16, 18) = 0.453291E+00
- PKER_RACCSS( 16, 19) = 0.522625E+00
- PKER_RACCSS( 16, 20) = 0.582754E+00
- PKER_RACCSS( 16, 21) = 0.632931E+00
- PKER_RACCSS( 16, 22) = 0.674315E+00
- PKER_RACCSS( 16, 23) = 0.708381E+00
- PKER_RACCSS( 16, 24) = 0.736437E+00
- PKER_RACCSS( 16, 25) = 0.759561E+00
- PKER_RACCSS( 16, 26) = 0.778635E+00
- PKER_RACCSS( 16, 27) = 0.794376E+00
- PKER_RACCSS( 16, 28) = 0.807373E+00
- PKER_RACCSS( 16, 29) = 0.818107E+00
- PKER_RACCSS( 16, 30) = 0.826976E+00
- PKER_RACCSS( 16, 31) = 0.834305E+00
- PKER_RACCSS( 16, 32) = 0.840364E+00
- PKER_RACCSS( 16, 33) = 0.845372E+00
- PKER_RACCSS( 16, 34) = 0.849513E+00
- PKER_RACCSS( 16, 35) = 0.852937E+00
- PKER_RACCSS( 16, 36) = 0.855769E+00
- PKER_RACCSS( 16, 37) = 0.858111E+00
- PKER_RACCSS( 16, 38) = 0.860049E+00
- PKER_RACCSS( 16, 39) = 0.861651E+00
- PKER_RACCSS( 16, 40) = 0.862977E+00
- PKER_RACCSS( 17, 1) = 0.124213E+02
- PKER_RACCSS( 17, 2) = 0.100509E+02
- PKER_RACCSS( 17, 3) = 0.808575E+01
- PKER_RACCSS( 17, 4) = 0.645799E+01
- PKER_RACCSS( 17, 5) = 0.511241E+01
- PKER_RACCSS( 17, 6) = 0.400412E+01
- PKER_RACCSS( 17, 7) = 0.309649E+01
- PKER_RACCSS( 17, 8) = 0.235922E+01
- PKER_RACCSS( 17, 9) = 0.176609E+01
- PKER_RACCSS( 17, 10) = 0.129457E+01
- PKER_RACCSS( 17, 11) = 0.925505E+00
- PKER_RACCSS( 17, 12) = 0.645198E+00
- PKER_RACCSS( 17, 13) = 0.445624E+00
- PKER_RACCSS( 17, 14) = 0.323478E+00
- PKER_RACCSS( 17, 15) = 0.273502E+00
- PKER_RACCSS( 17, 16) = 0.283242E+00
- PKER_RACCSS( 17, 17) = 0.332409E+00
- PKER_RACCSS( 17, 18) = 0.399085E+00
- PKER_RACCSS( 17, 19) = 0.466618E+00
- PKER_RACCSS( 17, 20) = 0.526766E+00
- PKER_RACCSS( 17, 21) = 0.577417E+00
- PKER_RACCSS( 17, 22) = 0.619256E+00
- PKER_RACCSS( 17, 23) = 0.653670E+00
- PKER_RACCSS( 17, 24) = 0.681981E+00
- PKER_RACCSS( 17, 25) = 0.705292E+00
- PKER_RACCSS( 17, 26) = 0.724504E+00
- PKER_RACCSS( 17, 27) = 0.740347E+00
- PKER_RACCSS( 17, 28) = 0.753421E+00
- PKER_RACCSS( 17, 29) = 0.764213E+00
- PKER_RACCSS( 17, 30) = 0.773126E+00
- PKER_RACCSS( 17, 31) = 0.780488E+00
- PKER_RACCSS( 17, 32) = 0.786572E+00
- PKER_RACCSS( 17, 33) = 0.791600E+00
- PKER_RACCSS( 17, 34) = 0.795757E+00
- PKER_RACCSS( 17, 35) = 0.799193E+00
- PKER_RACCSS( 17, 36) = 0.802034E+00
- PKER_RACCSS( 17, 37) = 0.804384E+00
- PKER_RACCSS( 17, 38) = 0.806327E+00
- PKER_RACCSS( 17, 39) = 0.807934E+00
- PKER_RACCSS( 17, 40) = 0.809263E+00
- PKER_RACCSS( 18, 1) = 0.128154E+02
- PKER_RACCSS( 18, 2) = 0.104204E+02
- PKER_RACCSS( 18, 3) = 0.843413E+01
- PKER_RACCSS( 18, 4) = 0.678683E+01
- PKER_RACCSS( 18, 5) = 0.542138E+01
- PKER_RACCSS( 18, 6) = 0.429102E+01
- PKER_RACCSS( 18, 7) = 0.335759E+01
- PKER_RACCSS( 18, 8) = 0.259006E+01
- PKER_RACCSS( 18, 9) = 0.196292E+01
- PKER_RACCSS( 18, 10) = 0.145521E+01
- PKER_RACCSS( 18, 11) = 0.105012E+01
- PKER_RACCSS( 18, 12) = 0.735213E+00
- PKER_RACCSS( 18, 13) = 0.502981E+00
- PKER_RACCSS( 18, 14) = 0.349702E+00
- PKER_RACCSS( 18, 15) = 0.270984E+00
- PKER_RACCSS( 18, 16) = 0.257444E+00
- PKER_RACCSS( 18, 17) = 0.290889E+00
- PKER_RACCSS( 18, 18) = 0.349332E+00
- PKER_RACCSS( 18, 19) = 0.413950E+00
- PKER_RACCSS( 18, 20) = 0.473752E+00
- PKER_RACCSS( 18, 21) = 0.524859E+00
- PKER_RACCSS( 18, 22) = 0.567227E+00
- PKER_RACCSS( 18, 23) = 0.602062E+00
- PKER_RACCSS( 18, 24) = 0.630684E+00
- PKER_RACCSS( 18, 25) = 0.654223E+00
- PKER_RACCSS( 18, 26) = 0.673602E+00
- PKER_RACCSS( 18, 27) = 0.689569E+00
- PKER_RACCSS( 18, 28) = 0.702735E+00
- PKER_RACCSS( 18, 29) = 0.713598E+00
- PKER_RACCSS( 18, 30) = 0.722563E+00
- PKER_RACCSS( 18, 31) = 0.729966E+00
- PKER_RACCSS( 18, 32) = 0.736081E+00
- PKER_RACCSS( 18, 33) = 0.741133E+00
- PKER_RACCSS( 18, 34) = 0.745308E+00
- PKER_RACCSS( 18, 35) = 0.748758E+00
- PKER_RACCSS( 18, 36) = 0.751610E+00
- PKER_RACCSS( 18, 37) = 0.753968E+00
- PKER_RACCSS( 18, 38) = 0.755918E+00
- PKER_RACCSS( 18, 39) = 0.757530E+00
- PKER_RACCSS( 18, 40) = 0.758863E+00
- PKER_RACCSS( 19, 1) = 0.130200E+02
- PKER_RACCSS( 19, 2) = 0.106194E+02
- PKER_RACCSS( 19, 3) = 0.861836E+01
- PKER_RACCSS( 19, 4) = 0.696790E+01
- PKER_RACCSS( 19, 5) = 0.559884E+01
- PKER_RACCSS( 19, 6) = 0.446351E+01
- PKER_RACCSS( 19, 7) = 0.352286E+01
- PKER_RACCSS( 19, 8) = 0.274506E+01
- PKER_RACCSS( 19, 9) = 0.210428E+01
- PKER_RACCSS( 19, 10) = 0.157967E+01
- PKER_RACCSS( 19, 11) = 0.115491E+01
- PKER_RACCSS( 19, 12) = 0.818114E+00
- PKER_RACCSS( 19, 13) = 0.561856E+00
- PKER_RACCSS( 19, 14) = 0.382552E+00
- PKER_RACCSS( 19, 15) = 0.277758E+00
- PKER_RACCSS( 19, 16) = 0.240448E+00
- PKER_RACCSS( 19, 17) = 0.256115E+00
- PKER_RACCSS( 19, 18) = 0.304240E+00
- PKER_RACCSS( 19, 19) = 0.364597E+00
- PKER_RACCSS( 19, 20) = 0.423522E+00
- PKER_RACCSS( 19, 21) = 0.475005E+00
- PKER_RACCSS( 19, 22) = 0.517969E+00
- PKER_RACCSS( 19, 23) = 0.553309E+00
- PKER_RACCSS( 19, 24) = 0.582308E+00
- PKER_RACCSS( 19, 25) = 0.606124E+00
- PKER_RACCSS( 19, 26) = 0.625706E+00
- PKER_RACCSS( 19, 27) = 0.641824E+00
- PKER_RACCSS( 19, 28) = 0.655102E+00
- PKER_RACCSS( 19, 29) = 0.666049E+00
- PKER_RACCSS( 19, 30) = 0.675078E+00
- PKER_RACCSS( 19, 31) = 0.682530E+00
- PKER_RACCSS( 19, 32) = 0.688681E+00
- PKER_RACCSS( 19, 33) = 0.693762E+00
- PKER_RACCSS( 19, 34) = 0.697958E+00
- PKER_RACCSS( 19, 35) = 0.701425E+00
- PKER_RACCSS( 19, 36) = 0.704291E+00
- PKER_RACCSS( 19, 37) = 0.706659E+00
- PKER_RACCSS( 19, 38) = 0.708617E+00
- PKER_RACCSS( 19, 39) = 0.710235E+00
- PKER_RACCSS( 19, 40) = 0.711573E+00
- PKER_RACCSS( 20, 1) = 0.130152E+02
- PKER_RACCSS( 20, 2) = 0.106128E+02
- PKER_RACCSS( 20, 3) = 0.862376E+01
- PKER_RACCSS( 20, 4) = 0.697519E+01
- PKER_RACCSS( 20, 5) = 0.560897E+01
- PKER_RACCSS( 20, 6) = 0.447725E+01
- PKER_RACCSS( 20, 7) = 0.354067E+01
- PKER_RACCSS( 20, 8) = 0.276691E+01
- PKER_RACCSS( 20, 9) = 0.212960E+01
- PKER_RACCSS( 20, 10) = 0.160726E+01
- PKER_RACCSS( 20, 11) = 0.118288E+01
- PKER_RACCSS( 20, 12) = 0.843836E+00
- PKER_RACCSS( 20, 13) = 0.582069E+00
- PKER_RACCSS( 20, 14) = 0.393463E+00
- PKER_RACCSS( 20, 15) = 0.276097E+00
- PKER_RACCSS( 20, 16) = 0.225467E+00
- PKER_RACCSS( 20, 17) = 0.230037E+00
- PKER_RACCSS( 20, 18) = 0.271189E+00
- PKER_RACCSS( 20, 19) = 0.328491E+00
- PKER_RACCSS( 20, 20) = 0.386520E+00
- PKER_RACCSS( 20, 21) = 0.437762E+00
- PKER_RACCSS( 20, 22) = 0.480551E+00
- PKER_RACCSS( 20, 23) = 0.515714E+00
- PKER_RACCSS( 20, 24) = 0.544556E+00
- PKER_RACCSS( 20, 25) = 0.568241E+00
- PKER_RACCSS( 20, 26) = 0.587716E+00
- PKER_RACCSS( 20, 27) = 0.603746E+00
- PKER_RACCSS( 20, 28) = 0.616952E+00
- PKER_RACCSS( 20, 29) = 0.627840E+00
- PKER_RACCSS( 20, 30) = 0.636822E+00
- PKER_RACCSS( 20, 31) = 0.644235E+00
- PKER_RACCSS( 20, 32) = 0.650356E+00
- PKER_RACCSS( 20, 33) = 0.655411E+00
- PKER_RACCSS( 20, 34) = 0.659588E+00
- PKER_RACCSS( 20, 35) = 0.663040E+00
- PKER_RACCSS( 20, 36) = 0.665893E+00
- PKER_RACCSS( 20, 37) = 0.668251E+00
- PKER_RACCSS( 20, 38) = 0.670201E+00
- PKER_RACCSS( 20, 39) = 0.671813E+00
- PKER_RACCSS( 20, 40) = 0.673146E+00
- PKER_RACCSS( 21, 1) = 0.131125E+02
- PKER_RACCSS( 21, 2) = 0.107140E+02
- PKER_RACCSS( 21, 3) = 0.872645E+01
- PKER_RACCSS( 21, 4) = 0.707917E+01
- PKER_RACCSS( 21, 5) = 0.571350E+01
- PKER_RACCSS( 21, 6) = 0.458184E+01
- PKER_RACCSS( 21, 7) = 0.364426E+01
- PKER_RACCSS( 21, 8) = 0.286816E+01
- PKER_RACCSS( 21, 9) = 0.222687E+01
- PKER_RACCSS( 21, 10) = 0.169872E+01
- PKER_RACCSS( 21, 11) = 0.126640E+01
- PKER_RACCSS( 21, 12) = 0.916826E+00
- PKER_RACCSS( 21, 13) = 0.641196E+00
- PKER_RACCSS( 21, 14) = 0.434976E+00
- PKER_RACCSS( 21, 15) = 0.296519E+00
- PKER_RACCSS( 21, 16) = 0.223392E+00
- PKER_RACCSS( 21, 17) = 0.208305E+00
- PKER_RACCSS( 21, 18) = 0.235749E+00
- PKER_RACCSS( 21, 19) = 0.285974E+00
- PKER_RACCSS( 21, 20) = 0.341761E+00
- PKER_RACCSS( 21, 21) = 0.393018E+00
- PKER_RACCSS( 21, 22) = 0.436400E+00
- PKER_RACCSS( 21, 23) = 0.472122E+00
- PKER_RACCSS( 21, 24) = 0.501385E+00
- PKER_RACCSS( 21, 25) = 0.525377E+00
- PKER_RACCSS( 21, 26) = 0.545076E+00
- PKER_RACCSS( 21, 27) = 0.561270E+00
- PKER_RACCSS( 21, 28) = 0.574597E+00
- PKER_RACCSS( 21, 29) = 0.585576E+00
- PKER_RACCSS( 21, 30) = 0.594625E+00
- PKER_RACCSS( 21, 31) = 0.602089E+00
- PKER_RACCSS( 21, 32) = 0.608249E+00
- PKER_RACCSS( 21, 33) = 0.613334E+00
- PKER_RACCSS( 21, 34) = 0.617533E+00
- PKER_RACCSS( 21, 35) = 0.621002E+00
- PKER_RACCSS( 21, 36) = 0.623868E+00
- PKER_RACCSS( 21, 37) = 0.626237E+00
- PKER_RACCSS( 21, 38) = 0.628195E+00
- PKER_RACCSS( 21, 39) = 0.629813E+00
- PKER_RACCSS( 21, 40) = 0.631151E+00
- PKER_RACCSS( 22, 1) = 0.131920E+02
- PKER_RACCSS( 22, 2) = 0.107956E+02
- PKER_RACCSS( 22, 3) = 0.880994E+01
- PKER_RACCSS( 22, 4) = 0.716437E+01
- PKER_RACCSS( 22, 5) = 0.580041E+01
- PKER_RACCSS( 22, 6) = 0.466975E+01
- PKER_RACCSS( 22, 7) = 0.373254E+01
- PKER_RACCSS( 22, 8) = 0.295593E+01
- PKER_RACCSS( 22, 9) = 0.231299E+01
- PKER_RACCSS( 22, 10) = 0.178176E+01
- PKER_RACCSS( 22, 11) = 0.134458E+01
- PKER_RACCSS( 22, 12) = 0.987803E+00
- PKER_RACCSS( 22, 13) = 0.701877E+00
- PKER_RACCSS( 22, 14) = 0.481371E+00
- PKER_RACCSS( 22, 15) = 0.324403E+00
- PKER_RACCSS( 22, 16) = 0.230380E+00
- PKER_RACCSS( 22, 17) = 0.194899E+00
- PKER_RACCSS( 22, 18) = 0.206478E+00
- PKER_RACCSS( 22, 19) = 0.247505E+00
- PKER_RACCSS( 22, 20) = 0.299696E+00
- PKER_RACCSS( 22, 21) = 0.350479E+00
- PKER_RACCSS( 22, 22) = 0.394413E+00
- PKER_RACCSS( 22, 23) = 0.430778E+00
- PKER_RACCSS( 22, 24) = 0.460550E+00
- PKER_RACCSS( 22, 25) = 0.484917E+00
- PKER_RACCSS( 22, 26) = 0.504890E+00
- PKER_RACCSS( 22, 27) = 0.521285E+00
- PKER_RACCSS( 22, 28) = 0.534760E+00
- PKER_RACCSS( 22, 29) = 0.545847E+00
- PKER_RACCSS( 22, 30) = 0.554978E+00
- PKER_RACCSS( 22, 31) = 0.562504E+00
- PKER_RACCSS( 22, 32) = 0.568710E+00
- PKER_RACCSS( 22, 33) = 0.573830E+00
- PKER_RACCSS( 22, 34) = 0.578056E+00
- PKER_RACCSS( 22, 35) = 0.581546E+00
- PKER_RACCSS( 22, 36) = 0.584428E+00
- PKER_RACCSS( 22, 37) = 0.586809E+00
- PKER_RACCSS( 22, 38) = 0.588777E+00
- PKER_RACCSS( 22, 39) = 0.590402E+00
- PKER_RACCSS( 22, 40) = 0.591746E+00
- PKER_RACCSS( 23, 1) = 0.131938E+02
- PKER_RACCSS( 23, 2) = 0.107982E+02
- PKER_RACCSS( 23, 3) = 0.881349E+01
- PKER_RACCSS( 23, 4) = 0.716907E+01
- PKER_RACCSS( 23, 5) = 0.580647E+01
- PKER_RACCSS( 23, 6) = 0.467739E+01
- PKER_RACCSS( 23, 7) = 0.374195E+01
- PKER_RACCSS( 23, 8) = 0.296730E+01
- PKER_RACCSS( 23, 9) = 0.232637E+01
- PKER_RACCSS( 23, 10) = 0.179707E+01
- PKER_RACCSS( 23, 11) = 0.136146E+01
- PKER_RACCSS( 23, 12) = 0.100542E+01
- PKER_RACCSS( 23, 13) = 0.718765E+00
- PKER_RACCSS( 23, 14) = 0.495225E+00
- PKER_RACCSS( 23, 15) = 0.332302E+00
- PKER_RACCSS( 23, 16) = 0.229655E+00
- PKER_RACCSS( 23, 17) = 0.184785E+00
- PKER_RACCSS( 23, 18) = 0.188568E+00
- PKER_RACCSS( 23, 19) = 0.224757E+00
- PKER_RACCSS( 23, 20) = 0.274870E+00
- PKER_RACCSS( 23, 21) = 0.324979E+00
- PKER_RACCSS( 23, 22) = 0.368651E+00
- PKER_RACCSS( 23, 23) = 0.404816E+00
- PKER_RACCSS( 23, 24) = 0.434406E+00
- PKER_RACCSS( 23, 25) = 0.458613E+00
- PKER_RACCSS( 23, 26) = 0.478450E+00
- PKER_RACCSS( 23, 27) = 0.494732E+00
- PKER_RACCSS( 23, 28) = 0.508114E+00
- PKER_RACCSS( 23, 29) = 0.519125E+00
- PKER_RACCSS( 23, 30) = 0.528193E+00
- PKER_RACCSS( 23, 31) = 0.535667E+00
- PKER_RACCSS( 23, 32) = 0.541832E+00
- PKER_RACCSS( 23, 33) = 0.546918E+00
- PKER_RACCSS( 23, 34) = 0.551118E+00
- PKER_RACCSS( 23, 35) = 0.554586E+00
- PKER_RACCSS( 23, 36) = 0.557451E+00
- PKER_RACCSS( 23, 37) = 0.559818E+00
- PKER_RACCSS( 23, 38) = 0.561775E+00
- PKER_RACCSS( 23, 39) = 0.563392E+00
- PKER_RACCSS( 23, 40) = 0.564729E+00
- PKER_RACCSS( 24, 1) = 0.132604E+02
- PKER_RACCSS( 24, 2) = 0.108662E+02
- PKER_RACCSS( 24, 3) = 0.888291E+01
- PKER_RACCSS( 24, 4) = 0.723981E+01
- PKER_RACCSS( 24, 5) = 0.587837E+01
- PKER_RACCSS( 24, 6) = 0.475021E+01
- PKER_RACCSS( 24, 7) = 0.381534E+01
- PKER_RACCSS( 24, 8) = 0.304075E+01
- PKER_RACCSS( 24, 9) = 0.239923E+01
- PKER_RACCSS( 24, 10) = 0.186846E+01
- PKER_RACCSS( 24, 11) = 0.143025E+01
- PKER_RACCSS( 24, 12) = 0.107011E+01
- PKER_RACCSS( 24, 13) = 0.777131E+00
- PKER_RACCSS( 24, 14) = 0.544102E+00
- PKER_RACCSS( 24, 15) = 0.367799E+00
- PKER_RACCSS( 24, 16) = 0.247847E+00
- PKER_RACCSS( 24, 17) = 0.183590E+00
- PKER_RACCSS( 24, 18) = 0.170001E+00
- PKER_RACCSS( 24, 19) = 0.194028E+00
- PKER_RACCSS( 24, 20) = 0.238143E+00
- PKER_RACCSS( 24, 21) = 0.286632E+00
- PKER_RACCSS( 24, 22) = 0.330592E+00
- PKER_RACCSS( 24, 23) = 0.367413E+00
- PKER_RACCSS( 24, 24) = 0.397561E+00
- PKER_RACCSS( 24, 25) = 0.422182E+00
- PKER_RACCSS( 24, 26) = 0.442320E+00
- PKER_RACCSS( 24, 27) = 0.458820E+00
- PKER_RACCSS( 24, 28) = 0.472362E+00
- PKER_RACCSS( 24, 29) = 0.483490E+00
- PKER_RACCSS( 24, 30) = 0.492645E+00
- PKER_RACCSS( 24, 31) = 0.500183E+00
- PKER_RACCSS( 24, 32) = 0.506396E+00
- PKER_RACCSS( 24, 33) = 0.511519E+00
- PKER_RACCSS( 24, 34) = 0.515746E+00
- PKER_RACCSS( 24, 35) = 0.519235E+00
- PKER_RACCSS( 24, 36) = 0.522116E+00
- PKER_RACCSS( 24, 37) = 0.524495E+00
- PKER_RACCSS( 24, 38) = 0.526461E+00
- PKER_RACCSS( 24, 39) = 0.528086E+00
- PKER_RACCSS( 24, 40) = 0.529428E+00
- PKER_RACCSS( 25, 1) = 0.132727E+02
- PKER_RACCSS( 25, 2) = 0.108791E+02
- PKER_RACCSS( 25, 3) = 0.889643E+01
- PKER_RACCSS( 25, 4) = 0.725400E+01
- PKER_RACCSS( 25, 5) = 0.589330E+01
- PKER_RACCSS( 25, 6) = 0.476595E+01
- PKER_RACCSS( 25, 7) = 0.383193E+01
- PKER_RACCSS( 25, 8) = 0.305823E+01
- PKER_RACCSS( 25, 9) = 0.241759E+01
- PKER_RACCSS( 25, 10) = 0.188761E+01
- PKER_RACCSS( 25, 11) = 0.145001E+01
- PKER_RACCSS( 25, 12) = 0.109002E+01
- PKER_RACCSS( 25, 13) = 0.796378E+00
- PKER_RACCSS( 25, 14) = 0.561248E+00
- PKER_RACCSS( 25, 15) = 0.380756E+00
- PKER_RACCSS( 25, 16) = 0.254180E+00
- PKER_RACCSS( 25, 17) = 0.181628E+00
- PKER_RACCSS( 25, 18) = 0.159817E+00
- PKER_RACCSS( 25, 19) = 0.177698E+00
- PKER_RACCSS( 25, 20) = 0.218491E+00
- PKER_RACCSS( 25, 21) = 0.265780E+00
- PKER_RACCSS( 25, 22) = 0.309426E+00
- PKER_RACCSS( 25, 23) = 0.346155E+00
- PKER_RACCSS( 25, 24) = 0.376229E+00
- PKER_RACCSS( 25, 25) = 0.400772E+00
- PKER_RACCSS( 25, 26) = 0.420833E+00
- PKER_RACCSS( 25, 27) = 0.437263E+00
- PKER_RACCSS( 25, 28) = 0.450741E+00
- PKER_RACCSS( 25, 29) = 0.461813E+00
- PKER_RACCSS( 25, 30) = 0.470921E+00
- PKER_RACCSS( 25, 31) = 0.478420E+00
- PKER_RACCSS( 25, 32) = 0.484599E+00
- PKER_RACCSS( 25, 33) = 0.489695E+00
- PKER_RACCSS( 25, 34) = 0.493900E+00
- PKER_RACCSS( 25, 35) = 0.497371E+00
- PKER_RACCSS( 25, 36) = 0.500237E+00
- PKER_RACCSS( 25, 37) = 0.502605E+00
- PKER_RACCSS( 25, 38) = 0.504561E+00
- PKER_RACCSS( 25, 39) = 0.506178E+00
- PKER_RACCSS( 25, 40) = 0.507515E+00
- PKER_RACCSS( 26, 1) = 0.132920E+02
- PKER_RACCSS( 26, 2) = 0.108989E+02
- PKER_RACCSS( 26, 3) = 0.891678E+01
- PKER_RACCSS( 26, 4) = 0.727493E+01
- PKER_RACCSS( 26, 5) = 0.591484E+01
- PKER_RACCSS( 26, 6) = 0.478808E+01
- PKER_RACCSS( 26, 7) = 0.385465E+01
- PKER_RACCSS( 26, 8) = 0.308150E+01
- PKER_RACCSS( 26, 9) = 0.244133E+01
- PKER_RACCSS( 26, 10) = 0.191165E+01
- PKER_RACCSS( 26, 11) = 0.147412E+01
- PKER_RACCSS( 26, 12) = 0.111377E+01
- PKER_RACCSS( 26, 13) = 0.819060E+00
- PKER_RACCSS( 26, 14) = 0.581616E+00
- PKER_RACCSS( 26, 15) = 0.396967E+00
- PKER_RACCSS( 26, 16) = 0.263905E+00
- PKER_RACCSS( 26, 17) = 0.183093E+00
- PKER_RACCSS( 26, 18) = 0.152502E+00
- PKER_RACCSS( 26, 19) = 0.163408E+00
- PKER_RACCSS( 26, 20) = 0.200211E+00
- PKER_RACCSS( 26, 21) = 0.245979E+00
- PKER_RACCSS( 26, 22) = 0.289323E+00
- PKER_RACCSS( 26, 23) = 0.326076E+00
- PKER_RACCSS( 26, 24) = 0.356191E+00
- PKER_RACCSS( 26, 25) = 0.380747E+00
- PKER_RACCSS( 26, 26) = 0.400802E+00
- PKER_RACCSS( 26, 27) = 0.417213E+00
- PKER_RACCSS( 26, 28) = 0.430667E+00
- PKER_RACCSS( 26, 29) = 0.441715E+00
- PKER_RACCSS( 26, 30) = 0.450799E+00
- PKER_RACCSS( 26, 31) = 0.458276E+00
- PKER_RACCSS( 26, 32) = 0.464436E+00
- PKER_RACCSS( 26, 33) = 0.469515E+00
- PKER_RACCSS( 26, 34) = 0.473706E+00
- PKER_RACCSS( 26, 35) = 0.477165E+00
- PKER_RACCSS( 26, 36) = 0.480022E+00
- PKER_RACCSS( 26, 37) = 0.482382E+00
- PKER_RACCSS( 26, 38) = 0.484332E+00
- PKER_RACCSS( 26, 39) = 0.485944E+00
- PKER_RACCSS( 26, 40) = 0.487277E+00
- PKER_RACCSS( 27, 1) = 0.133152E+02
- PKER_RACCSS( 27, 2) = 0.109226E+02
- PKER_RACCSS( 27, 3) = 0.894105E+01
- PKER_RACCSS( 27, 4) = 0.729974E+01
- PKER_RACCSS( 27, 5) = 0.594018E+01
- PKER_RACCSS( 27, 6) = 0.481393E+01
- PKER_RACCSS( 27, 7) = 0.388096E+01
- PKER_RACCSS( 27, 8) = 0.310819E+01
- PKER_RACCSS( 27, 9) = 0.246829E+01
- PKER_RACCSS( 27, 10) = 0.193872E+01
- PKER_RACCSS( 27, 11) = 0.150102E+01
- PKER_RACCSS( 27, 12) = 0.114014E+01
- PKER_RACCSS( 27, 13) = 0.844229E+00
- PKER_RACCSS( 27, 14) = 0.604486E+00
- PKER_RACCSS( 27, 15) = 0.415857E+00
- PKER_RACCSS( 27, 16) = 0.276675E+00
- PKER_RACCSS( 27, 17) = 0.187412E+00
- PKER_RACCSS( 27, 18) = 0.147742E+00
- PKER_RACCSS( 27, 19) = 0.150845E+00
- PKER_RACCSS( 27, 20) = 0.182865E+00
- PKER_RACCSS( 27, 21) = 0.226606E+00
- PKER_RACCSS( 27, 22) = 0.269575E+00
- PKER_RACCSS( 27, 23) = 0.306424E+00
- PKER_RACCSS( 27, 24) = 0.336671E+00
- PKER_RACCSS( 27, 25) = 0.361315E+00
- PKER_RACCSS( 27, 26) = 0.381419E+00
- PKER_RACCSS( 27, 27) = 0.397855E+00
- PKER_RACCSS( 27, 28) = 0.411319E+00
- PKER_RACCSS( 27, 29) = 0.422366E+00
- PKER_RACCSS( 27, 30) = 0.431444E+00
- PKER_RACCSS( 27, 31) = 0.438913E+00
- PKER_RACCSS( 27, 32) = 0.445065E+00
- PKER_RACCSS( 27, 33) = 0.450136E+00
- PKER_RACCSS( 27, 34) = 0.454319E+00
- PKER_RACCSS( 27, 35) = 0.457772E+00
- PKER_RACCSS( 27, 36) = 0.460623E+00
- PKER_RACCSS( 27, 37) = 0.462978E+00
- PKER_RACCSS( 27, 38) = 0.464924E+00
- PKER_RACCSS( 27, 39) = 0.466533E+00
- PKER_RACCSS( 27, 40) = 0.467862E+00
- PKER_RACCSS( 28, 1) = 0.133174E+02
- PKER_RACCSS( 28, 2) = 0.109250E+02
- PKER_RACCSS( 28, 3) = 0.894357E+01
- PKER_RACCSS( 28, 4) = 0.730246E+01
- PKER_RACCSS( 28, 5) = 0.594310E+01
- PKER_RACCSS( 28, 6) = 0.481710E+01
- PKER_RACCSS( 28, 7) = 0.388442E+01
- PKER_RACCSS( 28, 8) = 0.311196E+01
- PKER_RACCSS( 28, 9) = 0.247241E+01
- PKER_RACCSS( 28, 10) = 0.194320E+01
- PKER_RACCSS( 28, 11) = 0.150587E+01
- PKER_RACCSS( 28, 12) = 0.114529E+01
- PKER_RACCSS( 28, 13) = 0.849555E+00
- PKER_RACCSS( 28, 14) = 0.609651E+00
- PKER_RACCSS( 28, 15) = 0.420263E+00
- PKER_RACCSS( 28, 16) = 0.279397E+00
- PKER_RACCSS( 28, 17) = 0.187745E+00
- PKER_RACCSS( 28, 18) = 0.145098E+00
- PKER_RACCSS( 28, 19) = 0.145712E+00
- PKER_RACCSS( 28, 20) = 0.176041E+00
- PKER_RACCSS( 28, 21) = 0.219062E+00
- PKER_RACCSS( 28, 22) = 0.261729E+00
- PKER_RACCSS( 28, 23) = 0.298420E+00
- PKER_RACCSS( 28, 24) = 0.328533E+00
- PKER_RACCSS( 28, 25) = 0.353058E+00
- PKER_RACCSS( 28, 26) = 0.373058E+00
- PKER_RACCSS( 28, 27) = 0.389404E+00
- PKER_RACCSS( 28, 28) = 0.402791E+00
- PKER_RACCSS( 28, 29) = 0.413775E+00
- PKER_RACCSS( 28, 30) = 0.422800E+00
- PKER_RACCSS( 28, 31) = 0.430226E+00
- PKER_RACCSS( 28, 32) = 0.436342E+00
- PKER_RACCSS( 28, 33) = 0.441385E+00
- PKER_RACCSS( 28, 34) = 0.445545E+00
- PKER_RACCSS( 28, 35) = 0.448979E+00
- PKER_RACCSS( 28, 36) = 0.451815E+00
- PKER_RACCSS( 28, 37) = 0.454158E+00
- PKER_RACCSS( 28, 38) = 0.456095E+00
- PKER_RACCSS( 28, 39) = 0.457696E+00
- PKER_RACCSS( 28, 40) = 0.459020E+00
- PKER_RACCSS( 29, 1) = 0.133288E+02
- PKER_RACCSS( 29, 2) = 0.109367E+02
- PKER_RACCSS( 29, 3) = 0.895552E+01
- PKER_RACCSS( 29, 4) = 0.731466E+01
- PKER_RACCSS( 29, 5) = 0.595557E+01
- PKER_RACCSS( 29, 6) = 0.482983E+01
- PKER_RACCSS( 29, 7) = 0.389738E+01
- PKER_RACCSS( 29, 8) = 0.312513E+01
- PKER_RACCSS( 29, 9) = 0.248574E+01
- PKER_RACCSS( 29, 10) = 0.195663E+01
- PKER_RACCSS( 29, 11) = 0.151928E+01
- PKER_RACCSS( 29, 12) = 0.115855E+01
- PKER_RACCSS( 29, 13) = 0.862383E+00
- PKER_RACCSS( 29, 14) = 0.621546E+00
- PKER_RACCSS( 29, 15) = 0.430452E+00
- PKER_RACCSS( 29, 16) = 0.286744E+00
- PKER_RACCSS( 29, 17) = 0.191004E+00
- PKER_RACCSS( 29, 18) = 0.143575E+00
- PKER_RACCSS( 29, 19) = 0.139762E+00
- PKER_RACCSS( 29, 20) = 0.167150E+00
- PKER_RACCSS( 29, 21) = 0.208833E+00
- PKER_RACCSS( 29, 22) = 0.251165E+00
- PKER_RACCSS( 29, 23) = 0.287851E+00
- PKER_RACCSS( 29, 24) = 0.318000E+00
- PKER_RACCSS( 29, 25) = 0.342541E+00
- PKER_RACCSS( 29, 26) = 0.362540E+00
- PKER_RACCSS( 29, 27) = 0.378877E+00
- PKER_RACCSS( 29, 28) = 0.392249E+00
- PKER_RACCSS( 29, 29) = 0.403215E+00
- PKER_RACCSS( 29, 30) = 0.412224E+00
- PKER_RACCSS( 29, 31) = 0.419634E+00
- PKER_RACCSS( 29, 32) = 0.425736E+00
- PKER_RACCSS( 29, 33) = 0.430766E+00
- PKER_RACCSS( 29, 34) = 0.434916E+00
- PKER_RACCSS( 29, 35) = 0.438341E+00
- PKER_RACCSS( 29, 36) = 0.441170E+00
- PKER_RACCSS( 29, 37) = 0.443508E+00
- PKER_RACCSS( 29, 38) = 0.445440E+00
- PKER_RACCSS( 29, 39) = 0.447037E+00
- PKER_RACCSS( 29, 40) = 0.448358E+00
- PKER_RACCSS( 30, 1) = 0.133459E+02
- PKER_RACCSS( 30, 2) = 0.109540E+02
- PKER_RACCSS( 30, 3) = 0.897321E+01
- PKER_RACCSS( 30, 4) = 0.733267E+01
- PKER_RACCSS( 30, 5) = 0.597388E+01
- PKER_RACCSS( 30, 6) = 0.484841E+01
- PKER_RACCSS( 30, 7) = 0.391619E+01
- PKER_RACCSS( 30, 8) = 0.314412E+01
- PKER_RACCSS( 30, 9) = 0.250482E+01
- PKER_RACCSS( 30, 10) = 0.197571E+01
- PKER_RACCSS( 30, 11) = 0.153818E+01
- PKER_RACCSS( 30, 12) = 0.117710E+01
- PKER_RACCSS( 30, 13) = 0.880195E+00
- PKER_RACCSS( 30, 14) = 0.638053E+00
- PKER_RACCSS( 30, 15) = 0.444783E+00
- PKER_RACCSS( 30, 16) = 0.297652E+00
- PKER_RACCSS( 30, 17) = 0.196773E+00
- PKER_RACCSS( 30, 18) = 0.143267E+00
- PKER_RACCSS( 30, 19) = 0.133534E+00
- PKER_RACCSS( 30, 20) = 0.156845E+00
- PKER_RACCSS( 30, 21) = 0.196561E+00
- PKER_RACCSS( 30, 22) = 0.238416E+00
- PKER_RACCSS( 30, 23) = 0.275173E+00
- PKER_RACCSS( 30, 24) = 0.305462E+00
- PKER_RACCSS( 30, 25) = 0.330107E+00
- PKER_RACCSS( 30, 26) = 0.350172E+00
- PKER_RACCSS( 30, 27) = 0.366548E+00
- PKER_RACCSS( 30, 28) = 0.379943E+00
- PKER_RACCSS( 30, 29) = 0.390920E+00
- PKER_RACCSS( 30, 30) = 0.399933E+00
- PKER_RACCSS( 30, 31) = 0.407343E+00
- PKER_RACCSS( 30, 32) = 0.413443E+00
- PKER_RACCSS( 30, 33) = 0.418470E+00
- PKER_RACCSS( 30, 34) = 0.422617E+00
- PKER_RACCSS( 30, 35) = 0.426039E+00
- PKER_RACCSS( 30, 36) = 0.428865E+00
- PKER_RACCSS( 30, 37) = 0.431199E+00
- PKER_RACCSS( 30, 38) = 0.433129E+00
- PKER_RACCSS( 30, 39) = 0.434724E+00
- PKER_RACCSS( 30, 40) = 0.436043E+00
- PKER_RACCSS( 31, 1) = 0.133542E+02
- PKER_RACCSS( 31, 2) = 0.109625E+02
- PKER_RACCSS( 31, 3) = 0.898189E+01
- PKER_RACCSS( 31, 4) = 0.734152E+01
- PKER_RACCSS( 31, 5) = 0.598289E+01
- PKER_RACCSS( 31, 6) = 0.485757E+01
- PKER_RACCSS( 31, 7) = 0.392550E+01
- PKER_RACCSS( 31, 8) = 0.315354E+01
- PKER_RACCSS( 31, 9) = 0.251434E+01
- PKER_RACCSS( 31, 10) = 0.198527E+01
- PKER_RACCSS( 31, 11) = 0.154772E+01
- PKER_RACCSS( 31, 12) = 0.118655E+01
- PKER_RACCSS( 31, 13) = 0.889360E+00
- PKER_RACCSS( 31, 14) = 0.646660E+00
- PKER_RACCSS( 31, 15) = 0.452369E+00
- PKER_RACCSS( 31, 16) = 0.303553E+00
- PKER_RACCSS( 31, 17) = 0.200026E+00
- PKER_RACCSS( 31, 18) = 0.143287E+00
- PKER_RACCSS( 31, 19) = 0.130339E+00
- PKER_RACCSS( 31, 20) = 0.151258E+00
- PKER_RACCSS( 31, 21) = 0.189789E+00
- PKER_RACCSS( 31, 22) = 0.231305E+00
- PKER_RACCSS( 31, 23) = 0.268057E+00
- PKER_RACCSS( 31, 24) = 0.298394E+00
- PKER_RACCSS( 31, 25) = 0.323071E+00
- PKER_RACCSS( 31, 26) = 0.343153E+00
- PKER_RACCSS( 31, 27) = 0.359533E+00
- PKER_RACCSS( 31, 28) = 0.372926E+00
- PKER_RACCSS( 31, 29) = 0.383898E+00
- PKER_RACCSS( 31, 30) = 0.392903E+00
- PKER_RACCSS( 31, 31) = 0.400305E+00
- PKER_RACCSS( 31, 32) = 0.406398E+00
- PKER_RACCSS( 31, 33) = 0.411418E+00
- PKER_RACCSS( 31, 34) = 0.415558E+00
- PKER_RACCSS( 31, 35) = 0.418975E+00
- PKER_RACCSS( 31, 36) = 0.421797E+00
- PKER_RACCSS( 31, 37) = 0.424128E+00
- PKER_RACCSS( 31, 38) = 0.426055E+00
- PKER_RACCSS( 31, 39) = 0.427647E+00
- PKER_RACCSS( 31, 40) = 0.428965E+00
- PKER_RACCSS( 32, 1) = 0.133590E+02
- PKER_RACCSS( 32, 2) = 0.109675E+02
- PKER_RACCSS( 32, 3) = 0.898691E+01
- PKER_RACCSS( 32, 4) = 0.734663E+01
- PKER_RACCSS( 32, 5) = 0.598811E+01
- PKER_RACCSS( 32, 6) = 0.486289E+01
- PKER_RACCSS( 32, 7) = 0.393091E+01
- PKER_RACCSS( 32, 8) = 0.315903E+01
- PKER_RACCSS( 32, 9) = 0.251990E+01
- PKER_RACCSS( 32, 10) = 0.199087E+01
- PKER_RACCSS( 32, 11) = 0.155332E+01
- PKER_RACCSS( 32, 12) = 0.119212E+01
- PKER_RACCSS( 32, 13) = 0.894787E+00
- PKER_RACCSS( 32, 14) = 0.651780E+00
- PKER_RACCSS( 32, 15) = 0.456934E+00
- PKER_RACCSS( 32, 16) = 0.307161E+00
- PKER_RACCSS( 32, 17) = 0.202078E+00
- PKER_RACCSS( 32, 18) = 0.143390E+00
- PKER_RACCSS( 32, 19) = 0.128438E+00
- PKER_RACCSS( 32, 20) = 0.147873E+00
- PKER_RACCSS( 32, 21) = 0.185637E+00
- PKER_RACCSS( 32, 22) = 0.226925E+00
- PKER_RACCSS( 32, 23) = 0.263661E+00
- PKER_RACCSS( 32, 24) = 0.294017E+00
- PKER_RACCSS( 32, 25) = 0.318706E+00
- PKER_RACCSS( 32, 26) = 0.338791E+00
- PKER_RACCSS( 32, 27) = 0.355169E+00
- PKER_RACCSS( 32, 28) = 0.368556E+00
- PKER_RACCSS( 32, 29) = 0.379520E+00
- PKER_RACCSS( 32, 30) = 0.388518E+00
- PKER_RACCSS( 32, 31) = 0.395913E+00
- PKER_RACCSS( 32, 32) = 0.401999E+00
- PKER_RACCSS( 32, 33) = 0.407013E+00
- PKER_RACCSS( 32, 34) = 0.411148E+00
- PKER_RACCSS( 32, 35) = 0.414561E+00
- PKER_RACCSS( 32, 36) = 0.417379E+00
- PKER_RACCSS( 32, 37) = 0.419707E+00
- PKER_RACCSS( 32, 38) = 0.421631E+00
- PKER_RACCSS( 32, 39) = 0.423222E+00
- PKER_RACCSS( 32, 40) = 0.424538E+00
- PKER_RACCSS( 33, 1) = 0.133634E+02
- PKER_RACCSS( 33, 2) = 0.109719E+02
- PKER_RACCSS( 33, 3) = 0.899144E+01
- PKER_RACCSS( 33, 4) = 0.735125E+01
- PKER_RACCSS( 33, 5) = 0.599281E+01
- PKER_RACCSS( 33, 6) = 0.486766E+01
- PKER_RACCSS( 33, 7) = 0.393575E+01
- PKER_RACCSS( 33, 8) = 0.316394E+01
- PKER_RACCSS( 33, 9) = 0.252485E+01
- PKER_RACCSS( 33, 10) = 0.199585E+01
- PKER_RACCSS( 33, 11) = 0.155829E+01
- PKER_RACCSS( 33, 12) = 0.119704E+01
- PKER_RACCSS( 33, 13) = 0.899566E+00
- PKER_RACCSS( 33, 14) = 0.656282E+00
- PKER_RACCSS( 33, 15) = 0.460951E+00
- PKER_RACCSS( 33, 16) = 0.310395E+00
- PKER_RACCSS( 33, 17) = 0.203981E+00
- PKER_RACCSS( 33, 18) = 0.143650E+00
- PKER_RACCSS( 33, 19) = 0.126977E+00
- PKER_RACCSS( 33, 20) = 0.145114E+00
- PKER_RACCSS( 33, 21) = 0.182187E+00
- PKER_RACCSS( 33, 22) = 0.223272E+00
- PKER_RACCSS( 33, 23) = 0.260002E+00
- PKER_RACCSS( 33, 24) = 0.290386E+00
- PKER_RACCSS( 33, 25) = 0.315096E+00
- PKER_RACCSS( 33, 26) = 0.335192E+00
- PKER_RACCSS( 33, 27) = 0.351574E+00
- PKER_RACCSS( 33, 28) = 0.364961E+00
- PKER_RACCSS( 33, 29) = 0.375924E+00
- PKER_RACCSS( 33, 30) = 0.384918E+00
- PKER_RACCSS( 33, 31) = 0.392309E+00
- PKER_RACCSS( 33, 32) = 0.398391E+00
- PKER_RACCSS( 33, 33) = 0.403402E+00
- PKER_RACCSS( 33, 34) = 0.407534E+00
- PKER_RACCSS( 33, 35) = 0.410944E+00
- PKER_RACCSS( 33, 36) = 0.413760E+00
- PKER_RACCSS( 33, 37) = 0.416087E+00
- PKER_RACCSS( 33, 38) = 0.418009E+00
- PKER_RACCSS( 33, 39) = 0.419599E+00
- PKER_RACCSS( 33, 40) = 0.420913E+00
- PKER_RACCSS( 34, 1) = 0.133630E+02
- PKER_RACCSS( 34, 2) = 0.109715E+02
- PKER_RACCSS( 34, 3) = 0.899100E+01
- PKER_RACCSS( 34, 4) = 0.735081E+01
- PKER_RACCSS( 34, 5) = 0.599238E+01
- PKER_RACCSS( 34, 6) = 0.486725E+01
- PKER_RACCSS( 34, 7) = 0.393536E+01
- PKER_RACCSS( 34, 8) = 0.316356E+01
- PKER_RACCSS( 34, 9) = 0.252450E+01
- PKER_RACCSS( 34, 10) = 0.199554E+01
- PKER_RACCSS( 34, 11) = 0.155801E+01
- PKER_RACCSS( 34, 12) = 0.119682E+01
- PKER_RACCSS( 34, 13) = 0.899401E+00
- PKER_RACCSS( 34, 14) = 0.656145E+00
- PKER_RACCSS( 34, 15) = 0.460886E+00
- PKER_RACCSS( 34, 16) = 0.310328E+00
- PKER_RACCSS( 34, 17) = 0.203917E+00
- PKER_RACCSS( 34, 18) = 0.143502E+00
- PKER_RACCSS( 34, 19) = 0.126714E+00
- PKER_RACCSS( 34, 20) = 0.144814E+00
- PKER_RACCSS( 34, 21) = 0.181862E+00
- PKER_RACCSS( 34, 22) = 0.222931E+00
- PKER_RACCSS( 34, 23) = 0.259636E+00
- PKER_RACCSS( 34, 24) = 0.289994E+00
- PKER_RACCSS( 34, 25) = 0.314682E+00
- PKER_RACCSS( 34, 26) = 0.334759E+00
- PKER_RACCSS( 34, 27) = 0.351126E+00
- PKER_RACCSS( 34, 28) = 0.364500E+00
- PKER_RACCSS( 34, 29) = 0.375452E+00
- PKER_RACCSS( 34, 30) = 0.384438E+00
- PKER_RACCSS( 34, 31) = 0.391823E+00
- PKER_RACCSS( 34, 32) = 0.397899E+00
- PKER_RACCSS( 34, 33) = 0.402906E+00
- PKER_RACCSS( 34, 34) = 0.407035E+00
- PKER_RACCSS( 34, 35) = 0.410442E+00
- PKER_RACCSS( 34, 36) = 0.413255E+00
- PKER_RACCSS( 34, 37) = 0.415580E+00
- PKER_RACCSS( 34, 38) = 0.417501E+00
- PKER_RACCSS( 34, 39) = 0.419090E+00
- PKER_RACCSS( 34, 40) = 0.420403E+00
- PKER_RACCSS( 35, 1) = 0.133672E+02
- PKER_RACCSS( 35, 2) = 0.109758E+02
- PKER_RACCSS( 35, 3) = 0.899541E+01
- PKER_RACCSS( 35, 4) = 0.735530E+01
- PKER_RACCSS( 35, 5) = 0.599694E+01
- PKER_RACCSS( 35, 6) = 0.487187E+01
- PKER_RACCSS( 35, 7) = 0.394004E+01
- PKER_RACCSS( 35, 8) = 0.316829E+01
- PKER_RACCSS( 35, 9) = 0.252925E+01
- PKER_RACCSS( 35, 10) = 0.200030E+01
- PKER_RACCSS( 35, 11) = 0.156274E+01
- PKER_RACCSS( 35, 12) = 0.120148E+01
- PKER_RACCSS( 35, 13) = 0.903909E+00
- PKER_RACCSS( 35, 14) = 0.660382E+00
- PKER_RACCSS( 35, 15) = 0.464658E+00
- PKER_RACCSS( 35, 16) = 0.313423E+00
- PKER_RACCSS( 35, 17) = 0.205790E+00
- PKER_RACCSS( 35, 18) = 0.143918E+00
- PKER_RACCSS( 35, 19) = 0.125539E+00
- PKER_RACCSS( 35, 20) = 0.142455E+00
- PKER_RACCSS( 35, 21) = 0.178845E+00
- PKER_RACCSS( 35, 22) = 0.219725E+00
- PKER_RACCSS( 35, 23) = 0.256434E+00
- PKER_RACCSS( 35, 24) = 0.286832E+00
- PKER_RACCSS( 35, 25) = 0.311550E+00
- PKER_RACCSS( 35, 26) = 0.331648E+00
- PKER_RACCSS( 35, 27) = 0.348027E+00
- PKER_RACCSS( 35, 28) = 0.361408E+00
- PKER_RACCSS( 35, 29) = 0.372363E+00
- PKER_RACCSS( 35, 30) = 0.381350E+00
- PKER_RACCSS( 35, 31) = 0.388735E+00
- PKER_RACCSS( 35, 32) = 0.394811E+00
- PKER_RACCSS( 35, 33) = 0.399816E+00
- PKER_RACCSS( 35, 34) = 0.403944E+00
- PKER_RACCSS( 35, 35) = 0.407350E+00
- PKER_RACCSS( 35, 36) = 0.410162E+00
- PKER_RACCSS( 35, 37) = 0.412486E+00
- PKER_RACCSS( 35, 38) = 0.414407E+00
- PKER_RACCSS( 35, 39) = 0.415994E+00
- PKER_RACCSS( 35, 40) = 0.417308E+00
- PKER_RACCSS( 36, 1) = 0.133777E+02
- PKER_RACCSS( 36, 2) = 0.109864E+02
- PKER_RACCSS( 36, 3) = 0.900621E+01
- PKER_RACCSS( 36, 4) = 0.736627E+01
- PKER_RACCSS( 36, 5) = 0.600806E+01
- PKER_RACCSS( 36, 6) = 0.488314E+01
- PKER_RACCSS( 36, 7) = 0.395142E+01
- PKER_RACCSS( 36, 8) = 0.317976E+01
- PKER_RACCSS( 36, 9) = 0.254077E+01
- PKER_RACCSS( 36, 10) = 0.201180E+01
- PKER_RACCSS( 36, 11) = 0.157415E+01
- PKER_RACCSS( 36, 12) = 0.121269E+01
- PKER_RACCSS( 36, 13) = 0.914730E+00
- PKER_RACCSS( 36, 14) = 0.670578E+00
- PKER_RACCSS( 36, 15) = 0.473704E+00
- PKER_RACCSS( 36, 16) = 0.320913E+00
- PKER_RACCSS( 36, 17) = 0.210405E+00
- PKER_RACCSS( 36, 18) = 0.145253E+00
- PKER_RACCSS( 36, 19) = 0.123196E+00
- PKER_RACCSS( 36, 20) = 0.137328E+00
- PKER_RACCSS( 36, 21) = 0.172099E+00
- PKER_RACCSS( 36, 22) = 0.212483E+00
- PKER_RACCSS( 36, 23) = 0.249214E+00
- PKER_RACCSS( 36, 24) = 0.279734E+00
- PKER_RACCSS( 36, 25) = 0.304552E+00
- PKER_RACCSS( 36, 26) = 0.324719E+00
- PKER_RACCSS( 36, 27) = 0.341145E+00
- PKER_RACCSS( 36, 28) = 0.354556E+00
- PKER_RACCSS( 36, 29) = 0.365531E+00
- PKER_RACCSS( 36, 30) = 0.374530E+00
- PKER_RACCSS( 36, 31) = 0.381922E+00
- PKER_RACCSS( 36, 32) = 0.388003E+00
- PKER_RACCSS( 36, 33) = 0.393010E+00
- PKER_RACCSS( 36, 34) = 0.397139E+00
- PKER_RACCSS( 36, 35) = 0.400545E+00
- PKER_RACCSS( 36, 36) = 0.403358E+00
- PKER_RACCSS( 36, 37) = 0.405681E+00
- PKER_RACCSS( 36, 38) = 0.407601E+00
- PKER_RACCSS( 36, 39) = 0.409189E+00
- PKER_RACCSS( 36, 40) = 0.410501E+00
+ PKER_RACCSS( 1, 1) = 0.778513E+01
+ PKER_RACCSS( 1, 2) = 0.611693E+01
+ PKER_RACCSS( 1, 3) = 0.469673E+01
+ PKER_RACCSS( 1, 4) = 0.351291E+01
+ PKER_RACCSS( 1, 5) = 0.255165E+01
+ PKER_RACCSS( 1, 6) = 0.180370E+01
+ PKER_RACCSS( 1, 7) = 0.126294E+01
+ PKER_RACCSS( 1, 8) = 0.924202E+00
+ PKER_RACCSS( 1, 9) = 0.775231E+00
+ PKER_RACCSS( 1, 10) = 0.787292E+00
+ PKER_RACCSS( 1, 11) = 0.911536E+00
+ PKER_RACCSS( 1, 12) = 0.109094E+01
+ PKER_RACCSS( 1, 13) = 0.127926E+01
+ PKER_RACCSS( 1, 14) = 0.145083E+01
+ PKER_RACCSS( 1, 15) = 0.159745E+01
+ PKER_RACCSS( 1, 16) = 0.171978E+01
+ PKER_RACCSS( 1, 17) = 0.182114E+01
+ PKER_RACCSS( 1, 18) = 0.190501E+01
+ PKER_RACCSS( 1, 19) = 0.197441E+01
+ PKER_RACCSS( 1, 20) = 0.203184E+01
+ PKER_RACCSS( 1, 21) = 0.207937E+01
+ PKER_RACCSS( 1, 22) = 0.211870E+01
+ PKER_RACCSS( 1, 23) = 0.215125E+01
+ PKER_RACCSS( 1, 24) = 0.217819E+01
+ PKER_RACCSS( 1, 25) = 0.220049E+01
+ PKER_RACCSS( 1, 26) = 0.221895E+01
+ PKER_RACCSS( 1, 27) = 0.223423E+01
+ PKER_RACCSS( 1, 28) = 0.224687E+01
+ PKER_RACCSS( 1, 29) = 0.225734E+01
+ PKER_RACCSS( 1, 30) = 0.226601E+01
+ PKER_RACCSS( 1, 31) = 0.227318E+01
+ PKER_RACCSS( 1, 32) = 0.227911E+01
+ PKER_RACCSS( 1, 33) = 0.228403E+01
+ PKER_RACCSS( 1, 34) = 0.228810E+01
+ PKER_RACCSS( 1, 35) = 0.229146E+01
+ PKER_RACCSS( 1, 36) = 0.229425E+01
+ PKER_RACCSS( 1, 37) = 0.229656E+01
+ PKER_RACCSS( 1, 38) = 0.229847E+01
+ PKER_RACCSS( 1, 39) = 0.230005E+01
+ PKER_RACCSS( 1, 40) = 0.230136E+01
+ PKER_RACCSS( 2, 1) = 0.777519E+01
+ PKER_RACCSS( 2, 2) = 0.620120E+01
+ PKER_RACCSS( 2, 3) = 0.482130E+01
+ PKER_RACCSS( 2, 4) = 0.365151E+01
+ PKER_RACCSS( 2, 5) = 0.268556E+01
+ PKER_RACCSS( 2, 6) = 0.191605E+01
+ PKER_RACCSS( 2, 7) = 0.134047E+01
+ PKER_RACCSS( 2, 8) = 0.956677E+00
+ PKER_RACCSS( 2, 9) = 0.757265E+00
+ PKER_RACCSS( 2, 10) = 0.720633E+00
+ PKER_RACCSS( 2, 11) = 0.806882E+00
+ PKER_RACCSS( 2, 12) = 0.963181E+00
+ PKER_RACCSS( 2, 13) = 0.114076E+01
+ PKER_RACCSS( 2, 14) = 0.130870E+01
+ PKER_RACCSS( 2, 15) = 0.145451E+01
+ PKER_RACCSS( 2, 16) = 0.157680E+01
+ PKER_RACCSS( 2, 17) = 0.167825E+01
+ PKER_RACCSS( 2, 18) = 0.176221E+01
+ PKER_RACCSS( 2, 19) = 0.183168E+01
+ PKER_RACCSS( 2, 20) = 0.188915E+01
+ PKER_RACCSS( 2, 21) = 0.193671E+01
+ PKER_RACCSS( 2, 22) = 0.197607E+01
+ PKER_RACCSS( 2, 23) = 0.200864E+01
+ PKER_RACCSS( 2, 24) = 0.203559E+01
+ PKER_RACCSS( 2, 25) = 0.205790E+01
+ PKER_RACCSS( 2, 26) = 0.207637E+01
+ PKER_RACCSS( 2, 27) = 0.209165E+01
+ PKER_RACCSS( 2, 28) = 0.210430E+01
+ PKER_RACCSS( 2, 29) = 0.211478E+01
+ PKER_RACCSS( 2, 30) = 0.212344E+01
+ PKER_RACCSS( 2, 31) = 0.213062E+01
+ PKER_RACCSS( 2, 32) = 0.213656E+01
+ PKER_RACCSS( 2, 33) = 0.214147E+01
+ PKER_RACCSS( 2, 34) = 0.214554E+01
+ PKER_RACCSS( 2, 35) = 0.214891E+01
+ PKER_RACCSS( 2, 36) = 0.215170E+01
+ PKER_RACCSS( 2, 37) = 0.215401E+01
+ PKER_RACCSS( 2, 38) = 0.215592E+01
+ PKER_RACCSS( 2, 39) = 0.215750E+01
+ PKER_RACCSS( 2, 40) = 0.215881E+01
+ PKER_RACCSS( 3, 1) = 0.762215E+01
+ PKER_RACCSS( 3, 2) = 0.621106E+01
+ PKER_RACCSS( 3, 3) = 0.490698E+01
+ PKER_RACCSS( 3, 4) = 0.376761E+01
+ PKER_RACCSS( 3, 5) = 0.280896E+01
+ PKER_RACCSS( 3, 6) = 0.202903E+01
+ PKER_RACCSS( 3, 7) = 0.142689E+01
+ PKER_RACCSS( 3, 8) = 0.100388E+01
+ PKER_RACCSS( 3, 9) = 0.757013E+00
+ PKER_RACCSS( 3, 10) = 0.673206E+00
+ PKER_RACCSS( 3, 11) = 0.719335E+00
+ PKER_RACCSS( 3, 12) = 0.849040E+00
+ PKER_RACCSS( 3, 13) = 0.101307E+01
+ PKER_RACCSS( 3, 14) = 0.117592E+01
+ PKER_RACCSS( 3, 15) = 0.132041E+01
+ PKER_RACCSS( 3, 16) = 0.144256E+01
+ PKER_RACCSS( 3, 17) = 0.154410E+01
+ PKER_RACCSS( 3, 18) = 0.162816E+01
+ PKER_RACCSS( 3, 19) = 0.169770E+01
+ PKER_RACCSS( 3, 20) = 0.175523E+01
+ PKER_RACCSS( 3, 21) = 0.180284E+01
+ PKER_RACCSS( 3, 22) = 0.184222E+01
+ PKER_RACCSS( 3, 23) = 0.187482E+01
+ PKER_RACCSS( 3, 24) = 0.190179E+01
+ PKER_RACCSS( 3, 25) = 0.192411E+01
+ PKER_RACCSS( 3, 26) = 0.194259E+01
+ PKER_RACCSS( 3, 27) = 0.195788E+01
+ PKER_RACCSS( 3, 28) = 0.197054E+01
+ PKER_RACCSS( 3, 29) = 0.198101E+01
+ PKER_RACCSS( 3, 30) = 0.198968E+01
+ PKER_RACCSS( 3, 31) = 0.199686E+01
+ PKER_RACCSS( 3, 32) = 0.200280E+01
+ PKER_RACCSS( 3, 33) = 0.200772E+01
+ PKER_RACCSS( 3, 34) = 0.201179E+01
+ PKER_RACCSS( 3, 35) = 0.201516E+01
+ PKER_RACCSS( 3, 36) = 0.201795E+01
+ PKER_RACCSS( 3, 37) = 0.202026E+01
+ PKER_RACCSS( 3, 38) = 0.202217E+01
+ PKER_RACCSS( 3, 39) = 0.202375E+01
+ PKER_RACCSS( 3, 40) = 0.202506E+01
+ PKER_RACCSS( 4, 1) = 0.726688E+01
+ PKER_RACCSS( 4, 2) = 0.610352E+01
+ PKER_RACCSS( 4, 3) = 0.493154E+01
+ PKER_RACCSS( 4, 4) = 0.385226E+01
+ PKER_RACCSS( 4, 5) = 0.291497E+01
+ PKER_RACCSS( 4, 6) = 0.213576E+01
+ PKER_RACCSS( 4, 7) = 0.151726E+01
+ PKER_RACCSS( 4, 8) = 0.106239E+01
+ PKER_RACCSS( 4, 9) = 0.773458E+00
+ PKER_RACCSS( 4, 10) = 0.643197E+00
+ PKER_RACCSS( 4, 11) = 0.648455E+00
+ PKER_RACCSS( 4, 12) = 0.748702E+00
+ PKER_RACCSS( 4, 13) = 0.896286E+00
+ PKER_RACCSS( 4, 14) = 0.105225E+01
+ PKER_RACCSS( 4, 15) = 0.119469E+01
+ PKER_RACCSS( 4, 16) = 0.131651E+01
+ PKER_RACCSS( 4, 17) = 0.141813E+01
+ PKER_RACCSS( 4, 18) = 0.150231E+01
+ PKER_RACCSS( 4, 19) = 0.157195E+01
+ PKER_RACCSS( 4, 20) = 0.162955E+01
+ PKER_RACCSS( 4, 21) = 0.167720E+01
+ PKER_RACCSS( 4, 22) = 0.171662E+01
+ PKER_RACCSS( 4, 23) = 0.174924E+01
+ PKER_RACCSS( 4, 24) = 0.177624E+01
+ PKER_RACCSS( 4, 25) = 0.179858E+01
+ PKER_RACCSS( 4, 26) = 0.181706E+01
+ PKER_RACCSS( 4, 27) = 0.183237E+01
+ PKER_RACCSS( 4, 28) = 0.184503E+01
+ PKER_RACCSS( 4, 29) = 0.185551E+01
+ PKER_RACCSS( 4, 30) = 0.186419E+01
+ PKER_RACCSS( 4, 31) = 0.187137E+01
+ PKER_RACCSS( 4, 32) = 0.187731E+01
+ PKER_RACCSS( 4, 33) = 0.188223E+01
+ PKER_RACCSS( 4, 34) = 0.188630E+01
+ PKER_RACCSS( 4, 35) = 0.188967E+01
+ PKER_RACCSS( 4, 36) = 0.189246E+01
+ PKER_RACCSS( 4, 37) = 0.189477E+01
+ PKER_RACCSS( 4, 38) = 0.189668E+01
+ PKER_RACCSS( 4, 39) = 0.189826E+01
+ PKER_RACCSS( 4, 40) = 0.189957E+01
+ PKER_RACCSS( 5, 1) = 0.666156E+01
+ PKER_RACCSS( 5, 2) = 0.583010E+01
+ PKER_RACCSS( 5, 3) = 0.485991E+01
+ PKER_RACCSS( 5, 4) = 0.388726E+01
+ PKER_RACCSS( 5, 5) = 0.299622E+01
+ PKER_RACCSS( 5, 6) = 0.223002E+01
+ PKER_RACCSS( 5, 7) = 0.160523E+01
+ PKER_RACCSS( 5, 8) = 0.112806E+01
+ PKER_RACCSS( 5, 9) = 0.803444E+00
+ PKER_RACCSS( 5, 10) = 0.630781E+00
+ PKER_RACCSS( 5, 11) = 0.594728E+00
+ PKER_RACCSS( 5, 12) = 0.662791E+00
+ PKER_RACCSS( 5, 13) = 0.790719E+00
+ PKER_RACCSS( 5, 14) = 0.937530E+00
+ PKER_RACCSS( 5, 15) = 0.107695E+01
+ PKER_RACCSS( 5, 16) = 0.119816E+01
+ PKER_RACCSS( 5, 17) = 0.129982E+01
+ PKER_RACCSS( 5, 18) = 0.138414E+01
+ PKER_RACCSS( 5, 19) = 0.145388E+01
+ PKER_RACCSS( 5, 20) = 0.151157E+01
+ PKER_RACCSS( 5, 21) = 0.155928E+01
+ PKER_RACCSS( 5, 22) = 0.159875E+01
+ PKER_RACCSS( 5, 23) = 0.163140E+01
+ PKER_RACCSS( 5, 24) = 0.165842E+01
+ PKER_RACCSS( 5, 25) = 0.168078E+01
+ PKER_RACCSS( 5, 26) = 0.169928E+01
+ PKER_RACCSS( 5, 27) = 0.171459E+01
+ PKER_RACCSS( 5, 28) = 0.172727E+01
+ PKER_RACCSS( 5, 29) = 0.173775E+01
+ PKER_RACCSS( 5, 30) = 0.174643E+01
+ PKER_RACCSS( 5, 31) = 0.175362E+01
+ PKER_RACCSS( 5, 32) = 0.175957E+01
+ PKER_RACCSS( 5, 33) = 0.176449E+01
+ PKER_RACCSS( 5, 34) = 0.176856E+01
+ PKER_RACCSS( 5, 35) = 0.177193E+01
+ PKER_RACCSS( 5, 36) = 0.177472E+01
+ PKER_RACCSS( 5, 37) = 0.177703E+01
+ PKER_RACCSS( 5, 38) = 0.177895E+01
+ PKER_RACCSS( 5, 39) = 0.178053E+01
+ PKER_RACCSS( 5, 40) = 0.178184E+01
+ PKER_RACCSS( 6, 1) = 0.579411E+01
+ PKER_RACCSS( 6, 2) = 0.535171E+01
+ PKER_RACCSS( 6, 3) = 0.465234E+01
+ PKER_RACCSS( 6, 4) = 0.384358E+01
+ PKER_RACCSS( 6, 5) = 0.303756E+01
+ PKER_RACCSS( 6, 6) = 0.230559E+01
+ PKER_RACCSS( 6, 7) = 0.168583E+01
+ PKER_RACCSS( 6, 8) = 0.119580E+01
+ PKER_RACCSS( 6, 9) = 0.843934E+00
+ PKER_RACCSS( 6, 10) = 0.633155E+00
+ PKER_RACCSS( 6, 11) = 0.557339E+00
+ PKER_RACCSS( 6, 12) = 0.591240E+00
+ PKER_RACCSS( 6, 13) = 0.696457E+00
+ PKER_RACCSS( 6, 14) = 0.831746E+00
+ PKER_RACCSS( 6, 15) = 0.966879E+00
+ PKER_RACCSS( 6, 16) = 0.108705E+01
+ PKER_RACCSS( 6, 17) = 0.118868E+01
+ PKER_RACCSS( 6, 18) = 0.127314E+01
+ PKER_RACCSS( 6, 19) = 0.134302E+01
+ PKER_RACCSS( 6, 20) = 0.140081E+01
+ PKER_RACCSS( 6, 21) = 0.144859E+01
+ PKER_RACCSS( 6, 22) = 0.148812E+01
+ PKER_RACCSS( 6, 23) = 0.152081E+01
+ PKER_RACCSS( 6, 24) = 0.154786E+01
+ PKER_RACCSS( 6, 25) = 0.157025E+01
+ PKER_RACCSS( 6, 26) = 0.158876E+01
+ PKER_RACCSS( 6, 27) = 0.160409E+01
+ PKER_RACCSS( 6, 28) = 0.161677E+01
+ PKER_RACCSS( 6, 29) = 0.162727E+01
+ PKER_RACCSS( 6, 30) = 0.163595E+01
+ PKER_RACCSS( 6, 31) = 0.164314E+01
+ PKER_RACCSS( 6, 32) = 0.164909E+01
+ PKER_RACCSS( 6, 33) = 0.165402E+01
+ PKER_RACCSS( 6, 34) = 0.165809E+01
+ PKER_RACCSS( 6, 35) = 0.166147E+01
+ PKER_RACCSS( 6, 36) = 0.166426E+01
+ PKER_RACCSS( 6, 37) = 0.166657E+01
+ PKER_RACCSS( 6, 38) = 0.166848E+01
+ PKER_RACCSS( 6, 39) = 0.167007E+01
+ PKER_RACCSS( 6, 40) = 0.167138E+01
+ PKER_RACCSS( 7, 1) = 0.471256E+01
+ PKER_RACCSS( 7, 2) = 0.465839E+01
+ PKER_RACCSS( 7, 3) = 0.427722E+01
+ PKER_RACCSS( 7, 4) = 0.368892E+01
+ PKER_RACCSS( 7, 5) = 0.301520E+01
+ PKER_RACCSS( 7, 6) = 0.234970E+01
+ PKER_RACCSS( 7, 7) = 0.175327E+01
+ PKER_RACCSS( 7, 8) = 0.126056E+01
+ PKER_RACCSS( 7, 9) = 0.889610E+00
+ PKER_RACCSS( 7, 10) = 0.648011E+00
+ PKER_RACCSS( 7, 11) = 0.534534E+00
+ PKER_RACCSS( 7, 12) = 0.533743E+00
+ PKER_RACCSS( 7, 13) = 0.613806E+00
+ PKER_RACCSS( 7, 14) = 0.735010E+00
+ PKER_RACCSS( 7, 15) = 0.864301E+00
+ PKER_RACCSS( 7, 16) = 0.982807E+00
+ PKER_RACCSS( 7, 17) = 0.108425E+01
+ PKER_RACCSS( 7, 18) = 0.116886E+01
+ PKER_RACCSS( 7, 19) = 0.123890E+01
+ PKER_RACCSS( 7, 20) = 0.129681E+01
+ PKER_RACCSS( 7, 21) = 0.134469E+01
+ PKER_RACCSS( 7, 22) = 0.138428E+01
+ PKER_RACCSS( 7, 23) = 0.141702E+01
+ PKER_RACCSS( 7, 24) = 0.144411E+01
+ PKER_RACCSS( 7, 25) = 0.146652E+01
+ PKER_RACCSS( 7, 26) = 0.148506E+01
+ PKER_RACCSS( 7, 27) = 0.150040E+01
+ PKER_RACCSS( 7, 28) = 0.151309E+01
+ PKER_RACCSS( 7, 29) = 0.152360E+01
+ PKER_RACCSS( 7, 30) = 0.153229E+01
+ PKER_RACCSS( 7, 31) = 0.153949E+01
+ PKER_RACCSS( 7, 32) = 0.154544E+01
+ PKER_RACCSS( 7, 33) = 0.155037E+01
+ PKER_RACCSS( 7, 34) = 0.155445E+01
+ PKER_RACCSS( 7, 35) = 0.155782E+01
+ PKER_RACCSS( 7, 36) = 0.156062E+01
+ PKER_RACCSS( 7, 37) = 0.156293E+01
+ PKER_RACCSS( 7, 38) = 0.156484E+01
+ PKER_RACCSS( 7, 39) = 0.156643E+01
+ PKER_RACCSS( 7, 40) = 0.156774E+01
+ PKER_RACCSS( 8, 1) = 0.353255E+01
+ PKER_RACCSS( 8, 2) = 0.378953E+01
+ PKER_RACCSS( 8, 3) = 0.372636E+01
+ PKER_RACCSS( 8, 4) = 0.339746E+01
+ PKER_RACCSS( 8, 5) = 0.290255E+01
+ PKER_RACCSS( 8, 6) = 0.234259E+01
+ PKER_RACCSS( 8, 7) = 0.179670E+01
+ PKER_RACCSS( 8, 8) = 0.131725E+01
+ PKER_RACCSS( 8, 9) = 0.936217E+00
+ PKER_RACCSS( 8, 10) = 0.670685E+00
+ PKER_RACCSS( 8, 11) = 0.525055E+00
+ PKER_RACCSS( 8, 12) = 0.490553E+00
+ PKER_RACCSS( 8, 13) = 0.543364E+00
+ PKER_RACCSS( 8, 14) = 0.647682E+00
+ PKER_RACCSS( 8, 15) = 0.769109E+00
+ PKER_RACCSS( 8, 16) = 0.885089E+00
+ PKER_RACCSS( 8, 17) = 0.986107E+00
+ PKER_RACCSS( 8, 18) = 0.107085E+01
+ PKER_RACCSS( 8, 19) = 0.114108E+01
+ PKER_RACCSS( 8, 20) = 0.119914E+01
+ PKER_RACCSS( 8, 21) = 0.124712E+01
+ PKER_RACCSS( 8, 22) = 0.128680E+01
+ PKER_RACCSS( 8, 23) = 0.131960E+01
+ PKER_RACCSS( 8, 24) = 0.134673E+01
+ PKER_RACCSS( 8, 25) = 0.136917E+01
+ PKER_RACCSS( 8, 26) = 0.138774E+01
+ PKER_RACCSS( 8, 27) = 0.140310E+01
+ PKER_RACCSS( 8, 28) = 0.141581E+01
+ PKER_RACCSS( 8, 29) = 0.142633E+01
+ PKER_RACCSS( 8, 30) = 0.143503E+01
+ PKER_RACCSS( 8, 31) = 0.144223E+01
+ PKER_RACCSS( 8, 32) = 0.144819E+01
+ PKER_RACCSS( 8, 33) = 0.145312E+01
+ PKER_RACCSS( 8, 34) = 0.145720E+01
+ PKER_RACCSS( 8, 35) = 0.146058E+01
+ PKER_RACCSS( 8, 36) = 0.146338E+01
+ PKER_RACCSS( 8, 37) = 0.146569E+01
+ PKER_RACCSS( 8, 38) = 0.146761E+01
+ PKER_RACCSS( 8, 39) = 0.146919E+01
+ PKER_RACCSS( 8, 40) = 0.147050E+01
+ PKER_RACCSS( 9, 1) = 0.240807E+01
+ PKER_RACCSS( 9, 2) = 0.283932E+01
+ PKER_RACCSS( 9, 3) = 0.303178E+01
+ PKER_RACCSS( 9, 4) = 0.296265E+01
+ PKER_RACCSS( 9, 5) = 0.267871E+01
+ PKER_RACCSS( 9, 6) = 0.226276E+01
+ PKER_RACCSS( 9, 7) = 0.179979E+01
+ PKER_RACCSS( 9, 8) = 0.135674E+01
+ PKER_RACCSS( 9, 9) = 0.979933E+00
+ PKER_RACCSS( 9, 10) = 0.698320E+00
+ PKER_RACCSS( 9, 11) = 0.525242E+00
+ PKER_RACCSS( 9, 12) = 0.460033E+00
+ PKER_RACCSS( 9, 13) = 0.484763E+00
+ PKER_RACCSS( 9, 14) = 0.569735E+00
+ PKER_RACCSS( 9, 15) = 0.681283E+00
+ PKER_RACCSS( 9, 16) = 0.793641E+00
+ PKER_RACCSS( 9, 17) = 0.893878E+00
+ PKER_RACCSS( 9, 18) = 0.978690E+00
+ PKER_RACCSS( 9, 19) = 0.104914E+01
+ PKER_RACCSS( 9, 20) = 0.110738E+01
+ PKER_RACCSS( 9, 21) = 0.115550E+01
+ PKER_RACCSS( 9, 22) = 0.119527E+01
+ PKER_RACCSS( 9, 23) = 0.122815E+01
+ PKER_RACCSS( 9, 24) = 0.125533E+01
+ PKER_RACCSS( 9, 25) = 0.127782E+01
+ PKER_RACCSS( 9, 26) = 0.129641E+01
+ PKER_RACCSS( 9, 27) = 0.131179E+01
+ PKER_RACCSS( 9, 28) = 0.132452E+01
+ PKER_RACCSS( 9, 29) = 0.133505E+01
+ PKER_RACCSS( 9, 30) = 0.134376E+01
+ PKER_RACCSS( 9, 31) = 0.135097E+01
+ PKER_RACCSS( 9, 32) = 0.135694E+01
+ PKER_RACCSS( 9, 33) = 0.136188E+01
+ PKER_RACCSS( 9, 34) = 0.136596E+01
+ PKER_RACCSS( 9, 35) = 0.136934E+01
+ PKER_RACCSS( 9, 36) = 0.137214E+01
+ PKER_RACCSS( 9, 37) = 0.137446E+01
+ PKER_RACCSS( 9, 38) = 0.137637E+01
+ PKER_RACCSS( 9, 39) = 0.137796E+01
+ PKER_RACCSS( 9, 40) = 0.137927E+01
+ PKER_RACCSS( 10, 1) = 0.147671E+01
+ PKER_RACCSS( 10, 2) = 0.193328E+01
+ PKER_RACCSS( 10, 3) = 0.227014E+01
+ PKER_RACCSS( 10, 4) = 0.241054E+01
+ PKER_RACCSS( 10, 5) = 0.233821E+01
+ PKER_RACCSS( 10, 6) = 0.209295E+01
+ PKER_RACCSS( 10, 7) = 0.174482E+01
+ PKER_RACCSS( 10, 8) = 0.136525E+01
+ PKER_RACCSS( 10, 9) = 0.101239E+01
+ PKER_RACCSS( 10, 10) = 0.726741E+00
+ PKER_RACCSS( 10, 11) = 0.533079E+00
+ PKER_RACCSS( 10, 12) = 0.439515E+00
+ PKER_RACCSS( 10, 13) = 0.437071E+00
+ PKER_RACCSS( 10, 14) = 0.501385E+00
+ PKER_RACCSS( 10, 15) = 0.600980E+00
+ PKER_RACCSS( 10, 16) = 0.708337E+00
+ PKER_RACCSS( 10, 17) = 0.807233E+00
+ PKER_RACCSS( 10, 18) = 0.892004E+00
+ PKER_RACCSS( 10, 19) = 0.962681E+00
+ PKER_RACCSS( 10, 20) = 0.102114E+01
+ PKER_RACCSS( 10, 21) = 0.106943E+01
+ PKER_RACCSS( 10, 22) = 0.110932E+01
+ PKER_RACCSS( 10, 23) = 0.114228E+01
+ PKER_RACCSS( 10, 24) = 0.116953E+01
+ PKER_RACCSS( 10, 25) = 0.119207E+01
+ PKER_RACCSS( 10, 26) = 0.121070E+01
+ PKER_RACCSS( 10, 27) = 0.122611E+01
+ PKER_RACCSS( 10, 28) = 0.123886E+01
+ PKER_RACCSS( 10, 29) = 0.124940E+01
+ PKER_RACCSS( 10, 30) = 0.125813E+01
+ PKER_RACCSS( 10, 31) = 0.126535E+01
+ PKER_RACCSS( 10, 32) = 0.127132E+01
+ PKER_RACCSS( 10, 33) = 0.127626E+01
+ PKER_RACCSS( 10, 34) = 0.128035E+01
+ PKER_RACCSS( 10, 35) = 0.128374E+01
+ PKER_RACCSS( 10, 36) = 0.128654E+01
+ PKER_RACCSS( 10, 37) = 0.128886E+01
+ PKER_RACCSS( 10, 38) = 0.129077E+01
+ PKER_RACCSS( 10, 39) = 0.129236E+01
+ PKER_RACCSS( 10, 40) = 0.129368E+01
+ PKER_RACCSS( 11, 1) = 0.808661E+00
+ PKER_RACCSS( 11, 2) = 0.118349E+01
+ PKER_RACCSS( 11, 3) = 0.154344E+01
+ PKER_RACCSS( 11, 4) = 0.180338E+01
+ PKER_RACCSS( 11, 5) = 0.190224E+01
+ PKER_RACCSS( 11, 6) = 0.182880E+01
+ PKER_RACCSS( 11, 7) = 0.161765E+01
+ PKER_RACCSS( 11, 8) = 0.132833E+01
+ PKER_RACCSS( 11, 9) = 0.102209E+01
+ PKER_RACCSS( 11, 10) = 0.749176E+00
+ PKER_RACCSS( 11, 11) = 0.544780E+00
+ PKER_RACCSS( 11, 12) = 0.428018E+00
+ PKER_RACCSS( 11, 13) = 0.399615E+00
+ PKER_RACCSS( 11, 14) = 0.442486E+00
+ PKER_RACCSS( 11, 15) = 0.528291E+00
+ PKER_RACCSS( 11, 16) = 0.629068E+00
+ PKER_RACCSS( 11, 17) = 0.725892E+00
+ PKER_RACCSS( 11, 18) = 0.810425E+00
+ PKER_RACCSS( 11, 19) = 0.881336E+00
+ PKER_RACCSS( 11, 20) = 0.940053E+00
+ PKER_RACCSS( 11, 21) = 0.988540E+00
+ PKER_RACCSS( 11, 22) = 0.102858E+01
+ PKER_RACCSS( 11, 23) = 0.106165E+01
+ PKER_RACCSS( 11, 24) = 0.108898E+01
+ PKER_RACCSS( 11, 25) = 0.111157E+01
+ PKER_RACCSS( 11, 26) = 0.113025E+01
+ PKER_RACCSS( 11, 27) = 0.114569E+01
+ PKER_RACCSS( 11, 28) = 0.115847E+01
+ PKER_RACCSS( 11, 29) = 0.116903E+01
+ PKER_RACCSS( 11, 30) = 0.117777E+01
+ PKER_RACCSS( 11, 31) = 0.118500E+01
+ PKER_RACCSS( 11, 32) = 0.119098E+01
+ PKER_RACCSS( 11, 33) = 0.119593E+01
+ PKER_RACCSS( 11, 34) = 0.120003E+01
+ PKER_RACCSS( 11, 35) = 0.120342E+01
+ PKER_RACCSS( 11, 36) = 0.120622E+01
+ PKER_RACCSS( 11, 37) = 0.120854E+01
+ PKER_RACCSS( 11, 38) = 0.121046E+01
+ PKER_RACCSS( 11, 39) = 0.121205E+01
+ PKER_RACCSS( 11, 40) = 0.121337E+01
+ PKER_RACCSS( 12, 1) = 0.394253E+00
+ PKER_RACCSS( 12, 2) = 0.646179E+00
+ PKER_RACCSS( 12, 3) = 0.942558E+00
+ PKER_RACCSS( 12, 4) = 0.122389E+01
+ PKER_RACCSS( 12, 5) = 0.142127E+01
+ PKER_RACCSS( 12, 6) = 0.148735E+01
+ PKER_RACCSS( 12, 7) = 0.141473E+01
+ PKER_RACCSS( 12, 8) = 0.123412E+01
+ PKER_RACCSS( 12, 9) = 0.996999E+00
+ PKER_RACCSS( 12, 10) = 0.756208E+00
+ PKER_RACCSS( 12, 11) = 0.555253E+00
+ PKER_RACCSS( 12, 12) = 0.422862E+00
+ PKER_RACCSS( 12, 13) = 0.371247E+00
+ PKER_RACCSS( 12, 14) = 0.392052E+00
+ PKER_RACCSS( 12, 15) = 0.462634E+00
+ PKER_RACCSS( 12, 16) = 0.555651E+00
+ PKER_RACCSS( 12, 17) = 0.649618E+00
+ PKER_RACCSS( 12, 18) = 0.733630E+00
+ PKER_RACCSS( 12, 19) = 0.804744E+00
+ PKER_RACCSS( 12, 20) = 0.863761E+00
+ PKER_RACCSS( 12, 21) = 0.912491E+00
+ PKER_RACCSS( 12, 22) = 0.952708E+00
+ PKER_RACCSS( 12, 23) = 0.985912E+00
+ PKER_RACCSS( 12, 24) = 0.101334E+01
+ PKER_RACCSS( 12, 25) = 0.103600E+01
+ PKER_RACCSS( 12, 26) = 0.105473E+01
+ PKER_RACCSS( 12, 27) = 0.107022E+01
+ PKER_RACCSS( 12, 28) = 0.108302E+01
+ PKER_RACCSS( 12, 29) = 0.109361E+01
+ PKER_RACCSS( 12, 30) = 0.110236E+01
+ PKER_RACCSS( 12, 31) = 0.110961E+01
+ PKER_RACCSS( 12, 32) = 0.111560E+01
+ PKER_RACCSS( 12, 33) = 0.112056E+01
+ PKER_RACCSS( 12, 34) = 0.112466E+01
+ PKER_RACCSS( 12, 35) = 0.112805E+01
+ PKER_RACCSS( 12, 36) = 0.113086E+01
+ PKER_RACCSS( 12, 37) = 0.113319E+01
+ PKER_RACCSS( 12, 38) = 0.113511E+01
+ PKER_RACCSS( 12, 39) = 0.113670E+01
+ PKER_RACCSS( 12, 40) = 0.113802E+01
+ PKER_RACCSS( 13, 1) = 0.171360E+00
+ PKER_RACCSS( 13, 2) = 0.313975E+00
+ PKER_RACCSS( 13, 3) = 0.512870E+00
+ PKER_RACCSS( 13, 4) = 0.744995E+00
+ PKER_RACCSS( 13, 5) = 0.962081E+00
+ PKER_RACCSS( 13, 6) = 0.110931E+01
+ PKER_RACCSS( 13, 7) = 0.114976E+01
+ PKER_RACCSS( 13, 8) = 0.107985E+01
+ PKER_RACCSS( 13, 9) = 0.927521E+00
+ PKER_RACCSS( 13, 10) = 0.737617E+00
+ PKER_RACCSS( 13, 11) = 0.556237E+00
+ PKER_RACCSS( 13, 12) = 0.420066E+00
+ PKER_RACCSS( 13, 13) = 0.350230E+00
+ PKER_RACCSS( 13, 14) = 0.349906E+00
+ PKER_RACCSS( 13, 15) = 0.404063E+00
+ PKER_RACCSS( 13, 16) = 0.487780E+00
+ PKER_RACCSS( 13, 17) = 0.578111E+00
+ PKER_RACCSS( 13, 18) = 0.661299E+00
+ PKER_RACCSS( 13, 19) = 0.732568E+00
+ PKER_RACCSS( 13, 20) = 0.791923E+00
+ PKER_RACCSS( 13, 21) = 0.840945E+00
+ PKER_RACCSS( 13, 22) = 0.881381E+00
+ PKER_RACCSS( 13, 23) = 0.914745E+00
+ PKER_RACCSS( 13, 24) = 0.942288E+00
+ PKER_RACCSS( 13, 25) = 0.965037E+00
+ PKER_RACCSS( 13, 26) = 0.983832E+00
+ PKER_RACCSS( 13, 27) = 0.999365E+00
+ PKER_RACCSS( 13, 28) = 0.101221E+01
+ PKER_RACCSS( 13, 29) = 0.102282E+01
+ PKER_RACCSS( 13, 30) = 0.103160E+01
+ PKER_RACCSS( 13, 31) = 0.103886E+01
+ PKER_RACCSS( 13, 32) = 0.104487E+01
+ PKER_RACCSS( 13, 33) = 0.104983E+01
+ PKER_RACCSS( 13, 34) = 0.105394E+01
+ PKER_RACCSS( 13, 35) = 0.105734E+01
+ PKER_RACCSS( 13, 36) = 0.106016E+01
+ PKER_RACCSS( 13, 37) = 0.106248E+01
+ PKER_RACCSS( 13, 38) = 0.106441E+01
+ PKER_RACCSS( 13, 39) = 0.106600E+01
+ PKER_RACCSS( 13, 40) = 0.106732E+01
+ PKER_RACCSS( 14, 1) = 0.880495E-01
+ PKER_RACCSS( 14, 2) = 0.175611E+00
+ PKER_RACCSS( 14, 3) = 0.247975E+00
+ PKER_RACCSS( 14, 4) = 0.403566E+00
+ PKER_RACCSS( 14, 5) = 0.583307E+00
+ PKER_RACCSS( 14, 6) = 0.748280E+00
+ PKER_RACCSS( 14, 7) = 0.855344E+00
+ PKER_RACCSS( 14, 8) = 0.876333E+00
+ PKER_RACCSS( 14, 9) = 0.811263E+00
+ PKER_RACCSS( 14, 10) = 0.685718E+00
+ PKER_RACCSS( 14, 11) = 0.539707E+00
+ PKER_RACCSS( 14, 12) = 0.412364E+00
+ PKER_RACCSS( 14, 13) = 0.333785E+00
+ PKER_RACCSS( 14, 14) = 0.315877E+00
+ PKER_RACCSS( 14, 15) = 0.352939E+00
+ PKER_RACCSS( 14, 16) = 0.425537E+00
+ PKER_RACCSS( 14, 17) = 0.511002E+00
+ PKER_RACCSS( 14, 18) = 0.593027E+00
+ PKER_RACCSS( 14, 19) = 0.664451E+00
+ PKER_RACCSS( 14, 20) = 0.724208E+00
+ PKER_RACCSS( 14, 21) = 0.773584E+00
+ PKER_RACCSS( 14, 22) = 0.814286E+00
+ PKER_RACCSS( 14, 23) = 0.847845E+00
+ PKER_RACCSS( 14, 24) = 0.875531E+00
+ PKER_RACCSS( 14, 25) = 0.898385E+00
+ PKER_RACCSS( 14, 26) = 0.917258E+00
+ PKER_RACCSS( 14, 27) = 0.932850E+00
+ PKER_RACCSS( 14, 28) = 0.945734E+00
+ PKER_RACCSS( 14, 29) = 0.956384E+00
+ PKER_RACCSS( 14, 30) = 0.965189E+00
+ PKER_RACCSS( 14, 31) = 0.972469E+00
+ PKER_RACCSS( 14, 32) = 0.978490E+00
+ PKER_RACCSS( 14, 33) = 0.983469E+00
+ PKER_RACCSS( 14, 34) = 0.987588E+00
+ PKER_RACCSS( 14, 35) = 0.990995E+00
+ PKER_RACCSS( 14, 36) = 0.993813E+00
+ PKER_RACCSS( 14, 37) = 0.996145E+00
+ PKER_RACCSS( 14, 38) = 0.998074E+00
+ PKER_RACCSS( 14, 39) = 0.999670E+00
+ PKER_RACCSS( 14, 40) = 0.100099E+01
+ PKER_RACCSS( 15, 1) = 0.315291E-01
+ PKER_RACCSS( 15, 2) = 0.693241E-01
+ PKER_RACCSS( 15, 3) = 0.137798E+00
+ PKER_RACCSS( 15, 4) = 0.193925E+00
+ PKER_RACCSS( 15, 5) = 0.314161E+00
+ PKER_RACCSS( 15, 6) = 0.451226E+00
+ PKER_RACCSS( 15, 7) = 0.574319E+00
+ PKER_RACCSS( 15, 8) = 0.649498E+00
+ PKER_RACCSS( 15, 9) = 0.656529E+00
+ PKER_RACCSS( 15, 10) = 0.598237E+00
+ PKER_RACCSS( 15, 11) = 0.499202E+00
+ PKER_RACCSS( 15, 12) = 0.394122E+00
+ PKER_RACCSS( 15, 13) = 0.316374E+00
+ PKER_RACCSS( 15, 14) = 0.287121E+00
+ PKER_RACCSS( 15, 15) = 0.308960E+00
+ PKER_RACCSS( 15, 16) = 0.369539E+00
+ PKER_RACCSS( 15, 17) = 0.448627E+00
+ PKER_RACCSS( 15, 18) = 0.528619E+00
+ PKER_RACCSS( 15, 19) = 0.600043E+00
+ PKER_RACCSS( 15, 20) = 0.660278E+00
+ PKER_RACCSS( 15, 21) = 0.710095E+00
+ PKER_RACCSS( 15, 22) = 0.751124E+00
+ PKER_RACCSS( 15, 23) = 0.784920E+00
+ PKER_RACCSS( 15, 24) = 0.812780E+00
+ PKER_RACCSS( 15, 25) = 0.835762E+00
+ PKER_RACCSS( 15, 26) = 0.854730E+00
+ PKER_RACCSS( 15, 27) = 0.870393E+00
+ PKER_RACCSS( 15, 28) = 0.883331E+00
+ PKER_RACCSS( 15, 29) = 0.894022E+00
+ PKER_RACCSS( 15, 30) = 0.902857E+00
+ PKER_RACCSS( 15, 31) = 0.910161E+00
+ PKER_RACCSS( 15, 32) = 0.916200E+00
+ PKER_RACCSS( 15, 33) = 0.921193E+00
+ PKER_RACCSS( 15, 34) = 0.925323E+00
+ PKER_RACCSS( 15, 35) = 0.928738E+00
+ PKER_RACCSS( 15, 36) = 0.931563E+00
+ PKER_RACCSS( 15, 37) = 0.933900E+00
+ PKER_RACCSS( 15, 38) = 0.935833E+00
+ PKER_RACCSS( 15, 39) = 0.937432E+00
+ PKER_RACCSS( 15, 40) = 0.938755E+00
+ PKER_RACCSS( 16, 1) = 0.360358E+01
+ PKER_RACCSS( 16, 2) = 0.281969E+01
+ PKER_RACCSS( 16, 3) = 0.219170E+01
+ PKER_RACCSS( 16, 4) = 0.170588E+01
+ PKER_RACCSS( 16, 5) = 0.135069E+01
+ PKER_RACCSS( 16, 6) = 0.110996E+01
+ PKER_RACCSS( 16, 7) = 0.957328E+00
+ PKER_RACCSS( 16, 8) = 0.855867E+00
+ PKER_RACCSS( 16, 9) = 0.767727E+00
+ PKER_RACCSS( 16, 10) = 0.667811E+00
+ PKER_RACCSS( 16, 11) = 0.551774E+00
+ PKER_RACCSS( 16, 12) = 0.434001E+00
+ PKER_RACCSS( 16, 13) = 0.338225E+00
+ PKER_RACCSS( 16, 14) = 0.285601E+00
+ PKER_RACCSS( 16, 15) = 0.284136E+00
+ PKER_RACCSS( 16, 16) = 0.326430E+00
+ PKER_RACCSS( 16, 17) = 0.394397E+00
+ PKER_RACCSS( 16, 18) = 0.469502E+00
+ PKER_RACCSS( 16, 19) = 0.539605E+00
+ PKER_RACCSS( 16, 20) = 0.599949E+00
+ PKER_RACCSS( 16, 21) = 0.650193E+00
+ PKER_RACCSS( 16, 22) = 0.691608E+00
+ PKER_RACCSS( 16, 23) = 0.725693E+00
+ PKER_RACCSS( 16, 24) = 0.753765E+00
+ PKER_RACCSS( 16, 25) = 0.776902E+00
+ PKER_RACCSS( 16, 26) = 0.795985E+00
+ PKER_RACCSS( 16, 27) = 0.811734E+00
+ PKER_RACCSS( 16, 28) = 0.824737E+00
+ PKER_RACCSS( 16, 29) = 0.835476E+00
+ PKER_RACCSS( 16, 30) = 0.844348E+00
+ PKER_RACCSS( 16, 31) = 0.851681E+00
+ PKER_RACCSS( 16, 32) = 0.857741E+00
+ PKER_RACCSS( 16, 33) = 0.862751E+00
+ PKER_RACCSS( 16, 34) = 0.866894E+00
+ PKER_RACCSS( 16, 35) = 0.870319E+00
+ PKER_RACCSS( 16, 36) = 0.873152E+00
+ PKER_RACCSS( 16, 37) = 0.875495E+00
+ PKER_RACCSS( 16, 38) = 0.877433E+00
+ PKER_RACCSS( 16, 39) = 0.879036E+00
+ PKER_RACCSS( 16, 40) = 0.880362E+00
+ PKER_RACCSS( 17, 1) = 0.472676E+01
+ PKER_RACCSS( 17, 2) = 0.370797E+01
+ PKER_RACCSS( 17, 3) = 0.231793E+01
+ PKER_RACCSS( 17, 4) = 0.179758E+01
+ PKER_RACCSS( 17, 5) = 0.139358E+01
+ PKER_RACCSS( 17, 6) = 0.109574E+01
+ PKER_RACCSS( 17, 7) = 0.890250E+00
+ PKER_RACCSS( 17, 8) = 0.755210E+00
+ PKER_RACCSS( 17, 9) = 0.661386E+00
+ PKER_RACCSS( 17, 10) = 0.579824E+00
+ PKER_RACCSS( 17, 11) = 0.493157E+00
+ PKER_RACCSS( 17, 12) = 0.401316E+00
+ PKER_RACCSS( 17, 13) = 0.318099E+00
+ PKER_RACCSS( 17, 14) = 0.264075E+00
+ PKER_RACCSS( 17, 15) = 0.252206E+00
+ PKER_RACCSS( 17, 16) = 0.282309E+00
+ PKER_RACCSS( 17, 17) = 0.341880E+00
+ PKER_RACCSS( 17, 18) = 0.413082E+00
+ PKER_RACCSS( 17, 19) = 0.482222E+00
+ PKER_RACCSS( 17, 20) = 0.542813E+00
+ PKER_RACCSS( 17, 21) = 0.593576E+00
+ PKER_RACCSS( 17, 22) = 0.635456E+00
+ PKER_RACCSS( 17, 23) = 0.669894E+00
+ PKER_RACCSS( 17, 24) = 0.698224E+00
+ PKER_RACCSS( 17, 25) = 0.721550E+00
+ PKER_RACCSS( 17, 26) = 0.740773E+00
+ PKER_RACCSS( 17, 27) = 0.756626E+00
+ PKER_RACCSS( 17, 28) = 0.769706E+00
+ PKER_RACCSS( 17, 29) = 0.780504E+00
+ PKER_RACCSS( 17, 30) = 0.789421E+00
+ PKER_RACCSS( 17, 31) = 0.796788E+00
+ PKER_RACCSS( 17, 32) = 0.802874E+00
+ PKER_RACCSS( 17, 33) = 0.807905E+00
+ PKER_RACCSS( 17, 34) = 0.812063E+00
+ PKER_RACCSS( 17, 35) = 0.815500E+00
+ PKER_RACCSS( 17, 36) = 0.818342E+00
+ PKER_RACCSS( 17, 37) = 0.820693E+00
+ PKER_RACCSS( 17, 38) = 0.822636E+00
+ PKER_RACCSS( 17, 39) = 0.824244E+00
+ PKER_RACCSS( 17, 40) = 0.825573E+00
+ PKER_RACCSS( 18, 1) = 0.603863E+01
+ PKER_RACCSS( 18, 2) = 0.389316E+01
+ PKER_RACCSS( 18, 3) = 0.305031E+01
+ PKER_RACCSS( 18, 4) = 0.236338E+01
+ PKER_RACCSS( 18, 5) = 0.147231E+01
+ PKER_RACCSS( 18, 6) = 0.113620E+01
+ PKER_RACCSS( 18, 7) = 0.886115E+00
+ PKER_RACCSS( 18, 8) = 0.710209E+00
+ PKER_RACCSS( 18, 9) = 0.590674E+00
+ PKER_RACCSS( 18, 10) = 0.504703E+00
+ PKER_RACCSS( 18, 11) = 0.431038E+00
+ PKER_RACCSS( 18, 12) = 0.358809E+00
+ PKER_RACCSS( 18, 13) = 0.290844E+00
+ PKER_RACCSS( 18, 14) = 0.240768E+00
+ PKER_RACCSS( 18, 15) = 0.223220E+00
+ PKER_RACCSS( 18, 16) = 0.243218E+00
+ PKER_RACCSS( 18, 17) = 0.293836E+00
+ PKER_RACCSS( 18, 18) = 0.360151E+00
+ PKER_RACCSS( 18, 19) = 0.427795E+00
+ PKER_RACCSS( 18, 20) = 0.488580E+00
+ PKER_RACCSS( 18, 21) = 0.539954E+00
+ PKER_RACCSS( 18, 22) = 0.582396E+00
+ PKER_RACCSS( 18, 23) = 0.617263E+00
+ PKER_RACCSS( 18, 24) = 0.645906E+00
+ PKER_RACCSS( 18, 25) = 0.669463E+00
+ PKER_RACCSS( 18, 26) = 0.688855E+00
+ PKER_RACCSS( 18, 27) = 0.704834E+00
+ PKER_RACCSS( 18, 28) = 0.718008E+00
+ PKER_RACCSS( 18, 29) = 0.728877E+00
+ PKER_RACCSS( 18, 30) = 0.737848E+00
+ PKER_RACCSS( 18, 31) = 0.745255E+00
+ PKER_RACCSS( 18, 32) = 0.751373E+00
+ PKER_RACCSS( 18, 33) = 0.756428E+00
+ PKER_RACCSS( 18, 34) = 0.760604E+00
+ PKER_RACCSS( 18, 35) = 0.764056E+00
+ PKER_RACCSS( 18, 36) = 0.766910E+00
+ PKER_RACCSS( 18, 37) = 0.769269E+00
+ PKER_RACCSS( 18, 38) = 0.771219E+00
+ PKER_RACCSS( 18, 39) = 0.772832E+00
+ PKER_RACCSS( 18, 40) = 0.774166E+00
+ PKER_RACCSS( 19, 1) = 0.795385E+01
+ PKER_RACCSS( 19, 2) = 0.638846E+01
+ PKER_RACCSS( 19, 3) = 0.434595E+01
+ PKER_RACCSS( 19, 4) = 0.343549E+01
+ PKER_RACCSS( 19, 5) = 0.268818E+01
+ PKER_RACCSS( 19, 6) = 0.208133E+01
+ PKER_RACCSS( 19, 7) = 0.159740E+01
+ PKER_RACCSS( 19, 8) = 0.122163E+01
+ PKER_RACCSS( 19, 9) = 0.938335E+00
+ PKER_RACCSS( 19, 10) = 0.728285E+00
+ PKER_RACCSS( 19, 11) = 0.570145E+00
+ PKER_RACCSS( 19, 12) = 0.445027E+00
+ PKER_RACCSS( 19, 13) = 0.343893E+00
+ PKER_RACCSS( 19, 14) = 0.268248E+00
+ PKER_RACCSS( 19, 15) = 0.226350E+00
+ PKER_RACCSS( 19, 16) = 0.224325E+00
+ PKER_RACCSS( 19, 17) = 0.257856E+00
+ PKER_RACCSS( 19, 18) = 0.313989E+00
+ PKER_RACCSS( 19, 19) = 0.377472E+00
+ PKER_RACCSS( 19, 20) = 0.437368E+00
+ PKER_RACCSS( 19, 21) = 0.489118E+00
+ PKER_RACCSS( 19, 22) = 0.532165E+00
+ PKER_RACCSS( 19, 23) = 0.567544E+00
+ PKER_RACCSS( 19, 24) = 0.596569E+00
+ PKER_RACCSS( 19, 25) = 0.620406E+00
+ PKER_RACCSS( 19, 26) = 0.640004E+00
+ PKER_RACCSS( 19, 27) = 0.656135E+00
+ PKER_RACCSS( 19, 28) = 0.669424E+00
+ PKER_RACCSS( 19, 29) = 0.680378E+00
+ PKER_RACCSS( 19, 30) = 0.689414E+00
+ PKER_RACCSS( 19, 31) = 0.696870E+00
+ PKER_RACCSS( 19, 32) = 0.703026E+00
+ PKER_RACCSS( 19, 33) = 0.708109E+00
+ PKER_RACCSS( 19, 34) = 0.712308E+00
+ PKER_RACCSS( 19, 35) = 0.715777E+00
+ PKER_RACCSS( 19, 36) = 0.718644E+00
+ PKER_RACCSS( 19, 37) = 0.721014E+00
+ PKER_RACCSS( 19, 38) = 0.722972E+00
+ PKER_RACCSS( 19, 39) = 0.724592E+00
+ PKER_RACCSS( 19, 40) = 0.725930E+00
+ PKER_RACCSS( 20, 1) = 0.634781E+01
+ PKER_RACCSS( 20, 2) = 0.508413E+01
+ PKER_RACCSS( 20, 3) = 0.328893E+01
+ PKER_RACCSS( 20, 4) = 0.259197E+01
+ PKER_RACCSS( 20, 5) = 0.161527E+01
+ PKER_RACCSS( 20, 6) = 0.125279E+01
+ PKER_RACCSS( 20, 7) = 0.963381E+00
+ PKER_RACCSS( 20, 8) = 0.738949E+00
+ PKER_RACCSS( 20, 9) = 0.571583E+00
+ PKER_RACCSS( 20, 10) = 0.451257E+00
+ PKER_RACCSS( 20, 11) = 0.365125E+00
+ PKER_RACCSS( 20, 12) = 0.299475E+00
+ PKER_RACCSS( 20, 13) = 0.245596E+00
+ PKER_RACCSS( 20, 14) = 0.203304E+00
+ PKER_RACCSS( 20, 15) = 0.180537E+00
+ PKER_RACCSS( 20, 16) = 0.185574E+00
+ PKER_RACCSS( 20, 17) = 0.220030E+00
+ PKER_RACCSS( 20, 18) = 0.275495E+00
+ PKER_RACCSS( 20, 19) = 0.338734E+00
+ PKER_RACCSS( 20, 20) = 0.398970E+00
+ PKER_RACCSS( 20, 21) = 0.450959E+00
+ PKER_RACCSS( 20, 22) = 0.493976E+00
+ PKER_RACCSS( 20, 23) = 0.529200E+00
+ PKER_RACCSS( 20, 24) = 0.558067E+00
+ PKER_RACCSS( 20, 25) = 0.581769E+00
+ PKER_RACCSS( 20, 26) = 0.601256E+00
+ PKER_RACCSS( 20, 27) = 0.617297E+00
+ PKER_RACCSS( 20, 28) = 0.630511E+00
+ PKER_RACCSS( 20, 29) = 0.641405E+00
+ PKER_RACCSS( 20, 30) = 0.650392E+00
+ PKER_RACCSS( 20, 31) = 0.657810E+00
+ PKER_RACCSS( 20, 32) = 0.663934E+00
+ PKER_RACCSS( 20, 33) = 0.668992E+00
+ PKER_RACCSS( 20, 34) = 0.673171E+00
+ PKER_RACCSS( 20, 35) = 0.676624E+00
+ PKER_RACCSS( 20, 36) = 0.679478E+00
+ PKER_RACCSS( 20, 37) = 0.681837E+00
+ PKER_RACCSS( 20, 38) = 0.683788E+00
+ PKER_RACCSS( 20, 39) = 0.685401E+00
+ PKER_RACCSS( 20, 40) = 0.686734E+00
+ PKER_RACCSS( 21, 1) = 0.102443E+02
+ PKER_RACCSS( 21, 2) = 0.752283E+01
+ PKER_RACCSS( 21, 3) = 0.532770E+01
+ PKER_RACCSS( 21, 4) = 0.425873E+01
+ PKER_RACCSS( 21, 5) = 0.288056E+01
+ PKER_RACCSS( 21, 6) = 0.226207E+01
+ PKER_RACCSS( 21, 7) = 0.175652E+01
+ PKER_RACCSS( 21, 8) = 0.134803E+01
+ PKER_RACCSS( 21, 9) = 0.102375E+01
+ PKER_RACCSS( 21, 10) = 0.771986E+00
+ PKER_RACCSS( 21, 11) = 0.580680E+00
+ PKER_RACCSS( 21, 12) = 0.436943E+00
+ PKER_RACCSS( 21, 13) = 0.328804E+00
+ PKER_RACCSS( 21, 14) = 0.249300E+00
+ PKER_RACCSS( 21, 15) = 0.198560E+00
+ PKER_RACCSS( 21, 16) = 0.180676E+00
+ PKER_RACCSS( 21, 17) = 0.196350E+00
+ PKER_RACCSS( 21, 18) = 0.238922E+00
+ PKER_RACCSS( 21, 19) = 0.295536E+00
+ PKER_RACCSS( 21, 20) = 0.353574E+00
+ PKER_RACCSS( 21, 21) = 0.405455E+00
+ PKER_RACCSS( 21, 22) = 0.448988E+00
+ PKER_RACCSS( 21, 23) = 0.484753E+00
+ PKER_RACCSS( 21, 24) = 0.514042E+00
+ PKER_RACCSS( 21, 25) = 0.538053E+00
+ PKER_RACCSS( 21, 26) = 0.557767E+00
+ PKER_RACCSS( 21, 27) = 0.573974E+00
+ PKER_RACCSS( 21, 28) = 0.587311E+00
+ PKER_RACCSS( 21, 29) = 0.598297E+00
+ PKER_RACCSS( 21, 30) = 0.607353E+00
+ PKER_RACCSS( 21, 31) = 0.614822E+00
+ PKER_RACCSS( 21, 32) = 0.620985E+00
+ PKER_RACCSS( 21, 33) = 0.626073E+00
+ PKER_RACCSS( 21, 34) = 0.630275E+00
+ PKER_RACCSS( 21, 35) = 0.633746E+00
+ PKER_RACCSS( 21, 36) = 0.636613E+00
+ PKER_RACCSS( 21, 37) = 0.638983E+00
+ PKER_RACCSS( 21, 38) = 0.640942E+00
+ PKER_RACCSS( 21, 39) = 0.642561E+00
+ PKER_RACCSS( 21, 40) = 0.643900E+00
+ PKER_RACCSS( 22, 1) = 0.115320E+02
+ PKER_RACCSS( 22, 2) = 0.885714E+01
+ PKER_RACCSS( 22, 3) = 0.661944E+01
+ PKER_RACCSS( 22, 4) = 0.533800E+01
+ PKER_RACCSS( 22, 5) = 0.383246E+01
+ PKER_RACCSS( 22, 6) = 0.304296E+01
+ PKER_RACCSS( 22, 7) = 0.239235E+01
+ PKER_RACCSS( 22, 8) = 0.185899E+01
+ PKER_RACCSS( 22, 9) = 0.142556E+01
+ PKER_RACCSS( 22, 10) = 0.107781E+01
+ PKER_RACCSS( 22, 11) = 0.803526E+00
+ PKER_RACCSS( 22, 12) = 0.590905E+00
+ PKER_RACCSS( 22, 13) = 0.429091E+00
+ PKER_RACCSS( 22, 14) = 0.309341E+00
+ PKER_RACCSS( 22, 15) = 0.227914E+00
+ PKER_RACCSS( 22, 16) = 0.184487E+00
+ PKER_RACCSS( 22, 17) = 0.179339E+00
+ PKER_RACCSS( 22, 18) = 0.207043E+00
+ PKER_RACCSS( 22, 19) = 0.255369E+00
+ PKER_RACCSS( 22, 20) = 0.310362E+00
+ PKER_RACCSS( 22, 21) = 0.362024E+00
+ PKER_RACCSS( 22, 22) = 0.406192E+00
+ PKER_RACCSS( 22, 23) = 0.442617E+00
+ PKER_RACCSS( 22, 24) = 0.472415E+00
+ PKER_RACCSS( 22, 25) = 0.496799E+00
+ PKER_RACCSS( 22, 26) = 0.516786E+00
+ PKER_RACCSS( 22, 27) = 0.533194E+00
+ PKER_RACCSS( 22, 28) = 0.546679E+00
+ PKER_RACCSS( 22, 29) = 0.557776E+00
+ PKER_RACCSS( 22, 30) = 0.566914E+00
+ PKER_RACCSS( 22, 31) = 0.574445E+00
+ PKER_RACCSS( 22, 32) = 0.580656E+00
+ PKER_RACCSS( 22, 33) = 0.585779E+00
+ PKER_RACCSS( 22, 34) = 0.590009E+00
+ PKER_RACCSS( 22, 35) = 0.593501E+00
+ PKER_RACCSS( 22, 36) = 0.596384E+00
+ PKER_RACCSS( 22, 37) = 0.598767E+00
+ PKER_RACCSS( 22, 38) = 0.600735E+00
+ PKER_RACCSS( 22, 39) = 0.602362E+00
+ PKER_RACCSS( 22, 40) = 0.603707E+00
+ PKER_RACCSS( 23, 1) = 0.120552E+02
+ PKER_RACCSS( 23, 2) = 0.943853E+01
+ PKER_RACCSS( 23, 3) = 0.723099E+01
+ PKER_RACCSS( 23, 4) = 0.538764E+01
+ PKER_RACCSS( 23, 5) = 0.432828E+01
+ PKER_RACCSS( 23, 6) = 0.309359E+01
+ PKER_RACCSS( 23, 7) = 0.244279E+01
+ PKER_RACCSS( 23, 8) = 0.190778E+01
+ PKER_RACCSS( 23, 9) = 0.147059E+01
+ PKER_RACCSS( 23, 10) = 0.111661E+01
+ PKER_RACCSS( 23, 11) = 0.833900E+00
+ PKER_RACCSS( 23, 12) = 0.611721E+00
+ PKER_RACCSS( 23, 13) = 0.440899E+00
+ PKER_RACCSS( 23, 14) = 0.313483E+00
+ PKER_RACCSS( 23, 15) = 0.225201E+00
+ PKER_RACCSS( 23, 16) = 0.175156E+00
+ PKER_RACCSS( 23, 17) = 0.163153E+00
+ PKER_RACCSS( 23, 18) = 0.185306E+00
+ PKER_RACCSS( 23, 19) = 0.230283E+00
+ PKER_RACCSS( 23, 20) = 0.284175E+00
+ PKER_RACCSS( 23, 21) = 0.335712E+00
+ PKER_RACCSS( 23, 22) = 0.379840E+00
+ PKER_RACCSS( 23, 23) = 0.416119E+00
+ PKER_RACCSS( 23, 24) = 0.445741E+00
+ PKER_RACCSS( 23, 25) = 0.469966E+00
+ PKER_RACCSS( 23, 26) = 0.489818E+00
+ PKER_RACCSS( 23, 27) = 0.506111E+00
+ PKER_RACCSS( 23, 28) = 0.519502E+00
+ PKER_RACCSS( 23, 29) = 0.530519E+00
+ PKER_RACCSS( 23, 30) = 0.539593E+00
+ PKER_RACCSS( 23, 31) = 0.547072E+00
+ PKER_RACCSS( 23, 32) = 0.553240E+00
+ PKER_RACCSS( 23, 33) = 0.558330E+00
+ PKER_RACCSS( 23, 34) = 0.562532E+00
+ PKER_RACCSS( 23, 35) = 0.566002E+00
+ PKER_RACCSS( 23, 36) = 0.568868E+00
+ PKER_RACCSS( 23, 37) = 0.571236E+00
+ PKER_RACCSS( 23, 38) = 0.573194E+00
+ PKER_RACCSS( 23, 39) = 0.574812E+00
+ PKER_RACCSS( 23, 40) = 0.576149E+00
+ PKER_RACCSS( 24, 1) = 0.129576E+02
+ PKER_RACCSS( 24, 2) = 0.102975E+02
+ PKER_RACCSS( 24, 3) = 0.818920E+01
+ PKER_RACCSS( 24, 4) = 0.640995E+01
+ PKER_RACCSS( 24, 5) = 0.491149E+01
+ PKER_RACCSS( 24, 6) = 0.394577E+01
+ PKER_RACCSS( 24, 7) = 0.291637E+01
+ PKER_RACCSS( 24, 8) = 0.230081E+01
+ PKER_RACCSS( 24, 9) = 0.179410E+01
+ PKER_RACCSS( 24, 10) = 0.137900E+01
+ PKER_RACCSS( 24, 11) = 0.104163E+01
+ PKER_RACCSS( 24, 12) = 0.770431E+00
+ PKER_RACCSS( 24, 13) = 0.556107E+00
+ PKER_RACCSS( 24, 14) = 0.391190E+00
+ PKER_RACCSS( 24, 15) = 0.270786E+00
+ PKER_RACCSS( 24, 16) = 0.192864E+00
+ PKER_RACCSS( 24, 17) = 0.156677E+00
+ PKER_RACCSS( 24, 18) = 0.159396E+00
+ PKER_RACCSS( 24, 19) = 0.191937E+00
+ PKER_RACCSS( 24, 20) = 0.240898E+00
+ PKER_RACCSS( 24, 21) = 0.292797E+00
+ PKER_RACCSS( 24, 22) = 0.339207E+00
+ PKER_RACCSS( 24, 23) = 0.377404E+00
+ PKER_RACCSS( 24, 24) = 0.408063E+00
+ PKER_RACCSS( 24, 25) = 0.432806E+00
+ PKER_RACCSS( 24, 26) = 0.452971E+00
+ PKER_RACCSS( 24, 27) = 0.469485E+00
+ PKER_RACCSS( 24, 28) = 0.483037E+00
+ PKER_RACCSS( 24, 29) = 0.494174E+00
+ PKER_RACCSS( 24, 30) = 0.503336E+00
+ PKER_RACCSS( 24, 31) = 0.510880E+00
+ PKER_RACCSS( 24, 32) = 0.517096E+00
+ PKER_RACCSS( 24, 33) = 0.522223E+00
+ PKER_RACCSS( 24, 34) = 0.526452E+00
+ PKER_RACCSS( 24, 35) = 0.529943E+00
+ PKER_RACCSS( 24, 36) = 0.532826E+00
+ PKER_RACCSS( 24, 37) = 0.535207E+00
+ PKER_RACCSS( 24, 38) = 0.537174E+00
+ PKER_RACCSS( 24, 39) = 0.538799E+00
+ PKER_RACCSS( 24, 40) = 0.540142E+00
+ PKER_RACCSS( 25, 1) = 0.131514E+02
+ PKER_RACCSS( 25, 2) = 0.106419E+02
+ PKER_RACCSS( 25, 3) = 0.845868E+01
+ PKER_RACCSS( 25, 4) = 0.672282E+01
+ PKER_RACCSS( 25, 5) = 0.526076E+01
+ PKER_RACCSS( 25, 6) = 0.423970E+01
+ PKER_RACCSS( 25, 7) = 0.322433E+01
+ PKER_RACCSS( 25, 8) = 0.255677E+01
+ PKER_RACCSS( 25, 9) = 0.200589E+01
+ PKER_RACCSS( 25, 10) = 0.155266E+01
+ PKER_RACCSS( 25, 11) = 0.118171E+01
+ PKER_RACCSS( 25, 12) = 0.880334E+00
+ PKER_RACCSS( 25, 13) = 0.638726E+00
+ PKER_RACCSS( 25, 14) = 0.449351E+00
+ PKER_RACCSS( 25, 15) = 0.307558E+00
+ PKER_RACCSS( 25, 16) = 0.211438E+00
+ PKER_RACCSS( 25, 17) = 0.160608E+00
+ PKER_RACCSS( 25, 18) = 0.152419E+00
+ PKER_RACCSS( 25, 19) = 0.178285E+00
+ PKER_RACCSS( 25, 20) = 0.223628E+00
+ PKER_RACCSS( 25, 21) = 0.273609E+00
+ PKER_RACCSS( 25, 22) = 0.318759E+00
+ PKER_RACCSS( 25, 23) = 0.356134E+00
+ PKER_RACCSS( 25, 24) = 0.386398E+00
+ PKER_RACCSS( 25, 25) = 0.410983E+00
+ PKER_RACCSS( 25, 26) = 0.431059E+00
+ PKER_RACCSS( 25, 27) = 0.447500E+00
+ PKER_RACCSS( 25, 28) = 0.460986E+00
+ PKER_RACCSS( 25, 29) = 0.472065E+00
+ PKER_RACCSS( 25, 30) = 0.481178E+00
+ PKER_RACCSS( 25, 31) = 0.488681E+00
+ PKER_RACCSS( 25, 32) = 0.494864E+00
+ PKER_RACCSS( 25, 33) = 0.499963E+00
+ PKER_RACCSS( 25, 34) = 0.504169E+00
+ PKER_RACCSS( 25, 35) = 0.507642E+00
+ PKER_RACCSS( 25, 36) = 0.510510E+00
+ PKER_RACCSS( 25, 37) = 0.512879E+00
+ PKER_RACCSS( 25, 38) = 0.514836E+00
+ PKER_RACCSS( 25, 39) = 0.516454E+00
+ PKER_RACCSS( 25, 40) = 0.517791E+00
+ PKER_RACCSS( 26, 1) = 0.132742E+02
+ PKER_RACCSS( 26, 2) = 0.108337E+02
+ PKER_RACCSS( 26, 3) = 0.872586E+01
+ PKER_RACCSS( 26, 4) = 0.703900E+01
+ PKER_RACCSS( 26, 5) = 0.562634E+01
+ PKER_RACCSS( 26, 6) = 0.444059E+01
+ PKER_RACCSS( 26, 7) = 0.356562E+01
+ PKER_RACCSS( 26, 8) = 0.274250E+01
+ PKER_RACCSS( 26, 9) = 0.216207E+01
+ PKER_RACCSS( 26, 10) = 0.168328E+01
+ PKER_RACCSS( 26, 11) = 0.128971E+01
+ PKER_RACCSS( 26, 12) = 0.967844E+00
+ PKER_RACCSS( 26, 13) = 0.707228E+00
+ PKER_RACCSS( 26, 14) = 0.499963E+00
+ PKER_RACCSS( 26, 15) = 0.341292E+00
+ PKER_RACCSS( 26, 16) = 0.229353E+00
+ PKER_RACCSS( 26, 17) = 0.164063E+00
+ PKER_RACCSS( 26, 18) = 0.143754E+00
+ PKER_RACCSS( 26, 19) = 0.160834E+00
+ PKER_RACCSS( 26, 20) = 0.201345E+00
+ PKER_RACCSS( 26, 21) = 0.249884E+00
+ PKER_RACCSS( 26, 22) = 0.295670E+00
+ PKER_RACCSS( 26, 23) = 0.334320E+00
+ PKER_RACCSS( 26, 24) = 0.365515E+00
+ PKER_RACCSS( 26, 25) = 0.390474E+00
+ PKER_RACCSS( 26, 26) = 0.410622E+00
+ PKER_RACCSS( 26, 27) = 0.427051E+00
+ PKER_RACCSS( 26, 28) = 0.440513E+00
+ PKER_RACCSS( 26, 29) = 0.451566E+00
+ PKER_RACCSS( 26, 30) = 0.460654E+00
+ PKER_RACCSS( 26, 31) = 0.468135E+00
+ PKER_RACCSS( 26, 32) = 0.474298E+00
+ PKER_RACCSS( 26, 33) = 0.479380E+00
+ PKER_RACCSS( 26, 34) = 0.483572E+00
+ PKER_RACCSS( 26, 35) = 0.487033E+00
+ PKER_RACCSS( 26, 36) = 0.489891E+00
+ PKER_RACCSS( 26, 37) = 0.492252E+00
+ PKER_RACCSS( 26, 38) = 0.494203E+00
+ PKER_RACCSS( 26, 39) = 0.495815E+00
+ PKER_RACCSS( 26, 40) = 0.497148E+00
+ PKER_RACCSS( 27, 1) = 0.133097E+02
+ PKER_RACCSS( 27, 2) = 0.109011E+02
+ PKER_RACCSS( 27, 3) = 0.888269E+01
+ PKER_RACCSS( 27, 4) = 0.719362E+01
+ PKER_RACCSS( 27, 5) = 0.580985E+01
+ PKER_RACCSS( 27, 6) = 0.465501E+01
+ PKER_RACCSS( 27, 7) = 0.374781E+01
+ PKER_RACCSS( 27, 8) = 0.294825E+01
+ PKER_RACCSS( 27, 9) = 0.233507E+01
+ PKER_RACCSS( 27, 10) = 0.182826E+01
+ PKER_RACCSS( 27, 11) = 0.141027E+01
+ PKER_RACCSS( 27, 12) = 0.106668E+01
+ PKER_RACCSS( 27, 13) = 0.786260E+00
+ PKER_RACCSS( 27, 14) = 0.560532E+00
+ PKER_RACCSS( 27, 15) = 0.384455E+00
+ PKER_RACCSS( 27, 16) = 0.256127E+00
+ PKER_RACCSS( 27, 17) = 0.176040E+00
+ PKER_RACCSS( 27, 18) = 0.143310E+00
+ PKER_RACCSS( 27, 19) = 0.151524E+00
+ PKER_RACCSS( 27, 20) = 0.186916E+00
+ PKER_RACCSS( 27, 21) = 0.233004E+00
+ PKER_RACCSS( 27, 22) = 0.277474E+00
+ PKER_RACCSS( 27, 23) = 0.315252E+00
+ PKER_RACCSS( 27, 24) = 0.345942E+00
+ PKER_RACCSS( 27, 25) = 0.370729E+00
+ PKER_RACCSS( 27, 26) = 0.390865E+00
+ PKER_RACCSS( 27, 27) = 0.407311E+00
+ PKER_RACCSS( 27, 28) = 0.420780E+00
+ PKER_RACCSS( 27, 29) = 0.431832E+00
+ PKER_RACCSS( 27, 30) = 0.440914E+00
+ PKER_RACCSS( 27, 31) = 0.448386E+00
+ PKER_RACCSS( 27, 32) = 0.454540E+00
+ PKER_RACCSS( 27, 33) = 0.459613E+00
+ PKER_RACCSS( 27, 34) = 0.463798E+00
+ PKER_RACCSS( 27, 35) = 0.467251E+00
+ PKER_RACCSS( 27, 36) = 0.470104E+00
+ PKER_RACCSS( 27, 37) = 0.472459E+00
+ PKER_RACCSS( 27, 38) = 0.474406E+00
+ PKER_RACCSS( 27, 39) = 0.476015E+00
+ PKER_RACCSS( 27, 40) = 0.477346E+00
+ PKER_RACCSS( 28, 1) = 0.133115E+02
+ PKER_RACCSS( 28, 2) = 0.109156E+02
+ PKER_RACCSS( 28, 3) = 0.892137E+01
+ PKER_RACCSS( 28, 4) = 0.726595E+01
+ PKER_RACCSS( 28, 5) = 0.588073E+01
+ PKER_RACCSS( 28, 6) = 0.474162E+01
+ PKER_RACCSS( 28, 7) = 0.379341E+01
+ PKER_RACCSS( 28, 8) = 0.303518E+01
+ PKER_RACCSS( 28, 9) = 0.240761E+01
+ PKER_RACCSS( 28, 10) = 0.188860E+01
+ PKER_RACCSS( 28, 11) = 0.146011E+01
+ PKER_RACCSS( 28, 12) = 0.110727E+01
+ PKER_RACCSS( 28, 13) = 0.818541E+00
+ PKER_RACCSS( 28, 14) = 0.585150E+00
+ PKER_RACCSS( 28, 15) = 0.401892E+00
+ PKER_RACCSS( 28, 16) = 0.266865E+00
+ PKER_RACCSS( 28, 17) = 0.180994E+00
+ PKER_RACCSS( 28, 18) = 0.143621E+00
+ PKER_RACCSS( 28, 19) = 0.148709E+00
+ PKER_RACCSS( 28, 20) = 0.182192E+00
+ PKER_RACCSS( 28, 21) = 0.227050E+00
+ PKER_RACCSS( 28, 22) = 0.270562E+00
+ PKER_RACCSS( 28, 23) = 0.307571E+00
+ PKER_RACCSS( 28, 24) = 0.337783E+00
+ PKER_RACCSS( 28, 25) = 0.362333E+00
+ PKER_RACCSS( 28, 26) = 0.382340E+00
+ PKER_RACCSS( 28, 27) = 0.398692E+00
+ PKER_RACCSS( 28, 28) = 0.412083E+00
+ PKER_RACCSS( 28, 29) = 0.423069E+00
+ PKER_RACCSS( 28, 30) = 0.432097E+00
+ PKER_RACCSS( 28, 31) = 0.439525E+00
+ PKER_RACCSS( 28, 32) = 0.445643E+00
+ PKER_RACCSS( 28, 33) = 0.450687E+00
+ PKER_RACCSS( 28, 34) = 0.454848E+00
+ PKER_RACCSS( 28, 35) = 0.458283E+00
+ PKER_RACCSS( 28, 36) = 0.461119E+00
+ PKER_RACCSS( 28, 37) = 0.463463E+00
+ PKER_RACCSS( 28, 38) = 0.465400E+00
+ PKER_RACCSS( 28, 39) = 0.467002E+00
+ PKER_RACCSS( 28, 40) = 0.468326E+00
+ PKER_RACCSS( 29, 1) = 0.133215E+02
+ PKER_RACCSS( 29, 2) = 0.109289E+02
+ PKER_RACCSS( 29, 3) = 0.894604E+01
+ PKER_RACCSS( 29, 4) = 0.730119E+01
+ PKER_RACCSS( 29, 5) = 0.593124E+01
+ PKER_RACCSS( 29, 6) = 0.480144E+01
+ PKER_RACCSS( 29, 7) = 0.386406E+01
+ PKER_RACCSS( 29, 8) = 0.309611E+01
+ PKER_RACCSS( 29, 9) = 0.246034E+01
+ PKER_RACCSS( 29, 10) = 0.193432E+01
+ PKER_RACCSS( 29, 11) = 0.149394E+01
+ PKER_RACCSS( 29, 12) = 0.113665E+01
+ PKER_RACCSS( 29, 13) = 0.843665E+00
+ PKER_RACCSS( 29, 14) = 0.605916E+00
+ PKER_RACCSS( 29, 15) = 0.417943E+00
+ PKER_RACCSS( 29, 16) = 0.277581E+00
+ PKER_RACCSS( 29, 17) = 0.185747E+00
+ PKER_RACCSS( 29, 18) = 0.142370E+00
+ PKER_RACCSS( 29, 19) = 0.142343E+00
+ PKER_RACCSS( 29, 20) = 0.172458E+00
+ PKER_RACCSS( 29, 21) = 0.215669E+00
+ PKER_RACCSS( 29, 22) = 0.258726E+00
+ PKER_RACCSS( 29, 23) = 0.295879E+00
+ PKER_RACCSS( 29, 24) = 0.326452E+00
+ PKER_RACCSS( 29, 25) = 0.351334E+00
+ PKER_RACCSS( 29, 26) = 0.371529E+00
+ PKER_RACCSS( 29, 27) = 0.387939E+00
+ PKER_RACCSS( 29, 28) = 0.401329E+00
+ PKER_RACCSS( 29, 29) = 0.412300E+00
+ PKER_RACCSS( 29, 30) = 0.421310E+00
+ PKER_RACCSS( 29, 31) = 0.428722E+00
+ PKER_RACCSS( 29, 32) = 0.434825E+00
+ PKER_RACCSS( 29, 33) = 0.439856E+00
+ PKER_RACCSS( 29, 34) = 0.444007E+00
+ PKER_RACCSS( 29, 35) = 0.447433E+00
+ PKER_RACCSS( 29, 36) = 0.450262E+00
+ PKER_RACCSS( 29, 37) = 0.452600E+00
+ PKER_RACCSS( 29, 38) = 0.454532E+00
+ PKER_RACCSS( 29, 39) = 0.456130E+00
+ PKER_RACCSS( 29, 40) = 0.457451E+00
+ PKER_RACCSS( 30, 1) = 0.133375E+02
+ PKER_RACCSS( 30, 2) = 0.109457E+02
+ PKER_RACCSS( 30, 3) = 0.896468E+01
+ PKER_RACCSS( 30, 4) = 0.732350E+01
+ PKER_RACCSS( 30, 5) = 0.596323E+01
+ PKER_RACCSS( 30, 6) = 0.483579E+01
+ PKER_RACCSS( 30, 7) = 0.390254E+01
+ PKER_RACCSS( 30, 8) = 0.313132E+01
+ PKER_RACCSS( 30, 9) = 0.249276E+01
+ PKER_RACCSS( 30, 10) = 0.196278E+01
+ PKER_RACCSS( 30, 11) = 0.152606E+01
+ PKER_RACCSS( 30, 12) = 0.116570E+01
+ PKER_RACCSS( 30, 13) = 0.869566E+00
+ PKER_RACCSS( 30, 14) = 0.628357E+00
+ PKER_RACCSS( 30, 15) = 0.436329E+00
+ PKER_RACCSS( 30, 16) = 0.290939E+00
+ PKER_RACCSS( 30, 17) = 0.192920E+00
+ PKER_RACCSS( 30, 18) = 0.142864E+00
+ PKER_RACCSS( 30, 19) = 0.136857E+00
+ PKER_RACCSS( 30, 20) = 0.162977E+00
+ PKER_RACCSS( 30, 21) = 0.204357E+00
+ PKER_RACCSS( 30, 22) = 0.246873E+00
+ PKER_RACCSS( 30, 23) = 0.283849E+00
+ PKER_RACCSS( 30, 24) = 0.314229E+00
+ PKER_RACCSS( 30, 25) = 0.338918E+00
+ PKER_RACCSS( 30, 26) = 0.359002E+00
+ PKER_RACCSS( 30, 27) = 0.375384E+00
+ PKER_RACCSS( 30, 28) = 0.388781E+00
+ PKER_RACCSS( 30, 29) = 0.399761E+00
+ PKER_RACCSS( 30, 30) = 0.408775E+00
+ PKER_RACCSS( 30, 31) = 0.416186E+00
+ PKER_RACCSS( 30, 32) = 0.422287E+00
+ PKER_RACCSS( 30, 33) = 0.427315E+00
+ PKER_RACCSS( 30, 34) = 0.431462E+00
+ PKER_RACCSS( 30, 35) = 0.434884E+00
+ PKER_RACCSS( 30, 36) = 0.437711E+00
+ PKER_RACCSS( 30, 37) = 0.440046E+00
+ PKER_RACCSS( 30, 38) = 0.441975E+00
+ PKER_RACCSS( 30, 39) = 0.443571E+00
+ PKER_RACCSS( 30, 40) = 0.444890E+00
+ PKER_RACCSS( 31, 1) = 0.133457E+02
+ PKER_RACCSS( 31, 2) = 0.109540E+02
+ PKER_RACCSS( 31, 3) = 0.897333E+01
+ PKER_RACCSS( 31, 4) = 0.733289E+01
+ PKER_RACCSS( 31, 5) = 0.597403E+01
+ PKER_RACCSS( 31, 6) = 0.484844E+01
+ PKER_RACCSS( 31, 7) = 0.391622E+01
+ PKER_RACCSS( 31, 8) = 0.314409E+01
+ PKER_RACCSS( 31, 9) = 0.250503E+01
+ PKER_RACCSS( 31, 10) = 0.197608E+01
+ PKER_RACCSS( 31, 11) = 0.153866E+01
+ PKER_RACCSS( 31, 12) = 0.117759E+01
+ PKER_RACCSS( 31, 13) = 0.880647E+00
+ PKER_RACCSS( 31, 14) = 0.638378E+00
+ PKER_RACCSS( 31, 15) = 0.444889E+00
+ PKER_RACCSS( 31, 16) = 0.297371E+00
+ PKER_RACCSS( 31, 17) = 0.196420E+00
+ PKER_RACCSS( 31, 18) = 0.142908E+00
+ PKER_RACCSS( 31, 19) = 0.133631E+00
+ PKER_RACCSS( 31, 20) = 0.157422E+00
+ PKER_RACCSS( 31, 21) = 0.197662E+00
+ PKER_RACCSS( 31, 22) = 0.239819E+00
+ PKER_RACCSS( 31, 23) = 0.276723E+00
+ PKER_RACCSS( 31, 24) = 0.307082E+00
+ PKER_RACCSS( 31, 25) = 0.331764E+00
+ PKER_RACCSS( 31, 26) = 0.351849E+00
+ PKER_RACCSS( 31, 27) = 0.368231E+00
+ PKER_RACCSS( 31, 28) = 0.381625E+00
+ PKER_RACCSS( 31, 29) = 0.392598E+00
+ PKER_RACCSS( 31, 30) = 0.401604E+00
+ PKER_RACCSS( 31, 31) = 0.409008E+00
+ PKER_RACCSS( 31, 32) = 0.415101E+00
+ PKER_RACCSS( 31, 33) = 0.420122E+00
+ PKER_RACCSS( 31, 34) = 0.424262E+00
+ PKER_RACCSS( 31, 35) = 0.427680E+00
+ PKER_RACCSS( 31, 36) = 0.430501E+00
+ PKER_RACCSS( 31, 37) = 0.432833E+00
+ PKER_RACCSS( 31, 38) = 0.434760E+00
+ PKER_RACCSS( 31, 39) = 0.436352E+00
+ PKER_RACCSS( 31, 40) = 0.437670E+00
+ PKER_RACCSS( 32, 1) = 0.133505E+02
+ PKER_RACCSS( 32, 2) = 0.109589E+02
+ PKER_RACCSS( 32, 3) = 0.897836E+01
+ PKER_RACCSS( 32, 4) = 0.733809E+01
+ PKER_RACCSS( 32, 5) = 0.597956E+01
+ PKER_RACCSS( 32, 6) = 0.485431E+01
+ PKER_RACCSS( 32, 7) = 0.392231E+01
+ PKER_RACCSS( 32, 8) = 0.315042E+01
+ PKER_RACCSS( 32, 9) = 0.251126E+01
+ PKER_RACCSS( 32, 10) = 0.198225E+01
+ PKER_RACCSS( 32, 11) = 0.154473E+01
+ PKER_RACCSS( 32, 12) = 0.118355E+01
+ PKER_RACCSS( 32, 13) = 0.886389E+00
+ PKER_RACCSS( 32, 14) = 0.643737E+00
+ PKER_RACCSS( 32, 15) = 0.449607E+00
+ PKER_RACCSS( 32, 16) = 0.300995E+00
+ PKER_RACCSS( 32, 17) = 0.198415E+00
+ PKER_RACCSS( 32, 18) = 0.142843E+00
+ PKER_RACCSS( 32, 19) = 0.131565E+00
+ PKER_RACCSS( 32, 20) = 0.153886E+00
+ PKER_RACCSS( 32, 21) = 0.193406E+00
+ PKER_RACCSS( 32, 22) = 0.235356E+00
+ PKER_RACCSS( 32, 23) = 0.272245E+00
+ PKER_RACCSS( 32, 24) = 0.302622E+00
+ PKER_RACCSS( 32, 25) = 0.327315E+00
+ PKER_RACCSS( 32, 26) = 0.347401E+00
+ PKER_RACCSS( 32, 27) = 0.363781E+00
+ PKER_RACCSS( 32, 28) = 0.377168E+00
+ PKER_RACCSS( 32, 29) = 0.388134E+00
+ PKER_RACCSS( 32, 30) = 0.397132E+00
+ PKER_RACCSS( 32, 31) = 0.404527E+00
+ PKER_RACCSS( 32, 32) = 0.410614E+00
+ PKER_RACCSS( 32, 33) = 0.415629E+00
+ PKER_RACCSS( 32, 34) = 0.419764E+00
+ PKER_RACCSS( 32, 35) = 0.423177E+00
+ PKER_RACCSS( 32, 36) = 0.425995E+00
+ PKER_RACCSS( 32, 37) = 0.428323E+00
+ PKER_RACCSS( 32, 38) = 0.430248E+00
+ PKER_RACCSS( 32, 39) = 0.431839E+00
+ PKER_RACCSS( 32, 40) = 0.433154E+00
+ PKER_RACCSS( 33, 1) = 0.133549E+02
+ PKER_RACCSS( 33, 2) = 0.109634E+02
+ PKER_RACCSS( 33, 3) = 0.898293E+01
+ PKER_RACCSS( 33, 4) = 0.734275E+01
+ PKER_RACCSS( 33, 5) = 0.598430E+01
+ PKER_RACCSS( 33, 6) = 0.485916E+01
+ PKER_RACCSS( 33, 7) = 0.392725E+01
+ PKER_RACCSS( 33, 8) = 0.315543E+01
+ PKER_RACCSS( 33, 9) = 0.251634E+01
+ PKER_RACCSS( 33, 10) = 0.198734E+01
+ PKER_RACCSS( 33, 11) = 0.154980E+01
+ PKER_RACCSS( 33, 12) = 0.118857E+01
+ PKER_RACCSS( 33, 13) = 0.891252E+00
+ PKER_RACCSS( 33, 14) = 0.648304E+00
+ PKER_RACCSS( 33, 15) = 0.453668E+00
+ PKER_RACCSS( 33, 16) = 0.304190E+00
+ PKER_RACCSS( 33, 17) = 0.200247E+00
+ PKER_RACCSS( 33, 18) = 0.142958E+00
+ PKER_RACCSS( 33, 19) = 0.129943E+00
+ PKER_RACCSS( 33, 20) = 0.150972E+00
+ PKER_RACCSS( 33, 21) = 0.189862E+00
+ PKER_RACCSS( 33, 22) = 0.231629E+00
+ PKER_RACCSS( 33, 23) = 0.268519E+00
+ PKER_RACCSS( 33, 24) = 0.298923E+00
+ PKER_RACCSS( 33, 25) = 0.323635E+00
+ PKER_RACCSS( 33, 26) = 0.343732E+00
+ PKER_RACCSS( 33, 27) = 0.360115E+00
+ PKER_RACCSS( 33, 28) = 0.373503E+00
+ PKER_RACCSS( 33, 29) = 0.384466E+00
+ PKER_RACCSS( 33, 30) = 0.393460E+00
+ PKER_RACCSS( 33, 31) = 0.400852E+00
+ PKER_RACCSS( 33, 32) = 0.406935E+00
+ PKER_RACCSS( 33, 33) = 0.411946E+00
+ PKER_RACCSS( 33, 34) = 0.416078E+00
+ PKER_RACCSS( 33, 35) = 0.419488E+00
+ PKER_RACCSS( 33, 36) = 0.422304E+00
+ PKER_RACCSS( 33, 37) = 0.424631E+00
+ PKER_RACCSS( 33, 38) = 0.426553E+00
+ PKER_RACCSS( 33, 39) = 0.428143E+00
+ PKER_RACCSS( 33, 40) = 0.429458E+00
+ PKER_RACCSS( 34, 1) = 0.133545E+02
+ PKER_RACCSS( 34, 2) = 0.109630E+02
+ PKER_RACCSS( 34, 3) = 0.898249E+01
+ PKER_RACCSS( 34, 4) = 0.734231E+01
+ PKER_RACCSS( 34, 5) = 0.598387E+01
+ PKER_RACCSS( 34, 6) = 0.485874E+01
+ PKER_RACCSS( 34, 7) = 0.392685E+01
+ PKER_RACCSS( 34, 8) = 0.315505E+01
+ PKER_RACCSS( 34, 9) = 0.251599E+01
+ PKER_RACCSS( 34, 10) = 0.198703E+01
+ PKER_RACCSS( 34, 11) = 0.154953E+01
+ PKER_RACCSS( 34, 12) = 0.118835E+01
+ PKER_RACCSS( 34, 13) = 0.891084E+00
+ PKER_RACCSS( 34, 14) = 0.648191E+00
+ PKER_RACCSS( 34, 15) = 0.453598E+00
+ PKER_RACCSS( 34, 16) = 0.304088E+00
+ PKER_RACCSS( 34, 17) = 0.200150E+00
+ PKER_RACCSS( 34, 18) = 0.142751E+00
+ PKER_RACCSS( 34, 19) = 0.129699E+00
+ PKER_RACCSS( 34, 20) = 0.150660E+00
+ PKER_RACCSS( 34, 21) = 0.189538E+00
+ PKER_RACCSS( 34, 22) = 0.231282E+00
+ PKER_RACCSS( 34, 23) = 0.268145E+00
+ PKER_RACCSS( 34, 24) = 0.298523E+00
+ PKER_RACCSS( 34, 25) = 0.323213E+00
+ PKER_RACCSS( 34, 26) = 0.343290E+00
+ PKER_RACCSS( 34, 27) = 0.359658E+00
+ PKER_RACCSS( 34, 28) = 0.373032E+00
+ PKER_RACCSS( 34, 29) = 0.383985E+00
+ PKER_RACCSS( 34, 30) = 0.392971E+00
+ PKER_RACCSS( 34, 31) = 0.400356E+00
+ PKER_RACCSS( 34, 32) = 0.406433E+00
+ PKER_RACCSS( 34, 33) = 0.411440E+00
+ PKER_RACCSS( 34, 34) = 0.415568E+00
+ PKER_RACCSS( 34, 35) = 0.418976E+00
+ PKER_RACCSS( 34, 36) = 0.421789E+00
+ PKER_RACCSS( 34, 37) = 0.424114E+00
+ PKER_RACCSS( 34, 38) = 0.426035E+00
+ PKER_RACCSS( 34, 39) = 0.427624E+00
+ PKER_RACCSS( 34, 40) = 0.428937E+00
+ PKER_RACCSS( 35, 1) = 0.133588E+02
+ PKER_RACCSS( 35, 2) = 0.109673E+02
+ PKER_RACCSS( 35, 3) = 0.898695E+01
+ PKER_RACCSS( 35, 4) = 0.734684E+01
+ PKER_RACCSS( 35, 5) = 0.598848E+01
+ PKER_RACCSS( 35, 6) = 0.486341E+01
+ PKER_RACCSS( 35, 7) = 0.393158E+01
+ PKER_RACCSS( 35, 8) = 0.315983E+01
+ PKER_RACCSS( 35, 9) = 0.252079E+01
+ PKER_RACCSS( 35, 10) = 0.199184E+01
+ PKER_RACCSS( 35, 11) = 0.155430E+01
+ PKER_RACCSS( 35, 12) = 0.119306E+01
+ PKER_RACCSS( 35, 13) = 0.895641E+00
+ PKER_RACCSS( 35, 14) = 0.652461E+00
+ PKER_RACCSS( 35, 15) = 0.457402E+00
+ PKER_RACCSS( 35, 16) = 0.307153E+00
+ PKER_RACCSS( 35, 17) = 0.201981E+00
+ PKER_RACCSS( 35, 18) = 0.143041E+00
+ PKER_RACCSS( 35, 19) = 0.128393E+00
+ PKER_RACCSS( 35, 20) = 0.148145E+00
+ PKER_RACCSS( 35, 21) = 0.186428E+00
+ PKER_RACCSS( 35, 22) = 0.228006E+00
+ PKER_RACCSS( 35, 23) = 0.264882E+00
+ PKER_RACCSS( 35, 24) = 0.295301E+00
+ PKER_RACCSS( 35, 25) = 0.320021E+00
+ PKER_RACCSS( 35, 26) = 0.340118E+00
+ PKER_RACCSS( 35, 27) = 0.356498E+00
+ PKER_RACCSS( 35, 28) = 0.369879E+00
+ PKER_RACCSS( 35, 29) = 0.380835E+00
+ PKER_RACCSS( 35, 30) = 0.389822E+00
+ PKER_RACCSS( 35, 31) = 0.397206E+00
+ PKER_RACCSS( 35, 32) = 0.403283E+00
+ PKER_RACCSS( 35, 33) = 0.408288E+00
+ PKER_RACCSS( 35, 34) = 0.412416E+00
+ PKER_RACCSS( 35, 35) = 0.415822E+00
+ PKER_RACCSS( 35, 36) = 0.418634E+00
+ PKER_RACCSS( 35, 37) = 0.420958E+00
+ PKER_RACCSS( 35, 38) = 0.422879E+00
+ PKER_RACCSS( 35, 39) = 0.424467E+00
+ PKER_RACCSS( 35, 40) = 0.425780E+00
+ PKER_RACCSS( 36, 1) = 0.133693E+02
+ PKER_RACCSS( 36, 2) = 0.109781E+02
+ PKER_RACCSS( 36, 3) = 0.899787E+01
+ PKER_RACCSS( 36, 4) = 0.735793E+01
+ PKER_RACCSS( 36, 5) = 0.599972E+01
+ PKER_RACCSS( 36, 6) = 0.487480E+01
+ PKER_RACCSS( 36, 7) = 0.394309E+01
+ PKER_RACCSS( 36, 8) = 0.317142E+01
+ PKER_RACCSS( 36, 9) = 0.253243E+01
+ PKER_RACCSS( 36, 10) = 0.200346E+01
+ PKER_RACCSS( 36, 11) = 0.156582E+01
+ PKER_RACCSS( 36, 12) = 0.120440E+01
+ PKER_RACCSS( 36, 13) = 0.906578E+00
+ PKER_RACCSS( 36, 14) = 0.662698E+00
+ PKER_RACCSS( 36, 15) = 0.466524E+00
+ PKER_RACCSS( 36, 16) = 0.314682E+00
+ PKER_RACCSS( 36, 17) = 0.206574E+00
+ PKER_RACCSS( 36, 18) = 0.144245E+00
+ PKER_RACCSS( 36, 19) = 0.125763E+00
+ PKER_RACCSS( 36, 20) = 0.142684E+00
+ PKER_RACCSS( 36, 21) = 0.179440E+00
+ PKER_RACCSS( 36, 22) = 0.220596E+00
+ PKER_RACCSS( 36, 23) = 0.257524E+00
+ PKER_RACCSS( 36, 24) = 0.288068E+00
+ PKER_RACCSS( 36, 25) = 0.312888E+00
+ PKER_RACCSS( 36, 26) = 0.333055E+00
+ PKER_RACCSS( 36, 27) = 0.349481E+00
+ PKER_RACCSS( 36, 28) = 0.362892E+00
+ PKER_RACCSS( 36, 29) = 0.373867E+00
+ PKER_RACCSS( 36, 30) = 0.382866E+00
+ PKER_RACCSS( 36, 31) = 0.390258E+00
+ PKER_RACCSS( 36, 32) = 0.396339E+00
+ PKER_RACCSS( 36, 33) = 0.401346E+00
+ PKER_RACCSS( 36, 34) = 0.405475E+00
+ PKER_RACCSS( 36, 35) = 0.408881E+00
+ PKER_RACCSS( 36, 36) = 0.411694E+00
+ PKER_RACCSS( 36, 37) = 0.414017E+00
+ PKER_RACCSS( 36, 38) = 0.415937E+00
+ PKER_RACCSS( 36, 39) = 0.417525E+00
+ PKER_RACCSS( 36, 40) = 0.418837E+00
PKER_RACCSS( 37, 1) = 0.000000E+00
PKER_RACCSS( 37, 2) = 0.000000E+00
PKER_RACCSS( 37, 3) = 0.000000E+00
@@ -1745,2125 +1712,2125 @@ IF( PRESENT(PKER_RACCSS) ) THEN
END IF
!
IF( PRESENT(PKER_RACCS ) ) THEN
- PKER_RACCS ( 1, 1) = 0.814426E+01
- PKER_RACCS ( 1, 2) = 0.628964E+01
- PKER_RACCS ( 1, 3) = 0.478343E+01
- PKER_RACCS ( 1, 4) = 0.356446E+01
- PKER_RACCS ( 1, 5) = 0.259019E+01
- PKER_RACCS ( 1, 6) = 0.183450E+01
- PKER_RACCS ( 1, 7) = 0.128354E+01
- PKER_RACCS ( 1, 8) = 0.931518E+00
- PKER_RACCS ( 1, 9) = 0.767621E+00
- PKER_RACCS ( 1, 10) = 0.765023E+00
- PKER_RACCS ( 1, 11) = 0.877850E+00
- PKER_RACCS ( 1, 12) = 0.105028E+01
- PKER_RACCS ( 1, 13) = 0.123545E+01
- PKER_RACCS ( 1, 14) = 0.140595E+01
- PKER_RACCS ( 1, 15) = 0.155229E+01
- PKER_RACCS ( 1, 16) = 0.167456E+01
- PKER_RACCS ( 1, 17) = 0.177591E+01
- PKER_RACCS ( 1, 18) = 0.185978E+01
- PKER_RACCS ( 1, 19) = 0.192918E+01
- PKER_RACCS ( 1, 20) = 0.198661E+01
- PKER_RACCS ( 1, 21) = 0.203413E+01
- PKER_RACCS ( 1, 22) = 0.207346E+01
- PKER_RACCS ( 1, 23) = 0.210601E+01
- PKER_RACCS ( 1, 24) = 0.213295E+01
- PKER_RACCS ( 1, 25) = 0.215525E+01
- PKER_RACCS ( 1, 26) = 0.217370E+01
- PKER_RACCS ( 1, 27) = 0.218898E+01
- PKER_RACCS ( 1, 28) = 0.220163E+01
- PKER_RACCS ( 1, 29) = 0.221209E+01
- PKER_RACCS ( 1, 30) = 0.222076E+01
- PKER_RACCS ( 1, 31) = 0.222793E+01
- PKER_RACCS ( 1, 32) = 0.223387E+01
- PKER_RACCS ( 1, 33) = 0.223878E+01
- PKER_RACCS ( 1, 34) = 0.224285E+01
- PKER_RACCS ( 1, 35) = 0.224622E+01
- PKER_RACCS ( 1, 36) = 0.224900E+01
- PKER_RACCS ( 1, 37) = 0.225131E+01
- PKER_RACCS ( 1, 38) = 0.225322E+01
- PKER_RACCS ( 1, 39) = 0.225480E+01
- PKER_RACCS ( 1, 40) = 0.225611E+01
- PKER_RACCS ( 2, 1) = 0.839153E+01
- PKER_RACCS ( 2, 2) = 0.650044E+01
- PKER_RACCS ( 2, 3) = 0.496754E+01
- PKER_RACCS ( 2, 4) = 0.372667E+01
- PKER_RACCS ( 2, 5) = 0.273066E+01
- PKER_RACCS ( 2, 6) = 0.194869E+01
- PKER_RACCS ( 2, 7) = 0.136367E+01
- PKER_RACCS ( 2, 8) = 0.968276E+00
- PKER_RACCS ( 2, 9) = 0.754403E+00
- PKER_RACCS ( 2, 10) = 0.703547E+00
- PKER_RACCS ( 2, 11) = 0.778348E+00
- PKER_RACCS ( 2, 12) = 0.926703E+00
- PKER_RACCS ( 2, 13) = 0.110037E+01
- PKER_RACCS ( 2, 14) = 0.126682E+01
- PKER_RACCS ( 2, 15) = 0.141220E+01
- PKER_RACCS ( 2, 16) = 0.153439E+01
- PKER_RACCS ( 2, 17) = 0.163583E+01
- PKER_RACCS ( 2, 18) = 0.171978E+01
- PKER_RACCS ( 2, 19) = 0.178924E+01
- PKER_RACCS ( 2, 20) = 0.184671E+01
- PKER_RACCS ( 2, 21) = 0.189427E+01
- PKER_RACCS ( 2, 22) = 0.193362E+01
- PKER_RACCS ( 2, 23) = 0.196619E+01
- PKER_RACCS ( 2, 24) = 0.199315E+01
- PKER_RACCS ( 2, 25) = 0.201546E+01
- PKER_RACCS ( 2, 26) = 0.203392E+01
- PKER_RACCS ( 2, 27) = 0.204920E+01
- PKER_RACCS ( 2, 28) = 0.206185E+01
- PKER_RACCS ( 2, 29) = 0.207232E+01
- PKER_RACCS ( 2, 30) = 0.208099E+01
- PKER_RACCS ( 2, 31) = 0.208817E+01
- PKER_RACCS ( 2, 32) = 0.209410E+01
- PKER_RACCS ( 2, 33) = 0.209902E+01
- PKER_RACCS ( 2, 34) = 0.210309E+01
- PKER_RACCS ( 2, 35) = 0.210646E+01
- PKER_RACCS ( 2, 36) = 0.210924E+01
- PKER_RACCS ( 2, 37) = 0.211155E+01
- PKER_RACCS ( 2, 38) = 0.211346E+01
- PKER_RACCS ( 2, 39) = 0.211504E+01
- PKER_RACCS ( 2, 40) = 0.211635E+01
- PKER_RACCS ( 3, 1) = 0.865470E+01
- PKER_RACCS ( 3, 2) = 0.672067E+01
- PKER_RACCS ( 3, 3) = 0.515647E+01
- PKER_RACCS ( 3, 4) = 0.389136E+01
- PKER_RACCS ( 3, 5) = 0.287356E+01
- PKER_RACCS ( 3, 6) = 0.206767E+01
- PKER_RACCS ( 3, 7) = 0.145267E+01
- PKER_RACCS ( 3, 8) = 0.101884E+01
- PKER_RACCS ( 3, 9) = 0.759717E+00
- PKER_RACCS ( 3, 10) = 0.661694E+00
- PKER_RACCS ( 3, 11) = 0.696084E+00
- PKER_RACCS ( 3, 12) = 0.816907E+00
- PKER_RACCS ( 3, 13) = 0.976132E+00
- PKER_RACCS ( 3, 14) = 0.113696E+01
- PKER_RACCS ( 3, 15) = 0.128080E+01
- PKER_RACCS ( 3, 16) = 0.140279E+01
- PKER_RACCS ( 3, 17) = 0.150431E+01
- PKER_RACCS ( 3, 18) = 0.158836E+01
- PKER_RACCS ( 3, 19) = 0.165789E+01
- PKER_RACCS ( 3, 20) = 0.171542E+01
- PKER_RACCS ( 3, 21) = 0.176302E+01
- PKER_RACCS ( 3, 22) = 0.180240E+01
- PKER_RACCS ( 3, 23) = 0.183499E+01
- PKER_RACCS ( 3, 24) = 0.186197E+01
- PKER_RACCS ( 3, 25) = 0.188429E+01
- PKER_RACCS ( 3, 26) = 0.190276E+01
- PKER_RACCS ( 3, 27) = 0.191805E+01
- PKER_RACCS ( 3, 28) = 0.193071E+01
- PKER_RACCS ( 3, 29) = 0.194118E+01
- PKER_RACCS ( 3, 30) = 0.194986E+01
- PKER_RACCS ( 3, 31) = 0.195703E+01
- PKER_RACCS ( 3, 32) = 0.196297E+01
- PKER_RACCS ( 3, 33) = 0.196789E+01
- PKER_RACCS ( 3, 34) = 0.197196E+01
- PKER_RACCS ( 3, 35) = 0.197533E+01
- PKER_RACCS ( 3, 36) = 0.197812E+01
- PKER_RACCS ( 3, 37) = 0.198043E+01
- PKER_RACCS ( 3, 38) = 0.198234E+01
- PKER_RACCS ( 3, 39) = 0.198392E+01
- PKER_RACCS ( 3, 40) = 0.198523E+01
- PKER_RACCS ( 4, 1) = 0.893754E+01
- PKER_RACCS ( 4, 2) = 0.695364E+01
- PKER_RACCS ( 4, 3) = 0.535280E+01
- PKER_RACCS ( 4, 4) = 0.406028E+01
- PKER_RACCS ( 4, 5) = 0.301947E+01
- PKER_RACCS ( 4, 6) = 0.219059E+01
- PKER_RACCS ( 4, 7) = 0.154888E+01
- PKER_RACCS ( 4, 8) = 0.108073E+01
- PKER_RACCS ( 4, 9) = 0.780001E+00
- PKER_RACCS ( 4, 10) = 0.637424E+00
- PKER_RACCS ( 4, 11) = 0.630494E+00
- PKER_RACCS ( 4, 12) = 0.721212E+00
- PKER_RACCS ( 4, 13) = 0.862905E+00
- PKER_RACCS ( 4, 14) = 0.101614E+01
- PKER_RACCS ( 4, 15) = 0.115766E+01
- PKER_RACCS ( 4, 16) = 0.127924E+01
- PKER_RACCS ( 4, 17) = 0.138081E+01
- PKER_RACCS ( 4, 18) = 0.146497E+01
- PKER_RACCS ( 4, 19) = 0.153460E+01
- PKER_RACCS ( 4, 20) = 0.159220E+01
- PKER_RACCS ( 4, 21) = 0.163984E+01
- PKER_RACCS ( 4, 22) = 0.167926E+01
- PKER_RACCS ( 4, 23) = 0.171188E+01
- PKER_RACCS ( 4, 24) = 0.173888E+01
- PKER_RACCS ( 4, 25) = 0.176121E+01
- PKER_RACCS ( 4, 26) = 0.177970E+01
- PKER_RACCS ( 4, 27) = 0.179500E+01
- PKER_RACCS ( 4, 28) = 0.180766E+01
- PKER_RACCS ( 4, 29) = 0.181814E+01
- PKER_RACCS ( 4, 30) = 0.182682E+01
- PKER_RACCS ( 4, 31) = 0.183400E+01
- PKER_RACCS ( 4, 32) = 0.183994E+01
- PKER_RACCS ( 4, 33) = 0.184486E+01
- PKER_RACCS ( 4, 34) = 0.184893E+01
- PKER_RACCS ( 4, 35) = 0.185230E+01
- PKER_RACCS ( 4, 36) = 0.185509E+01
- PKER_RACCS ( 4, 37) = 0.185740E+01
- PKER_RACCS ( 4, 38) = 0.185931E+01
- PKER_RACCS ( 4, 39) = 0.186089E+01
- PKER_RACCS ( 4, 40) = 0.186220E+01
- PKER_RACCS ( 5, 1) = 0.924285E+01
- PKER_RACCS ( 5, 2) = 0.720238E+01
- PKER_RACCS ( 5, 3) = 0.555928E+01
- PKER_RACCS ( 5, 4) = 0.423533E+01
- PKER_RACCS ( 5, 5) = 0.316956E+01
- PKER_RACCS ( 5, 6) = 0.231791E+01
- PKER_RACCS ( 5, 7) = 0.165116E+01
- PKER_RACCS ( 5, 8) = 0.115255E+01
- PKER_RACCS ( 5, 9) = 0.814299E+00
- PKER_RACCS ( 5, 10) = 0.629004E+00
- PKER_RACCS ( 5, 11) = 0.581107E+00
- PKER_RACCS ( 5, 12) = 0.639553E+00
- PKER_RACCS ( 5, 13) = 0.760776E+00
- PKER_RACCS ( 5, 14) = 0.904271E+00
- PKER_RACCS ( 5, 15) = 0.104240E+01
- PKER_RACCS ( 5, 16) = 0.116324E+01
- PKER_RACCS ( 5, 17) = 0.126482E+01
- PKER_RACCS ( 5, 18) = 0.134911E+01
- PKER_RACCS ( 5, 19) = 0.141885E+01
- PKER_RACCS ( 5, 20) = 0.147653E+01
- PKER_RACCS ( 5, 21) = 0.152423E+01
- PKER_RACCS ( 5, 22) = 0.156370E+01
- PKER_RACCS ( 5, 23) = 0.159635E+01
- PKER_RACCS ( 5, 24) = 0.162337E+01
- PKER_RACCS ( 5, 25) = 0.164573E+01
- PKER_RACCS ( 5, 26) = 0.166423E+01
- PKER_RACCS ( 5, 27) = 0.167954E+01
- PKER_RACCS ( 5, 28) = 0.169221E+01
- PKER_RACCS ( 5, 29) = 0.170270E+01
- PKER_RACCS ( 5, 30) = 0.171138E+01
- PKER_RACCS ( 5, 31) = 0.171856E+01
- PKER_RACCS ( 5, 32) = 0.172451E+01
- PKER_RACCS ( 5, 33) = 0.172943E+01
- PKER_RACCS ( 5, 34) = 0.173350E+01
- PKER_RACCS ( 5, 35) = 0.173687E+01
- PKER_RACCS ( 5, 36) = 0.173966E+01
- PKER_RACCS ( 5, 37) = 0.174197E+01
- PKER_RACCS ( 5, 38) = 0.174389E+01
- PKER_RACCS ( 5, 39) = 0.174547E+01
- PKER_RACCS ( 5, 40) = 0.174678E+01
- PKER_RACCS ( 6, 1) = 0.957149E+01
- PKER_RACCS ( 6, 2) = 0.746912E+01
- PKER_RACCS ( 6, 3) = 0.577847E+01
- PKER_RACCS ( 6, 4) = 0.441857E+01
- PKER_RACCS ( 6, 5) = 0.332499E+01
- PKER_RACCS ( 6, 6) = 0.244967E+01
- PKER_RACCS ( 6, 7) = 0.175911E+01
- PKER_RACCS ( 6, 8) = 0.123288E+01
- PKER_RACCS ( 6, 9) = 0.860857E+00
- PKER_RACCS ( 6, 10) = 0.636625E+00
- PKER_RACCS ( 6, 11) = 0.548403E+00
- PKER_RACCS ( 6, 12) = 0.572398E+00
- PKER_RACCS ( 6, 13) = 0.670215E+00
- PKER_RACCS ( 6, 14) = 0.801397E+00
- PKER_RACCS ( 6, 15) = 0.934778E+00
- PKER_RACCS ( 6, 16) = 0.105438E+01
- PKER_RACCS ( 6, 17) = 0.115586E+01
- PKER_RACCS ( 6, 18) = 0.124029E+01
- PKER_RACCS ( 6, 19) = 0.131016E+01
- PKER_RACCS ( 6, 20) = 0.136794E+01
- PKER_RACCS ( 6, 21) = 0.141572E+01
- PKER_RACCS ( 6, 22) = 0.145524E+01
- PKER_RACCS ( 6, 23) = 0.148793E+01
- PKER_RACCS ( 6, 24) = 0.151498E+01
- PKER_RACCS ( 6, 25) = 0.153736E+01
- PKER_RACCS ( 6, 26) = 0.155588E+01
- PKER_RACCS ( 6, 27) = 0.157120E+01
- PKER_RACCS ( 6, 28) = 0.158388E+01
- PKER_RACCS ( 6, 29) = 0.159438E+01
- PKER_RACCS ( 6, 30) = 0.160306E+01
- PKER_RACCS ( 6, 31) = 0.161025E+01
- PKER_RACCS ( 6, 32) = 0.161620E+01
- PKER_RACCS ( 6, 33) = 0.162112E+01
- PKER_RACCS ( 6, 34) = 0.162520E+01
- PKER_RACCS ( 6, 35) = 0.162857E+01
- PKER_RACCS ( 6, 36) = 0.163136E+01
- PKER_RACCS ( 6, 37) = 0.163368E+01
- PKER_RACCS ( 6, 38) = 0.163559E+01
- PKER_RACCS ( 6, 39) = 0.163717E+01
- PKER_RACCS ( 6, 40) = 0.163848E+01
- PKER_RACCS ( 7, 1) = 0.992136E+01
- PKER_RACCS ( 7, 2) = 0.775452E+01
- PKER_RACCS ( 7, 3) = 0.601220E+01
- PKER_RACCS ( 7, 4) = 0.461204E+01
- PKER_RACCS ( 7, 5) = 0.348745E+01
- PKER_RACCS ( 7, 6) = 0.258667E+01
- PKER_RACCS ( 7, 7) = 0.187240E+01
- PKER_RACCS ( 7, 8) = 0.132065E+01
- PKER_RACCS ( 7, 9) = 0.917845E+00
- PKER_RACCS ( 7, 10) = 0.657315E+00
- PKER_RACCS ( 7, 11) = 0.530840E+00
- PKER_RACCS ( 7, 12) = 0.519459E+00
- PKER_RACCS ( 7, 13) = 0.591459E+00
- PKER_RACCS ( 7, 14) = 0.707658E+00
- PKER_RACCS ( 7, 15) = 0.834585E+00
- PKER_RACCS ( 7, 16) = 0.952272E+00
- PKER_RACCS ( 7, 17) = 0.105349E+01
- PKER_RACCS ( 7, 18) = 0.113805E+01
- PKER_RACCS ( 7, 19) = 0.120808E+01
- PKER_RACCS ( 7, 20) = 0.126598E+01
- PKER_RACCS ( 7, 21) = 0.131385E+01
- PKER_RACCS ( 7, 22) = 0.135343E+01
- PKER_RACCS ( 7, 23) = 0.138617E+01
- PKER_RACCS ( 7, 24) = 0.141326E+01
- PKER_RACCS ( 7, 25) = 0.143566E+01
- PKER_RACCS ( 7, 26) = 0.145420E+01
- PKER_RACCS ( 7, 27) = 0.146954E+01
- PKER_RACCS ( 7, 28) = 0.148224E+01
- PKER_RACCS ( 7, 29) = 0.149274E+01
- PKER_RACCS ( 7, 30) = 0.150143E+01
- PKER_RACCS ( 7, 31) = 0.150863E+01
- PKER_RACCS ( 7, 32) = 0.151458E+01
- PKER_RACCS ( 7, 33) = 0.151951E+01
- PKER_RACCS ( 7, 34) = 0.152359E+01
- PKER_RACCS ( 7, 35) = 0.152696E+01
- PKER_RACCS ( 7, 36) = 0.152975E+01
- PKER_RACCS ( 7, 37) = 0.153207E+01
- PKER_RACCS ( 7, 38) = 0.153398E+01
- PKER_RACCS ( 7, 39) = 0.153557E+01
- PKER_RACCS ( 7, 40) = 0.153688E+01
- PKER_RACCS ( 8, 1) = 0.102868E+02
- PKER_RACCS ( 8, 2) = 0.805684E+01
- PKER_RACCS ( 8, 3) = 0.626092E+01
- PKER_RACCS ( 8, 4) = 0.481723E+01
- PKER_RACCS ( 8, 5) = 0.365838E+01
- PKER_RACCS ( 8, 6) = 0.273003E+01
- PKER_RACCS ( 8, 7) = 0.199156E+01
- PKER_RACCS ( 8, 8) = 0.141520E+01
- PKER_RACCS ( 8, 9) = 0.984343E+00
- PKER_RACCS ( 8, 10) = 0.690613E+00
- PKER_RACCS ( 8, 11) = 0.527056E+00
- PKER_RACCS ( 8, 12) = 0.480354E+00
- PKER_RACCS ( 8, 13) = 0.524589E+00
- PKER_RACCS ( 8, 14) = 0.623178E+00
- PKER_RACCS ( 8, 15) = 0.741765E+00
- PKER_RACCS ( 8, 16) = 0.856619E+00
- PKER_RACCS ( 8, 17) = 0.957307E+00
- PKER_RACCS ( 8, 18) = 0.104196E+01
- PKER_RACCS ( 8, 19) = 0.111217E+01
- PKER_RACCS ( 8, 20) = 0.117022E+01
- PKER_RACCS ( 8, 21) = 0.121820E+01
- PKER_RACCS ( 8, 22) = 0.125786E+01
- PKER_RACCS ( 8, 23) = 0.129066E+01
- PKER_RACCS ( 8, 24) = 0.131779E+01
- PKER_RACCS ( 8, 25) = 0.134023E+01
- PKER_RACCS ( 8, 26) = 0.135879E+01
- PKER_RACCS ( 8, 27) = 0.137415E+01
- PKER_RACCS ( 8, 28) = 0.138686E+01
- PKER_RACCS ( 8, 29) = 0.139737E+01
- PKER_RACCS ( 8, 30) = 0.140607E+01
- PKER_RACCS ( 8, 31) = 0.141327E+01
- PKER_RACCS ( 8, 32) = 0.141923E+01
- PKER_RACCS ( 8, 33) = 0.142417E+01
- PKER_RACCS ( 8, 34) = 0.142825E+01
- PKER_RACCS ( 8, 35) = 0.143162E+01
- PKER_RACCS ( 8, 36) = 0.143442E+01
- PKER_RACCS ( 8, 37) = 0.143673E+01
- PKER_RACCS ( 8, 38) = 0.143865E+01
- PKER_RACCS ( 8, 39) = 0.144023E+01
- PKER_RACCS ( 8, 40) = 0.144155E+01
- PKER_RACCS ( 9, 1) = 0.106586E+02
- PKER_RACCS ( 9, 2) = 0.837134E+01
- PKER_RACCS ( 9, 3) = 0.652308E+01
- PKER_RACCS ( 9, 4) = 0.503452E+01
- PKER_RACCS ( 9, 5) = 0.383885E+01
- PKER_RACCS ( 9, 6) = 0.288068E+01
- PKER_RACCS ( 9, 7) = 0.211691E+01
- PKER_RACCS ( 9, 8) = 0.151640E+01
- PKER_RACCS ( 9, 9) = 0.105934E+01
- PKER_RACCS ( 9, 10) = 0.735154E+00
- PKER_RACCS ( 9, 11) = 0.537362E+00
- PKER_RACCS ( 9, 12) = 0.455623E+00
- PKER_RACCS ( 9, 13) = 0.470067E+00
- PKER_RACCS ( 9, 14) = 0.548453E+00
- PKER_RACCS ( 9, 15) = 0.656404E+00
- PKER_RACCS ( 9, 16) = 0.767219E+00
- PKER_RACCS ( 9, 17) = 0.866939E+00
- PKER_RACCS ( 9, 18) = 0.951616E+00
- PKER_RACCS ( 9, 19) = 0.102203E+01
- PKER_RACCS ( 9, 20) = 0.108025E+01
- PKER_RACCS ( 9, 21) = 0.112837E+01
- PKER_RACCS ( 9, 22) = 0.116813E+01
- PKER_RACCS ( 9, 23) = 0.120100E+01
- PKER_RACCS ( 9, 24) = 0.122818E+01
- PKER_RACCS ( 9, 25) = 0.125066E+01
- PKER_RACCS ( 9, 26) = 0.126925E+01
- PKER_RACCS ( 9, 27) = 0.128464E+01
- PKER_RACCS ( 9, 28) = 0.129736E+01
- PKER_RACCS ( 9, 29) = 0.130789E+01
- PKER_RACCS ( 9, 30) = 0.131660E+01
- PKER_RACCS ( 9, 31) = 0.132381E+01
- PKER_RACCS ( 9, 32) = 0.132977E+01
- PKER_RACCS ( 9, 33) = 0.133471E+01
- PKER_RACCS ( 9, 34) = 0.133879E+01
- PKER_RACCS ( 9, 35) = 0.134218E+01
- PKER_RACCS ( 9, 36) = 0.134497E+01
- PKER_RACCS ( 9, 37) = 0.134729E+01
- PKER_RACCS ( 9, 38) = 0.134921E+01
- PKER_RACCS ( 9, 39) = 0.135079E+01
- PKER_RACCS ( 9, 40) = 0.135210E+01
- PKER_RACCS ( 10, 1) = 0.110254E+02
- PKER_RACCS ( 10, 2) = 0.869040E+01
- PKER_RACCS ( 10, 3) = 0.679467E+01
- PKER_RACCS ( 10, 4) = 0.526254E+01
- PKER_RACCS ( 10, 5) = 0.402907E+01
- PKER_RACCS ( 10, 6) = 0.303942E+01
- PKER_RACCS ( 10, 7) = 0.224898E+01
- PKER_RACCS ( 10, 8) = 0.162413E+01
- PKER_RACCS ( 10, 9) = 0.114216E+01
- PKER_RACCS ( 10, 10) = 0.789643E+00
- PKER_RACCS ( 10, 11) = 0.559475E+00
- PKER_RACCS ( 10, 12) = 0.444230E+00
- PKER_RACCS ( 10, 13) = 0.427864E+00
- PKER_RACCS ( 10, 14) = 0.483716E+00
- PKER_RACCS ( 10, 15) = 0.578655E+00
- PKER_RACCS ( 10, 16) = 0.683914E+00
- PKER_RACCS ( 10, 17) = 0.782074E+00
- PKER_RACCS ( 10, 18) = 0.866640E+00
- PKER_RACCS ( 10, 19) = 0.937264E+00
- PKER_RACCS ( 10, 20) = 0.995704E+00
- PKER_RACCS ( 10, 21) = 0.104398E+01
- PKER_RACCS ( 10, 22) = 0.108386E+01
- PKER_RACCS ( 10, 23) = 0.111682E+01
- PKER_RACCS ( 10, 24) = 0.114407E+01
- PKER_RACCS ( 10, 25) = 0.116659E+01
- PKER_RACCS ( 10, 26) = 0.118522E+01
- PKER_RACCS ( 10, 27) = 0.120063E+01
- PKER_RACCS ( 10, 28) = 0.121338E+01
- PKER_RACCS ( 10, 29) = 0.122392E+01
- PKER_RACCS ( 10, 30) = 0.123264E+01
- PKER_RACCS ( 10, 31) = 0.123986E+01
- PKER_RACCS ( 10, 32) = 0.124583E+01
- PKER_RACCS ( 10, 33) = 0.125077E+01
- PKER_RACCS ( 10, 34) = 0.125486E+01
- PKER_RACCS ( 10, 35) = 0.125825E+01
- PKER_RACCS ( 10, 36) = 0.126105E+01
- PKER_RACCS ( 10, 37) = 0.126337E+01
- PKER_RACCS ( 10, 38) = 0.126529E+01
- PKER_RACCS ( 10, 39) = 0.126687E+01
- PKER_RACCS ( 10, 40) = 0.126819E+01
- PKER_RACCS ( 11, 1) = 0.113754E+02
- PKER_RACCS ( 11, 2) = 0.900451E+01
- PKER_RACCS ( 11, 3) = 0.706934E+01
- PKER_RACCS ( 11, 4) = 0.549788E+01
- PKER_RACCS ( 11, 5) = 0.422787E+01
- PKER_RACCS ( 11, 6) = 0.320621E+01
- PKER_RACCS ( 11, 7) = 0.238819E+01
- PKER_RACCS ( 11, 8) = 0.173869E+01
- PKER_RACCS ( 11, 9) = 0.123242E+01
- PKER_RACCS ( 11, 10) = 0.853499E+00
- PKER_RACCS ( 11, 11) = 0.593264E+00
- PKER_RACCS ( 11, 12) = 0.445158E+00
- PKER_RACCS ( 11, 13) = 0.397733E+00
- PKER_RACCS ( 11, 14) = 0.429187E+00
- PKER_RACCS ( 11, 15) = 0.508684E+00
- PKER_RACCS ( 11, 16) = 0.606680E+00
- PKER_RACCS ( 11, 17) = 0.702460E+00
- PKER_RACCS ( 11, 18) = 0.786685E+00
- PKER_RACCS ( 11, 19) = 0.857512E+00
- PKER_RACCS ( 11, 20) = 0.916202E+00
- PKER_RACCS ( 11, 21) = 0.964675E+00
- PKER_RACCS ( 11, 22) = 0.100470E+01
- PKER_RACCS ( 11, 23) = 0.103777E+01
- PKER_RACCS ( 11, 24) = 0.106509E+01
- PKER_RACCS ( 11, 25) = 0.108768E+01
- PKER_RACCS ( 11, 26) = 0.110635E+01
- PKER_RACCS ( 11, 27) = 0.112179E+01
- PKER_RACCS ( 11, 28) = 0.113456E+01
- PKER_RACCS ( 11, 29) = 0.114512E+01
- PKER_RACCS ( 11, 30) = 0.115386E+01
- PKER_RACCS ( 11, 31) = 0.116109E+01
- PKER_RACCS ( 11, 32) = 0.116707E+01
- PKER_RACCS ( 11, 33) = 0.117202E+01
- PKER_RACCS ( 11, 34) = 0.117612E+01
- PKER_RACCS ( 11, 35) = 0.117950E+01
- PKER_RACCS ( 11, 36) = 0.118231E+01
- PKER_RACCS ( 11, 37) = 0.118463E+01
- PKER_RACCS ( 11, 38) = 0.118655E+01
- PKER_RACCS ( 11, 39) = 0.118814E+01
- PKER_RACCS ( 11, 40) = 0.118945E+01
- PKER_RACCS ( 12, 1) = 0.116988E+02
- PKER_RACCS ( 12, 2) = 0.930392E+01
- PKER_RACCS ( 12, 3) = 0.733917E+01
- PKER_RACCS ( 12, 4) = 0.573514E+01
- PKER_RACCS ( 12, 5) = 0.443234E+01
- PKER_RACCS ( 12, 6) = 0.337990E+01
- PKER_RACCS ( 12, 7) = 0.253428E+01
- PKER_RACCS ( 12, 8) = 0.185996E+01
- PKER_RACCS ( 12, 9) = 0.132989E+01
- PKER_RACCS ( 12, 10) = 0.925921E+00
- PKER_RACCS ( 12, 11) = 0.637666E+00
- PKER_RACCS ( 12, 12) = 0.458765E+00
- PKER_RACCS ( 12, 13) = 0.380203E+00
- PKER_RACCS ( 12, 14) = 0.385385E+00
- PKER_RACCS ( 12, 15) = 0.447035E+00
- PKER_RACCS ( 12, 16) = 0.535649E+00
- PKER_RACCS ( 12, 17) = 0.627944E+00
- PKER_RACCS ( 12, 18) = 0.711443E+00
- PKER_RACCS ( 12, 19) = 0.782423E+00
- PKER_RACCS ( 12, 20) = 0.841400E+00
- PKER_RACCS ( 12, 21) = 0.890112E+00
- PKER_RACCS ( 12, 22) = 0.930317E+00
- PKER_RACCS ( 12, 23) = 0.963511E+00
- PKER_RACCS ( 12, 24) = 0.990930E+00
- PKER_RACCS ( 12, 25) = 0.101359E+01
- PKER_RACCS ( 12, 26) = 0.103231E+01
- PKER_RACCS ( 12, 27) = 0.104779E+01
- PKER_RACCS ( 12, 28) = 0.106059E+01
- PKER_RACCS ( 12, 29) = 0.107118E+01
- PKER_RACCS ( 12, 30) = 0.107993E+01
- PKER_RACCS ( 12, 31) = 0.108718E+01
- PKER_RACCS ( 12, 32) = 0.109317E+01
- PKER_RACCS ( 12, 33) = 0.109812E+01
- PKER_RACCS ( 12, 34) = 0.110223E+01
- PKER_RACCS ( 12, 35) = 0.110562E+01
- PKER_RACCS ( 12, 36) = 0.110843E+01
- PKER_RACCS ( 12, 37) = 0.111075E+01
- PKER_RACCS ( 12, 38) = 0.111267E+01
- PKER_RACCS ( 12, 39) = 0.111426E+01
- PKER_RACCS ( 12, 40) = 0.111558E+01
- PKER_RACCS ( 13, 1) = 0.119889E+02
- PKER_RACCS ( 13, 2) = 0.958043E+01
- PKER_RACCS ( 13, 3) = 0.759606E+01
- PKER_RACCS ( 13, 4) = 0.596770E+01
- PKER_RACCS ( 13, 5) = 0.463793E+01
- PKER_RACCS ( 13, 6) = 0.355799E+01
- PKER_RACCS ( 13, 7) = 0.268619E+01
- PKER_RACCS ( 13, 8) = 0.198748E+01
- PKER_RACCS ( 13, 9) = 0.143413E+01
- PKER_RACCS ( 13, 10) = 0.100632E+01
- PKER_RACCS ( 13, 11) = 0.691714E+00
- PKER_RACCS ( 13, 12) = 0.483369E+00
- PKER_RACCS ( 13, 13) = 0.374777E+00
- PKER_RACCS ( 13, 14) = 0.352470E+00
- PKER_RACCS ( 13, 15) = 0.393978E+00
- PKER_RACCS ( 13, 16) = 0.471002E+00
- PKER_RACCS ( 13, 17) = 0.558411E+00
- PKER_RACCS ( 13, 18) = 0.640646E+00
- PKER_RACCS ( 13, 19) = 0.711672E+00
- PKER_RACCS ( 13, 20) = 0.770965E+00
- PKER_RACCS ( 13, 21) = 0.819964E+00
- PKER_RACCS ( 13, 22) = 0.860385E+00
- PKER_RACCS ( 13, 23) = 0.893737E+00
- PKER_RACCS ( 13, 24) = 0.921271E+00
- PKER_RACCS ( 13, 25) = 0.944012E+00
- PKER_RACCS ( 13, 26) = 0.962802E+00
- PKER_RACCS ( 13, 27) = 0.978330E+00
- PKER_RACCS ( 13, 28) = 0.991167E+00
- PKER_RACCS ( 13, 29) = 0.100178E+01
- PKER_RACCS ( 13, 30) = 0.101056E+01
- PKER_RACCS ( 13, 31) = 0.101782E+01
- PKER_RACCS ( 13, 32) = 0.102382E+01
- PKER_RACCS ( 13, 33) = 0.102879E+01
- PKER_RACCS ( 13, 34) = 0.103289E+01
- PKER_RACCS ( 13, 35) = 0.103629E+01
- PKER_RACCS ( 13, 36) = 0.103911E+01
- PKER_RACCS ( 13, 37) = 0.104143E+01
- PKER_RACCS ( 13, 38) = 0.104336E+01
- PKER_RACCS ( 13, 39) = 0.104495E+01
- PKER_RACCS ( 13, 40) = 0.104627E+01
- PKER_RACCS ( 14, 1) = 0.122430E+02
- PKER_RACCS ( 14, 2) = 0.982860E+01
- PKER_RACCS ( 14, 3) = 0.783321E+01
- PKER_RACCS ( 14, 4) = 0.618882E+01
- PKER_RACCS ( 14, 5) = 0.483905E+01
- PKER_RACCS ( 14, 6) = 0.373660E+01
- PKER_RACCS ( 14, 7) = 0.284160E+01
- PKER_RACCS ( 14, 8) = 0.212013E+01
- PKER_RACCS ( 14, 9) = 0.154456E+01
- PKER_RACCS ( 14, 10) = 0.109409E+01
- PKER_RACCS ( 14, 11) = 0.754883E+00
- PKER_RACCS ( 14, 12) = 0.518999E+00
- PKER_RACCS ( 14, 13) = 0.380699E+00
- PKER_RACCS ( 14, 14) = 0.330419E+00
- PKER_RACCS ( 14, 15) = 0.349888E+00
- PKER_RACCS ( 14, 16) = 0.412981E+00
- PKER_RACCS ( 14, 17) = 0.493882E+00
- PKER_RACCS ( 14, 18) = 0.574086E+00
- PKER_RACCS ( 14, 19) = 0.644958E+00
- PKER_RACCS ( 14, 20) = 0.704578E+00
- PKER_RACCS ( 14, 21) = 0.753918E+00
- PKER_RACCS ( 14, 22) = 0.794601E+00
- PKER_RACCS ( 14, 23) = 0.828145E+00
- PKER_RACCS ( 14, 24) = 0.855820E+00
- PKER_RACCS ( 14, 25) = 0.878666E+00
- PKER_RACCS ( 14, 26) = 0.897532E+00
- PKER_RACCS ( 14, 27) = 0.913119E+00
- PKER_RACCS ( 14, 28) = 0.925999E+00
- PKER_RACCS ( 14, 29) = 0.936646E+00
- PKER_RACCS ( 14, 30) = 0.945448E+00
- PKER_RACCS ( 14, 31) = 0.952726E+00
- PKER_RACCS ( 14, 32) = 0.958745E+00
- PKER_RACCS ( 14, 33) = 0.963723E+00
- PKER_RACCS ( 14, 34) = 0.967840E+00
- PKER_RACCS ( 14, 35) = 0.971246E+00
- PKER_RACCS ( 14, 36) = 0.974064E+00
- PKER_RACCS ( 14, 37) = 0.976395E+00
- PKER_RACCS ( 14, 38) = 0.978324E+00
- PKER_RACCS ( 14, 39) = 0.979920E+00
- PKER_RACCS ( 14, 40) = 0.981240E+00
- PKER_RACCS ( 15, 1) = 0.124614E+02
- PKER_RACCS ( 15, 2) = 0.100461E+02
- PKER_RACCS ( 15, 3) = 0.804614E+01
- PKER_RACCS ( 15, 4) = 0.639285E+01
- PKER_RACCS ( 15, 5) = 0.503002E+01
- PKER_RACCS ( 15, 6) = 0.391104E+01
- PKER_RACCS ( 15, 7) = 0.299717E+01
- PKER_RACCS ( 15, 8) = 0.225577E+01
- PKER_RACCS ( 15, 9) = 0.165987E+01
- PKER_RACCS ( 15, 10) = 0.118831E+01
- PKER_RACCS ( 15, 11) = 0.826200E+00
- PKER_RACCS ( 15, 12) = 0.564680E+00
- PKER_RACCS ( 15, 13) = 0.398301E+00
- PKER_RACCS ( 15, 14) = 0.319733E+00
- PKER_RACCS ( 15, 15) = 0.315376E+00
- PKER_RACCS ( 15, 16) = 0.362200E+00
- PKER_RACCS ( 15, 17) = 0.434552E+00
- PKER_RACCS ( 15, 18) = 0.511660E+00
- PKER_RACCS ( 15, 19) = 0.582018E+00
- PKER_RACCS ( 15, 20) = 0.641936E+00
- PKER_RACCS ( 15, 21) = 0.691670E+00
- PKER_RACCS ( 15, 22) = 0.732672E+00
- PKER_RACCS ( 15, 23) = 0.766451E+00
- PKER_RACCS ( 15, 24) = 0.794298E+00
- PKER_RACCS ( 15, 25) = 0.817269E+00
- PKER_RACCS ( 15, 26) = 0.836229E+00
- PKER_RACCS ( 15, 27) = 0.851886E+00
- PKER_RACCS ( 15, 28) = 0.864819E+00
- PKER_RACCS ( 15, 29) = 0.875505E+00
- PKER_RACCS ( 15, 30) = 0.884338E+00
- PKER_RACCS ( 15, 31) = 0.891639E+00
- PKER_RACCS ( 15, 32) = 0.897676E+00
- PKER_RACCS ( 15, 33) = 0.902668E+00
- PKER_RACCS ( 15, 34) = 0.906796E+00
- PKER_RACCS ( 15, 35) = 0.910210E+00
- PKER_RACCS ( 15, 36) = 0.913034E+00
- PKER_RACCS ( 15, 37) = 0.915371E+00
- PKER_RACCS ( 15, 38) = 0.917303E+00
- PKER_RACCS ( 15, 39) = 0.918902E+00
- PKER_RACCS ( 15, 40) = 0.920225E+00
- PKER_RACCS ( 16, 1) = 0.126466E+02
- PKER_RACCS ( 16, 2) = 0.102334E+02
- PKER_RACCS ( 16, 3) = 0.823298E+01
- PKER_RACCS ( 16, 4) = 0.657613E+01
- PKER_RACCS ( 16, 5) = 0.520617E+01
- PKER_RACCS ( 16, 6) = 0.407652E+01
- PKER_RACCS ( 16, 7) = 0.314887E+01
- PKER_RACCS ( 16, 8) = 0.239148E+01
- PKER_RACCS ( 16, 9) = 0.177804E+01
- PKER_RACCS ( 16, 10) = 0.128756E+01
- PKER_RACCS ( 16, 11) = 0.904610E+00
- PKER_RACCS ( 16, 12) = 0.619369E+00
- PKER_RACCS ( 16, 13) = 0.426243E+00
- PKER_RACCS ( 16, 14) = 0.320296E+00
- PKER_RACCS ( 16, 15) = 0.290790E+00
- PKER_RACCS ( 16, 16) = 0.319020E+00
- PKER_RACCS ( 16, 17) = 0.380654E+00
- PKER_RACCS ( 16, 18) = 0.453301E+00
- PKER_RACCS ( 16, 19) = 0.522625E+00
- PKER_RACCS ( 16, 20) = 0.582753E+00
- PKER_RACCS ( 16, 21) = 0.632931E+00
- PKER_RACCS ( 16, 22) = 0.674315E+00
- PKER_RACCS ( 16, 23) = 0.708381E+00
- PKER_RACCS ( 16, 24) = 0.736436E+00
- PKER_RACCS ( 16, 25) = 0.759561E+00
- PKER_RACCS ( 16, 26) = 0.778635E+00
- PKER_RACCS ( 16, 27) = 0.794376E+00
- PKER_RACCS ( 16, 28) = 0.807373E+00
- PKER_RACCS ( 16, 29) = 0.818107E+00
- PKER_RACCS ( 16, 30) = 0.826976E+00
- PKER_RACCS ( 16, 31) = 0.834305E+00
- PKER_RACCS ( 16, 32) = 0.840363E+00
- PKER_RACCS ( 16, 33) = 0.845372E+00
- PKER_RACCS ( 16, 34) = 0.849513E+00
- PKER_RACCS ( 16, 35) = 0.852937E+00
- PKER_RACCS ( 16, 36) = 0.855769E+00
- PKER_RACCS ( 16, 37) = 0.858111E+00
- PKER_RACCS ( 16, 38) = 0.860049E+00
- PKER_RACCS ( 16, 39) = 0.861651E+00
- PKER_RACCS ( 16, 40) = 0.862977E+00
- PKER_RACCS ( 17, 1) = 0.128025E+02
- PKER_RACCS ( 17, 2) = 0.103926E+02
- PKER_RACCS ( 17, 3) = 0.839412E+01
- PKER_RACCS ( 17, 4) = 0.673714E+01
- PKER_RACCS ( 17, 5) = 0.536445E+01
- PKER_RACCS ( 17, 6) = 0.422911E+01
- PKER_RACCS ( 17, 7) = 0.329268E+01
- PKER_RACCS ( 17, 8) = 0.252372E+01
- PKER_RACCS ( 17, 9) = 0.189638E+01
- PKER_RACCS ( 17, 10) = 0.138992E+01
- PKER_RACCS ( 17, 11) = 0.988667E+00
- PKER_RACCS ( 17, 12) = 0.682152E+00
- PKER_RACCS ( 17, 13) = 0.464420E+00
- PKER_RACCS ( 17, 14) = 0.331500E+00
- PKER_RACCS ( 17, 15) = 0.276277E+00
- PKER_RACCS ( 17, 16) = 0.283984E+00
- PKER_RACCS ( 17, 17) = 0.332552E+00
- PKER_RACCS ( 17, 18) = 0.399103E+00
- PKER_RACCS ( 17, 19) = 0.466619E+00
- PKER_RACCS ( 17, 20) = 0.526765E+00
- PKER_RACCS ( 17, 21) = 0.577417E+00
- PKER_RACCS ( 17, 22) = 0.619256E+00
- PKER_RACCS ( 17, 23) = 0.653670E+00
- PKER_RACCS ( 17, 24) = 0.681980E+00
- PKER_RACCS ( 17, 25) = 0.705292E+00
- PKER_RACCS ( 17, 26) = 0.724504E+00
- PKER_RACCS ( 17, 27) = 0.740347E+00
- PKER_RACCS ( 17, 28) = 0.753420E+00
- PKER_RACCS ( 17, 29) = 0.764213E+00
- PKER_RACCS ( 17, 30) = 0.773125E+00
- PKER_RACCS ( 17, 31) = 0.780488E+00
- PKER_RACCS ( 17, 32) = 0.786572E+00
- PKER_RACCS ( 17, 33) = 0.791600E+00
- PKER_RACCS ( 17, 34) = 0.795757E+00
- PKER_RACCS ( 17, 35) = 0.799193E+00
- PKER_RACCS ( 17, 36) = 0.802034E+00
- PKER_RACCS ( 17, 37) = 0.804383E+00
- PKER_RACCS ( 17, 38) = 0.806326E+00
- PKER_RACCS ( 17, 39) = 0.807933E+00
- PKER_RACCS ( 17, 40) = 0.809262E+00
- PKER_RACCS ( 18, 1) = 0.129333E+02
- PKER_RACCS ( 18, 2) = 0.105271E+02
- PKER_RACCS ( 18, 3) = 0.853146E+01
- PKER_RACCS ( 18, 4) = 0.687626E+01
- PKER_RACCS ( 18, 5) = 0.550368E+01
- PKER_RACCS ( 18, 6) = 0.436630E+01
- PKER_RACCS ( 18, 7) = 0.342530E+01
- PKER_RACCS ( 18, 8) = 0.264904E+01
- PKER_RACCS ( 18, 9) = 0.201178E+01
- PKER_RACCS ( 18, 10) = 0.149285E+01
- PKER_RACCS ( 18, 11) = 0.107638E+01
- PKER_RACCS ( 18, 12) = 0.751372E+00
- PKER_RACCS ( 18, 13) = 0.511541E+00
- PKER_RACCS ( 18, 14) = 0.353453E+00
- PKER_RACCS ( 18, 15) = 0.272312E+00
- PKER_RACCS ( 18, 16) = 0.257799E+00
- PKER_RACCS ( 18, 17) = 0.290956E+00
- PKER_RACCS ( 18, 18) = 0.349339E+00
- PKER_RACCS ( 18, 19) = 0.413950E+00
- PKER_RACCS ( 18, 20) = 0.473752E+00
- PKER_RACCS ( 18, 21) = 0.524859E+00
- PKER_RACCS ( 18, 22) = 0.567227E+00
- PKER_RACCS ( 18, 23) = 0.602062E+00
- PKER_RACCS ( 18, 24) = 0.630684E+00
- PKER_RACCS ( 18, 25) = 0.654223E+00
- PKER_RACCS ( 18, 26) = 0.673602E+00
- PKER_RACCS ( 18, 27) = 0.689569E+00
- PKER_RACCS ( 18, 28) = 0.702735E+00
- PKER_RACCS ( 18, 29) = 0.713597E+00
- PKER_RACCS ( 18, 30) = 0.722563E+00
- PKER_RACCS ( 18, 31) = 0.729966E+00
- PKER_RACCS ( 18, 32) = 0.736081E+00
- PKER_RACCS ( 18, 33) = 0.741133E+00
- PKER_RACCS ( 18, 34) = 0.745307E+00
- PKER_RACCS ( 18, 35) = 0.748758E+00
- PKER_RACCS ( 18, 36) = 0.751610E+00
- PKER_RACCS ( 18, 37) = 0.753968E+00
- PKER_RACCS ( 18, 38) = 0.755918E+00
- PKER_RACCS ( 18, 39) = 0.757530E+00
- PKER_RACCS ( 18, 40) = 0.758863E+00
- PKER_RACCS ( 19, 1) = 0.130431E+02
- PKER_RACCS ( 19, 2) = 0.106402E+02
- PKER_RACCS ( 19, 3) = 0.864775E+01
- PKER_RACCS ( 19, 4) = 0.699514E+01
- PKER_RACCS ( 19, 5) = 0.562421E+01
- PKER_RACCS ( 19, 6) = 0.448713E+01
- PKER_RACCS ( 19, 7) = 0.354462E+01
- PKER_RACCS ( 19, 8) = 0.276465E+01
- PKER_RACCS ( 19, 9) = 0.212123E+01
- PKER_RACCS ( 19, 10) = 0.159349E+01
- PKER_RACCS ( 19, 11) = 0.116527E+01
- PKER_RACCS ( 19, 12) = 0.825092E+00
- PKER_RACCS ( 19, 13) = 0.566015E+00
- PKER_RACCS ( 19, 14) = 0.384740E+00
- PKER_RACCS ( 19, 15) = 0.278832E+00
- PKER_RACCS ( 19, 16) = 0.240974E+00
- PKER_RACCS ( 19, 17) = 0.256376E+00
- PKER_RACCS ( 19, 18) = 0.304351E+00
- PKER_RACCS ( 19, 19) = 0.364630E+00
- PKER_RACCS ( 19, 20) = 0.423528E+00
- PKER_RACCS ( 19, 21) = 0.475006E+00
- PKER_RACCS ( 19, 22) = 0.517969E+00
- PKER_RACCS ( 19, 23) = 0.553309E+00
- PKER_RACCS ( 19, 24) = 0.582308E+00
- PKER_RACCS ( 19, 25) = 0.606123E+00
- PKER_RACCS ( 19, 26) = 0.625706E+00
- PKER_RACCS ( 19, 27) = 0.641824E+00
- PKER_RACCS ( 19, 28) = 0.655102E+00
- PKER_RACCS ( 19, 29) = 0.666049E+00
- PKER_RACCS ( 19, 30) = 0.675078E+00
- PKER_RACCS ( 19, 31) = 0.682529E+00
- PKER_RACCS ( 19, 32) = 0.688681E+00
- PKER_RACCS ( 19, 33) = 0.693761E+00
- PKER_RACCS ( 19, 34) = 0.697958E+00
- PKER_RACCS ( 19, 35) = 0.701425E+00
- PKER_RACCS ( 19, 36) = 0.704291E+00
- PKER_RACCS ( 19, 37) = 0.706659E+00
- PKER_RACCS ( 19, 38) = 0.708616E+00
- PKER_RACCS ( 19, 39) = 0.710235E+00
- PKER_RACCS ( 19, 40) = 0.711573E+00
- PKER_RACCS ( 20, 1) = 0.131354E+02
- PKER_RACCS ( 20, 2) = 0.107355E+02
- PKER_RACCS ( 20, 3) = 0.874600E+01
- PKER_RACCS ( 20, 4) = 0.709612E+01
- PKER_RACCS ( 20, 5) = 0.572748E+01
- PKER_RACCS ( 20, 6) = 0.459194E+01
- PKER_RACCS ( 20, 7) = 0.364986E+01
- PKER_RACCS ( 20, 8) = 0.286876E+01
- PKER_RACCS ( 20, 9) = 0.222228E+01
- PKER_RACCS ( 20, 10) = 0.168914E+01
- PKER_RACCS ( 20, 11) = 0.125273E+01
- PKER_RACCS ( 20, 12) = 0.900916E+00
- PKER_RACCS ( 20, 13) = 0.626108E+00
- PKER_RACCS ( 20, 14) = 0.424677E+00
- PKER_RACCS ( 20, 15) = 0.295132E+00
- PKER_RACCS ( 20, 16) = 0.233643E+00
- PKER_RACCS ( 20, 17) = 0.229493E+00
- PKER_RACCS ( 20, 18) = 0.264675E+00
- PKER_RACCS ( 20, 19) = 0.318862E+00
- PKER_RACCS ( 20, 20) = 0.375999E+00
- PKER_RACCS ( 20, 21) = 0.427627E+00
- PKER_RACCS ( 20, 22) = 0.471227E+00
- PKER_RACCS ( 20, 23) = 0.507163E+00
- PKER_RACCS ( 20, 24) = 0.536620E+00
- PKER_RACCS ( 20, 25) = 0.560772E+00
- PKER_RACCS ( 20, 26) = 0.580601E+00
- PKER_RACCS ( 20, 27) = 0.596902E+00
- PKER_RACCS ( 20, 28) = 0.610316E+00
- PKER_RACCS ( 20, 29) = 0.621365E+00
- PKER_RACCS ( 20, 30) = 0.630471E+00
- PKER_RACCS ( 20, 31) = 0.637980E+00
- PKER_RACCS ( 20, 32) = 0.644176E+00
- PKER_RACCS ( 20, 33) = 0.649291E+00
- PKER_RACCS ( 20, 34) = 0.653514E+00
- PKER_RACCS ( 20, 35) = 0.657001E+00
- PKER_RACCS ( 20, 36) = 0.659882E+00
- PKER_RACCS ( 20, 37) = 0.662263E+00
- PKER_RACCS ( 20, 38) = 0.664230E+00
- PKER_RACCS ( 20, 39) = 0.665856E+00
- PKER_RACCS ( 20, 40) = 0.667200E+00
- PKER_RACCS ( 21, 1) = 0.132135E+02
- PKER_RACCS ( 21, 2) = 0.108161E+02
- PKER_RACCS ( 21, 3) = 0.882908E+01
- PKER_RACCS ( 21, 4) = 0.718173E+01
- PKER_RACCS ( 21, 5) = 0.581548E+01
- PKER_RACCS ( 21, 6) = 0.468198E+01
- PKER_RACCS ( 21, 7) = 0.374134E+01
- PKER_RACCS ( 21, 8) = 0.296075E+01
- PKER_RACCS ( 21, 9) = 0.231341E+01
- PKER_RACCS ( 21, 10) = 0.177762E+01
- PKER_RACCS ( 21, 11) = 0.133622E+01
- PKER_RACCS ( 21, 12) = 0.976327E+00
- PKER_RACCS ( 21, 13) = 0.689420E+00
- PKER_RACCS ( 21, 14) = 0.471297E+00
- PKER_RACCS ( 21, 15) = 0.320744E+00
- PKER_RACCS ( 21, 16) = 0.236090E+00
- PKER_RACCS ( 21, 17) = 0.211045E+00
- PKER_RACCS ( 21, 18) = 0.231118E+00
- PKER_RACCS ( 21, 19) = 0.277043E+00
- PKER_RACCS ( 21, 20) = 0.331193E+00
- PKER_RACCS ( 21, 21) = 0.382553E+00
- PKER_RACCS ( 21, 22) = 0.426763E+00
- PKER_RACCS ( 21, 23) = 0.463386E+00
- PKER_RACCS ( 21, 24) = 0.493392E+00
- PKER_RACCS ( 21, 25) = 0.517952E+00
- PKER_RACCS ( 21, 26) = 0.538082E+00
- PKER_RACCS ( 21, 27) = 0.554604E+00
- PKER_RACCS ( 21, 28) = 0.568182E+00
- PKER_RACCS ( 21, 29) = 0.579354E+00
- PKER_RACCS ( 21, 30) = 0.588552E+00
- PKER_RACCS ( 21, 31) = 0.596132E+00
- PKER_RACCS ( 21, 32) = 0.602382E+00
- PKER_RACCS ( 21, 33) = 0.607537E+00
- PKER_RACCS ( 21, 34) = 0.611791E+00
- PKER_RACCS ( 21, 35) = 0.615303E+00
- PKER_RACCS ( 21, 36) = 0.618203E+00
- PKER_RACCS ( 21, 37) = 0.620598E+00
- PKER_RACCS ( 21, 38) = 0.622577E+00
- PKER_RACCS ( 21, 39) = 0.624211E+00
- PKER_RACCS ( 21, 40) = 0.625562E+00
- PKER_RACCS ( 22, 1) = 0.132798E+02
- PKER_RACCS ( 22, 2) = 0.108845E+02
- PKER_RACCS ( 22, 3) = 0.889959E+01
- PKER_RACCS ( 22, 4) = 0.725443E+01
- PKER_RACCS ( 22, 5) = 0.589038E+01
- PKER_RACCS ( 22, 6) = 0.475897E+01
- PKER_RACCS ( 22, 7) = 0.382015E+01
- PKER_RACCS ( 22, 8) = 0.304089E+01
- PKER_RACCS ( 22, 9) = 0.239407E+01
- PKER_RACCS ( 22, 10) = 0.185760E+01
- PKER_RACCS ( 22, 11) = 0.141374E+01
- PKER_RACCS ( 22, 12) = 0.104887E+01
- PKER_RACCS ( 22, 13) = 0.753499E+00
- PKER_RACCS ( 22, 14) = 0.522329E+00
- PKER_RACCS ( 22, 15) = 0.353784E+00
- PKER_RACCS ( 22, 16) = 0.247949E+00
- PKER_RACCS ( 22, 17) = 0.201539E+00
- PKER_RACCS ( 22, 18) = 0.204361E+00
- PKER_RACCS ( 22, 19) = 0.239684E+00
- PKER_RACCS ( 22, 20) = 0.289251E+00
- PKER_RACCS ( 22, 21) = 0.339660E+00
- PKER_RACCS ( 22, 22) = 0.384359E+00
- PKER_RACCS ( 22, 23) = 0.421741E+00
- PKER_RACCS ( 22, 24) = 0.452400E+00
- PKER_RACCS ( 22, 25) = 0.477452E+00
- PKER_RACCS ( 22, 26) = 0.497945E+00
- PKER_RACCS ( 22, 27) = 0.514735E+00
- PKER_RACCS ( 22, 28) = 0.528513E+00
- PKER_RACCS ( 22, 29) = 0.539833E+00
- PKER_RACCS ( 22, 30) = 0.549144E+00
- PKER_RACCS ( 22, 31) = 0.556808E+00
- PKER_RACCS ( 22, 32) = 0.563122E+00
- PKER_RACCS ( 22, 33) = 0.568326E+00
- PKER_RACCS ( 22, 34) = 0.572618E+00
- PKER_RACCS ( 22, 35) = 0.576159E+00
- PKER_RACCS ( 22, 36) = 0.579081E+00
- PKER_RACCS ( 22, 37) = 0.581494E+00
- PKER_RACCS ( 22, 38) = 0.583486E+00
- PKER_RACCS ( 22, 39) = 0.585131E+00
- PKER_RACCS ( 22, 40) = 0.586491E+00
- PKER_RACCS ( 23, 1) = 0.133366E+02
- PKER_RACCS ( 23, 2) = 0.109429E+02
- PKER_RACCS ( 23, 3) = 0.895974E+01
- PKER_RACCS ( 23, 4) = 0.731641E+01
- PKER_RACCS ( 23, 5) = 0.595424E+01
- PKER_RACCS ( 23, 6) = 0.482474E+01
- PKER_RACCS ( 23, 7) = 0.388776E+01
- PKER_RACCS ( 23, 8) = 0.311014E+01
- PKER_RACCS ( 23, 9) = 0.246454E+01
- PKER_RACCS ( 23, 10) = 0.192855E+01
- PKER_RACCS ( 23, 11) = 0.148402E+01
- PKER_RACCS ( 23, 12) = 0.111665E+01
- PKER_RACCS ( 23, 13) = 0.815949E+00
- PKER_RACCS ( 23, 14) = 0.575486E+00
- PKER_RACCS ( 23, 15) = 0.392736E+00
- PKER_RACCS ( 23, 16) = 0.268002E+00
- PKER_RACCS ( 23, 17) = 0.200817E+00
- PKER_RACCS ( 23, 18) = 0.185099E+00
- PKER_RACCS ( 23, 19) = 0.207499E+00
- PKER_RACCS ( 23, 20) = 0.250540E+00
- PKER_RACCS ( 23, 21) = 0.298964E+00
- PKER_RACCS ( 23, 22) = 0.343839E+00
- PKER_RACCS ( 23, 23) = 0.382006E+00
- PKER_RACCS ( 23, 24) = 0.413421E+00
- PKER_RACCS ( 23, 25) = 0.439064E+00
- PKER_RACCS ( 23, 26) = 0.459995E+00
- PKER_RACCS ( 23, 27) = 0.477110E+00
- PKER_RACCS ( 23, 28) = 0.491128E+00
- PKER_RACCS ( 23, 29) = 0.502628E+00
- PKER_RACCS ( 23, 30) = 0.512073E+00
- PKER_RACCS ( 23, 31) = 0.519839E+00
- PKER_RACCS ( 23, 32) = 0.526230E+00
- PKER_RACCS ( 23, 33) = 0.531494E+00
- PKER_RACCS ( 23, 34) = 0.535831E+00
- PKER_RACCS ( 23, 35) = 0.539407E+00
- PKER_RACCS ( 23, 36) = 0.542356E+00
- PKER_RACCS ( 23, 37) = 0.544789E+00
- PKER_RACCS ( 23, 38) = 0.546798E+00
- PKER_RACCS ( 23, 39) = 0.548456E+00
- PKER_RACCS ( 23, 40) = 0.549825E+00
- PKER_RACCS ( 24, 1) = 0.133856E+02
- PKER_RACCS ( 24, 2) = 0.109932E+02
- PKER_RACCS ( 24, 3) = 0.901139E+01
- PKER_RACCS ( 24, 4) = 0.736953E+01
- PKER_RACCS ( 24, 5) = 0.600893E+01
- PKER_RACCS ( 24, 6) = 0.488106E+01
- PKER_RACCS ( 24, 7) = 0.394574E+01
- PKER_RACCS ( 24, 8) = 0.316975E+01
- PKER_RACCS ( 24, 9) = 0.252560E+01
- PKER_RACCS ( 24, 10) = 0.199071E+01
- PKER_RACCS ( 24, 11) = 0.154659E+01
- PKER_RACCS ( 24, 12) = 0.117842E+01
- PKER_RACCS ( 24, 13) = 0.874907E+00
- PKER_RACCS ( 24, 14) = 0.628390E+00
- PKER_RACCS ( 24, 15) = 0.435189E+00
- PKER_RACCS ( 24, 16) = 0.295029E+00
- PKER_RACCS ( 24, 17) = 0.208644E+00
- PKER_RACCS ( 24, 18) = 0.173887E+00
- PKER_RACCS ( 24, 19) = 0.181362E+00
- PKER_RACCS ( 24, 20) = 0.215635E+00
- PKER_RACCS ( 24, 21) = 0.260621E+00
- PKER_RACCS ( 24, 22) = 0.305109E+00
- PKER_RACCS ( 24, 23) = 0.343981E+00
- PKER_RACCS ( 24, 24) = 0.376241E+00
- PKER_RACCS ( 24, 25) = 0.402580E+00
- PKER_RACCS ( 24, 26) = 0.424037E+00
- PKER_RACCS ( 24, 27) = 0.441543E+00
- PKER_RACCS ( 24, 28) = 0.455853E+00
- PKER_RACCS ( 24, 29) = 0.467570E+00
- PKER_RACCS ( 24, 30) = 0.477178E+00
- PKER_RACCS ( 24, 31) = 0.485066E+00
- PKER_RACCS ( 24, 32) = 0.491550E+00
- PKER_RACCS ( 24, 33) = 0.496884E+00
- PKER_RACCS ( 24, 34) = 0.501276E+00
- PKER_RACCS ( 24, 35) = 0.504893E+00
- PKER_RACCS ( 24, 36) = 0.507875E+00
- PKER_RACCS ( 24, 37) = 0.510333E+00
- PKER_RACCS ( 24, 38) = 0.512361E+00
- PKER_RACCS ( 24, 39) = 0.514034E+00
- PKER_RACCS ( 24, 40) = 0.515415E+00
- PKER_RACCS ( 25, 1) = 0.134282E+02
- PKER_RACCS ( 25, 2) = 0.110367E+02
- PKER_RACCS ( 25, 3) = 0.905605E+01
- PKER_RACCS ( 25, 4) = 0.741536E+01
- PKER_RACCS ( 25, 5) = 0.605602E+01
- PKER_RACCS ( 25, 6) = 0.492950E+01
- PKER_RACCS ( 25, 7) = 0.399560E+01
- PKER_RACCS ( 25, 8) = 0.322106E+01
- PKER_RACCS ( 25, 9) = 0.257835E+01
- PKER_RACCS ( 25, 10) = 0.204475E+01
- PKER_RACCS ( 25, 11) = 0.160158E+01
- PKER_RACCS ( 25, 12) = 0.123366E+01
- PKER_RACCS ( 25, 13) = 0.929054E+00
- PKER_RACCS ( 25, 14) = 0.679123E+00
- PKER_RACCS ( 25, 15) = 0.478799E+00
- PKER_RACCS ( 25, 16) = 0.326698E+00
- PKER_RACCS ( 25, 17) = 0.224072E+00
- PKER_RACCS ( 25, 18) = 0.170932E+00
- PKER_RACCS ( 25, 19) = 0.161993E+00
- PKER_RACCS ( 25, 20) = 0.185227E+00
- PKER_RACCS ( 25, 21) = 0.224972E+00
- PKER_RACCS ( 25, 22) = 0.268163E+00
- PKER_RACCS ( 25, 23) = 0.307509E+00
- PKER_RACCS ( 25, 24) = 0.340657E+00
- PKER_RACCS ( 25, 25) = 0.367801E+00
- PKER_RACCS ( 25, 26) = 0.389883E+00
- PKER_RACCS ( 25, 27) = 0.407857E+00
- PKER_RACCS ( 25, 28) = 0.422517E+00
- PKER_RACCS ( 25, 29) = 0.434495E+00
- PKER_RACCS ( 25, 30) = 0.444299E+00
- PKER_RACCS ( 25, 31) = 0.452336E+00
- PKER_RACCS ( 25, 32) = 0.458931E+00
- PKER_RACCS ( 25, 33) = 0.464351E+00
- PKER_RACCS ( 25, 34) = 0.468807E+00
- PKER_RACCS ( 25, 35) = 0.472474E+00
- PKER_RACCS ( 25, 36) = 0.475494E+00
- PKER_RACCS ( 25, 37) = 0.477983E+00
- PKER_RACCS ( 25, 38) = 0.480033E+00
- PKER_RACCS ( 25, 39) = 0.481725E+00
- PKER_RACCS ( 25, 40) = 0.483120E+00
- PKER_RACCS ( 26, 1) = 0.134654E+02
- PKER_RACCS ( 26, 2) = 0.110748E+02
- PKER_RACCS ( 26, 3) = 0.909494E+01
- PKER_RACCS ( 26, 4) = 0.745518E+01
- PKER_RACCS ( 26, 5) = 0.609685E+01
- PKER_RACCS ( 26, 6) = 0.497141E+01
- PKER_RACCS ( 26, 7) = 0.403868E+01
- PKER_RACCS ( 26, 8) = 0.326538E+01
- PKER_RACCS ( 26, 9) = 0.262395E+01
- PKER_RACCS ( 26, 10) = 0.209161E+01
- PKER_RACCS ( 26, 11) = 0.164957E+01
- PKER_RACCS ( 26, 12) = 0.128242E+01
- PKER_RACCS ( 26, 13) = 0.977793E+00
- PKER_RACCS ( 26, 14) = 0.726272E+00
- PKER_RACCS ( 26, 15) = 0.521639E+00
- PKER_RACCS ( 26, 16) = 0.361153E+00
- PKER_RACCS ( 26, 17) = 0.245274E+00
- PKER_RACCS ( 26, 18) = 0.175476E+00
- PKER_RACCS ( 26, 19) = 0.149840E+00
- PKER_RACCS ( 26, 20) = 0.160130E+00
- PKER_RACCS ( 26, 21) = 0.192585E+00
- PKER_RACCS ( 26, 22) = 0.233191E+00
- PKER_RACCS ( 26, 23) = 0.272508E+00
- PKER_RACCS ( 26, 24) = 0.306495E+00
- PKER_RACCS ( 26, 25) = 0.334534E+00
- PKER_RACCS ( 26, 26) = 0.357345E+00
- PKER_RACCS ( 26, 27) = 0.375875E+00
- PKER_RACCS ( 26, 28) = 0.390953E+00
- PKER_RACCS ( 26, 29) = 0.403245E+00
- PKER_RACCS ( 26, 30) = 0.413285E+00
- PKER_RACCS ( 26, 31) = 0.421500E+00
- PKER_RACCS ( 26, 32) = 0.428230E+00
- PKER_RACCS ( 26, 33) = 0.433752E+00
- PKER_RACCS ( 26, 34) = 0.438286E+00
- PKER_RACCS ( 26, 35) = 0.442014E+00
- PKER_RACCS ( 26, 36) = 0.445080E+00
- PKER_RACCS ( 26, 37) = 0.447604E+00
- PKER_RACCS ( 26, 38) = 0.449682E+00
- PKER_RACCS ( 26, 39) = 0.451395E+00
- PKER_RACCS ( 26, 40) = 0.452806E+00
- PKER_RACCS ( 27, 1) = 0.134982E+02
- PKER_RACCS ( 27, 2) = 0.111082E+02
- PKER_RACCS ( 27, 3) = 0.912906E+01
- PKER_RACCS ( 27, 4) = 0.749002E+01
- PKER_RACCS ( 27, 5) = 0.613249E+01
- PKER_RACCS ( 27, 6) = 0.500792E+01
- PKER_RACCS ( 27, 7) = 0.407612E+01
- PKER_RACCS ( 27, 8) = 0.330383E+01
- PKER_RACCS ( 27, 9) = 0.266348E+01
- PKER_RACCS ( 27, 10) = 0.213226E+01
- PKER_RACCS ( 27, 11) = 0.169133E+01
- PKER_RACCS ( 27, 12) = 0.132514E+01
- PKER_RACCS ( 27, 13) = 0.102106E+01
- PKER_RACCS ( 27, 14) = 0.769137E+00
- PKER_RACCS ( 27, 15) = 0.562205E+00
- PKER_RACCS ( 27, 16) = 0.396278E+00
- PKER_RACCS ( 27, 17) = 0.270632E+00
- PKER_RACCS ( 27, 18) = 0.186633E+00
- PKER_RACCS ( 27, 19) = 0.144971E+00
- PKER_RACCS ( 27, 20) = 0.141101E+00
- PKER_RACCS ( 27, 21) = 0.164198E+00
- PKER_RACCS ( 27, 22) = 0.200541E+00
- PKER_RACCS ( 27, 23) = 0.239024E+00
- PKER_RACCS ( 27, 24) = 0.273633E+00
- PKER_RACCS ( 27, 25) = 0.302606E+00
- PKER_RACCS ( 27, 26) = 0.326245E+00
- PKER_RACCS ( 27, 27) = 0.345426E+00
- PKER_RACCS ( 27, 28) = 0.360998E+00
- PKER_RACCS ( 27, 29) = 0.373665E+00
- PKER_RACCS ( 27, 30) = 0.383988E+00
- PKER_RACCS ( 27, 31) = 0.392416E+00
- PKER_RACCS ( 27, 32) = 0.399309E+00
- PKER_RACCS ( 27, 33) = 0.404953E+00
- PKER_RACCS ( 27, 34) = 0.409582E+00
- PKER_RACCS ( 27, 35) = 0.413381E+00
- PKER_RACCS ( 27, 36) = 0.416502E+00
- PKER_RACCS ( 27, 37) = 0.419069E+00
- PKER_RACCS ( 27, 38) = 0.421180E+00
- PKER_RACCS ( 27, 39) = 0.422919E+00
- PKER_RACCS ( 27, 40) = 0.424350E+00
- PKER_RACCS ( 28, 1) = 0.135274E+02
- PKER_RACCS ( 28, 2) = 0.111378E+02
- PKER_RACCS ( 28, 3) = 0.915921E+01
- PKER_RACCS ( 28, 4) = 0.752074E+01
- PKER_RACCS ( 28, 5) = 0.616383E+01
- PKER_RACCS ( 28, 6) = 0.503993E+01
- PKER_RACCS ( 28, 7) = 0.410888E+01
- PKER_RACCS ( 28, 8) = 0.333740E+01
- PKER_RACCS ( 28, 9) = 0.269793E+01
- PKER_RACCS ( 28, 10) = 0.216766E+01
- PKER_RACCS ( 28, 11) = 0.172770E+01
- PKER_RACCS ( 28, 12) = 0.136247E+01
- PKER_RACCS ( 28, 13) = 0.105916E+01
- PKER_RACCS ( 28, 14) = 0.807478E+00
- PKER_RACCS ( 28, 15) = 0.599612E+00
- PKER_RACCS ( 28, 16) = 0.430446E+00
- PKER_RACCS ( 28, 17) = 0.297946E+00
- PKER_RACCS ( 28, 18) = 0.202996E+00
- PKER_RACCS ( 28, 19) = 0.147037E+00
- PKER_RACCS ( 28, 20) = 0.128608E+00
- PKER_RACCS ( 28, 21) = 0.140561E+00
- PKER_RACCS ( 28, 22) = 0.170776E+00
- PKER_RACCS ( 28, 23) = 0.207238E+00
- PKER_RACCS ( 28, 24) = 0.242027E+00
- PKER_RACCS ( 28, 25) = 0.271878E+00
- PKER_RACCS ( 28, 26) = 0.296420E+00
- PKER_RACCS ( 28, 27) = 0.316343E+00
- PKER_RACCS ( 28, 28) = 0.332495E+00
- PKER_RACCS ( 28, 29) = 0.345604E+00
- PKER_RACCS ( 28, 30) = 0.356264E+00
- PKER_RACCS ( 28, 31) = 0.364948E+00
- PKER_RACCS ( 28, 32) = 0.372034E+00
- PKER_RACCS ( 28, 33) = 0.377826E+00
- PKER_RACCS ( 28, 34) = 0.382567E+00
- PKER_RACCS ( 28, 35) = 0.386453E+00
- PKER_RACCS ( 28, 36) = 0.389640E+00
- PKER_RACCS ( 28, 37) = 0.392258E+00
- PKER_RACCS ( 28, 38) = 0.394409E+00
- PKER_RACCS ( 28, 39) = 0.396178E+00
- PKER_RACCS ( 28, 40) = 0.397634E+00
- PKER_RACCS ( 29, 1) = 0.135534E+02
- PKER_RACCS ( 29, 2) = 0.111642E+02
- PKER_RACCS ( 29, 3) = 0.918602E+01
- PKER_RACCS ( 29, 4) = 0.754800E+01
- PKER_RACCS ( 29, 5) = 0.619157E+01
- PKER_RACCS ( 29, 6) = 0.506821E+01
- PKER_RACCS ( 29, 7) = 0.413774E+01
- PKER_RACCS ( 29, 8) = 0.336690E+01
- PKER_RACCS ( 29, 9) = 0.272813E+01
- PKER_RACCS ( 29, 10) = 0.219863E+01
- PKER_RACCS ( 29, 11) = 0.175950E+01
- PKER_RACCS ( 29, 12) = 0.139512E+01
- PKER_RACCS ( 29, 13) = 0.109261E+01
- PKER_RACCS ( 29, 14) = 0.841468E+00
- PKER_RACCS ( 29, 15) = 0.633435E+00
- PKER_RACCS ( 29, 16) = 0.462611E+00
- PKER_RACCS ( 29, 17) = 0.325782E+00
- PKER_RACCS ( 29, 18) = 0.222601E+00
- PKER_RACCS ( 29, 19) = 0.154703E+00
- PKER_RACCS ( 29, 20) = 0.122560E+00
- PKER_RACCS ( 29, 21) = 0.122340E+00
- PKER_RACCS ( 29, 22) = 0.144604E+00
- PKER_RACCS ( 29, 23) = 0.177555E+00
- PKER_RACCS ( 29, 24) = 0.211757E+00
- PKER_RACCS ( 29, 25) = 0.242272E+00
- PKER_RACCS ( 29, 26) = 0.267732E+00
- PKER_RACCS ( 29, 27) = 0.288477E+00
- PKER_RACCS ( 29, 28) = 0.305290E+00
- PKER_RACCS ( 29, 29) = 0.318915E+00
- PKER_RACCS ( 29, 30) = 0.329972E+00
- PKER_RACCS ( 29, 31) = 0.338960E+00
- PKER_RACCS ( 29, 32) = 0.346278E+00
- PKER_RACCS ( 29, 33) = 0.352247E+00
- PKER_RACCS ( 29, 34) = 0.357123E+00
- PKER_RACCS ( 29, 35) = 0.361112E+00
- PKER_RACCS ( 29, 36) = 0.364379E+00
- PKER_RACCS ( 29, 37) = 0.367058E+00
- PKER_RACCS ( 29, 38) = 0.369256E+00
- PKER_RACCS ( 29, 39) = 0.371062E+00
- PKER_RACCS ( 29, 40) = 0.372546E+00
- PKER_RACCS ( 30, 1) = 0.135768E+02
- PKER_RACCS ( 30, 2) = 0.111879E+02
- PKER_RACCS ( 30, 3) = 0.921003E+01
- PKER_RACCS ( 30, 4) = 0.757236E+01
- PKER_RACCS ( 30, 5) = 0.621631E+01
- PKER_RACCS ( 30, 6) = 0.509336E+01
- PKER_RACCS ( 30, 7) = 0.416334E+01
- PKER_RACCS ( 30, 8) = 0.339300E+01
- PKER_RACCS ( 30, 9) = 0.275479E+01
- PKER_RACCS ( 30, 10) = 0.222590E+01
- PKER_RACCS ( 30, 11) = 0.178745E+01
- PKER_RACCS ( 30, 12) = 0.142379E+01
- PKER_RACCS ( 30, 13) = 0.112200E+01
- PKER_RACCS ( 30, 14) = 0.871483E+00
- PKER_RACCS ( 30, 15) = 0.663698E+00
- PKER_RACCS ( 30, 16) = 0.492181E+00
- PKER_RACCS ( 30, 17) = 0.352805E+00
- PKER_RACCS ( 30, 18) = 0.244068E+00
- PKER_RACCS ( 30, 19) = 0.166744E+00
- PKER_RACCS ( 30, 20) = 0.122426E+00
- PKER_RACCS ( 30, 21) = 0.109881E+00
- PKER_RACCS ( 30, 22) = 0.122731E+00
- PKER_RACCS ( 30, 23) = 0.150504E+00
- PKER_RACCS ( 30, 24) = 0.183063E+00
- PKER_RACCS ( 30, 25) = 0.213801E+00
- PKER_RACCS ( 30, 26) = 0.240093E+00
- PKER_RACCS ( 30, 27) = 0.261699E+00
- PKER_RACCS ( 30, 28) = 0.279244E+00
- PKER_RACCS ( 30, 29) = 0.293457E+00
- PKER_RACCS ( 30, 30) = 0.304976E+00
- PKER_RACCS ( 30, 31) = 0.314321E+00
- PKER_RACCS ( 30, 32) = 0.321915E+00
- PKER_RACCS ( 30, 33) = 0.328094E+00
- PKER_RACCS ( 30, 34) = 0.333132E+00
- PKER_RACCS ( 30, 35) = 0.337244E+00
- PKER_RACCS ( 30, 36) = 0.340607E+00
- PKER_RACCS ( 30, 37) = 0.343359E+00
- PKER_RACCS ( 30, 38) = 0.345614E+00
- PKER_RACCS ( 30, 39) = 0.347463E+00
- PKER_RACCS ( 30, 40) = 0.348981E+00
- PKER_RACCS ( 31, 1) = 0.135979E+02
- PKER_RACCS ( 31, 2) = 0.112093E+02
- PKER_RACCS ( 31, 3) = 0.923164E+01
- PKER_RACCS ( 31, 4) = 0.759424E+01
- PKER_RACCS ( 31, 5) = 0.623849E+01
- PKER_RACCS ( 31, 6) = 0.511586E+01
- PKER_RACCS ( 31, 7) = 0.418620E+01
- PKER_RACCS ( 31, 8) = 0.341625E+01
- PKER_RACCS ( 31, 9) = 0.277847E+01
- PKER_RACCS ( 31, 10) = 0.225007E+01
- PKER_RACCS ( 31, 11) = 0.181215E+01
- PKER_RACCS ( 31, 12) = 0.144907E+01
- PKER_RACCS ( 31, 13) = 0.114791E+01
- PKER_RACCS ( 31, 14) = 0.897986E+00
- PKER_RACCS ( 31, 15) = 0.690615E+00
- PKER_RACCS ( 31, 16) = 0.518979E+00
- PKER_RACCS ( 31, 17) = 0.378230E+00
- PKER_RACCS ( 31, 18) = 0.265830E+00
- PKER_RACCS ( 31, 19) = 0.181772E+00
- PKER_RACCS ( 31, 20) = 0.127410E+00
- PKER_RACCS ( 31, 21) = 0.103164E+00
- PKER_RACCS ( 31, 22) = 0.105685E+00
- PKER_RACCS ( 31, 23) = 0.126731E+00
- PKER_RACCS ( 31, 24) = 0.156328E+00
- PKER_RACCS ( 31, 25) = 0.186597E+00
- PKER_RACCS ( 31, 26) = 0.213480E+00
- PKER_RACCS ( 31, 27) = 0.235920E+00
- PKER_RACCS ( 31, 28) = 0.254239E+00
- PKER_RACCS ( 31, 29) = 0.269103E+00
- PKER_RACCS ( 31, 30) = 0.281146E+00
- PKER_RACCS ( 31, 31) = 0.290906E+00
- PKER_RACCS ( 31, 32) = 0.298823E+00
- PKER_RACCS ( 31, 33) = 0.305252E+00
- PKER_RACCS ( 31, 34) = 0.310482E+00
- PKER_RACCS ( 31, 35) = 0.314742E+00
- PKER_RACCS ( 31, 36) = 0.318218E+00
- PKER_RACCS ( 31, 37) = 0.321058E+00
- PKER_RACCS ( 31, 38) = 0.323381E+00
- PKER_RACCS ( 31, 39) = 0.325283E+00
- PKER_RACCS ( 31, 40) = 0.326842E+00
- PKER_RACCS ( 32, 1) = 0.136171E+02
- PKER_RACCS ( 32, 2) = 0.112287E+02
- PKER_RACCS ( 32, 3) = 0.925121E+01
- PKER_RACCS ( 32, 4) = 0.761402E+01
- PKER_RACCS ( 32, 5) = 0.625849E+01
- PKER_RACCS ( 32, 6) = 0.513612E+01
- PKER_RACCS ( 32, 7) = 0.420673E+01
- PKER_RACCS ( 32, 8) = 0.343709E+01
- PKER_RACCS ( 32, 9) = 0.279965E+01
- PKER_RACCS ( 32, 10) = 0.227162E+01
- PKER_RACCS ( 32, 11) = 0.183412E+01
- PKER_RACCS ( 32, 12) = 0.147151E+01
- PKER_RACCS ( 32, 13) = 0.117086E+01
- PKER_RACCS ( 32, 14) = 0.921455E+00
- PKER_RACCS ( 32, 15) = 0.714531E+00
- PKER_RACCS ( 32, 16) = 0.543039E+00
- PKER_RACCS ( 32, 17) = 0.401678E+00
- PKER_RACCS ( 32, 18) = 0.287113E+00
- PKER_RACCS ( 32, 19) = 0.198241E+00
- PKER_RACCS ( 32, 20) = 0.136014E+00
- PKER_RACCS ( 32, 21) = 0.101554E+00
- PKER_RACCS ( 32, 22) = 0.937042E-01
- PKER_RACCS ( 32, 23) = 0.106837E+00
- PKER_RACCS ( 32, 24) = 0.132081E+00
- PKER_RACCS ( 32, 25) = 0.160921E+00
- PKER_RACCS ( 32, 26) = 0.187964E+00
- PKER_RACCS ( 32, 27) = 0.211107E+00
- PKER_RACCS ( 32, 28) = 0.230192E+00
- PKER_RACCS ( 32, 29) = 0.245743E+00
- PKER_RACCS ( 32, 30) = 0.258364E+00
- PKER_RACCS ( 32, 31) = 0.268595E+00
- PKER_RACCS ( 32, 32) = 0.276885E+00
- PKER_RACCS ( 32, 33) = 0.283607E+00
- PKER_RACCS ( 32, 34) = 0.289064E+00
- PKER_RACCS ( 32, 35) = 0.293500E+00
- PKER_RACCS ( 32, 36) = 0.297112E+00
- PKER_RACCS ( 32, 37) = 0.300056E+00
- PKER_RACCS ( 32, 38) = 0.302460E+00
- PKER_RACCS ( 32, 39) = 0.304425E+00
- PKER_RACCS ( 32, 40) = 0.306032E+00
- PKER_RACCS ( 33, 1) = 0.136346E+02
- PKER_RACCS ( 33, 2) = 0.112463E+02
- PKER_RACCS ( 33, 3) = 0.926900E+01
- PKER_RACCS ( 33, 4) = 0.763198E+01
- PKER_RACCS ( 33, 5) = 0.627663E+01
- PKER_RACCS ( 33, 6) = 0.515445E+01
- PKER_RACCS ( 33, 7) = 0.422528E+01
- PKER_RACCS ( 33, 8) = 0.345587E+01
- PKER_RACCS ( 33, 9) = 0.281869E+01
- PKER_RACCS ( 33, 10) = 0.229096E+01
- PKER_RACCS ( 33, 11) = 0.185378E+01
- PKER_RACCS ( 33, 12) = 0.149154E+01
- PKER_RACCS ( 33, 13) = 0.119129E+01
- PKER_RACCS ( 33, 14) = 0.942327E+00
- PKER_RACCS ( 33, 15) = 0.735819E+00
- PKER_RACCS ( 33, 16) = 0.564593E+00
- PKER_RACCS ( 33, 17) = 0.423036E+00
- PKER_RACCS ( 33, 18) = 0.307249E+00
- PKER_RACCS ( 33, 19) = 0.215289E+00
- PKER_RACCS ( 33, 20) = 0.147152E+00
- PKER_RACCS ( 33, 21) = 0.104182E+00
- PKER_RACCS ( 33, 22) = 0.866062E-01
- PKER_RACCS ( 33, 23) = 0.912133E-01
- PKER_RACCS ( 33, 24) = 0.110827E+00
- PKER_RACCS ( 33, 25) = 0.137151E+00
- PKER_RACCS ( 33, 26) = 0.163721E+00
- PKER_RACCS ( 33, 27) = 0.187299E+00
- PKER_RACCS ( 33, 28) = 0.207066E+00
- PKER_RACCS ( 33, 29) = 0.223299E+00
- PKER_RACCS ( 33, 30) = 0.236530E+00
- PKER_RACCS ( 33, 31) = 0.247276E+00
- PKER_RACCS ( 33, 32) = 0.255989E+00
- PKER_RACCS ( 33, 33) = 0.263049E+00
- PKER_RACCS ( 33, 34) = 0.268773E+00
- PKER_RACCS ( 33, 35) = 0.273417E+00
- PKER_RACCS ( 33, 36) = 0.277189E+00
- PKER_RACCS ( 33, 37) = 0.280259E+00
- PKER_RACCS ( 33, 38) = 0.282759E+00
- PKER_RACCS ( 33, 39) = 0.284799E+00
- PKER_RACCS ( 33, 40) = 0.286464E+00
- PKER_RACCS ( 34, 1) = 0.136506E+02
- PKER_RACCS ( 34, 2) = 0.112624E+02
- PKER_RACCS ( 34, 3) = 0.928526E+01
- PKER_RACCS ( 34, 4) = 0.764836E+01
- PKER_RACCS ( 34, 5) = 0.629315E+01
- PKER_RACCS ( 34, 6) = 0.517112E+01
- PKER_RACCS ( 34, 7) = 0.424212E+01
- PKER_RACCS ( 34, 8) = 0.347289E+01
- PKER_RACCS ( 34, 9) = 0.283592E+01
- PKER_RACCS ( 34, 10) = 0.230841E+01
- PKER_RACCS ( 34, 11) = 0.187149E+01
- PKER_RACCS ( 34, 12) = 0.150954E+01
- PKER_RACCS ( 34, 13) = 0.120961E+01
- PKER_RACCS ( 34, 14) = 0.960988E+00
- PKER_RACCS ( 34, 15) = 0.754836E+00
- PKER_RACCS ( 34, 16) = 0.583898E+00
- PKER_RACCS ( 34, 17) = 0.442381E+00
- PKER_RACCS ( 34, 18) = 0.325954E+00
- PKER_RACCS ( 34, 19) = 0.231985E+00
- PKER_RACCS ( 34, 20) = 0.159811E+00
- PKER_RACCS ( 34, 21) = 0.110179E+00
- PKER_RACCS ( 34, 22) = 0.839648E-01
- PKER_RACCS ( 34, 23) = 0.799523E-01
- PKER_RACCS ( 34, 24) = 0.930316E-01
- PKER_RACCS ( 34, 25) = 0.115716E+00
- PKER_RACCS ( 34, 26) = 0.141020E+00
- PKER_RACCS ( 34, 27) = 0.164617E+00
- PKER_RACCS ( 34, 28) = 0.184890E+00
- PKER_RACCS ( 34, 29) = 0.201739E+00
- PKER_RACCS ( 34, 30) = 0.215571E+00
- PKER_RACCS ( 34, 31) = 0.226859E+00
- PKER_RACCS ( 34, 32) = 0.236034E+00
- PKER_RACCS ( 34, 33) = 0.243476E+00
- PKER_RACCS ( 34, 34) = 0.249506E+00
- PKER_RACCS ( 34, 35) = 0.254393E+00
- PKER_RACCS ( 34, 36) = 0.258356E+00
- PKER_RACCS ( 34, 37) = 0.261573E+00
- PKER_RACCS ( 34, 38) = 0.264188E+00
- PKER_RACCS ( 34, 39) = 0.266317E+00
- PKER_RACCS ( 34, 40) = 0.268052E+00
- PKER_RACCS ( 35, 1) = 0.136654E+02
- PKER_RACCS ( 35, 2) = 0.112772E+02
- PKER_RACCS ( 35, 3) = 0.930016E+01
- PKER_RACCS ( 35, 4) = 0.766336E+01
- PKER_RACCS ( 35, 5) = 0.630826E+01
- PKER_RACCS ( 35, 6) = 0.518635E+01
- PKER_RACCS ( 35, 7) = 0.425748E+01
- PKER_RACCS ( 35, 8) = 0.348839E+01
- PKER_RACCS ( 35, 9) = 0.285158E+01
- PKER_RACCS ( 35, 10) = 0.232424E+01
- PKER_RACCS ( 35, 11) = 0.188752E+01
- PKER_RACCS ( 35, 12) = 0.152579E+01
- PKER_RACCS ( 35, 13) = 0.122610E+01
- PKER_RACCS ( 35, 14) = 0.977764E+00
- PKER_RACCS ( 35, 15) = 0.771907E+00
- PKER_RACCS ( 35, 16) = 0.601238E+00
- PKER_RACCS ( 35, 17) = 0.459844E+00
- PKER_RACCS ( 35, 18) = 0.343143E+00
- PKER_RACCS ( 35, 19) = 0.248008E+00
- PKER_RACCS ( 35, 20) = 0.172966E+00
- PKER_RACCS ( 35, 21) = 0.118299E+00
- PKER_RACCS ( 35, 22) = 0.849398E-01
- PKER_RACCS ( 35, 23) = 0.728604E-01
- PKER_RACCS ( 35, 24) = 0.789443E-01
- PKER_RACCS ( 35, 25) = 0.970290E-01
- PKER_RACCS ( 35, 26) = 0.120181E+00
- PKER_RACCS ( 35, 27) = 0.143256E+00
- PKER_RACCS ( 35, 28) = 0.163755E+00
- PKER_RACCS ( 35, 29) = 0.181083E+00
- PKER_RACCS ( 35, 30) = 0.195458E+00
- PKER_RACCS ( 35, 31) = 0.207277E+00
- PKER_RACCS ( 35, 32) = 0.216935E+00
- PKER_RACCS ( 35, 33) = 0.224793E+00
- PKER_RACCS ( 35, 34) = 0.231168E+00
- PKER_RACCS ( 35, 35) = 0.236333E+00
- PKER_RACCS ( 35, 36) = 0.240518E+00
- PKER_RACCS ( 35, 37) = 0.243910E+00
- PKER_RACCS ( 35, 38) = 0.246662E+00
- PKER_RACCS ( 35, 39) = 0.248897E+00
- PKER_RACCS ( 35, 40) = 0.250714E+00
- PKER_RACCS ( 36, 1) = 0.136789E+02
- PKER_RACCS ( 36, 2) = 0.112909E+02
- PKER_RACCS ( 36, 3) = 0.931386E+01
- PKER_RACCS ( 36, 4) = 0.767715E+01
- PKER_RACCS ( 36, 5) = 0.632213E+01
- PKER_RACCS ( 36, 6) = 0.520031E+01
- PKER_RACCS ( 36, 7) = 0.427154E+01
- PKER_RACCS ( 36, 8) = 0.350256E+01
- PKER_RACCS ( 36, 9) = 0.286587E+01
- PKER_RACCS ( 36, 10) = 0.233867E+01
- PKER_RACCS ( 36, 11) = 0.190210E+01
- PKER_RACCS ( 36, 12) = 0.154054E+01
- PKER_RACCS ( 36, 13) = 0.124105E+01
- PKER_RACCS ( 36, 14) = 0.992926E+00
- PKER_RACCS ( 36, 15) = 0.787304E+00
- PKER_RACCS ( 36, 16) = 0.616868E+00
- PKER_RACCS ( 36, 17) = 0.475637E+00
- PKER_RACCS ( 36, 18) = 0.358852E+00
- PKER_RACCS ( 36, 19) = 0.263041E+00
- PKER_RACCS ( 36, 20) = 0.186190E+00
- PKER_RACCS ( 36, 21) = 0.127793E+00
- PKER_RACCS ( 36, 22) = 0.886866E-01
- PKER_RACCS ( 36, 23) = 0.694465E-01
- PKER_RACCS ( 36, 24) = 0.685545E-01
- PKER_RACCS ( 36, 25) = 0.813394E-01
- PKER_RACCS ( 36, 26) = 0.101516E+00
- PKER_RACCS ( 36, 27) = 0.123451E+00
- PKER_RACCS ( 36, 28) = 0.143809E+00
- PKER_RACCS ( 36, 29) = 0.161408E+00
- PKER_RACCS ( 36, 30) = 0.176207E+00
- PKER_RACCS ( 36, 31) = 0.188501E+00
- PKER_RACCS ( 36, 32) = 0.198630E+00
- PKER_RACCS ( 36, 33) = 0.206920E+00
- PKER_RACCS ( 36, 34) = 0.213670E+00
- PKER_RACCS ( 36, 35) = 0.219149E+00
- PKER_RACCS ( 36, 36) = 0.223589E+00
- PKER_RACCS ( 36, 37) = 0.227184E+00
- PKER_RACCS ( 36, 38) = 0.230096E+00
- PKER_RACCS ( 36, 39) = 0.232457E+00
- PKER_RACCS ( 36, 40) = 0.234373E+00
- PKER_RACCS ( 37, 1) = 0.136915E+02
- PKER_RACCS ( 37, 2) = 0.113034E+02
- PKER_RACCS ( 37, 3) = 0.932650E+01
- PKER_RACCS ( 37, 4) = 0.768985E+01
- PKER_RACCS ( 37, 5) = 0.633490E+01
- PKER_RACCS ( 37, 6) = 0.521316E+01
- PKER_RACCS ( 37, 7) = 0.428446E+01
- PKER_RACCS ( 37, 8) = 0.351557E+01
- PKER_RACCS ( 37, 9) = 0.287897E+01
- PKER_RACCS ( 37, 10) = 0.235188E+01
- PKER_RACCS ( 37, 11) = 0.191542E+01
- PKER_RACCS ( 37, 12) = 0.155399E+01
- PKER_RACCS ( 37, 13) = 0.125465E+01
- PKER_RACCS ( 37, 14) = 0.100670E+01
- PKER_RACCS ( 37, 15) = 0.801261E+00
- PKER_RACCS ( 37, 16) = 0.631017E+00
- PKER_RACCS ( 37, 17) = 0.489944E+00
- PKER_RACCS ( 37, 18) = 0.373184E+00
- PKER_RACCS ( 37, 19) = 0.277006E+00
- PKER_RACCS ( 37, 20) = 0.198946E+00
- PKER_RACCS ( 37, 21) = 0.138042E+00
- PKER_RACCS ( 37, 22) = 0.945344E-01
- PKER_RACCS ( 37, 23) = 0.691693E-01
- PKER_RACCS ( 37, 24) = 0.616275E-01
- PKER_RACCS ( 37, 25) = 0.687885E-01
- PKER_RACCS ( 37, 26) = 0.852879E-01
- PKER_RACCS ( 37, 27) = 0.105439E+00
- PKER_RACCS ( 37, 28) = 0.125229E+00
- PKER_RACCS ( 37, 29) = 0.142838E+00
- PKER_RACCS ( 37, 30) = 0.157887E+00
- PKER_RACCS ( 37, 31) = 0.170547E+00
- PKER_RACCS ( 37, 32) = 0.181093E+00
- PKER_RACCS ( 37, 33) = 0.189802E+00
- PKER_RACCS ( 37, 34) = 0.196941E+00
- PKER_RACCS ( 37, 35) = 0.202759E+00
- PKER_RACCS ( 37, 36) = 0.207484E+00
- PKER_RACCS ( 37, 37) = 0.211312E+00
- PKER_RACCS ( 37, 38) = 0.214411E+00
- PKER_RACCS ( 37, 39) = 0.216920E+00
- PKER_RACCS ( 37, 40) = 0.218952E+00
- PKER_RACCS ( 38, 1) = 0.137031E+02
- PKER_RACCS ( 38, 2) = 0.113151E+02
- PKER_RACCS ( 38, 3) = 0.933820E+01
- PKER_RACCS ( 38, 4) = 0.770159E+01
- PKER_RACCS ( 38, 5) = 0.634669E+01
- PKER_RACCS ( 38, 6) = 0.522500E+01
- PKER_RACCS ( 38, 7) = 0.429637E+01
- PKER_RACCS ( 38, 8) = 0.352755E+01
- PKER_RACCS ( 38, 9) = 0.289102E+01
- PKER_RACCS ( 38, 10) = 0.236401E+01
- PKER_RACCS ( 38, 11) = 0.192764E+01
- PKER_RACCS ( 38, 12) = 0.156632E+01
- PKER_RACCS ( 38, 13) = 0.126709E+01
- PKER_RACCS ( 38, 14) = 0.101926E+01
- PKER_RACCS ( 38, 15) = 0.813972E+00
- PKER_RACCS ( 38, 16) = 0.643884E+00
- PKER_RACCS ( 38, 17) = 0.502953E+00
- PKER_RACCS ( 38, 18) = 0.386252E+00
- PKER_RACCS ( 38, 19) = 0.289901E+00
- PKER_RACCS ( 38, 20) = 0.211127E+00
- PKER_RACCS ( 38, 21) = 0.148400E+00
- PKER_RACCS ( 38, 22) = 0.101589E+00
- PKER_RACCS ( 38, 23) = 0.712905E-01
- PKER_RACCS ( 38, 24) = 0.577853E-01
- PKER_RACCS ( 38, 25) = 0.593100E-01
- PKER_RACCS ( 38, 26) = 0.716356E-01
- PKER_RACCS ( 38, 27) = 0.894059E-01
- PKER_RACCS ( 38, 28) = 0.108185E+00
- PKER_RACCS ( 38, 29) = 0.125512E+00
- PKER_RACCS ( 38, 30) = 0.140605E+00
- PKER_RACCS ( 38, 31) = 0.153476E+00
- PKER_RACCS ( 38, 32) = 0.164337E+00
- PKER_RACCS ( 38, 33) = 0.173413E+00
- PKER_RACCS ( 38, 34) = 0.180926E+00
- PKER_RACCS ( 38, 35) = 0.187095E+00
- PKER_RACCS ( 38, 36) = 0.192129E+00
- PKER_RACCS ( 38, 37) = 0.196217E+00
- PKER_RACCS ( 38, 38) = 0.199530E+00
- PKER_RACCS ( 38, 39) = 0.202210E+00
- PKER_RACCS ( 38, 40) = 0.204379E+00
- PKER_RACCS ( 39, 1) = 0.137138E+02
- PKER_RACCS ( 39, 2) = 0.113259E+02
- PKER_RACCS ( 39, 3) = 0.934903E+01
- PKER_RACCS ( 39, 4) = 0.771246E+01
- PKER_RACCS ( 39, 5) = 0.635761E+01
- PKER_RACCS ( 39, 6) = 0.523596E+01
- PKER_RACCS ( 39, 7) = 0.430737E+01
- PKER_RACCS ( 39, 8) = 0.353860E+01
- PKER_RACCS ( 39, 9) = 0.290213E+01
- PKER_RACCS ( 39, 10) = 0.237518E+01
- PKER_RACCS ( 39, 11) = 0.193889E+01
- PKER_RACCS ( 39, 12) = 0.157764E+01
- PKER_RACCS ( 39, 13) = 0.127850E+01
- PKER_RACCS ( 39, 14) = 0.103078E+01
- PKER_RACCS ( 39, 15) = 0.825598E+00
- PKER_RACCS ( 39, 16) = 0.655632E+00
- PKER_RACCS ( 39, 17) = 0.514822E+00
- PKER_RACCS ( 39, 18) = 0.398199E+00
- PKER_RACCS ( 39, 19) = 0.301778E+00
- PKER_RACCS ( 39, 20) = 0.222566E+00
- PKER_RACCS ( 39, 21) = 0.158680E+00
- PKER_RACCS ( 39, 22) = 0.109404E+00
- PKER_RACCS ( 39, 23) = 0.751723E-01
- PKER_RACCS ( 39, 24) = 0.565165E-01
- PKER_RACCS ( 39, 25) = 0.526713E-01
- PKER_RACCS ( 39, 26) = 0.605420E-01
- PKER_RACCS ( 39, 27) = 0.754562E-01
- PKER_RACCS ( 39, 28) = 0.928032E-01
- PKER_RACCS ( 39, 29) = 0.109558E+00
- PKER_RACCS ( 39, 30) = 0.124480E+00
- PKER_RACCS ( 39, 31) = 0.137384E+00
- PKER_RACCS ( 39, 32) = 0.148419E+00
- PKER_RACCS ( 39, 33) = 0.157766E+00
- PKER_RACCS ( 39, 34) = 0.165604E+00
- PKER_RACCS ( 39, 35) = 0.172109E+00
- PKER_RACCS ( 39, 36) = 0.177459E+00
- PKER_RACCS ( 39, 37) = 0.181828E+00
- PKER_RACCS ( 39, 38) = 0.185379E+00
- PKER_RACCS ( 39, 39) = 0.188256E+00
- PKER_RACCS ( 39, 40) = 0.190583E+00
- PKER_RACCS ( 40, 1) = 0.137238E+02
- PKER_RACCS ( 40, 2) = 0.113359E+02
- PKER_RACCS ( 40, 3) = 0.935909E+01
- PKER_RACCS ( 40, 4) = 0.772255E+01
- PKER_RACCS ( 40, 5) = 0.636773E+01
- PKER_RACCS ( 40, 6) = 0.524612E+01
- PKER_RACCS ( 40, 7) = 0.431757E+01
- PKER_RACCS ( 40, 8) = 0.354884E+01
- PKER_RACCS ( 40, 9) = 0.291241E+01
- PKER_RACCS ( 40, 10) = 0.238551E+01
- PKER_RACCS ( 40, 11) = 0.194927E+01
- PKER_RACCS ( 40, 12) = 0.158808E+01
- PKER_RACCS ( 40, 13) = 0.128901E+01
- PKER_RACCS ( 40, 14) = 0.104136E+01
- PKER_RACCS ( 40, 15) = 0.836271E+00
- PKER_RACCS ( 40, 16) = 0.666400E+00
- PKER_RACCS ( 40, 17) = 0.525688E+00
- PKER_RACCS ( 40, 18) = 0.409141E+00
- PKER_RACCS ( 40, 19) = 0.312712E+00
- PKER_RACCS ( 40, 20) = 0.233243E+00
- PKER_RACCS ( 40, 21) = 0.168554E+00
- PKER_RACCS ( 40, 22) = 0.117617E+00
- PKER_RACCS ( 40, 23) = 0.803792E-01
- PKER_RACCS ( 40, 24) = 0.573661E-01
- PKER_RACCS ( 40, 25) = 0.485548E-01
- PKER_RACCS ( 40, 26) = 0.519418E-01
- PKER_RACCS ( 40, 27) = 0.636428E-01
- PKER_RACCS ( 40, 28) = 0.791627E-01
- PKER_RACCS ( 40, 29) = 0.950607E-01
- PKER_RACCS ( 40, 30) = 0.109613E+00
- PKER_RACCS ( 40, 31) = 0.122376E+00
- PKER_RACCS ( 40, 32) = 0.133423E+00
- PKER_RACCS ( 40, 33) = 0.142912E+00
- PKER_RACCS ( 40, 34) = 0.150985E+00
- PKER_RACCS ( 40, 35) = 0.157777E+00
- PKER_RACCS ( 40, 36) = 0.163429E+00
- PKER_RACCS ( 40, 37) = 0.168087E+00
- PKER_RACCS ( 40, 38) = 0.171894E+00
- PKER_RACCS ( 40, 39) = 0.174990E+00
- PKER_RACCS ( 40, 40) = 0.177498E+00
+ PKER_RACCS ( 1, 1) = 0.810035E+01
+ PKER_RACCS ( 1, 2) = 0.624606E+01
+ PKER_RACCS ( 1, 3) = 0.474070E+01
+ PKER_RACCS ( 1, 4) = 0.352376E+01
+ PKER_RACCS ( 1, 5) = 0.255333E+01
+ PKER_RACCS ( 1, 6) = 0.180384E+01
+ PKER_RACCS ( 1, 7) = 0.126294E+01
+ PKER_RACCS ( 1, 8) = 0.924202E+00
+ PKER_RACCS ( 1, 9) = 0.775231E+00
+ PKER_RACCS ( 1, 10) = 0.787292E+00
+ PKER_RACCS ( 1, 11) = 0.911536E+00
+ PKER_RACCS ( 1, 12) = 0.109094E+01
+ PKER_RACCS ( 1, 13) = 0.127926E+01
+ PKER_RACCS ( 1, 14) = 0.145083E+01
+ PKER_RACCS ( 1, 15) = 0.159745E+01
+ PKER_RACCS ( 1, 16) = 0.171978E+01
+ PKER_RACCS ( 1, 17) = 0.182114E+01
+ PKER_RACCS ( 1, 18) = 0.190501E+01
+ PKER_RACCS ( 1, 19) = 0.197441E+01
+ PKER_RACCS ( 1, 20) = 0.203184E+01
+ PKER_RACCS ( 1, 21) = 0.207937E+01
+ PKER_RACCS ( 1, 22) = 0.211870E+01
+ PKER_RACCS ( 1, 23) = 0.215125E+01
+ PKER_RACCS ( 1, 24) = 0.217819E+01
+ PKER_RACCS ( 1, 25) = 0.220049E+01
+ PKER_RACCS ( 1, 26) = 0.221895E+01
+ PKER_RACCS ( 1, 27) = 0.223423E+01
+ PKER_RACCS ( 1, 28) = 0.224687E+01
+ PKER_RACCS ( 1, 29) = 0.225734E+01
+ PKER_RACCS ( 1, 30) = 0.226601E+01
+ PKER_RACCS ( 1, 31) = 0.227318E+01
+ PKER_RACCS ( 1, 32) = 0.227911E+01
+ PKER_RACCS ( 1, 33) = 0.228403E+01
+ PKER_RACCS ( 1, 34) = 0.228810E+01
+ PKER_RACCS ( 1, 35) = 0.229146E+01
+ PKER_RACCS ( 1, 36) = 0.229425E+01
+ PKER_RACCS ( 1, 37) = 0.229656E+01
+ PKER_RACCS ( 1, 38) = 0.229847E+01
+ PKER_RACCS ( 1, 39) = 0.230005E+01
+ PKER_RACCS ( 1, 40) = 0.230136E+01
+ PKER_RACCS ( 2, 1) = 0.835048E+01
+ PKER_RACCS ( 2, 2) = 0.645953E+01
+ PKER_RACCS ( 2, 3) = 0.492716E+01
+ PKER_RACCS ( 2, 4) = 0.368761E+01
+ PKER_RACCS ( 2, 5) = 0.269450E+01
+ PKER_RACCS ( 2, 6) = 0.191744E+01
+ PKER_RACCS ( 2, 7) = 0.134059E+01
+ PKER_RACCS ( 2, 8) = 0.956675E+00
+ PKER_RACCS ( 2, 9) = 0.757265E+00
+ PKER_RACCS ( 2, 10) = 0.720633E+00
+ PKER_RACCS ( 2, 11) = 0.806882E+00
+ PKER_RACCS ( 2, 12) = 0.963181E+00
+ PKER_RACCS ( 2, 13) = 0.114076E+01
+ PKER_RACCS ( 2, 14) = 0.130870E+01
+ PKER_RACCS ( 2, 15) = 0.145451E+01
+ PKER_RACCS ( 2, 16) = 0.157680E+01
+ PKER_RACCS ( 2, 17) = 0.167825E+01
+ PKER_RACCS ( 2, 18) = 0.176221E+01
+ PKER_RACCS ( 2, 19) = 0.183168E+01
+ PKER_RACCS ( 2, 20) = 0.188915E+01
+ PKER_RACCS ( 2, 21) = 0.193671E+01
+ PKER_RACCS ( 2, 22) = 0.197607E+01
+ PKER_RACCS ( 2, 23) = 0.200864E+01
+ PKER_RACCS ( 2, 24) = 0.203559E+01
+ PKER_RACCS ( 2, 25) = 0.205790E+01
+ PKER_RACCS ( 2, 26) = 0.207637E+01
+ PKER_RACCS ( 2, 27) = 0.209165E+01
+ PKER_RACCS ( 2, 28) = 0.210430E+01
+ PKER_RACCS ( 2, 29) = 0.211478E+01
+ PKER_RACCS ( 2, 30) = 0.212344E+01
+ PKER_RACCS ( 2, 31) = 0.213062E+01
+ PKER_RACCS ( 2, 32) = 0.213656E+01
+ PKER_RACCS ( 2, 33) = 0.214147E+01
+ PKER_RACCS ( 2, 34) = 0.214554E+01
+ PKER_RACCS ( 2, 35) = 0.214891E+01
+ PKER_RACCS ( 2, 36) = 0.215170E+01
+ PKER_RACCS ( 2, 37) = 0.215401E+01
+ PKER_RACCS ( 2, 38) = 0.215592E+01
+ PKER_RACCS ( 2, 39) = 0.215750E+01
+ PKER_RACCS ( 2, 40) = 0.215881E+01
+ PKER_RACCS ( 3, 1) = 0.861642E+01
+ PKER_RACCS ( 3, 2) = 0.668233E+01
+ PKER_RACCS ( 3, 3) = 0.511848E+01
+ PKER_RACCS ( 3, 4) = 0.385427E+01
+ PKER_RACCS ( 3, 5) = 0.283858E+01
+ PKER_RACCS ( 3, 6) = 0.203643E+01
+ PKER_RACCS ( 3, 7) = 0.142806E+01
+ PKER_RACCS ( 3, 8) = 0.100397E+01
+ PKER_RACCS ( 3, 9) = 0.757020E+00
+ PKER_RACCS ( 3, 10) = 0.673206E+00
+ PKER_RACCS ( 3, 11) = 0.719335E+00
+ PKER_RACCS ( 3, 12) = 0.849040E+00
+ PKER_RACCS ( 3, 13) = 0.101307E+01
+ PKER_RACCS ( 3, 14) = 0.117592E+01
+ PKER_RACCS ( 3, 15) = 0.132041E+01
+ PKER_RACCS ( 3, 16) = 0.144256E+01
+ PKER_RACCS ( 3, 17) = 0.154410E+01
+ PKER_RACCS ( 3, 18) = 0.162816E+01
+ PKER_RACCS ( 3, 19) = 0.169770E+01
+ PKER_RACCS ( 3, 20) = 0.175523E+01
+ PKER_RACCS ( 3, 21) = 0.180284E+01
+ PKER_RACCS ( 3, 22) = 0.184222E+01
+ PKER_RACCS ( 3, 23) = 0.187482E+01
+ PKER_RACCS ( 3, 24) = 0.190179E+01
+ PKER_RACCS ( 3, 25) = 0.192411E+01
+ PKER_RACCS ( 3, 26) = 0.194259E+01
+ PKER_RACCS ( 3, 27) = 0.195788E+01
+ PKER_RACCS ( 3, 28) = 0.197054E+01
+ PKER_RACCS ( 3, 29) = 0.198101E+01
+ PKER_RACCS ( 3, 30) = 0.198968E+01
+ PKER_RACCS ( 3, 31) = 0.199686E+01
+ PKER_RACCS ( 3, 32) = 0.200280E+01
+ PKER_RACCS ( 3, 33) = 0.200772E+01
+ PKER_RACCS ( 3, 34) = 0.201179E+01
+ PKER_RACCS ( 3, 35) = 0.201516E+01
+ PKER_RACCS ( 3, 36) = 0.201795E+01
+ PKER_RACCS ( 3, 37) = 0.202026E+01
+ PKER_RACCS ( 3, 38) = 0.202217E+01
+ PKER_RACCS ( 3, 39) = 0.202375E+01
+ PKER_RACCS ( 3, 40) = 0.202506E+01
+ PKER_RACCS ( 4, 1) = 0.890193E+01
+ PKER_RACCS ( 4, 2) = 0.691781E+01
+ PKER_RACCS ( 4, 3) = 0.531713E+01
+ PKER_RACCS ( 4, 4) = 0.402519E+01
+ PKER_RACCS ( 4, 5) = 0.298590E+01
+ PKER_RACCS ( 4, 6) = 0.216006E+01
+ PKER_RACCS ( 4, 7) = 0.152334E+01
+ PKER_RACCS ( 4, 8) = 0.106334E+01
+ PKER_RACCS ( 4, 9) = 0.773535E+00
+ PKER_RACCS ( 4, 10) = 0.643200E+00
+ PKER_RACCS ( 4, 11) = 0.648455E+00
+ PKER_RACCS ( 4, 12) = 0.748702E+00
+ PKER_RACCS ( 4, 13) = 0.896286E+00
+ PKER_RACCS ( 4, 14) = 0.105225E+01
+ PKER_RACCS ( 4, 15) = 0.119469E+01
+ PKER_RACCS ( 4, 16) = 0.131651E+01
+ PKER_RACCS ( 4, 17) = 0.141813E+01
+ PKER_RACCS ( 4, 18) = 0.150231E+01
+ PKER_RACCS ( 4, 19) = 0.157195E+01
+ PKER_RACCS ( 4, 20) = 0.162955E+01
+ PKER_RACCS ( 4, 21) = 0.167720E+01
+ PKER_RACCS ( 4, 22) = 0.171662E+01
+ PKER_RACCS ( 4, 23) = 0.174924E+01
+ PKER_RACCS ( 4, 24) = 0.177624E+01
+ PKER_RACCS ( 4, 25) = 0.179858E+01
+ PKER_RACCS ( 4, 26) = 0.181706E+01
+ PKER_RACCS ( 4, 27) = 0.183237E+01
+ PKER_RACCS ( 4, 28) = 0.184503E+01
+ PKER_RACCS ( 4, 29) = 0.185551E+01
+ PKER_RACCS ( 4, 30) = 0.186419E+01
+ PKER_RACCS ( 4, 31) = 0.187137E+01
+ PKER_RACCS ( 4, 32) = 0.187731E+01
+ PKER_RACCS ( 4, 33) = 0.188223E+01
+ PKER_RACCS ( 4, 34) = 0.188630E+01
+ PKER_RACCS ( 4, 35) = 0.188967E+01
+ PKER_RACCS ( 4, 36) = 0.189246E+01
+ PKER_RACCS ( 4, 37) = 0.189477E+01
+ PKER_RACCS ( 4, 38) = 0.189668E+01
+ PKER_RACCS ( 4, 39) = 0.189826E+01
+ PKER_RACCS ( 4, 40) = 0.189957E+01
+ PKER_RACCS ( 5, 1) = 0.920977E+01
+ PKER_RACCS ( 5, 2) = 0.716900E+01
+ PKER_RACCS ( 5, 3) = 0.552588E+01
+ PKER_RACCS ( 5, 4) = 0.420224E+01
+ PKER_RACCS ( 5, 5) = 0.313744E+01
+ PKER_RACCS ( 5, 6) = 0.228804E+01
+ PKER_RACCS ( 5, 7) = 0.162515E+01
+ PKER_RACCS ( 5, 8) = 0.113305E+01
+ PKER_RACCS ( 5, 9) = 0.804245E+00
+ PKER_RACCS ( 5, 10) = 0.630831E+00
+ PKER_RACCS ( 5, 11) = 0.594727E+00
+ PKER_RACCS ( 5, 12) = 0.662791E+00
+ PKER_RACCS ( 5, 13) = 0.790719E+00
+ PKER_RACCS ( 5, 14) = 0.937530E+00
+ PKER_RACCS ( 5, 15) = 0.107695E+01
+ PKER_RACCS ( 5, 16) = 0.119816E+01
+ PKER_RACCS ( 5, 17) = 0.129982E+01
+ PKER_RACCS ( 5, 18) = 0.138414E+01
+ PKER_RACCS ( 5, 19) = 0.145388E+01
+ PKER_RACCS ( 5, 20) = 0.151157E+01
+ PKER_RACCS ( 5, 21) = 0.155928E+01
+ PKER_RACCS ( 5, 22) = 0.159875E+01
+ PKER_RACCS ( 5, 23) = 0.163140E+01
+ PKER_RACCS ( 5, 24) = 0.165842E+01
+ PKER_RACCS ( 5, 25) = 0.168078E+01
+ PKER_RACCS ( 5, 26) = 0.169928E+01
+ PKER_RACCS ( 5, 27) = 0.171459E+01
+ PKER_RACCS ( 5, 28) = 0.172727E+01
+ PKER_RACCS ( 5, 29) = 0.173775E+01
+ PKER_RACCS ( 5, 30) = 0.174643E+01
+ PKER_RACCS ( 5, 31) = 0.175362E+01
+ PKER_RACCS ( 5, 32) = 0.175957E+01
+ PKER_RACCS ( 5, 33) = 0.176449E+01
+ PKER_RACCS ( 5, 34) = 0.176856E+01
+ PKER_RACCS ( 5, 35) = 0.177193E+01
+ PKER_RACCS ( 5, 36) = 0.177472E+01
+ PKER_RACCS ( 5, 37) = 0.177703E+01
+ PKER_RACCS ( 5, 38) = 0.177895E+01
+ PKER_RACCS ( 5, 39) = 0.178053E+01
+ PKER_RACCS ( 5, 40) = 0.178184E+01
+ PKER_RACCS ( 6, 1) = 0.954082E+01
+ PKER_RACCS ( 6, 2) = 0.743810E+01
+ PKER_RACCS ( 6, 3) = 0.574728E+01
+ PKER_RACCS ( 6, 4) = 0.438753E+01
+ PKER_RACCS ( 6, 5) = 0.329456E+01
+ PKER_RACCS ( 6, 6) = 0.242082E+01
+ PKER_RACCS ( 6, 7) = 0.173320E+01
+ PKER_RACCS ( 6, 8) = 0.121220E+01
+ PKER_RACCS ( 6, 9) = 0.848100E+00
+ PKER_RACCS ( 6, 10) = 0.633831E+00
+ PKER_RACCS ( 6, 11) = 0.557416E+00
+ PKER_RACCS ( 6, 12) = 0.591242E+00
+ PKER_RACCS ( 6, 13) = 0.696457E+00
+ PKER_RACCS ( 6, 14) = 0.831746E+00
+ PKER_RACCS ( 6, 15) = 0.966879E+00
+ PKER_RACCS ( 6, 16) = 0.108705E+01
+ PKER_RACCS ( 6, 17) = 0.118868E+01
+ PKER_RACCS ( 6, 18) = 0.127314E+01
+ PKER_RACCS ( 6, 19) = 0.134302E+01
+ PKER_RACCS ( 6, 20) = 0.140081E+01
+ PKER_RACCS ( 6, 21) = 0.144859E+01
+ PKER_RACCS ( 6, 22) = 0.148812E+01
+ PKER_RACCS ( 6, 23) = 0.152081E+01
+ PKER_RACCS ( 6, 24) = 0.154786E+01
+ PKER_RACCS ( 6, 25) = 0.157025E+01
+ PKER_RACCS ( 6, 26) = 0.158876E+01
+ PKER_RACCS ( 6, 27) = 0.160409E+01
+ PKER_RACCS ( 6, 28) = 0.161677E+01
+ PKER_RACCS ( 6, 29) = 0.162727E+01
+ PKER_RACCS ( 6, 30) = 0.163595E+01
+ PKER_RACCS ( 6, 31) = 0.164314E+01
+ PKER_RACCS ( 6, 32) = 0.164909E+01
+ PKER_RACCS ( 6, 33) = 0.165402E+01
+ PKER_RACCS ( 6, 34) = 0.165809E+01
+ PKER_RACCS ( 6, 35) = 0.166147E+01
+ PKER_RACCS ( 6, 36) = 0.166426E+01
+ PKER_RACCS ( 6, 37) = 0.166657E+01
+ PKER_RACCS ( 6, 38) = 0.166848E+01
+ PKER_RACCS ( 6, 39) = 0.167007E+01
+ PKER_RACCS ( 6, 40) = 0.167138E+01
+ PKER_RACCS ( 7, 1) = 0.989299E+01
+ PKER_RACCS ( 7, 2) = 0.772578E+01
+ PKER_RACCS ( 7, 3) = 0.598316E+01
+ PKER_RACCS ( 7, 4) = 0.458298E+01
+ PKER_RACCS ( 7, 5) = 0.345874E+01
+ PKER_RACCS ( 7, 6) = 0.255904E+01
+ PKER_RACCS ( 7, 7) = 0.184707E+01
+ PKER_RACCS ( 7, 8) = 0.129931E+01
+ PKER_RACCS ( 7, 9) = 0.903048E+00
+ PKER_RACCS ( 7, 10) = 0.651461E+00
+ PKER_RACCS ( 7, 11) = 0.535102E+00
+ PKER_RACCS ( 7, 12) = 0.533793E+00
+ PKER_RACCS ( 7, 13) = 0.613816E+00
+ PKER_RACCS ( 7, 14) = 0.735010E+00
+ PKER_RACCS ( 7, 15) = 0.864301E+00
+ PKER_RACCS ( 7, 16) = 0.982807E+00
+ PKER_RACCS ( 7, 17) = 0.108425E+01
+ PKER_RACCS ( 7, 18) = 0.116886E+01
+ PKER_RACCS ( 7, 19) = 0.123890E+01
+ PKER_RACCS ( 7, 20) = 0.129681E+01
+ PKER_RACCS ( 7, 21) = 0.134469E+01
+ PKER_RACCS ( 7, 22) = 0.138428E+01
+ PKER_RACCS ( 7, 23) = 0.141702E+01
+ PKER_RACCS ( 7, 24) = 0.144411E+01
+ PKER_RACCS ( 7, 25) = 0.146652E+01
+ PKER_RACCS ( 7, 26) = 0.148506E+01
+ PKER_RACCS ( 7, 27) = 0.150040E+01
+ PKER_RACCS ( 7, 28) = 0.151309E+01
+ PKER_RACCS ( 7, 29) = 0.152360E+01
+ PKER_RACCS ( 7, 30) = 0.153229E+01
+ PKER_RACCS ( 7, 31) = 0.153949E+01
+ PKER_RACCS ( 7, 32) = 0.154544E+01
+ PKER_RACCS ( 7, 33) = 0.155037E+01
+ PKER_RACCS ( 7, 34) = 0.155445E+01
+ PKER_RACCS ( 7, 35) = 0.155782E+01
+ PKER_RACCS ( 7, 36) = 0.156062E+01
+ PKER_RACCS ( 7, 37) = 0.156293E+01
+ PKER_RACCS ( 7, 38) = 0.156484E+01
+ PKER_RACCS ( 7, 39) = 0.156643E+01
+ PKER_RACCS ( 7, 40) = 0.156774E+01
+ PKER_RACCS ( 8, 1) = 0.102606E+02
+ PKER_RACCS ( 8, 2) = 0.803025E+01
+ PKER_RACCS ( 8, 3) = 0.623398E+01
+ PKER_RACCS ( 8, 4) = 0.479013E+01
+ PKER_RACCS ( 8, 5) = 0.363141E+01
+ PKER_RACCS ( 8, 6) = 0.270370E+01
+ PKER_RACCS ( 8, 7) = 0.196690E+01
+ PKER_RACCS ( 8, 8) = 0.139353E+01
+ PKER_RACCS ( 8, 9) = 0.967762E+00
+ PKER_RACCS ( 8, 10) = 0.681746E+00
+ PKER_RACCS ( 8, 11) = 0.527901E+00
+ PKER_RACCS ( 8, 12) = 0.491036E+00
+ PKER_RACCS ( 8, 13) = 0.543394E+00
+ PKER_RACCS ( 8, 14) = 0.647673E+00
+ PKER_RACCS ( 8, 15) = 0.769109E+00
+ PKER_RACCS ( 8, 16) = 0.885089E+00
+ PKER_RACCS ( 8, 17) = 0.986107E+00
+ PKER_RACCS ( 8, 18) = 0.107085E+01
+ PKER_RACCS ( 8, 19) = 0.114108E+01
+ PKER_RACCS ( 8, 20) = 0.119914E+01
+ PKER_RACCS ( 8, 21) = 0.124712E+01
+ PKER_RACCS ( 8, 22) = 0.128680E+01
+ PKER_RACCS ( 8, 23) = 0.131960E+01
+ PKER_RACCS ( 8, 24) = 0.134673E+01
+ PKER_RACCS ( 8, 25) = 0.136917E+01
+ PKER_RACCS ( 8, 26) = 0.138774E+01
+ PKER_RACCS ( 8, 27) = 0.140310E+01
+ PKER_RACCS ( 8, 28) = 0.141581E+01
+ PKER_RACCS ( 8, 29) = 0.142633E+01
+ PKER_RACCS ( 8, 30) = 0.143503E+01
+ PKER_RACCS ( 8, 31) = 0.144223E+01
+ PKER_RACCS ( 8, 32) = 0.144819E+01
+ PKER_RACCS ( 8, 33) = 0.145312E+01
+ PKER_RACCS ( 8, 34) = 0.145720E+01
+ PKER_RACCS ( 8, 35) = 0.146058E+01
+ PKER_RACCS ( 8, 36) = 0.146338E+01
+ PKER_RACCS ( 8, 37) = 0.146569E+01
+ PKER_RACCS ( 8, 38) = 0.146761E+01
+ PKER_RACCS ( 8, 39) = 0.146919E+01
+ PKER_RACCS ( 8, 40) = 0.147050E+01
+ PKER_RACCS ( 9, 1) = 0.106345E+02
+ PKER_RACCS ( 9, 2) = 0.834678E+01
+ PKER_RACCS ( 9, 3) = 0.649814E+01
+ PKER_RACCS ( 9, 4) = 0.500932E+01
+ PKER_RACCS ( 9, 5) = 0.381363E+01
+ PKER_RACCS ( 9, 6) = 0.285581E+01
+ PKER_RACCS ( 9, 7) = 0.209316E+01
+ PKER_RACCS ( 9, 8) = 0.149490E+01
+ PKER_RACCS ( 9, 9) = 0.104191E+01
+ PKER_RACCS ( 9, 10) = 0.724098E+00
+ PKER_RACCS ( 9, 11) = 0.534431E+00
+ PKER_RACCS ( 9, 12) = 0.462476E+00
+ PKER_RACCS ( 9, 13) = 0.485184E+00
+ PKER_RACCS ( 9, 14) = 0.569779E+00
+ PKER_RACCS ( 9, 15) = 0.681282E+00
+ PKER_RACCS ( 9, 16) = 0.793641E+00
+ PKER_RACCS ( 9, 17) = 0.893878E+00
+ PKER_RACCS ( 9, 18) = 0.978690E+00
+ PKER_RACCS ( 9, 19) = 0.104914E+01
+ PKER_RACCS ( 9, 20) = 0.110738E+01
+ PKER_RACCS ( 9, 21) = 0.115550E+01
+ PKER_RACCS ( 9, 22) = 0.119527E+01
+ PKER_RACCS ( 9, 23) = 0.122815E+01
+ PKER_RACCS ( 9, 24) = 0.125533E+01
+ PKER_RACCS ( 9, 25) = 0.127782E+01
+ PKER_RACCS ( 9, 26) = 0.129641E+01
+ PKER_RACCS ( 9, 27) = 0.131179E+01
+ PKER_RACCS ( 9, 28) = 0.132452E+01
+ PKER_RACCS ( 9, 29) = 0.133505E+01
+ PKER_RACCS ( 9, 30) = 0.134376E+01
+ PKER_RACCS ( 9, 31) = 0.135097E+01
+ PKER_RACCS ( 9, 32) = 0.135694E+01
+ PKER_RACCS ( 9, 33) = 0.136188E+01
+ PKER_RACCS ( 9, 34) = 0.136596E+01
+ PKER_RACCS ( 9, 35) = 0.136934E+01
+ PKER_RACCS ( 9, 36) = 0.137214E+01
+ PKER_RACCS ( 9, 37) = 0.137446E+01
+ PKER_RACCS ( 9, 38) = 0.137637E+01
+ PKER_RACCS ( 9, 39) = 0.137796E+01
+ PKER_RACCS ( 9, 40) = 0.137927E+01
+ PKER_RACCS ( 10, 1) = 0.110031E+02
+ PKER_RACCS ( 10, 2) = 0.866775E+01
+ PKER_RACCS ( 10, 3) = 0.677164E+01
+ PKER_RACCS ( 10, 4) = 0.523918E+01
+ PKER_RACCS ( 10, 5) = 0.400557E+01
+ PKER_RACCS ( 10, 6) = 0.301605E+01
+ PKER_RACCS ( 10, 7) = 0.222631E+01
+ PKER_RACCS ( 10, 8) = 0.160312E+01
+ PKER_RACCS ( 10, 9) = 0.112426E+01
+ PKER_RACCS ( 10, 10) = 0.776925E+00
+ PKER_RACCS ( 10, 11) = 0.554023E+00
+ PKER_RACCS ( 10, 12) = 0.447142E+00
+ PKER_RACCS ( 10, 13) = 0.439159E+00
+ PKER_RACCS ( 10, 14) = 0.501788E+00
+ PKER_RACCS ( 10, 15) = 0.601002E+00
+ PKER_RACCS ( 10, 16) = 0.708335E+00
+ PKER_RACCS ( 10, 17) = 0.807233E+00
+ PKER_RACCS ( 10, 18) = 0.892004E+00
+ PKER_RACCS ( 10, 19) = 0.962681E+00
+ PKER_RACCS ( 10, 20) = 0.102114E+01
+ PKER_RACCS ( 10, 21) = 0.106943E+01
+ PKER_RACCS ( 10, 22) = 0.110932E+01
+ PKER_RACCS ( 10, 23) = 0.114228E+01
+ PKER_RACCS ( 10, 24) = 0.116953E+01
+ PKER_RACCS ( 10, 25) = 0.119207E+01
+ PKER_RACCS ( 10, 26) = 0.121070E+01
+ PKER_RACCS ( 10, 27) = 0.122611E+01
+ PKER_RACCS ( 10, 28) = 0.123886E+01
+ PKER_RACCS ( 10, 29) = 0.124940E+01
+ PKER_RACCS ( 10, 30) = 0.125813E+01
+ PKER_RACCS ( 10, 31) = 0.126535E+01
+ PKER_RACCS ( 10, 32) = 0.127132E+01
+ PKER_RACCS ( 10, 33) = 0.127626E+01
+ PKER_RACCS ( 10, 34) = 0.128035E+01
+ PKER_RACCS ( 10, 35) = 0.128374E+01
+ PKER_RACCS ( 10, 36) = 0.128654E+01
+ PKER_RACCS ( 10, 37) = 0.128886E+01
+ PKER_RACCS ( 10, 38) = 0.129077E+01
+ PKER_RACCS ( 10, 39) = 0.129236E+01
+ PKER_RACCS ( 10, 40) = 0.129368E+01
+ PKER_RACCS ( 11, 1) = 0.113549E+02
+ PKER_RACCS ( 11, 2) = 0.898364E+01
+ PKER_RACCS ( 11, 3) = 0.704811E+01
+ PKER_RACCS ( 11, 4) = 0.547629E+01
+ PKER_RACCS ( 11, 5) = 0.420604E+01
+ PKER_RACCS ( 11, 6) = 0.318436E+01
+ PKER_RACCS ( 11, 7) = 0.236670E+01
+ PKER_RACCS ( 11, 8) = 0.171835E+01
+ PKER_RACCS ( 11, 9) = 0.121434E+01
+ PKER_RACCS ( 11, 10) = 0.839328E+00
+ PKER_RACCS ( 11, 11) = 0.585308E+00
+ PKER_RACCS ( 11, 12) = 0.445062E+00
+ PKER_RACCS ( 11, 13) = 0.405828E+00
+ PKER_RACCS ( 11, 14) = 0.444237E+00
+ PKER_RACCS ( 11, 15) = 0.528618E+00
+ PKER_RACCS ( 11, 16) = 0.629105E+00
+ PKER_RACCS ( 11, 17) = 0.725893E+00
+ PKER_RACCS ( 11, 18) = 0.810425E+00
+ PKER_RACCS ( 11, 19) = 0.881336E+00
+ PKER_RACCS ( 11, 20) = 0.940053E+00
+ PKER_RACCS ( 11, 21) = 0.988540E+00
+ PKER_RACCS ( 11, 22) = 0.102858E+01
+ PKER_RACCS ( 11, 23) = 0.106165E+01
+ PKER_RACCS ( 11, 24) = 0.108898E+01
+ PKER_RACCS ( 11, 25) = 0.111157E+01
+ PKER_RACCS ( 11, 26) = 0.113025E+01
+ PKER_RACCS ( 11, 27) = 0.114569E+01
+ PKER_RACCS ( 11, 28) = 0.115847E+01
+ PKER_RACCS ( 11, 29) = 0.116903E+01
+ PKER_RACCS ( 11, 30) = 0.117777E+01
+ PKER_RACCS ( 11, 31) = 0.118500E+01
+ PKER_RACCS ( 11, 32) = 0.119098E+01
+ PKER_RACCS ( 11, 33) = 0.119593E+01
+ PKER_RACCS ( 11, 34) = 0.120003E+01
+ PKER_RACCS ( 11, 35) = 0.120342E+01
+ PKER_RACCS ( 11, 36) = 0.120622E+01
+ PKER_RACCS ( 11, 37) = 0.120854E+01
+ PKER_RACCS ( 11, 38) = 0.121046E+01
+ PKER_RACCS ( 11, 39) = 0.121205E+01
+ PKER_RACCS ( 11, 40) = 0.121337E+01
+ PKER_RACCS ( 12, 1) = 0.116799E+02
+ PKER_RACCS ( 12, 2) = 0.928469E+01
+ PKER_RACCS ( 12, 3) = 0.731960E+01
+ PKER_RACCS ( 12, 4) = 0.571522E+01
+ PKER_RACCS ( 12, 5) = 0.441213E+01
+ PKER_RACCS ( 12, 6) = 0.335956E+01
+ PKER_RACCS ( 12, 7) = 0.251408E+01
+ PKER_RACCS ( 12, 8) = 0.184047E+01
+ PKER_RACCS ( 12, 9) = 0.131203E+01
+ PKER_RACCS ( 12, 10) = 0.911145E+00
+ PKER_RACCS ( 12, 11) = 0.627927E+00
+ PKER_RACCS ( 12, 12) = 0.455629E+00
+ PKER_RACCS ( 12, 13) = 0.385139E+00
+ PKER_RACCS ( 12, 14) = 0.397299E+00
+ PKER_RACCS ( 12, 15) = 0.464231E+00
+ PKER_RACCS ( 12, 16) = 0.555964E+00
+ PKER_RACCS ( 12, 17) = 0.649649E+00
+ PKER_RACCS ( 12, 18) = 0.733631E+00
+ PKER_RACCS ( 12, 19) = 0.804744E+00
+ PKER_RACCS ( 12, 20) = 0.863761E+00
+ PKER_RACCS ( 12, 21) = 0.912491E+00
+ PKER_RACCS ( 12, 22) = 0.952708E+00
+ PKER_RACCS ( 12, 23) = 0.985912E+00
+ PKER_RACCS ( 12, 24) = 0.101334E+01
+ PKER_RACCS ( 12, 25) = 0.103600E+01
+ PKER_RACCS ( 12, 26) = 0.105473E+01
+ PKER_RACCS ( 12, 27) = 0.107022E+01
+ PKER_RACCS ( 12, 28) = 0.108302E+01
+ PKER_RACCS ( 12, 29) = 0.109361E+01
+ PKER_RACCS ( 12, 30) = 0.110236E+01
+ PKER_RACCS ( 12, 31) = 0.110961E+01
+ PKER_RACCS ( 12, 32) = 0.111560E+01
+ PKER_RACCS ( 12, 33) = 0.112056E+01
+ PKER_RACCS ( 12, 34) = 0.112466E+01
+ PKER_RACCS ( 12, 35) = 0.112805E+01
+ PKER_RACCS ( 12, 36) = 0.113086E+01
+ PKER_RACCS ( 12, 37) = 0.113319E+01
+ PKER_RACCS ( 12, 38) = 0.113511E+01
+ PKER_RACCS ( 12, 39) = 0.113670E+01
+ PKER_RACCS ( 12, 40) = 0.113802E+01
+ PKER_RACCS ( 13, 1) = 0.119715E+02
+ PKER_RACCS ( 13, 2) = 0.956269E+01
+ PKER_RACCS ( 13, 3) = 0.757802E+01
+ PKER_RACCS ( 13, 4) = 0.594935E+01
+ PKER_RACCS ( 13, 5) = 0.461927E+01
+ PKER_RACCS ( 13, 6) = 0.353911E+01
+ PKER_RACCS ( 13, 7) = 0.266730E+01
+ PKER_RACCS ( 13, 8) = 0.196897E+01
+ PKER_RACCS ( 13, 9) = 0.141674E+01
+ PKER_RACCS ( 13, 10) = 0.991267E+00
+ PKER_RACCS ( 13, 11) = 0.680645E+00
+ PKER_RACCS ( 13, 12) = 0.478159E+00
+ PKER_RACCS ( 13, 13) = 0.376423E+00
+ PKER_RACCS ( 13, 14) = 0.361128E+00
+ PKER_RACCS ( 13, 15) = 0.408438E+00
+ PKER_RACCS ( 13, 16) = 0.489166E+00
+ PKER_RACCS ( 13, 17) = 0.578426E+00
+ PKER_RACCS ( 13, 18) = 0.661345E+00
+ PKER_RACCS ( 13, 19) = 0.732571E+00
+ PKER_RACCS ( 13, 20) = 0.791923E+00
+ PKER_RACCS ( 13, 21) = 0.840945E+00
+ PKER_RACCS ( 13, 22) = 0.881381E+00
+ PKER_RACCS ( 13, 23) = 0.914745E+00
+ PKER_RACCS ( 13, 24) = 0.942288E+00
+ PKER_RACCS ( 13, 25) = 0.965037E+00
+ PKER_RACCS ( 13, 26) = 0.983832E+00
+ PKER_RACCS ( 13, 27) = 0.999365E+00
+ PKER_RACCS ( 13, 28) = 0.101221E+01
+ PKER_RACCS ( 13, 29) = 0.102282E+01
+ PKER_RACCS ( 13, 30) = 0.103160E+01
+ PKER_RACCS ( 13, 31) = 0.103886E+01
+ PKER_RACCS ( 13, 32) = 0.104487E+01
+ PKER_RACCS ( 13, 33) = 0.104983E+01
+ PKER_RACCS ( 13, 34) = 0.105394E+01
+ PKER_RACCS ( 13, 35) = 0.105734E+01
+ PKER_RACCS ( 13, 36) = 0.106016E+01
+ PKER_RACCS ( 13, 37) = 0.106248E+01
+ PKER_RACCS ( 13, 38) = 0.106441E+01
+ PKER_RACCS ( 13, 39) = 0.106600E+01
+ PKER_RACCS ( 13, 40) = 0.106732E+01
+ PKER_RACCS ( 14, 1) = 0.122269E+02
+ PKER_RACCS ( 14, 2) = 0.981222E+01
+ PKER_RACCS ( 14, 3) = 0.781657E+01
+ PKER_RACCS ( 14, 4) = 0.617190E+01
+ PKER_RACCS ( 14, 5) = 0.482183E+01
+ PKER_RACCS ( 14, 6) = 0.371915E+01
+ PKER_RACCS ( 14, 7) = 0.282402E+01
+ PKER_RACCS ( 14, 8) = 0.210269E+01
+ PKER_RACCS ( 14, 9) = 0.152785E+01
+ PKER_RACCS ( 14, 10) = 0.107897E+01
+ PKER_RACCS ( 14, 11) = 0.742682E+00
+ PKER_RACCS ( 14, 12) = 0.511717E+00
+ PKER_RACCS ( 14, 13) = 0.379723E+00
+ PKER_RACCS ( 14, 14) = 0.336223E+00
+ PKER_RACCS ( 14, 15) = 0.361708E+00
+ PKER_RACCS ( 14, 16) = 0.429063E+00
+ PKER_RACCS ( 14, 17) = 0.512196E+00
+ PKER_RACCS ( 14, 18) = 0.593334E+00
+ PKER_RACCS ( 14, 19) = 0.664504E+00
+ PKER_RACCS ( 14, 20) = 0.724213E+00
+ PKER_RACCS ( 14, 21) = 0.773584E+00
+ PKER_RACCS ( 14, 22) = 0.814286E+00
+ PKER_RACCS ( 14, 23) = 0.847845E+00
+ PKER_RACCS ( 14, 24) = 0.875531E+00
+ PKER_RACCS ( 14, 25) = 0.898385E+00
+ PKER_RACCS ( 14, 26) = 0.917258E+00
+ PKER_RACCS ( 14, 27) = 0.932850E+00
+ PKER_RACCS ( 14, 28) = 0.945734E+00
+ PKER_RACCS ( 14, 29) = 0.956384E+00
+ PKER_RACCS ( 14, 30) = 0.965189E+00
+ PKER_RACCS ( 14, 31) = 0.972469E+00
+ PKER_RACCS ( 14, 32) = 0.978490E+00
+ PKER_RACCS ( 14, 33) = 0.983469E+00
+ PKER_RACCS ( 14, 34) = 0.987588E+00
+ PKER_RACCS ( 14, 35) = 0.990995E+00
+ PKER_RACCS ( 14, 36) = 0.993813E+00
+ PKER_RACCS ( 14, 37) = 0.996145E+00
+ PKER_RACCS ( 14, 38) = 0.998074E+00
+ PKER_RACCS ( 14, 39) = 0.999670E+00
+ PKER_RACCS ( 14, 40) = 0.100099E+01
+ PKER_RACCS ( 15, 1) = 0.124464E+02
+ PKER_RACCS ( 15, 2) = 0.100310E+02
+ PKER_RACCS ( 15, 3) = 0.803077E+01
+ PKER_RACCS ( 15, 4) = 0.637725E+01
+ PKER_RACCS ( 15, 5) = 0.501415E+01
+ PKER_RACCS ( 15, 6) = 0.389492E+01
+ PKER_RACCS ( 15, 7) = 0.298087E+01
+ PKER_RACCS ( 15, 8) = 0.223947E+01
+ PKER_RACCS ( 15, 9) = 0.164395E+01
+ PKER_RACCS ( 15, 10) = 0.117348E+01
+ PKER_RACCS ( 15, 11) = 0.813603E+00
+ PKER_RACCS ( 15, 12) = 0.555940E+00
+ PKER_RACCS ( 15, 13) = 0.394860E+00
+ PKER_RACCS ( 15, 14) = 0.322907E+00
+ PKER_RACCS ( 15, 15) = 0.324503E+00
+ PKER_RACCS ( 15, 16) = 0.375896E+00
+ PKER_RACCS ( 15, 17) = 0.451039E+00
+ PKER_RACCS ( 15, 18) = 0.529435E+00
+ PKER_RACCS ( 15, 19) = 0.600261E+00
+ PKER_RACCS ( 15, 20) = 0.660320E+00
+ PKER_RACCS ( 15, 21) = 0.710100E+00
+ PKER_RACCS ( 15, 22) = 0.751124E+00
+ PKER_RACCS ( 15, 23) = 0.784920E+00
+ PKER_RACCS ( 15, 24) = 0.812780E+00
+ PKER_RACCS ( 15, 25) = 0.835762E+00
+ PKER_RACCS ( 15, 26) = 0.854730E+00
+ PKER_RACCS ( 15, 27) = 0.870393E+00
+ PKER_RACCS ( 15, 28) = 0.883331E+00
+ PKER_RACCS ( 15, 29) = 0.894022E+00
+ PKER_RACCS ( 15, 30) = 0.902857E+00
+ PKER_RACCS ( 15, 31) = 0.910161E+00
+ PKER_RACCS ( 15, 32) = 0.916200E+00
+ PKER_RACCS ( 15, 33) = 0.921193E+00
+ PKER_RACCS ( 15, 34) = 0.925323E+00
+ PKER_RACCS ( 15, 35) = 0.928738E+00
+ PKER_RACCS ( 15, 36) = 0.931563E+00
+ PKER_RACCS ( 15, 37) = 0.933900E+00
+ PKER_RACCS ( 15, 38) = 0.935833E+00
+ PKER_RACCS ( 15, 39) = 0.937432E+00
+ PKER_RACCS ( 15, 40) = 0.938755E+00
+ PKER_RACCS ( 16, 1) = 0.126327E+02
+ PKER_RACCS ( 16, 2) = 0.102194E+02
+ PKER_RACCS ( 16, 3) = 0.821876E+01
+ PKER_RACCS ( 16, 4) = 0.656171E+01
+ PKER_RACCS ( 16, 5) = 0.519153E+01
+ PKER_RACCS ( 16, 6) = 0.406164E+01
+ PKER_RACCS ( 16, 7) = 0.313379E+01
+ PKER_RACCS ( 16, 8) = 0.237630E+01
+ PKER_RACCS ( 16, 9) = 0.176301E+01
+ PKER_RACCS ( 16, 10) = 0.127321E+01
+ PKER_RACCS ( 16, 11) = 0.891908E+00
+ PKER_RACCS ( 16, 12) = 0.609619E+00
+ PKER_RACCS ( 16, 13) = 0.421108E+00
+ PKER_RACCS ( 16, 14) = 0.320728E+00
+ PKER_RACCS ( 16, 15) = 0.297097E+00
+ PKER_RACCS ( 16, 16) = 0.330361E+00
+ PKER_RACCS ( 16, 17) = 0.395280E+00
+ PKER_RACCS ( 16, 18) = 0.469630E+00
+ PKER_RACCS ( 16, 19) = 0.539613E+00
+ PKER_RACCS ( 16, 20) = 0.599949E+00
+ PKER_RACCS ( 16, 21) = 0.650193E+00
+ PKER_RACCS ( 16, 22) = 0.691608E+00
+ PKER_RACCS ( 16, 23) = 0.725693E+00
+ PKER_RACCS ( 16, 24) = 0.753765E+00
+ PKER_RACCS ( 16, 25) = 0.776902E+00
+ PKER_RACCS ( 16, 26) = 0.795985E+00
+ PKER_RACCS ( 16, 27) = 0.811734E+00
+ PKER_RACCS ( 16, 28) = 0.824737E+00
+ PKER_RACCS ( 16, 29) = 0.835476E+00
+ PKER_RACCS ( 16, 30) = 0.844348E+00
+ PKER_RACCS ( 16, 31) = 0.851681E+00
+ PKER_RACCS ( 16, 32) = 0.857741E+00
+ PKER_RACCS ( 16, 33) = 0.862751E+00
+ PKER_RACCS ( 16, 34) = 0.866894E+00
+ PKER_RACCS ( 16, 35) = 0.870319E+00
+ PKER_RACCS ( 16, 36) = 0.873152E+00
+ PKER_RACCS ( 16, 37) = 0.875495E+00
+ PKER_RACCS ( 16, 38) = 0.877433E+00
+ PKER_RACCS ( 16, 39) = 0.879036E+00
+ PKER_RACCS ( 16, 40) = 0.880362E+00
+ PKER_RACCS ( 17, 1) = 0.127896E+02
+ PKER_RACCS ( 17, 2) = 0.103796E+02
+ PKER_RACCS ( 17, 3) = 0.838093E+01
+ PKER_RACCS ( 17, 4) = 0.672380E+01
+ PKER_RACCS ( 17, 5) = 0.535093E+01
+ PKER_RACCS ( 17, 6) = 0.421538E+01
+ PKER_RACCS ( 17, 7) = 0.327875E+01
+ PKER_RACCS ( 17, 8) = 0.250965E+01
+ PKER_RACCS ( 17, 9) = 0.188231E+01
+ PKER_RACCS ( 17, 10) = 0.137624E+01
+ PKER_RACCS ( 17, 11) = 0.976041E+00
+ PKER_RACCS ( 17, 12) = 0.671601E+00
+ PKER_RACCS ( 17, 13) = 0.457610E+00
+ PKER_RACCS ( 17, 14) = 0.329677E+00
+ PKER_RACCS ( 17, 15) = 0.280046E+00
+ PKER_RACCS ( 17, 16) = 0.292981E+00
+ PKER_RACCS ( 17, 17) = 0.345338E+00
+ PKER_RACCS ( 17, 18) = 0.413953E+00
+ PKER_RACCS ( 17, 19) = 0.482373E+00
+ PKER_RACCS ( 17, 20) = 0.542827E+00
+ PKER_RACCS ( 17, 21) = 0.593577E+00
+ PKER_RACCS ( 17, 22) = 0.635456E+00
+ PKER_RACCS ( 17, 23) = 0.669894E+00
+ PKER_RACCS ( 17, 24) = 0.698224E+00
+ PKER_RACCS ( 17, 25) = 0.721550E+00
+ PKER_RACCS ( 17, 26) = 0.740773E+00
+ PKER_RACCS ( 17, 27) = 0.756626E+00
+ PKER_RACCS ( 17, 28) = 0.769706E+00
+ PKER_RACCS ( 17, 29) = 0.780504E+00
+ PKER_RACCS ( 17, 30) = 0.789421E+00
+ PKER_RACCS ( 17, 31) = 0.796788E+00
+ PKER_RACCS ( 17, 32) = 0.802874E+00
+ PKER_RACCS ( 17, 33) = 0.807905E+00
+ PKER_RACCS ( 17, 34) = 0.812063E+00
+ PKER_RACCS ( 17, 35) = 0.815500E+00
+ PKER_RACCS ( 17, 36) = 0.818342E+00
+ PKER_RACCS ( 17, 37) = 0.820693E+00
+ PKER_RACCS ( 17, 38) = 0.822636E+00
+ PKER_RACCS ( 17, 39) = 0.824244E+00
+ PKER_RACCS ( 17, 40) = 0.825573E+00
+ PKER_RACCS ( 18, 1) = 0.129213E+02
+ PKER_RACCS ( 18, 2) = 0.105149E+02
+ PKER_RACCS ( 18, 3) = 0.851921E+01
+ PKER_RACCS ( 18, 4) = 0.686389E+01
+ PKER_RACCS ( 18, 5) = 0.549117E+01
+ PKER_RACCS ( 18, 6) = 0.435362E+01
+ PKER_RACCS ( 18, 7) = 0.341243E+01
+ PKER_RACCS ( 18, 8) = 0.263602E+01
+ PKER_RACCS ( 18, 9) = 0.199868E+01
+ PKER_RACCS ( 18, 10) = 0.147991E+01
+ PKER_RACCS ( 18, 11) = 0.106410E+01
+ PKER_RACCS ( 18, 12) = 0.740604E+00
+ PKER_RACCS ( 18, 13) = 0.503591E+00
+ PKER_RACCS ( 18, 14) = 0.349646E+00
+ PKER_RACCS ( 18, 15) = 0.273846E+00
+ PKER_RACCS ( 18, 16) = 0.264450E+00
+ PKER_RACCS ( 18, 17) = 0.301632E+00
+ PKER_RACCS ( 18, 18) = 0.362584E+00
+ PKER_RACCS ( 18, 19) = 0.428436E+00
+ PKER_RACCS ( 18, 20) = 0.488711E+00
+ PKER_RACCS ( 18, 21) = 0.539973E+00
+ PKER_RACCS ( 18, 22) = 0.582398E+00
+ PKER_RACCS ( 18, 23) = 0.617263E+00
+ PKER_RACCS ( 18, 24) = 0.645906E+00
+ PKER_RACCS ( 18, 25) = 0.669463E+00
+ PKER_RACCS ( 18, 26) = 0.688855E+00
+ PKER_RACCS ( 18, 27) = 0.704834E+00
+ PKER_RACCS ( 18, 28) = 0.718008E+00
+ PKER_RACCS ( 18, 29) = 0.728877E+00
+ PKER_RACCS ( 18, 30) = 0.737848E+00
+ PKER_RACCS ( 18, 31) = 0.745255E+00
+ PKER_RACCS ( 18, 32) = 0.751373E+00
+ PKER_RACCS ( 18, 33) = 0.756428E+00
+ PKER_RACCS ( 18, 34) = 0.760604E+00
+ PKER_RACCS ( 18, 35) = 0.764056E+00
+ PKER_RACCS ( 18, 36) = 0.766910E+00
+ PKER_RACCS ( 18, 37) = 0.769269E+00
+ PKER_RACCS ( 18, 38) = 0.771219E+00
+ PKER_RACCS ( 18, 39) = 0.772832E+00
+ PKER_RACCS ( 18, 40) = 0.774166E+00
+ PKER_RACCS ( 19, 1) = 0.130318E+02
+ PKER_RACCS ( 19, 2) = 0.106289E+02
+ PKER_RACCS ( 19, 3) = 0.863636E+01
+ PKER_RACCS ( 19, 4) = 0.698365E+01
+ PKER_RACCS ( 19, 5) = 0.561261E+01
+ PKER_RACCS ( 19, 6) = 0.447539E+01
+ PKER_RACCS ( 19, 7) = 0.353272E+01
+ PKER_RACCS ( 19, 8) = 0.275260E+01
+ PKER_RACCS ( 19, 9) = 0.210907E+01
+ PKER_RACCS ( 19, 10) = 0.158135E+01
+ PKER_RACCS ( 19, 11) = 0.115350E+01
+ PKER_RACCS ( 19, 12) = 0.814363E+00
+ PKER_RACCS ( 19, 13) = 0.557360E+00
+ PKER_RACCS ( 19, 14) = 0.379586E+00
+ PKER_RACCS ( 19, 15) = 0.278114E+00
+ PKER_RACCS ( 19, 16) = 0.245146E+00
+ PKER_RACCS ( 19, 17) = 0.264975E+00
+ PKER_RACCS ( 19, 18) = 0.315944E+00
+ PKER_RACCS ( 19, 19) = 0.377850E+00
+ PKER_RACCS ( 19, 20) = 0.437417E+00
+ PKER_RACCS ( 19, 21) = 0.489121E+00
+ PKER_RACCS ( 19, 22) = 0.532165E+00
+ PKER_RACCS ( 19, 23) = 0.567544E+00
+ PKER_RACCS ( 19, 24) = 0.596569E+00
+ PKER_RACCS ( 19, 25) = 0.620406E+00
+ PKER_RACCS ( 19, 26) = 0.640004E+00
+ PKER_RACCS ( 19, 27) = 0.656135E+00
+ PKER_RACCS ( 19, 28) = 0.669424E+00
+ PKER_RACCS ( 19, 29) = 0.680378E+00
+ PKER_RACCS ( 19, 30) = 0.689414E+00
+ PKER_RACCS ( 19, 31) = 0.696870E+00
+ PKER_RACCS ( 19, 32) = 0.703026E+00
+ PKER_RACCS ( 19, 33) = 0.708109E+00
+ PKER_RACCS ( 19, 34) = 0.712308E+00
+ PKER_RACCS ( 19, 35) = 0.715777E+00
+ PKER_RACCS ( 19, 36) = 0.718644E+00
+ PKER_RACCS ( 19, 37) = 0.721014E+00
+ PKER_RACCS ( 19, 38) = 0.722972E+00
+ PKER_RACCS ( 19, 39) = 0.724592E+00
+ PKER_RACCS ( 19, 40) = 0.725930E+00
+ PKER_RACCS ( 20, 1) = 0.131249E+02
+ PKER_RACCS ( 20, 2) = 0.107250E+02
+ PKER_RACCS ( 20, 3) = 0.873538E+01
+ PKER_RACCS ( 20, 4) = 0.708543E+01
+ PKER_RACCS ( 20, 5) = 0.571670E+01
+ PKER_RACCS ( 20, 6) = 0.458105E+01
+ PKER_RACCS ( 20, 7) = 0.363884E+01
+ PKER_RACCS ( 20, 8) = 0.285761E+01
+ PKER_RACCS ( 20, 9) = 0.221101E+01
+ PKER_RACCS ( 20, 10) = 0.167782E+01
+ PKER_RACCS ( 20, 11) = 0.124159E+01
+ PKER_RACCS ( 20, 12) = 0.890407E+00
+ PKER_RACCS ( 20, 13) = 0.616977E+00
+ PKER_RACCS ( 20, 14) = 0.418242E+00
+ PKER_RACCS ( 20, 15) = 0.292524E+00
+ PKER_RACCS ( 20, 16) = 0.235581E+00
+ PKER_RACCS ( 20, 17) = 0.235983E+00
+ PKER_RACCS ( 20, 18) = 0.274591E+00
+ PKER_RACCS ( 20, 19) = 0.330763E+00
+ PKER_RACCS ( 20, 20) = 0.388819E+00
+ PKER_RACCS ( 20, 21) = 0.440784E+00
+ PKER_RACCS ( 20, 22) = 0.484500E+00
+ PKER_RACCS ( 20, 23) = 0.520487E+00
+ PKER_RACCS ( 20, 24) = 0.549976E+00
+ PKER_RACCS ( 20, 25) = 0.574153E+00
+ PKER_RACCS ( 20, 26) = 0.594001E+00
+ PKER_RACCS ( 20, 27) = 0.610317E+00
+ PKER_RACCS ( 20, 28) = 0.623744E+00
+ PKER_RACCS ( 20, 29) = 0.634801E+00
+ PKER_RACCS ( 20, 30) = 0.643915E+00
+ PKER_RACCS ( 20, 31) = 0.651431E+00
+ PKER_RACCS ( 20, 32) = 0.657631E+00
+ PKER_RACCS ( 20, 33) = 0.662749E+00
+ PKER_RACCS ( 20, 34) = 0.666975E+00
+ PKER_RACCS ( 20, 35) = 0.670465E+00
+ PKER_RACCS ( 20, 36) = 0.673348E+00
+ PKER_RACCS ( 20, 37) = 0.675730E+00
+ PKER_RACCS ( 20, 38) = 0.677698E+00
+ PKER_RACCS ( 20, 39) = 0.679325E+00
+ PKER_RACCS ( 20, 40) = 0.680670E+00
+ PKER_RACCS ( 21, 1) = 0.132036E+02
+ PKER_RACCS ( 21, 2) = 0.108062E+02
+ PKER_RACCS ( 21, 3) = 0.881918E+01
+ PKER_RACCS ( 21, 4) = 0.717177E+01
+ PKER_RACCS ( 21, 5) = 0.580546E+01
+ PKER_RACCS ( 21, 6) = 0.467187E+01
+ PKER_RACCS ( 21, 7) = 0.373113E+01
+ PKER_RACCS ( 21, 8) = 0.295042E+01
+ PKER_RACCS ( 21, 9) = 0.230297E+01
+ PKER_RACCS ( 21, 10) = 0.176711E+01
+ PKER_RACCS ( 21, 11) = 0.132575E+01
+ PKER_RACCS ( 21, 12) = 0.966211E+00
+ PKER_RACCS ( 21, 13) = 0.680246E+00
+ PKER_RACCS ( 21, 14) = 0.464064E+00
+ PKER_RACCS ( 21, 15) = 0.316605E+00
+ PKER_RACCS ( 21, 16) = 0.236157E+00
+ PKER_RACCS ( 21, 17) = 0.215485E+00
+ PKER_RACCS ( 21, 18) = 0.239150E+00
+ PKER_RACCS ( 21, 19) = 0.287499E+00
+ PKER_RACCS ( 21, 20) = 0.342900E+00
+ PKER_RACCS ( 21, 21) = 0.394764E+00
+ PKER_RACCS ( 21, 22) = 0.439154E+00
+ PKER_RACCS ( 21, 23) = 0.475848E+00
+ PKER_RACCS ( 21, 24) = 0.505894E+00
+ PKER_RACCS ( 21, 25) = 0.530484E+00
+ PKER_RACCS ( 21, 26) = 0.550636E+00
+ PKER_RACCS ( 21, 27) = 0.567176E+00
+ PKER_RACCS ( 21, 28) = 0.580769E+00
+ PKER_RACCS ( 21, 29) = 0.591952E+00
+ PKER_RACCS ( 21, 30) = 0.601159E+00
+ PKER_RACCS ( 21, 31) = 0.608746E+00
+ PKER_RACCS ( 21, 32) = 0.615001E+00
+ PKER_RACCS ( 21, 33) = 0.620161E+00
+ PKER_RACCS ( 21, 34) = 0.624418E+00
+ PKER_RACCS ( 21, 35) = 0.627933E+00
+ PKER_RACCS ( 21, 36) = 0.630835E+00
+ PKER_RACCS ( 21, 37) = 0.633232E+00
+ PKER_RACCS ( 21, 38) = 0.635212E+00
+ PKER_RACCS ( 21, 39) = 0.636848E+00
+ PKER_RACCS ( 21, 40) = 0.638199E+00
+ PKER_RACCS ( 22, 1) = 0.132706E+02
+ PKER_RACCS ( 22, 2) = 0.108752E+02
+ PKER_RACCS ( 22, 3) = 0.889034E+01
+ PKER_RACCS ( 22, 4) = 0.724514E+01
+ PKER_RACCS ( 22, 5) = 0.588103E+01
+ PKER_RACCS ( 22, 6) = 0.474956E+01
+ PKER_RACCS ( 22, 7) = 0.381066E+01
+ PKER_RACCS ( 22, 8) = 0.303131E+01
+ PKER_RACCS ( 22, 9) = 0.238440E+01
+ PKER_RACCS ( 22, 10) = 0.184783E+01
+ PKER_RACCS ( 22, 11) = 0.140395E+01
+ PKER_RACCS ( 22, 12) = 0.103925E+01
+ PKER_RACCS ( 22, 13) = 0.744489E+00
+ PKER_RACCS ( 22, 14) = 0.514665E+00
+ PKER_RACCS ( 22, 15) = 0.348618E+00
+ PKER_RACCS ( 22, 16) = 0.246213E+00
+ PKER_RACCS ( 22, 17) = 0.203810E+00
+ PKER_RACCS ( 22, 18) = 0.210527E+00
+ PKER_RACCS ( 22, 19) = 0.248639E+00
+ PKER_RACCS ( 22, 20) = 0.299821E+00
+ PKER_RACCS ( 22, 21) = 0.350944E+00
+ PKER_RACCS ( 22, 22) = 0.395903E+00
+ PKER_RACCS ( 22, 23) = 0.433386E+00
+ PKER_RACCS ( 22, 24) = 0.464095E+00
+ PKER_RACCS ( 22, 25) = 0.489182E+00
+ PKER_RACCS ( 22, 26) = 0.509702E+00
+ PKER_RACCS ( 22, 27) = 0.526514E+00
+ PKER_RACCS ( 22, 28) = 0.540309E+00
+ PKER_RACCS ( 22, 29) = 0.551642E+00
+ PKER_RACCS ( 22, 30) = 0.560963E+00
+ PKER_RACCS ( 22, 31) = 0.568636E+00
+ PKER_RACCS ( 22, 32) = 0.574956E+00
+ PKER_RACCS ( 22, 33) = 0.580166E+00
+ PKER_RACCS ( 22, 34) = 0.584462E+00
+ PKER_RACCS ( 22, 35) = 0.588006E+00
+ PKER_RACCS ( 22, 36) = 0.590931E+00
+ PKER_RACCS ( 22, 37) = 0.593346E+00
+ PKER_RACCS ( 22, 38) = 0.595339E+00
+ PKER_RACCS ( 22, 39) = 0.596986E+00
+ PKER_RACCS ( 22, 40) = 0.598346E+00
+ PKER_RACCS ( 23, 1) = 0.133280E+02
+ PKER_RACCS ( 23, 2) = 0.109343E+02
+ PKER_RACCS ( 23, 3) = 0.895109E+01
+ PKER_RACCS ( 23, 4) = 0.730772E+01
+ PKER_RACCS ( 23, 5) = 0.594552E+01
+ PKER_RACCS ( 23, 6) = 0.481597E+01
+ PKER_RACCS ( 23, 7) = 0.387893E+01
+ PKER_RACCS ( 23, 8) = 0.310124E+01
+ PKER_RACCS ( 23, 9) = 0.245555E+01
+ PKER_RACCS ( 23, 10) = 0.191949E+01
+ PKER_RACCS ( 23, 11) = 0.147491E+01
+ PKER_RACCS ( 23, 12) = 0.110760E+01
+ PKER_RACCS ( 23, 13) = 0.807248E+00
+ PKER_RACCS ( 23, 14) = 0.567629E+00
+ PKER_RACCS ( 23, 15) = 0.386696E+00
+ PKER_RACCS ( 23, 16) = 0.264772E+00
+ PKER_RACCS ( 23, 17) = 0.201168E+00
+ PKER_RACCS ( 23, 18) = 0.189359E+00
+ PKER_RACCS ( 23, 19) = 0.214892E+00
+ PKER_RACCS ( 23, 20) = 0.259902E+00
+ PKER_RACCS ( 23, 21) = 0.309296E+00
+ PKER_RACCS ( 23, 22) = 0.354562E+00
+ PKER_RACCS ( 23, 23) = 0.392871E+00
+ PKER_RACCS ( 23, 24) = 0.424352E+00
+ PKER_RACCS ( 23, 25) = 0.450037E+00
+ PKER_RACCS ( 23, 26) = 0.471000E+00
+ PKER_RACCS ( 23, 27) = 0.488140E+00
+ PKER_RACCS ( 23, 28) = 0.502179E+00
+ PKER_RACCS ( 23, 29) = 0.513695E+00
+ PKER_RACCS ( 23, 30) = 0.523153E+00
+ PKER_RACCS ( 23, 31) = 0.530929E+00
+ PKER_RACCS ( 23, 32) = 0.537328E+00
+ PKER_RACCS ( 23, 33) = 0.542597E+00
+ PKER_RACCS ( 23, 34) = 0.546939E+00
+ PKER_RACCS ( 23, 35) = 0.550519E+00
+ PKER_RACCS ( 23, 36) = 0.553471E+00
+ PKER_RACCS ( 23, 37) = 0.555907E+00
+ PKER_RACCS ( 23, 38) = 0.557917E+00
+ PKER_RACCS ( 23, 39) = 0.559577E+00
+ PKER_RACCS ( 23, 40) = 0.560947E+00
+ PKER_RACCS ( 24, 1) = 0.133776E+02
+ PKER_RACCS ( 24, 2) = 0.109851E+02
+ PKER_RACCS ( 24, 3) = 0.900330E+01
+ PKER_RACCS ( 24, 4) = 0.736141E+01
+ PKER_RACCS ( 24, 5) = 0.600078E+01
+ PKER_RACCS ( 24, 6) = 0.487288E+01
+ PKER_RACCS ( 24, 7) = 0.393752E+01
+ PKER_RACCS ( 24, 8) = 0.316146E+01
+ PKER_RACCS ( 24, 9) = 0.251726E+01
+ PKER_RACCS ( 24, 10) = 0.198229E+01
+ PKER_RACCS ( 24, 11) = 0.153812E+01
+ PKER_RACCS ( 24, 12) = 0.116995E+01
+ PKER_RACCS ( 24, 13) = 0.866612E+00
+ PKER_RACCS ( 24, 14) = 0.620643E+00
+ PKER_RACCS ( 24, 15) = 0.428690E+00
+ PKER_RACCS ( 24, 16) = 0.290707E+00
+ PKER_RACCS ( 24, 17) = 0.207519E+00
+ PKER_RACCS ( 24, 18) = 0.176401E+00
+ PKER_RACCS ( 24, 19) = 0.187072E+00
+ PKER_RACCS ( 24, 20) = 0.223666E+00
+ PKER_RACCS ( 24, 21) = 0.269955E+00
+ PKER_RACCS ( 24, 22) = 0.315007E+00
+ PKER_RACCS ( 24, 23) = 0.354096E+00
+ PKER_RACCS ( 24, 24) = 0.386445E+00
+ PKER_RACCS ( 24, 25) = 0.412837E+00
+ PKER_RACCS ( 24, 26) = 0.434333E+00
+ PKER_RACCS ( 24, 27) = 0.451869E+00
+ PKER_RACCS ( 24, 28) = 0.466202E+00
+ PKER_RACCS ( 24, 29) = 0.477938E+00
+ PKER_RACCS ( 24, 30) = 0.487561E+00
+ PKER_RACCS ( 24, 31) = 0.495462E+00
+ PKER_RACCS ( 24, 32) = 0.501955E+00
+ PKER_RACCS ( 24, 33) = 0.507296E+00
+ PKER_RACCS ( 24, 34) = 0.511693E+00
+ PKER_RACCS ( 24, 35) = 0.515315E+00
+ PKER_RACCS ( 24, 36) = 0.518300E+00
+ PKER_RACCS ( 24, 37) = 0.520762E+00
+ PKER_RACCS ( 24, 38) = 0.522792E+00
+ PKER_RACCS ( 24, 39) = 0.524467E+00
+ PKER_RACCS ( 24, 40) = 0.525849E+00
+ PKER_RACCS ( 25, 1) = 0.134206E+02
+ PKER_RACCS ( 25, 2) = 0.110292E+02
+ PKER_RACCS ( 25, 3) = 0.904847E+01
+ PKER_RACCS ( 25, 4) = 0.740776E+01
+ PKER_RACCS ( 25, 5) = 0.604841E+01
+ PKER_RACCS ( 25, 6) = 0.492186E+01
+ PKER_RACCS ( 25, 7) = 0.398793E+01
+ PKER_RACCS ( 25, 8) = 0.321335E+01
+ PKER_RACCS ( 25, 9) = 0.257059E+01
+ PKER_RACCS ( 25, 10) = 0.203693E+01
+ PKER_RACCS ( 25, 11) = 0.159370E+01
+ PKER_RACCS ( 25, 12) = 0.122575E+01
+ PKER_RACCS ( 25, 13) = 0.921214E+00
+ PKER_RACCS ( 25, 14) = 0.671617E+00
+ PKER_RACCS ( 25, 15) = 0.472110E+00
+ PKER_RACCS ( 25, 16) = 0.321676E+00
+ PKER_RACCS ( 25, 17) = 0.221561E+00
+ PKER_RACCS ( 25, 18) = 0.171605E+00
+ PKER_RACCS ( 25, 19) = 0.166038E+00
+ PKER_RACCS ( 25, 20) = 0.191877E+00
+ PKER_RACCS ( 25, 21) = 0.233259E+00
+ PKER_RACCS ( 25, 22) = 0.277238E+00
+ PKER_RACCS ( 25, 23) = 0.316894E+00
+ PKER_RACCS ( 25, 24) = 0.350169E+00
+ PKER_RACCS ( 25, 25) = 0.377379E+00
+ PKER_RACCS ( 25, 26) = 0.399506E+00
+ PKER_RACCS ( 25, 27) = 0.417517E+00
+ PKER_RACCS ( 25, 28) = 0.432204E+00
+ PKER_RACCS ( 25, 29) = 0.444205E+00
+ PKER_RACCS ( 25, 30) = 0.454027E+00
+ PKER_RACCS ( 25, 31) = 0.462077E+00
+ PKER_RACCS ( 25, 32) = 0.468684E+00
+ PKER_RACCS ( 25, 33) = 0.474112E+00
+ PKER_RACCS ( 25, 34) = 0.478576E+00
+ PKER_RACCS ( 25, 35) = 0.482249E+00
+ PKER_RACCS ( 25, 36) = 0.485273E+00
+ PKER_RACCS ( 25, 37) = 0.487764E+00
+ PKER_RACCS ( 25, 38) = 0.489818E+00
+ PKER_RACCS ( 25, 39) = 0.491511E+00
+ PKER_RACCS ( 25, 40) = 0.492908E+00
+ PKER_RACCS ( 26, 1) = 0.134583E+02
+ PKER_RACCS ( 26, 2) = 0.110677E+02
+ PKER_RACCS ( 26, 3) = 0.908784E+01
+ PKER_RACCS ( 26, 4) = 0.744807E+01
+ PKER_RACCS ( 26, 5) = 0.608972E+01
+ PKER_RACCS ( 26, 6) = 0.496427E+01
+ PKER_RACCS ( 26, 7) = 0.403151E+01
+ PKER_RACCS ( 26, 8) = 0.325817E+01
+ PKER_RACCS ( 26, 9) = 0.261671E+01
+ PKER_RACCS ( 26, 10) = 0.208432E+01
+ PKER_RACCS ( 26, 11) = 0.164223E+01
+ PKER_RACCS ( 26, 12) = 0.127505E+01
+ PKER_RACCS ( 26, 13) = 0.970445E+00
+ PKER_RACCS ( 26, 14) = 0.719103E+00
+ PKER_RACCS ( 26, 15) = 0.514960E+00
+ PKER_RACCS ( 26, 16) = 0.355619E+00
+ PKER_RACCS ( 26, 17) = 0.241696E+00
+ PKER_RACCS ( 26, 18) = 0.174597E+00
+ PKER_RACCS ( 26, 19) = 0.152207E+00
+ PKER_RACCS ( 26, 20) = 0.165325E+00
+ PKER_RACCS ( 26, 21) = 0.199742E+00
+ PKER_RACCS ( 26, 22) = 0.241398E+00
+ PKER_RACCS ( 26, 23) = 0.281177E+00
+ PKER_RACCS ( 26, 24) = 0.315343E+00
+ PKER_RACCS ( 26, 25) = 0.343466E+00
+ PKER_RACCS ( 26, 26) = 0.366332E+00
+ PKER_RACCS ( 26, 27) = 0.384904E+00
+ PKER_RACCS ( 26, 28) = 0.400015E+00
+ PKER_RACCS ( 26, 29) = 0.412334E+00
+ PKER_RACCS ( 26, 30) = 0.422395E+00
+ PKER_RACCS ( 26, 31) = 0.430626E+00
+ PKER_RACCS ( 26, 32) = 0.437370E+00
+ PKER_RACCS ( 26, 33) = 0.442902E+00
+ PKER_RACCS ( 26, 34) = 0.447445E+00
+ PKER_RACCS ( 26, 35) = 0.451179E+00
+ PKER_RACCS ( 26, 36) = 0.454250E+00
+ PKER_RACCS ( 26, 37) = 0.456778E+00
+ PKER_RACCS ( 26, 38) = 0.458860E+00
+ PKER_RACCS ( 26, 39) = 0.460575E+00
+ PKER_RACCS ( 26, 40) = 0.461988E+00
+ PKER_RACCS ( 27, 1) = 0.134916E+02
+ PKER_RACCS ( 27, 2) = 0.111016E+02
+ PKER_RACCS ( 27, 3) = 0.912241E+01
+ PKER_RACCS ( 27, 4) = 0.748337E+01
+ PKER_RACCS ( 27, 5) = 0.612582E+01
+ PKER_RACCS ( 27, 6) = 0.500123E+01
+ PKER_RACCS ( 27, 7) = 0.406942E+01
+ PKER_RACCS ( 27, 8) = 0.329710E+01
+ PKER_RACCS ( 27, 9) = 0.265672E+01
+ PKER_RACCS ( 27, 10) = 0.212547E+01
+ PKER_RACCS ( 27, 11) = 0.168449E+01
+ PKER_RACCS ( 27, 12) = 0.131827E+01
+ PKER_RACCS ( 27, 13) = 0.101419E+01
+ PKER_RACCS ( 27, 14) = 0.762350E+00
+ PKER_RACCS ( 27, 15) = 0.555726E+00
+ PKER_RACCS ( 27, 16) = 0.390561E+00
+ PKER_RACCS ( 27, 17) = 0.266359E+00
+ PKER_RACCS ( 27, 18) = 0.184682E+00
+ PKER_RACCS ( 27, 19) = 0.145925E+00
+ PKER_RACCS ( 27, 20) = 0.144842E+00
+ PKER_RACCS ( 27, 21) = 0.170126E+00
+ PKER_RACCS ( 27, 22) = 0.207837E+00
+ PKER_RACCS ( 27, 23) = 0.246960E+00
+ PKER_RACCS ( 27, 24) = 0.281834E+00
+ PKER_RACCS ( 27, 25) = 0.310921E+00
+ PKER_RACCS ( 27, 26) = 0.334627E+00
+ PKER_RACCS ( 27, 27) = 0.353857E+00
+ PKER_RACCS ( 27, 28) = 0.369470E+00
+ PKER_RACCS ( 27, 29) = 0.382168E+00
+ PKER_RACCS ( 27, 30) = 0.392516E+00
+ PKER_RACCS ( 27, 31) = 0.400964E+00
+ PKER_RACCS ( 27, 32) = 0.407872E+00
+ PKER_RACCS ( 27, 33) = 0.413529E+00
+ PKER_RACCS ( 27, 34) = 0.418167E+00
+ PKER_RACCS ( 27, 35) = 0.421974E+00
+ PKER_RACCS ( 27, 36) = 0.425101E+00
+ PKER_RACCS ( 27, 37) = 0.427673E+00
+ PKER_RACCS ( 27, 38) = 0.429788E+00
+ PKER_RACCS ( 27, 39) = 0.431529E+00
+ PKER_RACCS ( 27, 40) = 0.432963E+00
+ PKER_RACCS ( 28, 1) = 0.135212E+02
+ PKER_RACCS ( 28, 2) = 0.111316E+02
+ PKER_RACCS ( 28, 3) = 0.915297E+01
+ PKER_RACCS ( 28, 4) = 0.751450E+01
+ PKER_RACCS ( 28, 5) = 0.615758E+01
+ PKER_RACCS ( 28, 6) = 0.503368E+01
+ PKER_RACCS ( 28, 7) = 0.410261E+01
+ PKER_RACCS ( 28, 8) = 0.333111E+01
+ PKER_RACCS ( 28, 9) = 0.269162E+01
+ PKER_RACCS ( 28, 10) = 0.216132E+01
+ PKER_RACCS ( 28, 11) = 0.172133E+01
+ PKER_RACCS ( 28, 12) = 0.135607E+01
+ PKER_RACCS ( 28, 13) = 0.105274E+01
+ PKER_RACCS ( 28, 14) = 0.801085E+00
+ PKER_RACCS ( 28, 15) = 0.593401E+00
+ PKER_RACCS ( 28, 16) = 0.424717E+00
+ PKER_RACCS ( 28, 17) = 0.293277E+00
+ PKER_RACCS ( 28, 18) = 0.200068E+00
+ PKER_RACCS ( 28, 19) = 0.146527E+00
+ PKER_RACCS ( 28, 20) = 0.130912E+00
+ PKER_RACCS ( 28, 21) = 0.145240E+00
+ PKER_RACCS ( 28, 22) = 0.177100E+00
+ PKER_RACCS ( 28, 23) = 0.214430E+00
+ PKER_RACCS ( 28, 24) = 0.249591E+00
+ PKER_RACCS ( 28, 25) = 0.279602E+00
+ PKER_RACCS ( 28, 26) = 0.304226E+00
+ PKER_RACCS ( 28, 27) = 0.324208E+00
+ PKER_RACCS ( 28, 28) = 0.340405E+00
+ PKER_RACCS ( 28, 29) = 0.353552E+00
+ PKER_RACCS ( 28, 30) = 0.364242E+00
+ PKER_RACCS ( 28, 31) = 0.372949E+00
+ PKER_RACCS ( 28, 32) = 0.380054E+00
+ PKER_RACCS ( 28, 33) = 0.385860E+00
+ PKER_RACCS ( 28, 34) = 0.390613E+00
+ PKER_RACCS ( 28, 35) = 0.394508E+00
+ PKER_RACCS ( 28, 36) = 0.397703E+00
+ PKER_RACCS ( 28, 37) = 0.400326E+00
+ PKER_RACCS ( 28, 38) = 0.402482E+00
+ PKER_RACCS ( 28, 39) = 0.404254E+00
+ PKER_RACCS ( 28, 40) = 0.405713E+00
+ PKER_RACCS ( 29, 1) = 0.135476E+02
+ PKER_RACCS ( 29, 2) = 0.111584E+02
+ PKER_RACCS ( 29, 3) = 0.918018E+01
+ PKER_RACCS ( 29, 4) = 0.754216E+01
+ PKER_RACCS ( 29, 5) = 0.618572E+01
+ PKER_RACCS ( 29, 6) = 0.506235E+01
+ PKER_RACCS ( 29, 7) = 0.413187E+01
+ PKER_RACCS ( 29, 8) = 0.336101E+01
+ PKER_RACCS ( 29, 9) = 0.272223E+01
+ PKER_RACCS ( 29, 10) = 0.219271E+01
+ PKER_RACCS ( 29, 11) = 0.175356E+01
+ PKER_RACCS ( 29, 12) = 0.138915E+01
+ PKER_RACCS ( 29, 13) = 0.108662E+01
+ PKER_RACCS ( 29, 14) = 0.835482E+00
+ PKER_RACCS ( 29, 15) = 0.627544E+00
+ PKER_RACCS ( 29, 16) = 0.457003E+00
+ PKER_RACCS ( 29, 17) = 0.320871E+00
+ PKER_RACCS ( 29, 18) = 0.218993E+00
+ PKER_RACCS ( 29, 19) = 0.153040E+00
+ PKER_RACCS ( 29, 20) = 0.123480E+00
+ PKER_RACCS ( 29, 21) = 0.125714E+00
+ PKER_RACCS ( 29, 22) = 0.149873E+00
+ PKER_RACCS ( 29, 23) = 0.183944E+00
+ PKER_RACCS ( 29, 24) = 0.218688E+00
+ PKER_RACCS ( 29, 25) = 0.249424E+00
+ PKER_RACCS ( 29, 26) = 0.274989E+00
+ PKER_RACCS ( 29, 27) = 0.295803E+00
+ PKER_RACCS ( 29, 28) = 0.312668E+00
+ PKER_RACCS ( 29, 29) = 0.326337E+00
+ PKER_RACCS ( 29, 30) = 0.337429E+00
+ PKER_RACCS ( 29, 31) = 0.346444E+00
+ PKER_RACCS ( 29, 32) = 0.353785E+00
+ PKER_RACCS ( 29, 33) = 0.359771E+00
+ PKER_RACCS ( 29, 34) = 0.364661E+00
+ PKER_RACCS ( 29, 35) = 0.368660E+00
+ PKER_RACCS ( 29, 36) = 0.371936E+00
+ PKER_RACCS ( 29, 37) = 0.374622E+00
+ PKER_RACCS ( 29, 38) = 0.376826E+00
+ PKER_RACCS ( 29, 39) = 0.378635E+00
+ PKER_RACCS ( 29, 40) = 0.380123E+00
+ PKER_RACCS ( 30, 1) = 0.135713E+02
+ PKER_RACCS ( 30, 2) = 0.111824E+02
+ PKER_RACCS ( 30, 3) = 0.920455E+01
+ PKER_RACCS ( 30, 4) = 0.756688E+01
+ PKER_RACCS ( 30, 5) = 0.621082E+01
+ PKER_RACCS ( 30, 6) = 0.508787E+01
+ PKER_RACCS ( 30, 7) = 0.415784E+01
+ PKER_RACCS ( 30, 8) = 0.338749E+01
+ PKER_RACCS ( 30, 9) = 0.274927E+01
+ PKER_RACCS ( 30, 10) = 0.222037E+01
+ PKER_RACCS ( 30, 11) = 0.178189E+01
+ PKER_RACCS ( 30, 12) = 0.141821E+01
+ PKER_RACCS ( 30, 13) = 0.111641E+01
+ PKER_RACCS ( 30, 14) = 0.865882E+00
+ PKER_RACCS ( 30, 15) = 0.658144E+00
+ PKER_RACCS ( 30, 16) = 0.486803E+00
+ PKER_RACCS ( 30, 17) = 0.347889E+00
+ PKER_RACCS ( 30, 18) = 0.240079E+00
+ PKER_RACCS ( 30, 19) = 0.164371E+00
+ PKER_RACCS ( 30, 20) = 0.122278E+00
+ PKER_RACCS ( 30, 21) = 0.112067E+00
+ PKER_RACCS ( 30, 22) = 0.126909E+00
+ PKER_RACCS ( 30, 23) = 0.156066E+00
+ PKER_RACCS ( 30, 24) = 0.189340E+00
+ PKER_RACCS ( 30, 25) = 0.220392E+00
+ PKER_RACCS ( 30, 26) = 0.246822E+00
+ PKER_RACCS ( 30, 27) = 0.268510E+00
+ PKER_RACCS ( 30, 28) = 0.286117E+00
+ PKER_RACCS ( 30, 29) = 0.300380E+00
+ PKER_RACCS ( 30, 30) = 0.311940E+00
+ PKER_RACCS ( 30, 31) = 0.321318E+00
+ PKER_RACCS ( 30, 32) = 0.328937E+00
+ PKER_RACCS ( 30, 33) = 0.335137E+00
+ PKER_RACCS ( 30, 34) = 0.340191E+00
+ PKER_RACCS ( 30, 35) = 0.344317E+00
+ PKER_RACCS ( 30, 36) = 0.347689E+00
+ PKER_RACCS ( 30, 37) = 0.350449E+00
+ PKER_RACCS ( 30, 38) = 0.352711E+00
+ PKER_RACCS ( 30, 39) = 0.354565E+00
+ PKER_RACCS ( 30, 40) = 0.356087E+00
+ PKER_RACCS ( 31, 1) = 0.135928E+02
+ PKER_RACCS ( 31, 2) = 0.112041E+02
+ PKER_RACCS ( 31, 3) = 0.922651E+01
+ PKER_RACCS ( 31, 4) = 0.758911E+01
+ PKER_RACCS ( 31, 5) = 0.623334E+01
+ PKER_RACCS ( 31, 6) = 0.511071E+01
+ PKER_RACCS ( 31, 7) = 0.418105E+01
+ PKER_RACCS ( 31, 8) = 0.341109E+01
+ PKER_RACCS ( 31, 9) = 0.277330E+01
+ PKER_RACCS ( 31, 10) = 0.224489E+01
+ PKER_RACCS ( 31, 11) = 0.180695E+01
+ PKER_RACCS ( 31, 12) = 0.144386E+01
+ PKER_RACCS ( 31, 13) = 0.114268E+01
+ PKER_RACCS ( 31, 14) = 0.892748E+00
+ PKER_RACCS ( 31, 15) = 0.685391E+00
+ PKER_RACCS ( 31, 16) = 0.513859E+00
+ PKER_RACCS ( 31, 17) = 0.373398E+00
+ PKER_RACCS ( 31, 18) = 0.261665E+00
+ PKER_RACCS ( 31, 19) = 0.178785E+00
+ PKER_RACCS ( 31, 20) = 0.126188E+00
+ PKER_RACCS ( 31, 21) = 0.104190E+00
+ PKER_RACCS ( 31, 22) = 0.108781E+00
+ PKER_RACCS ( 31, 23) = 0.131410E+00
+ PKER_RACCS ( 31, 24) = 0.161929E+00
+ PKER_RACCS ( 31, 25) = 0.192628E+00
+ PKER_RACCS ( 31, 26) = 0.219702E+00
+ PKER_RACCS ( 31, 27) = 0.242240E+00
+ PKER_RACCS ( 31, 28) = 0.260630E+00
+ PKER_RACCS ( 31, 29) = 0.275551E+00
+ PKER_RACCS ( 31, 30) = 0.287642E+00
+ PKER_RACCS ( 31, 31) = 0.297440E+00
+ PKER_RACCS ( 31, 32) = 0.305387E+00
+ PKER_RACCS ( 31, 33) = 0.311841E+00
+ PKER_RACCS ( 31, 34) = 0.317090E+00
+ PKER_RACCS ( 31, 35) = 0.321366E+00
+ PKER_RACCS ( 31, 36) = 0.324854E+00
+ PKER_RACCS ( 31, 37) = 0.327703E+00
+ PKER_RACCS ( 31, 38) = 0.330033E+00
+ PKER_RACCS ( 31, 39) = 0.331941E+00
+ PKER_RACCS ( 31, 40) = 0.333505E+00
+ PKER_RACCS ( 32, 1) = 0.136123E+02
+ PKER_RACCS ( 32, 2) = 0.112238E+02
+ PKER_RACCS ( 32, 3) = 0.924639E+01
+ PKER_RACCS ( 32, 4) = 0.760920E+01
+ PKER_RACCS ( 32, 5) = 0.625367E+01
+ PKER_RACCS ( 32, 6) = 0.513129E+01
+ PKER_RACCS ( 32, 7) = 0.420190E+01
+ PKER_RACCS ( 32, 8) = 0.343225E+01
+ PKER_RACCS ( 32, 9) = 0.279481E+01
+ PKER_RACCS ( 32, 10) = 0.226677E+01
+ PKER_RACCS ( 32, 11) = 0.182926E+01
+ PKER_RACCS ( 32, 12) = 0.146664E+01
+ PKER_RACCS ( 32, 13) = 0.116597E+01
+ PKER_RACCS ( 32, 14) = 0.916557E+00
+ PKER_RACCS ( 32, 15) = 0.709637E+00
+ PKER_RACCS ( 32, 16) = 0.538201E+00
+ PKER_RACCS ( 32, 17) = 0.397009E+00
+ PKER_RACCS ( 32, 18) = 0.282874E+00
+ PKER_RACCS ( 32, 19) = 0.194862E+00
+ PKER_RACCS ( 32, 20) = 0.133999E+00
+ PKER_RACCS ( 32, 21) = 0.101519E+00
+ PKER_RACCS ( 32, 22) = 0.957088E-01
+ PKER_RACCS ( 32, 23) = 0.110579E+00
+ PKER_RACCS ( 32, 24) = 0.136947E+00
+ PKER_RACCS ( 32, 25) = 0.166392E+00
+ PKER_RACCS ( 32, 26) = 0.193693E+00
+ PKER_RACCS ( 32, 27) = 0.216957E+00
+ PKER_RACCS ( 32, 28) = 0.236123E+00
+ PKER_RACCS ( 32, 29) = 0.251739E+00
+ PKER_RACCS ( 32, 30) = 0.264414E+00
+ PKER_RACCS ( 32, 31) = 0.274689E+00
+ PKER_RACCS ( 32, 32) = 0.283015E+00
+ PKER_RACCS ( 32, 33) = 0.289766E+00
+ PKER_RACCS ( 32, 34) = 0.295246E+00
+ PKER_RACCS ( 32, 35) = 0.299700E+00
+ PKER_RACCS ( 32, 36) = 0.303326E+00
+ PKER_RACCS ( 32, 37) = 0.306282E+00
+ PKER_RACCS ( 32, 38) = 0.308695E+00
+ PKER_RACCS ( 32, 39) = 0.310666E+00
+ PKER_RACCS ( 32, 40) = 0.312279E+00
+ PKER_RACCS ( 33, 1) = 0.136301E+02
+ PKER_RACCS ( 33, 2) = 0.112418E+02
+ PKER_RACCS ( 33, 3) = 0.926449E+01
+ PKER_RACCS ( 33, 4) = 0.762746E+01
+ PKER_RACCS ( 33, 5) = 0.627211E+01
+ PKER_RACCS ( 33, 6) = 0.514993E+01
+ PKER_RACCS ( 33, 7) = 0.422075E+01
+ PKER_RACCS ( 33, 8) = 0.345134E+01
+ PKER_RACCS ( 33, 9) = 0.281416E+01
+ PKER_RACCS ( 33, 10) = 0.228641E+01
+ PKER_RACCS ( 33, 11) = 0.184923E+01
+ PKER_RACCS ( 33, 12) = 0.148699E+01
+ PKER_RACCS ( 33, 13) = 0.118672E+01
+ PKER_RACCS ( 33, 14) = 0.937747E+00
+ PKER_RACCS ( 33, 15) = 0.731237E+00
+ PKER_RACCS ( 33, 16) = 0.560038E+00
+ PKER_RACCS ( 33, 17) = 0.418590E+00
+ PKER_RACCS ( 33, 18) = 0.303093E+00
+ PKER_RACCS ( 33, 19) = 0.211735E+00
+ PKER_RACCS ( 33, 20) = 0.144709E+00
+ PKER_RACCS ( 33, 21) = 0.103389E+00
+ PKER_RACCS ( 33, 22) = 0.876948E-01
+ PKER_RACCS ( 33, 23) = 0.940326E-01
+ PKER_RACCS ( 33, 24) = 0.114972E+00
+ PKER_RACCS ( 33, 25) = 0.142046E+00
+ PKER_RACCS ( 33, 26) = 0.168966E+00
+ PKER_RACCS ( 33, 27) = 0.192699E+00
+ PKER_RACCS ( 33, 28) = 0.212559E+00
+ PKER_RACCS ( 33, 29) = 0.228864E+00
+ PKER_RACCS ( 33, 30) = 0.242156E+00
+ PKER_RACCS ( 33, 31) = 0.252953E+00
+ PKER_RACCS ( 33, 32) = 0.261707E+00
+ PKER_RACCS ( 33, 33) = 0.268801E+00
+ PKER_RACCS ( 33, 34) = 0.274551E+00
+ PKER_RACCS ( 33, 35) = 0.279216E+00
+ PKER_RACCS ( 33, 36) = 0.283006E+00
+ PKER_RACCS ( 33, 37) = 0.286089E+00
+ PKER_RACCS ( 33, 38) = 0.288600E+00
+ PKER_RACCS ( 33, 39) = 0.290648E+00
+ PKER_RACCS ( 33, 40) = 0.292320E+00
+ PKER_RACCS ( 34, 1) = 0.136464E+02
+ PKER_RACCS ( 34, 2) = 0.112582E+02
+ PKER_RACCS ( 34, 3) = 0.928102E+01
+ PKER_RACCS ( 34, 4) = 0.764412E+01
+ PKER_RACCS ( 34, 5) = 0.628891E+01
+ PKER_RACCS ( 34, 6) = 0.516688E+01
+ PKER_RACCS ( 34, 7) = 0.423787E+01
+ PKER_RACCS ( 34, 8) = 0.346865E+01
+ PKER_RACCS ( 34, 9) = 0.283167E+01
+ PKER_RACCS ( 34, 10) = 0.230415E+01
+ PKER_RACCS ( 34, 11) = 0.186723E+01
+ PKER_RACCS ( 34, 12) = 0.150527E+01
+ PKER_RACCS ( 34, 13) = 0.120533E+01
+ PKER_RACCS ( 34, 14) = 0.956703E+00
+ PKER_RACCS ( 34, 15) = 0.750546E+00
+ PKER_RACCS ( 34, 16) = 0.579618E+00
+ PKER_RACCS ( 34, 17) = 0.438164E+00
+ PKER_RACCS ( 34, 18) = 0.321920E+00
+ PKER_RACCS ( 34, 19) = 0.228381E+00
+ PKER_RACCS ( 34, 20) = 0.157004E+00
+ PKER_RACCS ( 34, 21) = 0.108653E+00
+ PKER_RACCS ( 34, 22) = 0.841812E-01
+ PKER_RACCS ( 34, 23) = 0.818931E-01
+ PKER_RACCS ( 34, 24) = 0.964120E-01
+ PKER_RACCS ( 34, 25) = 0.120012E+00
+ PKER_RACCS ( 34, 26) = 0.145780E+00
+ PKER_RACCS ( 34, 27) = 0.169586E+00
+ PKER_RACCS ( 34, 28) = 0.189966E+00
+ PKER_RACCS ( 34, 29) = 0.206893E+00
+ PKER_RACCS ( 34, 30) = 0.220793E+00
+ PKER_RACCS ( 34, 31) = 0.232137E+00
+ PKER_RACCS ( 34, 32) = 0.241360E+00
+ PKER_RACCS ( 34, 33) = 0.248841E+00
+ PKER_RACCS ( 34, 34) = 0.254902E+00
+ PKER_RACCS ( 34, 35) = 0.259814E+00
+ PKER_RACCS ( 34, 36) = 0.263797E+00
+ PKER_RACCS ( 34, 37) = 0.267030E+00
+ PKER_RACCS ( 34, 38) = 0.269658E+00
+ PKER_RACCS ( 34, 39) = 0.271797E+00
+ PKER_RACCS ( 34, 40) = 0.273540E+00
+ PKER_RACCS ( 35, 1) = 0.136614E+02
+ PKER_RACCS ( 35, 2) = 0.112733E+02
+ PKER_RACCS ( 35, 3) = 0.929618E+01
+ PKER_RACCS ( 35, 4) = 0.765939E+01
+ PKER_RACCS ( 35, 5) = 0.630429E+01
+ PKER_RACCS ( 35, 6) = 0.518237E+01
+ PKER_RACCS ( 35, 7) = 0.425350E+01
+ PKER_RACCS ( 35, 8) = 0.348441E+01
+ PKER_RACCS ( 35, 9) = 0.284759E+01
+ PKER_RACCS ( 35, 10) = 0.232025E+01
+ PKER_RACCS ( 35, 11) = 0.188353E+01
+ PKER_RACCS ( 35, 12) = 0.152179E+01
+ PKER_RACCS ( 35, 13) = 0.122210E+01
+ PKER_RACCS ( 35, 14) = 0.973753E+00
+ PKER_RACCS ( 35, 15) = 0.767890E+00
+ PKER_RACCS ( 35, 16) = 0.597225E+00
+ PKER_RACCS ( 35, 17) = 0.455867E+00
+ PKER_RACCS ( 35, 18) = 0.339275E+00
+ PKER_RACCS ( 35, 19) = 0.244416E+00
+ PKER_RACCS ( 35, 20) = 0.169957E+00
+ PKER_RACCS ( 35, 21) = 0.116255E+00
+ PKER_RACCS ( 35, 22) = 0.843838E-01
+ PKER_RACCS ( 35, 23) = 0.739429E-01
+ PKER_RACCS ( 35, 24) = 0.815390E-01
+ PKER_RACCS ( 35, 25) = 0.100685E+00
+ PKER_RACCS ( 35, 26) = 0.124455E+00
+ PKER_RACCS ( 35, 27) = 0.147808E+00
+ PKER_RACCS ( 35, 28) = 0.168434E+00
+ PKER_RACCS ( 35, 29) = 0.185847E+00
+ PKER_RACCS ( 35, 30) = 0.200294E+00
+ PKER_RACCS ( 35, 31) = 0.212176E+00
+ PKER_RACCS ( 35, 32) = 0.221887E+00
+ PKER_RACCS ( 35, 33) = 0.229789E+00
+ PKER_RACCS ( 35, 34) = 0.236201E+00
+ PKER_RACCS ( 35, 35) = 0.241396E+00
+ PKER_RACCS ( 35, 36) = 0.245605E+00
+ PKER_RACCS ( 35, 37) = 0.249015E+00
+ PKER_RACCS ( 35, 38) = 0.251782E+00
+ PKER_RACCS ( 35, 39) = 0.254029E+00
+ PKER_RACCS ( 35, 40) = 0.255856E+00
+ PKER_RACCS ( 36, 1) = 0.136752E+02
+ PKER_RACCS ( 36, 2) = 0.112871E+02
+ PKER_RACCS ( 36, 3) = 0.931013E+01
+ PKER_RACCS ( 36, 4) = 0.767342E+01
+ PKER_RACCS ( 36, 5) = 0.631840E+01
+ PKER_RACCS ( 36, 6) = 0.519658E+01
+ PKER_RACCS ( 36, 7) = 0.426781E+01
+ PKER_RACCS ( 36, 8) = 0.349883E+01
+ PKER_RACCS ( 36, 9) = 0.286213E+01
+ PKER_RACCS ( 36, 10) = 0.233493E+01
+ PKER_RACCS ( 36, 11) = 0.189836E+01
+ PKER_RACCS ( 36, 12) = 0.153679E+01
+ PKER_RACCS ( 36, 13) = 0.123730E+01
+ PKER_RACCS ( 36, 14) = 0.989170E+00
+ PKER_RACCS ( 36, 15) = 0.783542E+00
+ PKER_RACCS ( 36, 16) = 0.613107E+00
+ PKER_RACCS ( 36, 17) = 0.471895E+00
+ PKER_RACCS ( 36, 18) = 0.355181E+00
+ PKER_RACCS ( 36, 19) = 0.259564E+00
+ PKER_RACCS ( 36, 20) = 0.183119E+00
+ PKER_RACCS ( 36, 21) = 0.125501E+00
+ PKER_RACCS ( 36, 22) = 0.876130E-01
+ PKER_RACCS ( 36, 23) = 0.698509E-01
+ PKER_RACCS ( 36, 24) = 0.704131E-01
+ PKER_RACCS ( 36, 25) = 0.843947E-01
+ PKER_RACCS ( 36, 26) = 0.105303E+00
+ PKER_RACCS ( 36, 27) = 0.127595E+00
+ PKER_RACCS ( 36, 28) = 0.148112E+00
+ PKER_RACCS ( 36, 29) = 0.165804E+00
+ PKER_RACCS ( 36, 30) = 0.180678E+00
+ PKER_RACCS ( 36, 31) = 0.193038E+00
+ PKER_RACCS ( 36, 32) = 0.203226E+00
+ PKER_RACCS ( 36, 33) = 0.211566E+00
+ PKER_RACCS ( 36, 34) = 0.218358E+00
+ PKER_RACCS ( 36, 35) = 0.223872E+00
+ PKER_RACCS ( 36, 36) = 0.228339E+00
+ PKER_RACCS ( 36, 37) = 0.231956E+00
+ PKER_RACCS ( 36, 38) = 0.234886E+00
+ PKER_RACCS ( 36, 39) = 0.237261E+00
+ PKER_RACCS ( 36, 40) = 0.239188E+00
+ PKER_RACCS ( 37, 1) = 0.136880E+02
+ PKER_RACCS ( 37, 2) = 0.113000E+02
+ PKER_RACCS ( 37, 3) = 0.932301E+01
+ PKER_RACCS ( 37, 4) = 0.768635E+01
+ PKER_RACCS ( 37, 5) = 0.633140E+01
+ PKER_RACCS ( 37, 6) = 0.520966E+01
+ PKER_RACCS ( 37, 7) = 0.428096E+01
+ PKER_RACCS ( 37, 8) = 0.351207E+01
+ PKER_RACCS ( 37, 9) = 0.287547E+01
+ PKER_RACCS ( 37, 10) = 0.234837E+01
+ PKER_RACCS ( 37, 11) = 0.191192E+01
+ PKER_RACCS ( 37, 12) = 0.155048E+01
+ PKER_RACCS ( 37, 13) = 0.125114E+01
+ PKER_RACCS ( 37, 14) = 0.100318E+01
+ PKER_RACCS ( 37, 15) = 0.797739E+00
+ PKER_RACCS ( 37, 16) = 0.627493E+00
+ PKER_RACCS ( 37, 17) = 0.486429E+00
+ PKER_RACCS ( 37, 18) = 0.369711E+00
+ PKER_RACCS ( 37, 19) = 0.273656E+00
+ PKER_RACCS ( 37, 20) = 0.195887E+00
+ PKER_RACCS ( 37, 21) = 0.135541E+00
+ PKER_RACCS ( 37, 22) = 0.929713E-01
+ PKER_RACCS ( 37, 23) = 0.689449E-01
+ PKER_RACCS ( 37, 24) = 0.628067E-01
+ PKER_RACCS ( 37, 25) = 0.712146E-01
+ PKER_RACCS ( 37, 26) = 0.885642E-01
+ PKER_RACCS ( 37, 27) = 0.109176E+00
+ PKER_RACCS ( 37, 28) = 0.129175E+00
+ PKER_RACCS ( 37, 29) = 0.146887E+00
+ PKER_RACCS ( 37, 30) = 0.162013E+00
+ PKER_RACCS ( 37, 31) = 0.174742E+00
+ PKER_RACCS ( 37, 32) = 0.185350E+00
+ PKER_RACCS ( 37, 33) = 0.194114E+00
+ PKER_RACCS ( 37, 34) = 0.201300E+00
+ PKER_RACCS ( 37, 35) = 0.207158E+00
+ PKER_RACCS ( 37, 36) = 0.211915E+00
+ PKER_RACCS ( 37, 37) = 0.215769E+00
+ PKER_RACCS ( 37, 38) = 0.218888E+00
+ PKER_RACCS ( 37, 39) = 0.221414E+00
+ PKER_RACCS ( 37, 40) = 0.223459E+00
+ PKER_RACCS ( 38, 1) = 0.136998E+02
+ PKER_RACCS ( 38, 2) = 0.113118E+02
+ PKER_RACCS ( 38, 3) = 0.933491E+01
+ PKER_RACCS ( 38, 4) = 0.769831E+01
+ PKER_RACCS ( 38, 5) = 0.634341E+01
+ PKER_RACCS ( 38, 6) = 0.522172E+01
+ PKER_RACCS ( 38, 7) = 0.429308E+01
+ PKER_RACCS ( 38, 8) = 0.352426E+01
+ PKER_RACCS ( 38, 9) = 0.288774E+01
+ PKER_RACCS ( 38, 10) = 0.236072E+01
+ PKER_RACCS ( 38, 11) = 0.192436E+01
+ PKER_RACCS ( 38, 12) = 0.156302E+01
+ PKER_RACCS ( 38, 13) = 0.126380E+01
+ PKER_RACCS ( 38, 14) = 0.101597E+01
+ PKER_RACCS ( 38, 15) = 0.810672E+00
+ PKER_RACCS ( 38, 16) = 0.640582E+00
+ PKER_RACCS ( 38, 17) = 0.499655E+00
+ PKER_RACCS ( 38, 18) = 0.382979E+00
+ PKER_RACCS ( 38, 19) = 0.286703E+00
+ PKER_RACCS ( 38, 20) = 0.208118E+00
+ PKER_RACCS ( 38, 21) = 0.145802E+00
+ PKER_RACCS ( 38, 22) = 0.996958E-01
+ PKER_RACCS ( 38, 23) = 0.705180E-01
+ PKER_RACCS ( 38, 24) = 0.583121E-01
+ PKER_RACCS ( 38, 25) = 0.611067E-01
+ PKER_RACCS ( 38, 26) = 0.743784E-01
+ PKER_RACCS ( 38, 27) = 0.927345E-01
+ PKER_RACCS ( 38, 28) = 0.111788E+00
+ PKER_RACCS ( 38, 29) = 0.129236E+00
+ PKER_RACCS ( 38, 30) = 0.144407E+00
+ PKER_RACCS ( 38, 31) = 0.157347E+00
+ PKER_RACCS ( 38, 32) = 0.168273E+00
+ PKER_RACCS ( 38, 33) = 0.177407E+00
+ PKER_RACCS ( 38, 34) = 0.184972E+00
+ PKER_RACCS ( 38, 35) = 0.191185E+00
+ PKER_RACCS ( 38, 36) = 0.196255E+00
+ PKER_RACCS ( 38, 37) = 0.200374E+00
+ PKER_RACCS ( 38, 38) = 0.203711E+00
+ PKER_RACCS ( 38, 39) = 0.206411E+00
+ PKER_RACCS ( 38, 40) = 0.208595E+00
+ PKER_RACCS ( 39, 1) = 0.137108E+02
+ PKER_RACCS ( 39, 2) = 0.113228E+02
+ PKER_RACCS ( 39, 3) = 0.934595E+01
+ PKER_RACCS ( 39, 4) = 0.770939E+01
+ PKER_RACCS ( 39, 5) = 0.635453E+01
+ PKER_RACCS ( 39, 6) = 0.523288E+01
+ PKER_RACCS ( 39, 7) = 0.430429E+01
+ PKER_RACCS ( 39, 8) = 0.353552E+01
+ PKER_RACCS ( 39, 9) = 0.289905E+01
+ PKER_RACCS ( 39, 10) = 0.237210E+01
+ PKER_RACCS ( 39, 11) = 0.193581E+01
+ PKER_RACCS ( 39, 12) = 0.157455E+01
+ PKER_RACCS ( 39, 13) = 0.127542E+01
+ PKER_RACCS ( 39, 14) = 0.102769E+01
+ PKER_RACCS ( 39, 15) = 0.822505E+00
+ PKER_RACCS ( 39, 16) = 0.652537E+00
+ PKER_RACCS ( 39, 17) = 0.511728E+00
+ PKER_RACCS ( 39, 18) = 0.395120E+00
+ PKER_RACCS ( 39, 19) = 0.298748E+00
+ PKER_RACCS ( 39, 20) = 0.219673E+00
+ PKER_RACCS ( 39, 21) = 0.156076E+00
+ PKER_RACCS ( 39, 22) = 0.107363E+00
+ PKER_RACCS ( 39, 23) = 0.740476E-01
+ PKER_RACCS ( 39, 24) = 0.565449E-01
+ PKER_RACCS ( 39, 25) = 0.539031E-01
+ PKER_RACCS ( 39, 26) = 0.628068E-01
+ PKER_RACCS ( 39, 27) = 0.783909E-01
+ PKER_RACCS ( 39, 28) = 0.960758E-01
+ PKER_RACCS ( 39, 29) = 0.112978E+00
+ PKER_RACCS ( 39, 30) = 0.127980E+00
+ PKER_RACCS ( 39, 31) = 0.140952E+00
+ PKER_RACCS ( 39, 32) = 0.152050E+00
+ PKER_RACCS ( 39, 33) = 0.161459E+00
+ PKER_RACCS ( 39, 34) = 0.169352E+00
+ PKER_RACCS ( 39, 35) = 0.175905E+00
+ PKER_RACCS ( 39, 36) = 0.181296E+00
+ PKER_RACCS ( 39, 37) = 0.185700E+00
+ PKER_RACCS ( 39, 38) = 0.189279E+00
+ PKER_RACCS ( 39, 39) = 0.192179E+00
+ PKER_RACCS ( 39, 40) = 0.194525E+00
+ PKER_RACCS ( 40, 1) = 0.137209E+02
+ PKER_RACCS ( 40, 2) = 0.113330E+02
+ PKER_RACCS ( 40, 3) = 0.935620E+01
+ PKER_RACCS ( 40, 4) = 0.771967E+01
+ PKER_RACCS ( 40, 5) = 0.636484E+01
+ PKER_RACCS ( 40, 6) = 0.524323E+01
+ PKER_RACCS ( 40, 7) = 0.431468E+01
+ PKER_RACCS ( 40, 8) = 0.354595E+01
+ PKER_RACCS ( 40, 9) = 0.290952E+01
+ PKER_RACCS ( 40, 10) = 0.238262E+01
+ PKER_RACCS ( 40, 11) = 0.194638E+01
+ PKER_RACCS ( 40, 12) = 0.158519E+01
+ PKER_RACCS ( 40, 13) = 0.128612E+01
+ PKER_RACCS ( 40, 14) = 0.103847E+01
+ PKER_RACCS ( 40, 15) = 0.833372E+00
+ PKER_RACCS ( 40, 16) = 0.663500E+00
+ PKER_RACCS ( 40, 17) = 0.522788E+00
+ PKER_RACCS ( 40, 18) = 0.406248E+00
+ PKER_RACCS ( 40, 19) = 0.309849E+00
+ PKER_RACCS ( 40, 20) = 0.230469E+00
+ PKER_RACCS ( 40, 21) = 0.165985E+00
+ PKER_RACCS ( 40, 22) = 0.115455E+00
+ PKER_RACCS ( 40, 23) = 0.789238E-01
+ PKER_RACCS ( 40, 24) = 0.569440E-01
+ PKER_RACCS ( 40, 25) = 0.492680E-01
+ PKER_RACCS ( 40, 26) = 0.537042E-01
+ PKER_RACCS ( 40, 27) = 0.661559E-01
+ PKER_RACCS ( 40, 28) = 0.821048E-01
+ PKER_RACCS ( 40, 29) = 0.981944E-01
+ PKER_RACCS ( 40, 30) = 0.112835E+00
+ PKER_RACCS ( 40, 31) = 0.125662E+00
+ PKER_RACCS ( 40, 32) = 0.136771E+00
+ PKER_RACCS ( 40, 33) = 0.146319E+00
+ PKER_RACCS ( 40, 34) = 0.154449E+00
+ PKER_RACCS ( 40, 35) = 0.161294E+00
+ PKER_RACCS ( 40, 36) = 0.166991E+00
+ PKER_RACCS ( 40, 37) = 0.171687E+00
+ PKER_RACCS ( 40, 38) = 0.175527E+00
+ PKER_RACCS ( 40, 39) = 0.178649E+00
+ PKER_RACCS ( 40, 40) = 0.181179E+00
END IF
!
IF( PRESENT(PKER_SACCRG) ) THEN
- PKER_SACCRG( 1, 1) = 0.877111E-02
- PKER_SACCRG( 1, 2) = 0.152577E-01
- PKER_SACCRG( 1, 3) = 0.246015E-01
- PKER_SACCRG( 1, 4) = 0.471313E-01
- PKER_SACCRG( 1, 5) = 0.929727E-01
- PKER_SACCRG( 1, 6) = 0.180516E+00
- PKER_SACCRG( 1, 7) = 0.332049E+00
- PKER_SACCRG( 1, 8) = 0.568971E+00
- PKER_SACCRG( 1, 9) = 0.904665E+00
- PKER_SACCRG( 1, 10) = 0.133760E+01
- PKER_SACCRG( 1, 11) = 0.184600E+01
- PKER_SACCRG( 1, 12) = 0.239807E+01
- PKER_SACCRG( 1, 13) = 0.295656E+01
- PKER_SACCRG( 1, 14) = 0.349230E+01
- PKER_SACCRG( 1, 15) = 0.398924E+01
- PKER_SACCRG( 1, 16) = 0.444596E+01
- PKER_SACCRG( 1, 17) = 0.486282E+01
- PKER_SACCRG( 1, 18) = 0.524532E+01
- PKER_SACCRG( 1, 19) = 0.559392E+01
- PKER_SACCRG( 1, 20) = 0.588619E+01
- PKER_SACCRG( 1, 21) = 0.616462E+01
- PKER_SACCRG( 1, 22) = 0.640685E+01
- PKER_SACCRG( 1, 23) = 0.657744E+01
- PKER_SACCRG( 1, 24) = 0.675687E+01
- PKER_SACCRG( 1, 25) = 0.686893E+01
- PKER_SACCRG( 1, 26) = 0.696149E+01
- PKER_SACCRG( 1, 27) = 0.704110E+01
- PKER_SACCRG( 1, 28) = 0.707873E+01
- PKER_SACCRG( 1, 29) = 0.711833E+01
- PKER_SACCRG( 1, 30) = 0.716010E+01
- PKER_SACCRG( 1, 31) = 0.718355E+01
- PKER_SACCRG( 1, 32) = 0.719792E+01
- PKER_SACCRG( 1, 33) = 0.720930E+01
- PKER_SACCRG( 1, 34) = 0.721120E+01
- PKER_SACCRG( 1, 35) = 0.722055E+01
- PKER_SACCRG( 1, 36) = 0.724034E+01
+ PKER_SACCRG( 1, 1) = 0.438311E-02
+ PKER_SACCRG( 1, 2) = 0.641932E-02
+ PKER_SACCRG( 1, 3) = 0.104323E-01
+ PKER_SACCRG( 1, 4) = 0.135168E-01
+ PKER_SACCRG( 1, 5) = 0.186190E-01
+ PKER_SACCRG( 1, 6) = 0.326141E-01
+ PKER_SACCRG( 1, 7) = 0.629897E-01
+ PKER_SACCRG( 1, 8) = 0.120410E+00
+ PKER_SACCRG( 1, 9) = 0.232733E+00
+ PKER_SACCRG( 1, 10) = 0.430353E+00
+ PKER_SACCRG( 1, 11) = 0.742288E+00
+ PKER_SACCRG( 1, 12) = 0.118527E+01
+ PKER_SACCRG( 1, 13) = 0.175377E+01
+ PKER_SACCRG( 1, 14) = 0.241509E+01
+ PKER_SACCRG( 1, 15) = 0.311676E+01
+ PKER_SACCRG( 1, 16) = 0.380271E+01
+ PKER_SACCRG( 1, 17) = 0.442968E+01
+ PKER_SACCRG( 1, 18) = 0.497509E+01
+ PKER_SACCRG( 1, 19) = 0.543503E+01
+ PKER_SACCRG( 1, 20) = 0.579503E+01
+ PKER_SACCRG( 1, 21) = 0.611243E+01
+ PKER_SACCRG( 1, 22) = 0.637529E+01
+ PKER_SACCRG( 1, 23) = 0.655579E+01
+ PKER_SACCRG( 1, 24) = 0.674119E+01
+ PKER_SACCRG( 1, 25) = 0.685610E+01
+ PKER_SACCRG( 1, 26) = 0.695045E+01
+ PKER_SACCRG( 1, 27) = 0.703114E+01
+ PKER_SACCRG( 1, 28) = 0.706922E+01
+ PKER_SACCRG( 1, 29) = 0.710917E+01
+ PKER_SACCRG( 1, 30) = 0.715122E+01
+ PKER_SACCRG( 1, 31) = 0.717481E+01
+ PKER_SACCRG( 1, 32) = 0.718927E+01
+ PKER_SACCRG( 1, 33) = 0.720073E+01
+ PKER_SACCRG( 1, 34) = 0.720264E+01
+ PKER_SACCRG( 1, 35) = 0.721205E+01
+ PKER_SACCRG( 1, 36) = 0.723197E+01
PKER_SACCRG( 1, 37) = 0.000000E+00
PKER_SACCRG( 1, 38) = 0.000000E+00
PKER_SACCRG( 1, 39) = 0.000000E+00
PKER_SACCRG( 1, 40) = 0.000000E+00
- PKER_SACCRG( 2, 1) = 0.496649E-02
- PKER_SACCRG( 2, 2) = 0.733482E-02
- PKER_SACCRG( 2, 3) = 0.127505E-01
- PKER_SACCRG( 2, 4) = 0.205454E-01
- PKER_SACCRG( 2, 5) = 0.393213E-01
- PKER_SACCRG( 2, 6) = 0.774769E-01
- PKER_SACCRG( 2, 7) = 0.150240E+00
- PKER_SACCRG( 2, 8) = 0.275822E+00
- PKER_SACCRG( 2, 9) = 0.471687E+00
- PKER_SACCRG( 2, 10) = 0.748723E+00
- PKER_SACCRG( 2, 11) = 0.110275E+01
- PKER_SACCRG( 2, 12) = 0.151806E+01
- PKER_SACCRG( 2, 13) = 0.196576E+01
- PKER_SACCRG( 2, 14) = 0.241560E+01
- PKER_SACCRG( 2, 15) = 0.284452E+01
- PKER_SACCRG( 2, 16) = 0.324320E+01
- PKER_SACCRG( 2, 17) = 0.360876E+01
- PKER_SACCRG( 2, 18) = 0.394696E+01
- PKER_SACCRG( 2, 19) = 0.426098E+01
- PKER_SACCRG( 2, 20) = 0.453181E+01
- PKER_SACCRG( 2, 21) = 0.479556E+01
- PKER_SACCRG( 2, 22) = 0.503087E+01
- PKER_SACCRG( 2, 23) = 0.520119E+01
- PKER_SACCRG( 2, 24) = 0.538106E+01
- PKER_SACCRG( 2, 25) = 0.549554E+01
- PKER_SACCRG( 2, 26) = 0.559038E+01
- PKER_SACCRG( 2, 27) = 0.567203E+01
- PKER_SACCRG( 2, 28) = 0.571103E+01
- PKER_SACCRG( 2, 29) = 0.575177E+01
- PKER_SACCRG( 2, 30) = 0.579458E+01
- PKER_SACCRG( 2, 31) = 0.581868E+01
- PKER_SACCRG( 2, 32) = 0.583345E+01
- PKER_SACCRG( 2, 33) = 0.584513E+01
- PKER_SACCRG( 2, 34) = 0.584711E+01
- PKER_SACCRG( 2, 35) = 0.585669E+01
- PKER_SACCRG( 2, 36) = 0.587692E+01
+ PKER_SACCRG( 2, 1) = 0.277360E-02
+ PKER_SACCRG( 2, 2) = 0.359904E-02
+ PKER_SACCRG( 2, 3) = 0.526623E-02
+ PKER_SACCRG( 2, 4) = 0.855403E-02
+ PKER_SACCRG( 2, 5) = 0.110798E-01
+ PKER_SACCRG( 2, 6) = 0.152575E-01
+ PKER_SACCRG( 2, 7) = 0.267157E-01
+ PKER_SACCRG( 2, 8) = 0.515725E-01
+ PKER_SACCRG( 2, 9) = 0.985371E-01
+ PKER_SACCRG( 2, 10) = 0.190336E+00
+ PKER_SACCRG( 2, 11) = 0.351702E+00
+ PKER_SACCRG( 2, 12) = 0.606144E+00
+ PKER_SACCRG( 2, 13) = 0.967078E+00
+ PKER_SACCRG( 2, 14) = 0.142977E+01
+ PKER_SACCRG( 2, 15) = 0.196754E+01
+ PKER_SACCRG( 2, 16) = 0.253781E+01
+ PKER_SACCRG( 2, 17) = 0.309551E+01
+ PKER_SACCRG( 2, 18) = 0.360619E+01
+ PKER_SACCRG( 2, 19) = 0.405195E+01
+ PKER_SACCRG( 2, 20) = 0.441025E+01
+ PKER_SACCRG( 2, 21) = 0.472710E+01
+ PKER_SACCRG( 2, 22) = 0.499143E+01
+ PKER_SACCRG( 2, 23) = 0.517586E+01
+ PKER_SACCRG( 2, 24) = 0.536386E+01
+ PKER_SACCRG( 2, 25) = 0.548206E+01
+ PKER_SACCRG( 2, 26) = 0.557912E+01
+ PKER_SACCRG( 2, 27) = 0.566202E+01
+ PKER_SACCRG( 2, 28) = 0.570152E+01
+ PKER_SACCRG( 2, 29) = 0.574264E+01
+ PKER_SACCRG( 2, 30) = 0.578573E+01
+ PKER_SACCRG( 2, 31) = 0.580997E+01
+ PKER_SACCRG( 2, 32) = 0.582483E+01
+ PKER_SACCRG( 2, 33) = 0.583658E+01
+ PKER_SACCRG( 2, 34) = 0.583857E+01
+ PKER_SACCRG( 2, 35) = 0.584821E+01
+ PKER_SACCRG( 2, 36) = 0.586858E+01
PKER_SACCRG( 2, 37) = 0.000000E+00
PKER_SACCRG( 2, 38) = 0.000000E+00
PKER_SACCRG( 2, 39) = 0.000000E+00
PKER_SACCRG( 2, 40) = 0.000000E+00
- PKER_SACCRG( 3, 1) = 0.387560E-02
- PKER_SACCRG( 3, 2) = 0.418169E-02
- PKER_SACCRG( 3, 3) = 0.617233E-02
- PKER_SACCRG( 3, 4) = 0.107206E-01
- PKER_SACCRG( 3, 5) = 0.172587E-01
- PKER_SACCRG( 3, 6) = 0.329944E-01
- PKER_SACCRG( 3, 7) = 0.649329E-01
- PKER_SACCRG( 3, 8) = 0.125620E+00
- PKER_SACCRG( 3, 9) = 0.230164E+00
- PKER_SACCRG( 3, 10) = 0.393075E+00
- PKER_SACCRG( 3, 11) = 0.620608E+00
- PKER_SACCRG( 3, 12) = 0.911294E+00
- PKER_SACCRG( 3, 13) = 0.124905E+01
- PKER_SACCRG( 3, 14) = 0.160958E+01
- PKER_SACCRG( 3, 15) = 0.196802E+01
- PKER_SACCRG( 3, 16) = 0.230789E+01
- PKER_SACCRG( 3, 17) = 0.262178E+01
- PKER_SACCRG( 3, 18) = 0.291317E+01
- PKER_SACCRG( 3, 19) = 0.318773E+01
- PKER_SACCRG( 3, 20) = 0.343092E+01
- PKER_SACCRG( 3, 21) = 0.367377E+01
- PKER_SACCRG( 3, 22) = 0.389690E+01
- PKER_SACCRG( 3, 23) = 0.406379E+01
- PKER_SACCRG( 3, 24) = 0.424139E+01
- PKER_SACCRG( 3, 25) = 0.435714E+01
- PKER_SACCRG( 3, 26) = 0.445357E+01
- PKER_SACCRG( 3, 27) = 0.453681E+01
- PKER_SACCRG( 3, 28) = 0.457709E+01
- PKER_SACCRG( 3, 29) = 0.461883E+01
- PKER_SACCRG( 3, 30) = 0.466257E+01
- PKER_SACCRG( 3, 31) = 0.468725E+01
- PKER_SACCRG( 3, 32) = 0.470239E+01
- PKER_SACCRG( 3, 33) = 0.471435E+01
- PKER_SACCRG( 3, 34) = 0.471642E+01
- PKER_SACCRG( 3, 35) = 0.472620E+01
- PKER_SACCRG( 3, 36) = 0.474682E+01
+ PKER_SACCRG( 3, 1) = 0.213410E-02
+ PKER_SACCRG( 3, 2) = 0.228042E-02
+ PKER_SACCRG( 3, 3) = 0.295439E-02
+ PKER_SACCRG( 3, 4) = 0.431810E-02
+ PKER_SACCRG( 3, 5) = 0.700935E-02
+ PKER_SACCRG( 3, 6) = 0.907613E-02
+ PKER_SACCRG( 3, 7) = 0.124938E-01
+ PKER_SACCRG( 3, 8) = 0.218668E-01
+ PKER_SACCRG( 3, 9) = 0.421887E-01
+ PKER_SACCRG( 3, 10) = 0.805544E-01
+ PKER_SACCRG( 3, 11) = 0.155474E+00
+ PKER_SACCRG( 3, 12) = 0.287036E+00
+ PKER_SACCRG( 3, 13) = 0.494206E+00
+ PKER_SACCRG( 3, 14) = 0.787675E+00
+ PKER_SACCRG( 3, 15) = 0.116334E+01
+ PKER_SACCRG( 3, 16) = 0.159943E+01
+ PKER_SACCRG( 3, 17) = 0.206153E+01
+ PKER_SACCRG( 3, 18) = 0.251365E+01
+ PKER_SACCRG( 3, 19) = 0.292842E+01
+ PKER_SACCRG( 3, 20) = 0.327509E+01
+ PKER_SACCRG( 3, 21) = 0.358546E+01
+ PKER_SACCRG( 3, 22) = 0.384740E+01
+ PKER_SACCRG( 3, 23) = 0.403374E+01
+ PKER_SACCRG( 3, 24) = 0.422232E+01
+ PKER_SACCRG( 3, 25) = 0.434292E+01
+ PKER_SACCRG( 3, 26) = 0.444208E+01
+ PKER_SACCRG( 3, 27) = 0.452673E+01
+ PKER_SACCRG( 3, 28) = 0.456755E+01
+ PKER_SACCRG( 3, 29) = 0.460968E+01
+ PKER_SACCRG( 3, 30) = 0.465368E+01
+ PKER_SACCRG( 3, 31) = 0.467850E+01
+ PKER_SACCRG( 3, 32) = 0.469374E+01
+ PKER_SACCRG( 3, 33) = 0.470577E+01
+ PKER_SACCRG( 3, 34) = 0.470785E+01
+ PKER_SACCRG( 3, 35) = 0.471769E+01
+ PKER_SACCRG( 3, 36) = 0.473846E+01
PKER_SACCRG( 3, 37) = 0.000000E+00
PKER_SACCRG( 3, 38) = 0.000000E+00
PKER_SACCRG( 3, 39) = 0.000000E+00
PKER_SACCRG( 3, 40) = 0.000000E+00
- PKER_SACCRG( 4, 1) = 0.233082E-02
- PKER_SACCRG( 4, 2) = 0.329775E-02
- PKER_SACCRG( 4, 3) = 0.355350E-02
- PKER_SACCRG( 4, 4) = 0.523982E-02
- PKER_SACCRG( 4, 5) = 0.909351E-02
- PKER_SACCRG( 4, 6) = 0.146213E-01
- PKER_SACCRG( 4, 7) = 0.279254E-01
- PKER_SACCRG( 4, 8) = 0.547795E-01
- PKER_SACCRG( 4, 9) = 0.105808E+00
- PKER_SACCRG( 4, 10) = 0.193747E+00
- PKER_SACCRG( 4, 11) = 0.328335E+00
- PKER_SACCRG( 4, 12) = 0.516566E+00
- PKER_SACCRG( 4, 13) = 0.754317E+00
- PKER_SACCRG( 4, 14) = 0.102681E+01
- PKER_SACCRG( 4, 15) = 0.131295E+01
- PKER_SACCRG( 4, 16) = 0.159350E+01
- PKER_SACCRG( 4, 17) = 0.185598E+01
- PKER_SACCRG( 4, 18) = 0.210025E+01
- PKER_SACCRG( 4, 19) = 0.233308E+01
- PKER_SACCRG( 4, 20) = 0.254446E+01
- PKER_SACCRG( 4, 21) = 0.276134E+01
- PKER_SACCRG( 4, 22) = 0.296725E+01
- PKER_SACCRG( 4, 23) = 0.312714E+01
- PKER_SACCRG( 4, 24) = 0.329925E+01
- PKER_SACCRG( 4, 25) = 0.341468E+01
- PKER_SACCRG( 4, 26) = 0.351167E+01
- PKER_SACCRG( 4, 27) = 0.359583E+01
- PKER_SACCRG( 4, 28) = 0.363721E+01
- PKER_SACCRG( 4, 29) = 0.367975E+01
- PKER_SACCRG( 4, 30) = 0.372418E+01
- PKER_SACCRG( 4, 31) = 0.374936E+01
- PKER_SACCRG( 4, 32) = 0.376483E+01
- PKER_SACCRG( 4, 33) = 0.377703E+01
- PKER_SACCRG( 4, 34) = 0.377918E+01
- PKER_SACCRG( 4, 35) = 0.378913E+01
- PKER_SACCRG( 4, 36) = 0.381008E+01
+ PKER_SACCRG( 4, 1) = 0.295930E-03
+ PKER_SACCRG( 4, 2) = 0.175883E-02
+ PKER_SACCRG( 4, 3) = 0.187537E-02
+ PKER_SACCRG( 4, 4) = 0.242497E-02
+ PKER_SACCRG( 4, 5) = 0.353954E-02
+ PKER_SACCRG( 4, 6) = 0.574121E-02
+ PKER_SACCRG( 4, 7) = 0.743054E-02
+ PKER_SACCRG( 4, 8) = 0.102239E-01
+ PKER_SACCRG( 4, 9) = 0.178843E-01
+ PKER_SACCRG( 4, 10) = 0.344817E-01
+ PKER_SACCRG( 4, 11) = 0.657827E-01
+ PKER_SACCRG( 4, 12) = 0.126844E+00
+ PKER_SACCRG( 4, 13) = 0.233919E+00
+ PKER_SACCRG( 4, 14) = 0.402255E+00
+ PKER_SACCRG( 4, 15) = 0.640286E+00
+ PKER_SACCRG( 4, 16) = 0.944426E+00
+ PKER_SACCRG( 4, 17) = 0.129689E+01
+ PKER_SACCRG( 4, 18) = 0.167004E+01
+ PKER_SACCRG( 4, 19) = 0.203514E+01
+ PKER_SACCRG( 4, 20) = 0.235706E+01
+ PKER_SACCRG( 4, 21) = 0.265244E+01
+ PKER_SACCRG( 4, 22) = 0.290663E+01
+ PKER_SACCRG( 4, 23) = 0.309194E+01
+ PKER_SACCRG( 4, 24) = 0.327835E+01
+ PKER_SACCRG( 4, 25) = 0.339993E+01
+ PKER_SACCRG( 4, 26) = 0.350021E+01
+ PKER_SACCRG( 4, 27) = 0.358586E+01
+ PKER_SACCRG( 4, 28) = 0.362775E+01
+ PKER_SACCRG( 4, 29) = 0.367067E+01
+ PKER_SACCRG( 4, 30) = 0.371533E+01
+ PKER_SACCRG( 4, 31) = 0.374064E+01
+ PKER_SACCRG( 4, 32) = 0.375621E+01
+ PKER_SACCRG( 4, 33) = 0.376848E+01
+ PKER_SACCRG( 4, 34) = 0.377064E+01
+ PKER_SACCRG( 4, 35) = 0.378066E+01
+ PKER_SACCRG( 4, 36) = 0.380174E+01
PKER_SACCRG( 4, 37) = 0.000000E+00
PKER_SACCRG( 4, 38) = 0.000000E+00
PKER_SACCRG( 4, 39) = 0.000000E+00
PKER_SACCRG( 4, 40) = 0.000000E+00
- PKER_SACCRG( 5, 1) = 0.166101E-02
- PKER_SACCRG( 5, 2) = 0.201508E-02
- PKER_SACCRG( 5, 3) = 0.284375E-02
- PKER_SACCRG( 5, 4) = 0.305925E-02
- PKER_SACCRG( 5, 5) = 0.450515E-02
- PKER_SACCRG( 5, 6) = 0.685012E-02
- PKER_SACCRG( 5, 7) = 0.125482E-01
- PKER_SACCRG( 5, 8) = 0.238658E-01
- PKER_SACCRG( 5, 9) = 0.467698E-01
- PKER_SACCRG( 5, 10) = 0.903807E-01
- PKER_SACCRG( 5, 11) = 0.163737E+00
- PKER_SACCRG( 5, 12) = 0.277152E+00
- PKER_SACCRG( 5, 13) = 0.433844E+00
- PKER_SACCRG( 5, 14) = 0.628539E+00
- PKER_SACCRG( 5, 15) = 0.846823E+00
- PKER_SACCRG( 5, 16) = 0.107394E+01
- PKER_SACCRG( 5, 17) = 0.128990E+01
- PKER_SACCRG( 5, 18) = 0.149136E+01
- PKER_SACCRG( 5, 19) = 0.167940E+01
- PKER_SACCRG( 5, 20) = 0.185196E+01
- PKER_SACCRG( 5, 21) = 0.203310E+01
- PKER_SACCRG( 5, 22) = 0.221353E+01
- PKER_SACCRG( 5, 23) = 0.236106E+01
- PKER_SACCRG( 5, 24) = 0.252355E+01
- PKER_SACCRG( 5, 25) = 0.263652E+01
- PKER_SACCRG( 5, 26) = 0.273266E+01
- PKER_SACCRG( 5, 27) = 0.281674E+01
- PKER_SACCRG( 5, 28) = 0.285890E+01
- PKER_SACCRG( 5, 29) = 0.290190E+01
- PKER_SACCRG( 5, 30) = 0.294670E+01
- PKER_SACCRG( 5, 31) = 0.297223E+01
- PKER_SACCRG( 5, 32) = 0.298795E+01
- PKER_SACCRG( 5, 33) = 0.300033E+01
- PKER_SACCRG( 5, 34) = 0.300256E+01
- PKER_SACCRG( 5, 35) = 0.301263E+01
- PKER_SACCRG( 5, 36) = 0.303379E+01
+ PKER_SACCRG( 5, 1) = 0.258805E-03
+ PKER_SACCRG( 5, 2) = 0.244750E-03
+ PKER_SACCRG( 5, 3) = 0.145106E-02
+ PKER_SACCRG( 5, 4) = 0.154319E-02
+ PKER_SACCRG( 5, 5) = 0.199078E-02
+ PKER_SACCRG( 5, 6) = 0.290099E-02
+ PKER_SACCRG( 5, 7) = 0.470103E-02
+ PKER_SACCRG( 5, 8) = 0.608063E-02
+ PKER_SACCRG( 5, 9) = 0.836193E-02
+ PKER_SACCRG( 5, 10) = 0.146173E-01
+ PKER_SACCRG( 5, 11) = 0.281586E-01
+ PKER_SACCRG( 5, 12) = 0.536650E-01
+ PKER_SACCRG( 5, 13) = 0.103352E+00
+ PKER_SACCRG( 5, 14) = 0.190326E+00
+ PKER_SACCRG( 5, 15) = 0.326791E+00
+ PKER_SACCRG( 5, 16) = 0.519290E+00
+ PKER_SACCRG( 5, 17) = 0.764650E+00
+ PKER_SACCRG( 5, 18) = 0.104842E+01
+ PKER_SACCRG( 5, 19) = 0.134831E+01
+ PKER_SACCRG( 5, 20) = 0.163103E+01
+ PKER_SACCRG( 5, 21) = 0.190095E+01
+ PKER_SACCRG( 5, 22) = 0.214036E+01
+ PKER_SACCRG( 5, 23) = 0.232046E+01
+ PKER_SACCRG( 5, 24) = 0.250112E+01
+ PKER_SACCRG( 5, 25) = 0.262167E+01
+ PKER_SACCRG( 5, 26) = 0.272160E+01
+ PKER_SACCRG( 5, 27) = 0.280712E+01
+ PKER_SACCRG( 5, 28) = 0.284966E+01
+ PKER_SACCRG( 5, 29) = 0.289298E+01
+ PKER_SACCRG( 5, 30) = 0.293794E+01
+ PKER_SACCRG( 5, 31) = 0.296358E+01
+ PKER_SACCRG( 5, 32) = 0.297938E+01
+ PKER_SACCRG( 5, 33) = 0.299183E+01
+ PKER_SACCRG( 5, 34) = 0.299407E+01
+ PKER_SACCRG( 5, 35) = 0.300421E+01
+ PKER_SACCRG( 5, 36) = 0.302549E+01
PKER_SACCRG( 5, 37) = 0.000000E+00
PKER_SACCRG( 5, 38) = 0.000000E+00
PKER_SACCRG( 5, 39) = 0.000000E+00
PKER_SACCRG( 5, 40) = 0.000000E+00
- PKER_SACCRG( 6, 1) = 0.152888E-02
- PKER_SACCRG( 6, 2) = 0.147010E-02
- PKER_SACCRG( 6, 3) = 0.177671E-02
- PKER_SACCRG( 6, 4) = 0.249917E-02
- PKER_SACCRG( 6, 5) = 0.268336E-02
- PKER_SACCRG( 6, 6) = 0.394392E-02
- PKER_SACCRG( 6, 7) = 0.599571E-02
- PKER_SACCRG( 6, 8) = 0.109227E-01
- PKER_SACCRG( 6, 9) = 0.207634E-01
- PKER_SACCRG( 6, 10) = 0.410478E-01
- PKER_SACCRG( 6, 11) = 0.776430E-01
- PKER_SACCRG( 6, 12) = 0.141169E+00
- PKER_SACCRG( 6, 13) = 0.237707E+00
- PKER_SACCRG( 6, 14) = 0.368362E+00
- PKER_SACCRG( 6, 15) = 0.526347E+00
- PKER_SACCRG( 6, 16) = 0.703856E+00
- PKER_SACCRG( 6, 17) = 0.878746E+00
- PKER_SACCRG( 6, 18) = 0.104485E+01
- PKER_SACCRG( 6, 19) = 0.119552E+01
- PKER_SACCRG( 6, 20) = 0.133217E+01
- PKER_SACCRG( 6, 21) = 0.147449E+01
- PKER_SACCRG( 6, 22) = 0.162096E+01
- PKER_SACCRG( 6, 23) = 0.174701E+01
- PKER_SACCRG( 6, 24) = 0.189187E+01
- PKER_SACCRG( 6, 25) = 0.199787E+01
- PKER_SACCRG( 6, 26) = 0.209063E+01
- PKER_SACCRG( 6, 27) = 0.217314E+01
- PKER_SACCRG( 6, 28) = 0.221555E+01
- PKER_SACCRG( 6, 29) = 0.225853E+01
- PKER_SACCRG( 6, 30) = 0.230325E+01
- PKER_SACCRG( 6, 31) = 0.232891E+01
- PKER_SACCRG( 6, 32) = 0.234475E+01
- PKER_SACCRG( 6, 33) = 0.235721E+01
- PKER_SACCRG( 6, 34) = 0.235952E+01
- PKER_SACCRG( 6, 35) = 0.236963E+01
- PKER_SACCRG( 6, 36) = 0.239082E+01
+ PKER_SACCRG( 6, 1) = 0.113399E-04
+ PKER_SACCRG( 6, 2) = 0.215064E-03
+ PKER_SACCRG( 6, 3) = 0.202732E-03
+ PKER_SACCRG( 6, 4) = 0.119915E-02
+ PKER_SACCRG( 6, 5) = 0.127127E-02
+ PKER_SACCRG( 6, 6) = 0.163527E-02
+ PKER_SACCRG( 6, 7) = 0.237805E-02
+ PKER_SACCRG( 6, 8) = 0.384847E-02
+ PKER_SACCRG( 6, 9) = 0.497431E-02
+ PKER_SACCRG( 6, 10) = 0.683637E-02
+ PKER_SACCRG( 6, 11) = 0.119405E-01
+ PKER_SACCRG( 6, 12) = 0.229776E-01
+ PKER_SACCRG( 6, 13) = 0.437340E-01
+ PKER_SACCRG( 6, 14) = 0.840961E-01
+ PKER_SACCRG( 6, 15) = 0.154590E+00
+ PKER_SACCRG( 6, 16) = 0.264896E+00
+ PKER_SACCRG( 6, 17) = 0.420012E+00
+ PKER_SACCRG( 6, 18) = 0.617142E+00
+ PKER_SACCRG( 6, 19) = 0.844302E+00
+ PKER_SACCRG( 6, 20) = 0.107600E+01
+ PKER_SACCRG( 6, 21) = 0.130965E+01
+ PKER_SACCRG( 6, 22) = 0.152596E+01
+ PKER_SACCRG( 6, 23) = 0.169541E+01
+ PKER_SACCRG( 6, 24) = 0.186600E+01
+ PKER_SACCRG( 6, 25) = 0.198276E+01
+ PKER_SACCRG( 6, 26) = 0.208029E+01
+ PKER_SACCRG( 6, 27) = 0.216408E+01
+ PKER_SACCRG( 6, 28) = 0.220656E+01
+ PKER_SACCRG( 6, 29) = 0.224971E+01
+ PKER_SACCRG( 6, 30) = 0.229446E+01
+ PKER_SACCRG( 6, 31) = 0.232020E+01
+ PKER_SACCRG( 6, 32) = 0.233613E+01
+ PKER_SACCRG( 6, 33) = 0.234866E+01
+ PKER_SACCRG( 6, 34) = 0.235098E+01
+ PKER_SACCRG( 6, 35) = 0.236115E+01
+ PKER_SACCRG( 6, 36) = 0.238249E+01
PKER_SACCRG( 6, 37) = 0.000000E+00
PKER_SACCRG( 6, 38) = 0.000000E+00
PKER_SACCRG( 6, 39) = 0.000000E+00
PKER_SACCRG( 6, 40) = 0.000000E+00
- PKER_SACCRG( 7, 1) = 0.264791E-03
- PKER_SACCRG( 7, 2) = 0.139727E-02
- PKER_SACCRG( 7, 3) = 0.133878E-02
- PKER_SACCRG( 7, 4) = 0.161185E-02
- PKER_SACCRG( 7, 5) = 0.226010E-02
- PKER_SACCRG( 7, 6) = 0.241784E-02
- PKER_SACCRG( 7, 7) = 0.354835E-02
- PKER_SACCRG( 7, 8) = 0.535643E-02
- PKER_SACCRG( 7, 9) = 0.975212E-02
- PKER_SACCRG( 7, 10) = 0.191136E-01
- PKER_SACCRG( 7, 11) = 0.359963E-01
- PKER_SACCRG( 7, 12) = 0.691180E-01
- PKER_SACCRG( 7, 13) = 0.125106E+00
- PKER_SACCRG( 7, 14) = 0.207529E+00
- PKER_SACCRG( 7, 15) = 0.314996E+00
- PKER_SACCRG( 7, 16) = 0.447746E+00
- PKER_SACCRG( 7, 17) = 0.584330E+00
- PKER_SACCRG( 7, 18) = 0.719009E+00
- PKER_SACCRG( 7, 19) = 0.838848E+00
- PKER_SACCRG( 7, 20) = 0.946546E+00
- PKER_SACCRG( 7, 21) = 0.105574E+01
- PKER_SACCRG( 7, 22) = 0.117005E+01
- PKER_SACCRG( 7, 23) = 0.127202E+01
- PKER_SACCRG( 7, 24) = 0.139279E+01
- PKER_SACCRG( 7, 25) = 0.148504E+01
- PKER_SACCRG( 7, 26) = 0.156853E+01
- PKER_SACCRG( 7, 27) = 0.164525E+01
- PKER_SACCRG( 7, 28) = 0.168599E+01
- PKER_SACCRG( 7, 29) = 0.172777E+01
- PKER_SACCRG( 7, 30) = 0.177164E+01
- PKER_SACCRG( 7, 31) = 0.179711E+01
- PKER_SACCRG( 7, 32) = 0.181292E+01
- PKER_SACCRG( 7, 33) = 0.182533E+01
- PKER_SACCRG( 7, 34) = 0.182770E+01
- PKER_SACCRG( 7, 35) = 0.183775E+01
- PKER_SACCRG( 7, 36) = 0.185878E+01
+ PKER_SACCRG( 7, 1) = 0.140987E-06
+ PKER_SACCRG( 7, 2) = 0.947184E-05
+ PKER_SACCRG( 7, 3) = 0.179369E-03
+ PKER_SACCRG( 7, 4) = 0.168563E-03
+ PKER_SACCRG( 7, 5) = 0.993006E-03
+ PKER_SACCRG( 7, 6) = 0.104915E-02
+ PKER_SACCRG( 7, 7) = 0.134474E-02
+ PKER_SACCRG( 7, 8) = 0.195051E-02
+ PKER_SACCRG( 7, 9) = 0.315182E-02
+ PKER_SACCRG( 7, 10) = 0.406997E-02
+ PKER_SACCRG( 7, 11) = 0.558802E-02
+ PKER_SACCRG( 7, 12) = 0.975020E-02
+ PKER_SACCRG( 7, 13) = 0.187363E-01
+ PKER_SACCRG( 7, 14) = 0.356024E-01
+ PKER_SACCRG( 7, 15) = 0.683270E-01
+ PKER_SACCRG( 7, 16) = 0.125305E+00
+ PKER_SACCRG( 7, 17) = 0.214147E+00
+ PKER_SACCRG( 7, 18) = 0.338617E+00
+ PKER_SACCRG( 7, 19) = 0.495951E+00
+ PKER_SACCRG( 7, 20) = 0.671057E+00
+ PKER_SACCRG( 7, 21) = 0.860119E+00
+ PKER_SACCRG( 7, 22) = 0.104532E+01
+ PKER_SACCRG( 7, 23) = 0.119790E+01
+ PKER_SACCRG( 7, 24) = 0.135335E+01
+ PKER_SACCRG( 7, 25) = 0.146305E+01
+ PKER_SACCRG( 7, 26) = 0.155556E+01
+ PKER_SACCRG( 7, 27) = 0.163553E+01
+ PKER_SACCRG( 7, 28) = 0.167695E+01
+ PKER_SACCRG( 7, 29) = 0.171904E+01
+ PKER_SACCRG( 7, 30) = 0.176289E+01
+ PKER_SACCRG( 7, 31) = 0.178841E+01
+ PKER_SACCRG( 7, 32) = 0.180429E+01
+ PKER_SACCRG( 7, 33) = 0.181678E+01
+ PKER_SACCRG( 7, 34) = 0.181916E+01
+ PKER_SACCRG( 7, 35) = 0.182927E+01
+ PKER_SACCRG( 7, 36) = 0.185045E+01
PKER_SACCRG( 7, 37) = 0.000000E+00
PKER_SACCRG( 7, 38) = 0.000000E+00
PKER_SACCRG( 7, 39) = 0.000000E+00
PKER_SACCRG( 7, 40) = 0.000000E+00
- PKER_SACCRG( 8, 1) = 0.317815E-03
- PKER_SACCRG( 8, 2) = 0.252599E-03
- PKER_SACCRG( 8, 3) = 0.133161E-02
- PKER_SACCRG( 8, 4) = 0.127305E-02
- PKER_SACCRG( 8, 5) = 0.152834E-02
- PKER_SACCRG( 8, 6) = 0.128386E-02
- PKER_SACCRG( 8, 7) = 0.226109E-02
- PKER_SACCRG( 8, 8) = 0.334741E-02
- PKER_SACCRG( 8, 9) = 0.496919E-02
- PKER_SACCRG( 8, 10) = 0.978495E-02
- PKER_SACCRG( 8, 11) = 0.172860E-01
- PKER_SACCRG( 8, 12) = 0.345824E-01
- PKER_SACCRG( 8, 13) = 0.663911E-01
- PKER_SACCRG( 8, 14) = 0.117314E+00
- PKER_SACCRG( 8, 15) = 0.188133E+00
- PKER_SACCRG( 8, 16) = 0.287577E+00
- PKER_SACCRG( 8, 17) = 0.393140E+00
- PKER_SACCRG( 8, 18) = 0.502193E+00
- PKER_SACCRG( 8, 19) = 0.593145E+00
- PKER_SACCRG( 8, 20) = 0.672659E+00
- PKER_SACCRG( 8, 21) = 0.748552E+00
- PKER_SACCRG( 8, 22) = 0.831164E+00
- PKER_SACCRG( 8, 23) = 0.909684E+00
- PKER_SACCRG( 8, 24) = 0.100645E+01
- PKER_SACCRG( 8, 25) = 0.108404E+01
- PKER_SACCRG( 8, 26) = 0.115598E+01
- PKER_SACCRG( 8, 27) = 0.122335E+01
- PKER_SACCRG( 8, 28) = 0.125991E+01
- PKER_SACCRG( 8, 29) = 0.129749E+01
- PKER_SACCRG( 8, 30) = 0.133742E+01
- PKER_SACCRG( 8, 31) = 0.136092E+01
- PKER_SACCRG( 8, 32) = 0.137562E+01
- PKER_SACCRG( 8, 33) = 0.138727E+01
- PKER_SACCRG( 8, 34) = 0.138941E+01
- PKER_SACCRG( 8, 35) = 0.139896E+01
- PKER_SACCRG( 8, 36) = 0.141941E+01
+ PKER_SACCRG( 8, 1) = 0.000000E+00
+ PKER_SACCRG( 8, 2) = 0.120931E-06
+ PKER_SACCRG( 8, 3) = 0.796677E-05
+ PKER_SACCRG( 8, 4) = 0.150232E-03
+ PKER_SACCRG( 8, 5) = 0.140781E-03
+ PKER_SACCRG( 8, 6) = 0.825725E-03
+ PKER_SACCRG( 8, 7) = 0.867958E-03
+ PKER_SACCRG( 8, 8) = 0.110764E-02
+ PKER_SACCRG( 8, 9) = 0.160165E-02
+ PKER_SACCRG( 8, 10) = 0.258288E-02
+ PKER_SACCRG( 8, 11) = 0.333132E-02
+ PKER_SACCRG( 8, 12) = 0.456846E-02
+ PKER_SACCRG( 8, 13) = 0.795989E-02
+ PKER_SACCRG( 8, 14) = 0.152680E-01
+ PKER_SACCRG( 8, 15) = 0.289527E-01
+ PKER_SACCRG( 8, 16) = 0.554343E-01
+ PKER_SACCRG( 8, 17) = 0.101328E+00
+ PKER_SACCRG( 8, 18) = 0.172576E+00
+ PKER_SACCRG( 8, 19) = 0.271870E+00
+ PKER_SACCRG( 8, 20) = 0.392855E+00
+ PKER_SACCRG( 8, 21) = 0.534703E+00
+ PKER_SACCRG( 8, 22) = 0.683665E+00
+ PKER_SACCRG( 8, 23) = 0.814385E+00
+ PKER_SACCRG( 8, 24) = 0.950462E+00
+ PKER_SACCRG( 8, 25) = 0.105116E+01
+ PKER_SACCRG( 8, 26) = 0.113664E+01
+ PKER_SACCRG( 8, 27) = 0.121103E+01
+ PKER_SACCRG( 8, 28) = 0.125059E+01
+ PKER_SACCRG( 8, 29) = 0.128945E+01
+ PKER_SACCRG( 8, 30) = 0.132965E+01
+ PKER_SACCRG( 8, 31) = 0.135316E+01
+ PKER_SACCRG( 8, 32) = 0.136781E+01
+ PKER_SACCRG( 8, 33) = 0.137937E+01
+ PKER_SACCRG( 8, 34) = 0.138153E+01
+ PKER_SACCRG( 8, 35) = 0.139094E+01
+ PKER_SACCRG( 8, 36) = 0.141107E+01
PKER_SACCRG( 8, 37) = 0.000000E+00
PKER_SACCRG( 8, 38) = 0.000000E+00
PKER_SACCRG( 8, 39) = 0.000000E+00
PKER_SACCRG( 8, 40) = 0.000000E+00
- PKER_SACCRG( 9, 1) = 0.202490E-04
- PKER_SACCRG( 9, 2) = 0.320456E-03
- PKER_SACCRG( 9, 3) = 0.255340E-03
- PKER_SACCRG( 9, 4) = 0.345631E-03
- PKER_SACCRG( 9, 5) = 0.129395E-02
- PKER_SACCRG( 9, 6) = 0.155380E-02
- PKER_SACCRG( 9, 7) = 0.129132E-02
- PKER_SACCRG( 9, 8) = 0.241391E-02
- PKER_SACCRG( 9, 9) = 0.325213E-02
- PKER_SACCRG( 9, 10) = 0.608274E-02
- PKER_SACCRG( 9, 11) = 0.933465E-02
- PKER_SACCRG( 9, 12) = 0.192557E-01
- PKER_SACCRG( 9, 13) = 0.379422E-01
- PKER_SACCRG( 9, 14) = 0.697676E-01
- PKER_SACCRG( 9, 15) = 0.116091E+00
- PKER_SACCRG( 9, 16) = 0.192455E+00
- PKER_SACCRG( 9, 17) = 0.275386E+00
- PKER_SACCRG( 9, 18) = 0.366801E+00
- PKER_SACCRG( 9, 19) = 0.437805E+00
- PKER_SACCRG( 9, 20) = 0.496439E+00
- PKER_SACCRG( 9, 21) = 0.543577E+00
- PKER_SACCRG( 9, 22) = 0.594385E+00
- PKER_SACCRG( 9, 23) = 0.645381E+00
- PKER_SACCRG( 9, 24) = 0.714434E+00
- PKER_SACCRG( 9, 25) = 0.774496E+00
- PKER_SACCRG( 9, 26) = 0.833620E+00
- PKER_SACCRG( 9, 27) = 0.891273E+00
- PKER_SACCRG( 9, 28) = 0.923925E+00
- PKER_SACCRG( 9, 29) = 0.957551E+00
- PKER_SACCRG( 9, 30) = 0.993408E+00
- PKER_SACCRG( 9, 31) = 0.101480E+01
- PKER_SACCRG( 9, 32) = 0.102829E+01
- PKER_SACCRG( 9, 33) = 0.103894E+01
- PKER_SACCRG( 9, 34) = 0.104106E+01
- PKER_SACCRG( 9, 35) = 0.104971E+01
- PKER_SACCRG( 9, 36) = 0.106791E+01
+ PKER_SACCRG( 9, 1) = 0.000000E+00
+ PKER_SACCRG( 9, 2) = 0.000000E+00
+ PKER_SACCRG( 9, 3) = 0.104997E-06
+ PKER_SACCRG( 9, 4) = 0.675258E-05
+ PKER_SACCRG( 9, 5) = 0.126824E-03
+ PKER_SACCRG( 9, 6) = 0.118316E-03
+ PKER_SACCRG( 9, 7) = 0.690238E-03
+ PKER_SACCRG( 9, 8) = 0.721206E-03
+ PKER_SACCRG( 9, 9) = 0.915100E-03
+ PKER_SACCRG( 9, 10) = 0.131754E-02
+ PKER_SACCRG( 9, 11) = 0.143784E-02
+ PKER_SACCRG( 9, 12) = 0.272855E-02
+ PKER_SACCRG( 9, 13) = 0.373587E-02
+ PKER_SACCRG( 9, 14) = 0.649562E-02
+ PKER_SACCRG( 9, 15) = 0.120098E-01
+ PKER_SACCRG( 9, 16) = 0.235379E-01
+ PKER_SACCRG( 9, 17) = 0.448605E-01
+ PKER_SACCRG( 9, 18) = 0.816757E-01
+ PKER_SACCRG( 9, 19) = 0.138586E+00
+ PKER_SACCRG( 9, 20) = 0.214609E+00
+ PKER_SACCRG( 9, 21) = 0.312274E+00
+ PKER_SACCRG( 9, 22) = 0.423436E+00
+ PKER_SACCRG( 9, 23) = 0.528300E+00
+ PKER_SACCRG( 9, 24) = 0.641806E+00
+ PKER_SACCRG( 9, 25) = 0.730809E+00
+ PKER_SACCRG( 9, 26) = 0.808021E+00
+ PKER_SACCRG( 9, 27) = 0.875899E+00
+ PKER_SACCRG( 9, 28) = 0.913416E+00
+ PKER_SACCRG( 9, 29) = 0.949497E+00
+ PKER_SACCRG( 9, 30) = 0.986085E+00
+ PKER_SACCRG( 9, 31) = 0.100768E+01
+ PKER_SACCRG( 9, 32) = 0.102123E+01
+ PKER_SACCRG( 9, 33) = 0.103190E+01
+ PKER_SACCRG( 9, 34) = 0.103403E+01
+ PKER_SACCRG( 9, 35) = 0.104270E+01
+ PKER_SACCRG( 9, 36) = 0.106096E+01
PKER_SACCRG( 9, 37) = 0.000000E+00
PKER_SACCRG( 9, 38) = 0.000000E+00
PKER_SACCRG( 9, 39) = 0.000000E+00
PKER_SACCRG( 9, 40) = 0.000000E+00
- PKER_SACCRG( 10, 1) = 0.598569E-06
- PKER_SACCRG( 10, 2) = 0.219301E-04
- PKER_SACCRG( 10, 3) = 0.349965E-03
- PKER_SACCRG( 10, 4) = 0.281582E-03
- PKER_SACCRG( 10, 5) = 0.386467E-03
- PKER_SACCRG( 10, 6) = 0.147208E-02
- PKER_SACCRG( 10, 7) = 0.182967E-02
- PKER_SACCRG( 10, 8) = 0.187448E-02
- PKER_SACCRG( 10, 9) = 0.248519E-02
- PKER_SACCRG( 10, 10) = 0.563498E-02
- PKER_SACCRG( 10, 11) = 0.631394E-02
- PKER_SACCRG( 10, 12) = 0.139486E-01
- PKER_SACCRG( 10, 13) = 0.267739E-01
- PKER_SACCRG( 10, 14) = 0.486729E-01
- PKER_SACCRG( 10, 15) = 0.806977E-01
- PKER_SACCRG( 10, 16) = 0.144576E+00
- PKER_SACCRG( 10, 17) = 0.213972E+00
- PKER_SACCRG( 10, 18) = 0.295412E+00
- PKER_SACCRG( 10, 19) = 0.352322E+00
- PKER_SACCRG( 10, 20) = 0.395343E+00
- PKER_SACCRG( 10, 21) = 0.418974E+00
- PKER_SACCRG( 10, 22) = 0.443095E+00
- PKER_SACCRG( 10, 23) = 0.469475E+00
- PKER_SACCRG( 10, 24) = 0.510948E+00
- PKER_SACCRG( 10, 25) = 0.549871E+00
- PKER_SACCRG( 10, 26) = 0.591101E+00
- PKER_SACCRG( 10, 27) = 0.634398E+00
- PKER_SACCRG( 10, 28) = 0.660120E+00
- PKER_SACCRG( 10, 29) = 0.687990E+00
- PKER_SACCRG( 10, 30) = 0.718802E+00
- PKER_SACCRG( 10, 31) = 0.737650E+00
- PKER_SACCRG( 10, 32) = 0.749681E+00
- PKER_SACCRG( 10, 33) = 0.759223E+00
- PKER_SACCRG( 10, 34) = 0.761178E+00
- PKER_SACCRG( 10, 35) = 0.768937E+00
- PKER_SACCRG( 10, 36) = 0.785293E+00
+ PKER_SACCRG( 10, 1) = 0.000000E+00
+ PKER_SACCRG( 10, 2) = 0.000000E+00
+ PKER_SACCRG( 10, 3) = 0.000000E+00
+ PKER_SACCRG( 10, 4) = 0.925928E-07
+ PKER_SACCRG( 10, 5) = 0.578353E-05
+ PKER_SACCRG( 10, 6) = 0.108100E-03
+ PKER_SACCRG( 10, 7) = 0.100301E-03
+ PKER_SACCRG( 10, 8) = 0.581236E-03
+ PKER_SACCRG( 10, 9) = 0.602709E-03
+ PKER_SACCRG( 10, 10) = 0.759037E-03
+ PKER_SACCRG( 10, 11) = 0.108651E-02
+ PKER_SACCRG( 10, 12) = 0.118139E-02
+ PKER_SACCRG( 10, 13) = 0.223637E-02
+ PKER_SACCRG( 10, 14) = 0.305413E-02
+ PKER_SACCRG( 10, 15) = 0.529953E-02
+ PKER_SACCRG( 10, 16) = 0.980986E-02
+ PKER_SACCRG( 10, 17) = 0.190727E-01
+ PKER_SACCRG( 10, 18) = 0.361040E-01
+ PKER_SACCRG( 10, 19) = 0.657489E-01
+ PKER_SACCRG( 10, 20) = 0.108973E+00
+ PKER_SACCRG( 10, 21) = 0.170419E+00
+ PKER_SACCRG( 10, 22) = 0.246769E+00
+ PKER_SACCRG( 10, 23) = 0.324574E+00
+ PKER_SACCRG( 10, 24) = 0.413749E+00
+ PKER_SACCRG( 10, 25) = 0.487749E+00
+ PKER_SACCRG( 10, 26) = 0.555040E+00
+ PKER_SACCRG( 10, 27) = 0.614174E+00
+ PKER_SACCRG( 10, 28) = 0.647730E+00
+ PKER_SACCRG( 10, 29) = 0.679592E+00
+ PKER_SACCRG( 10, 30) = 0.711627E+00
+ PKER_SACCRG( 10, 31) = 0.730757E+00
+ PKER_SACCRG( 10, 32) = 0.742853E+00
+ PKER_SACCRG( 10, 33) = 0.752426E+00
+ PKER_SACCRG( 10, 34) = 0.754388E+00
+ PKER_SACCRG( 10, 35) = 0.762180E+00
+ PKER_SACCRG( 10, 36) = 0.778605E+00
PKER_SACCRG( 10, 37) = 0.000000E+00
PKER_SACCRG( 10, 38) = 0.000000E+00
PKER_SACCRG( 10, 39) = 0.000000E+00
PKER_SACCRG( 10, 40) = 0.000000E+00
PKER_SACCRG( 11, 1) = 0.000000E+00
- PKER_SACCRG( 11, 2) = 0.720403E-06
- PKER_SACCRG( 11, 3) = 0.264157E-04
- PKER_SACCRG( 11, 4) = 0.430057E-03
- PKER_SACCRG( 11, 5) = 0.357147E-03
- PKER_SACCRG( 11, 6) = 0.513732E-03
- PKER_SACCRG( 11, 7) = 0.223031E-02
- PKER_SACCRG( 11, 8) = 0.453334E-02
- PKER_SACCRG( 11, 9) = 0.197619E-02
- PKER_SACCRG( 11, 10) = 0.699670E-02
- PKER_SACCRG( 11, 11) = 0.559959E-02
- PKER_SACCRG( 11, 12) = 0.143088E-01
- PKER_SACCRG( 11, 13) = 0.254483E-01
- PKER_SACCRG( 11, 14) = 0.431850E-01
- PKER_SACCRG( 11, 15) = 0.673872E-01
- PKER_SACCRG( 11, 16) = 0.126953E+00
- PKER_SACCRG( 11, 17) = 0.190653E+00
- PKER_SACCRG( 11, 18) = 0.269512E+00
- PKER_SACCRG( 11, 19) = 0.318624E+00
- PKER_SACCRG( 11, 20) = 0.352402E+00
- PKER_SACCRG( 11, 21) = 0.358160E+00
- PKER_SACCRG( 11, 22) = 0.360271E+00
- PKER_SACCRG( 11, 23) = 0.364777E+00
- PKER_SACCRG( 11, 24) = 0.381211E+00
- PKER_SACCRG( 11, 25) = 0.400286E+00
- PKER_SACCRG( 11, 26) = 0.424050E+00
- PKER_SACCRG( 11, 27) = 0.451584E+00
- PKER_SACCRG( 11, 28) = 0.468600E+00
- PKER_SACCRG( 11, 29) = 0.487607E+00
- PKER_SACCRG( 11, 30) = 0.509441E+00
- PKER_SACCRG( 11, 31) = 0.523036E+00
- PKER_SACCRG( 11, 32) = 0.531878E+00
- PKER_SACCRG( 11, 33) = 0.539025E+00
- PKER_SACCRG( 11, 34) = 0.540283E+00
- PKER_SACCRG( 11, 35) = 0.546255E+00
- PKER_SACCRG( 11, 36) = 0.559768E+00
+ PKER_SACCRG( 11, 2) = 0.000000E+00
+ PKER_SACCRG( 11, 3) = 0.000000E+00
+ PKER_SACCRG( 11, 4) = 0.000000E+00
+ PKER_SACCRG( 11, 5) = 0.832906E-07
+ PKER_SACCRG( 11, 6) = 0.502409E-05
+ PKER_SACCRG( 11, 7) = 0.933604E-04
+ PKER_SACCRG( 11, 8) = 0.860483E-04
+ PKER_SACCRG( 11, 9) = 0.494464E-03
+ PKER_SACCRG( 11, 10) = 0.507648E-03
+ PKER_SACCRG( 11, 11) = 0.632846E-03
+ PKER_SACCRG( 11, 12) = 0.898351E-03
+ PKER_SACCRG( 11, 13) = 0.971535E-03
+ PKER_SACCRG( 11, 14) = 0.183107E-02
+ PKER_SACCRG( 11, 15) = 0.249471E-02
+ PKER_SACCRG( 11, 16) = 0.439233E-02
+ PKER_SACCRG( 11, 17) = 0.797693E-02
+ PKER_SACCRG( 11, 18) = 0.152441E-01
+ PKER_SACCRG( 11, 19) = 0.293789E-01
+ PKER_SACCRG( 11, 20) = 0.515725E-01
+ PKER_SACCRG( 11, 21) = 0.871846E-01
+ PKER_SACCRG( 11, 22) = 0.135867E+00
+ PKER_SACCRG( 11, 23) = 0.189869E+00
+ PKER_SACCRG( 11, 24) = 0.256544E+00
+ PKER_SACCRG( 11, 25) = 0.317064E+00
+ PKER_SACCRG( 11, 26) = 0.373502E+00
+ PKER_SACCRG( 11, 27) = 0.424161E+00
+ PKER_SACCRG( 11, 28) = 0.454262E+00
+ PKER_SACCRG( 11, 29) = 0.480107E+00
+ PKER_SACCRG( 11, 30) = 0.504244E+00
+ PKER_SACCRG( 11, 31) = 0.518345E+00
+ PKER_SACCRG( 11, 32) = 0.527147E+00
+ PKER_SACCRG( 11, 33) = 0.534136E+00
+ PKER_SACCRG( 11, 34) = 0.535557E+00
+ PKER_SACCRG( 11, 35) = 0.541319E+00
+ PKER_SACCRG( 11, 36) = 0.553653E+00
PKER_SACCRG( 11, 37) = 0.000000E+00
PKER_SACCRG( 11, 38) = 0.000000E+00
PKER_SACCRG( 11, 39) = 0.000000E+00
PKER_SACCRG( 11, 40) = 0.000000E+00
PKER_SACCRG( 12, 1) = 0.000000E+00
PKER_SACCRG( 12, 2) = 0.000000E+00
- PKER_SACCRG( 12, 3) = 0.994899E-06
- PKER_SACCRG( 12, 4) = 0.373403E-04
- PKER_SACCRG( 12, 5) = 0.641460E-03
- PKER_SACCRG( 12, 6) = 0.583012E-03
- PKER_SACCRG( 12, 7) = 0.116235E-02
- PKER_SACCRG( 12, 8) = 0.440959E-02
- PKER_SACCRG( 12, 9) = 0.241125E-02
- PKER_SACCRG( 12, 10) = 0.871351E-02
- PKER_SACCRG( 12, 11) = 0.756834E-02
- PKER_SACCRG( 12, 12) = 0.185463E-01
- PKER_SACCRG( 12, 13) = 0.310975E-01
- PKER_SACCRG( 12, 14) = 0.485523E-01
- PKER_SACCRG( 12, 15) = 0.681502E-01
- PKER_SACCRG( 12, 16) = 0.128535E+00
- PKER_SACCRG( 12, 17) = 0.191879E+00
- PKER_SACCRG( 12, 18) = 0.274041E+00
- PKER_SACCRG( 12, 19) = 0.321177E+00
- PKER_SACCRG( 12, 20) = 0.351147E+00
- PKER_SACCRG( 12, 21) = 0.344524E+00
- PKER_SACCRG( 12, 22) = 0.329993E+00
- PKER_SACCRG( 12, 23) = 0.316769E+00
- PKER_SACCRG( 12, 24) = 0.312214E+00
- PKER_SACCRG( 12, 25) = 0.313069E+00
- PKER_SACCRG( 12, 26) = 0.319695E+00
- PKER_SACCRG( 12, 27) = 0.331543E+00
- PKER_SACCRG( 12, 28) = 0.339530E+00
- PKER_SACCRG( 12, 29) = 0.350452E+00
- PKER_SACCRG( 12, 30) = 0.364581E+00
- PKER_SACCRG( 12, 31) = 0.373975E+00
- PKER_SACCRG( 12, 32) = 0.380308E+00
- PKER_SACCRG( 12, 33) = 0.385525E+00
- PKER_SACCRG( 12, 34) = 0.386603E+00
- PKER_SACCRG( 12, 35) = 0.390979E+00
- PKER_SACCRG( 12, 36) = 0.400436E+00
+ PKER_SACCRG( 12, 3) = 0.000000E+00
+ PKER_SACCRG( 12, 4) = 0.000000E+00
+ PKER_SACCRG( 12, 5) = 0.000000E+00
+ PKER_SACCRG( 12, 6) = 0.773960E-07
+ PKER_SACCRG( 12, 7) = 0.444316E-05
+ PKER_SACCRG( 12, 8) = 0.820904E-04
+ PKER_SACCRG( 12, 9) = 0.749946E-04
+ PKER_SACCRG( 12, 10) = 0.426372E-03
+ PKER_SACCRG( 12, 11) = 0.431983E-03
+ PKER_SACCRG( 12, 12) = 0.530818E-03
+ PKER_SACCRG( 12, 13) = 0.743872E-03
+ PKER_SACCRG( 12, 14) = 0.796002E-03
+ PKER_SACCRG( 12, 15) = 0.116910E-02
+ PKER_SACCRG( 12, 16) = 0.216714E-02
+ PKER_SACCRG( 12, 17) = 0.358946E-02
+ PKER_SACCRG( 12, 18) = 0.644847E-02
+ PKER_SACCRG( 12, 19) = 0.128412E-01
+ PKER_SACCRG( 12, 20) = 0.229402E-01
+ PKER_SACCRG( 12, 21) = 0.422368E-01
+ PKER_SACCRG( 12, 22) = 0.714492E-01
+ PKER_SACCRG( 12, 23) = 0.106564E+00
+ PKER_SACCRG( 12, 24) = 0.153890E+00
+ PKER_SACCRG( 12, 25) = 0.202266E+00
+ PKER_SACCRG( 12, 26) = 0.249410E+00
+ PKER_SACCRG( 12, 27) = 0.293259E+00
+ PKER_SACCRG( 12, 28) = 0.320617E+00
+ PKER_SACCRG( 12, 29) = 0.341855E+00
+ PKER_SACCRG( 12, 30) = 0.359983E+00
+ PKER_SACCRG( 12, 31) = 0.370284E+00
+ PKER_SACCRG( 12, 32) = 0.376667E+00
+ PKER_SACCRG( 12, 33) = 0.381816E+00
+ PKER_SACCRG( 12, 34) = 0.382869E+00
+ PKER_SACCRG( 12, 35) = 0.387206E+00
+ PKER_SACCRG( 12, 36) = 0.396588E+00
PKER_SACCRG( 12, 37) = 0.000000E+00
PKER_SACCRG( 12, 38) = 0.000000E+00
PKER_SACCRG( 12, 39) = 0.000000E+00
PKER_SACCRG( 12, 40) = 0.000000E+00
PKER_SACCRG( 13, 1) = 0.000000E+00
PKER_SACCRG( 13, 2) = 0.000000E+00
- PKER_SACCRG( 13, 3) = 0.449611E-08
- PKER_SACCRG( 13, 4) = 0.169690E-05
- PKER_SACCRG( 13, 5) = 0.686632E-04
- PKER_SACCRG( 13, 6) = 0.127709E-03
- PKER_SACCRG( 13, 7) = 0.236529E-02
- PKER_SACCRG( 13, 8) = 0.119372E-01
- PKER_SACCRG( 13, 9) = 0.448982E-02
- PKER_SACCRG( 13, 10) = 0.129780E-01
- PKER_SACCRG( 13, 11) = 0.155888E-01
- PKER_SACCRG( 13, 12) = 0.309368E-01
- PKER_SACCRG( 13, 13) = 0.497395E-01
- PKER_SACCRG( 13, 14) = 0.640867E-01
- PKER_SACCRG( 13, 15) = 0.800523E-01
- PKER_SACCRG( 13, 16) = 0.144293E+00
- PKER_SACCRG( 13, 17) = 0.208219E+00
- PKER_SACCRG( 13, 18) = 0.296651E+00
- PKER_SACCRG( 13, 19) = 0.345954E+00
- PKER_SACCRG( 13, 20) = 0.376717E+00
- PKER_SACCRG( 13, 21) = 0.362657E+00
- PKER_SACCRG( 13, 22) = 0.336746E+00
- PKER_SACCRG( 13, 23) = 0.310501E+00
- PKER_SACCRG( 13, 24) = 0.289797E+00
- PKER_SACCRG( 13, 25) = 0.275726E+00
- PKER_SACCRG( 13, 26) = 0.267684E+00
- PKER_SACCRG( 13, 27) = 0.265096E+00
- PKER_SACCRG( 13, 28) = 0.264355E+00
- PKER_SACCRG( 13, 29) = 0.266500E+00
- PKER_SACCRG( 13, 30) = 0.271273E+00
- PKER_SACCRG( 13, 31) = 0.274865E+00
- PKER_SACCRG( 13, 32) = 0.277460E+00
- PKER_SACCRG( 13, 33) = 0.279736E+00
- PKER_SACCRG( 13, 34) = 0.280140E+00
- PKER_SACCRG( 13, 35) = 0.282174E+00
- PKER_SACCRG( 13, 36) = 0.286838E+00
+ PKER_SACCRG( 13, 3) = 0.000000E+00
+ PKER_SACCRG( 13, 4) = 0.000000E+00
+ PKER_SACCRG( 13, 5) = 0.000000E+00
+ PKER_SACCRG( 13, 6) = 0.000000E+00
+ PKER_SACCRG( 13, 7) = 0.735833E-07
+ PKER_SACCRG( 13, 8) = 0.403716E-05
+ PKER_SACCRG( 13, 9) = 0.739090E-04
+ PKER_SACCRG( 13, 10) = 0.668732E-04
+ PKER_SACCRG( 13, 11) = 0.374752E-03
+ PKER_SACCRG( 13, 12) = 0.372451E-03
+ PKER_SACCRG( 13, 13) = 0.447074E-03
+ PKER_SACCRG( 13, 14) = 0.610717E-03
+ PKER_SACCRG( 13, 15) = 0.641614E-03
+ PKER_SACCRG( 13, 16) = 0.119058E-02
+ PKER_SACCRG( 13, 17) = 0.179867E-02
+ PKER_SACCRG( 13, 18) = 0.291204E-02
+ PKER_SACCRG( 13, 19) = 0.606676E-02
+ PKER_SACCRG( 13, 20) = 0.100429E-01
+ PKER_SACCRG( 13, 21) = 0.203541E-01
+ PKER_SACCRG( 13, 22) = 0.377872E-01
+ PKER_SACCRG( 13, 23) = 0.606389E-01
+ PKER_SACCRG( 13, 24) = 0.937549E-01
+ PKER_SACCRG( 13, 25) = 0.133605E+00
+ PKER_SACCRG( 13, 26) = 0.174990E+00
+ PKER_SACCRG( 13, 27) = 0.214629E+00
+ PKER_SACCRG( 13, 28) = 0.241011E+00
+ PKER_SACCRG( 13, 29) = 0.258073E+00
+ PKER_SACCRG( 13, 30) = 0.269310E+00
+ PKER_SACCRG( 13, 31) = 0.274592E+00
+ PKER_SACCRG( 13, 32) = 0.277413E+00
+ PKER_SACCRG( 13, 33) = 0.279664E+00
+ PKER_SACCRG( 13, 34) = 0.280055E+00
+ PKER_SACCRG( 13, 35) = 0.282059E+00
+ PKER_SACCRG( 13, 36) = 0.286665E+00
PKER_SACCRG( 13, 37) = 0.000000E+00
PKER_SACCRG( 13, 38) = 0.000000E+00
PKER_SACCRG( 13, 39) = 0.000000E+00
@@ -3871,39 +3838,39 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 14, 1) = 0.000000E+00
PKER_SACCRG( 14, 2) = 0.000000E+00
PKER_SACCRG( 14, 3) = 0.000000E+00
- PKER_SACCRG( 14, 4) = 0.248952E-07
- PKER_SACCRG( 14, 5) = 0.409625E-05
- PKER_SACCRG( 14, 6) = 0.207207E-03
- PKER_SACCRG( 14, 7) = 0.118958E-02
- PKER_SACCRG( 14, 8) = 0.512152E-01
- PKER_SACCRG( 14, 9) = 0.120164E-01
- PKER_SACCRG( 14, 10) = 0.226965E-01
- PKER_SACCRG( 14, 11) = 0.279317E-01
- PKER_SACCRG( 14, 12) = 0.685054E-01
- PKER_SACCRG( 14, 13) = 0.852867E-01
- PKER_SACCRG( 14, 14) = 0.888063E-01
- PKER_SACCRG( 14, 15) = 0.103419E+00
- PKER_SACCRG( 14, 16) = 0.175768E+00
- PKER_SACCRG( 14, 17) = 0.236929E+00
- PKER_SACCRG( 14, 18) = 0.329532E+00
- PKER_SACCRG( 14, 19) = 0.381995E+00
- PKER_SACCRG( 14, 20) = 0.416426E+00
- PKER_SACCRG( 14, 21) = 0.399052E+00
- PKER_SACCRG( 14, 22) = 0.366422E+00
- PKER_SACCRG( 14, 23) = 0.331610E+00
- PKER_SACCRG( 14, 24) = 0.299802E+00
- PKER_SACCRG( 14, 25) = 0.274735E+00
- PKER_SACCRG( 14, 26) = 0.255289E+00
- PKER_SACCRG( 14, 27) = 0.240971E+00
- PKER_SACCRG( 14, 28) = 0.232445E+00
- PKER_SACCRG( 14, 29) = 0.226737E+00
- PKER_SACCRG( 14, 30) = 0.223184E+00
- PKER_SACCRG( 14, 31) = 0.221575E+00
- PKER_SACCRG( 14, 32) = 0.220779E+00
- PKER_SACCRG( 14, 33) = 0.220423E+00
- PKER_SACCRG( 14, 34) = 0.220072E+00
- PKER_SACCRG( 14, 35) = 0.220044E+00
- PKER_SACCRG( 14, 36) = 0.220720E+00
+ PKER_SACCRG( 14, 4) = 0.000000E+00
+ PKER_SACCRG( 14, 5) = 0.000000E+00
+ PKER_SACCRG( 14, 6) = 0.000000E+00
+ PKER_SACCRG( 14, 7) = 0.000000E+00
+ PKER_SACCRG( 14, 8) = 0.728176E-07
+ PKER_SACCRG( 14, 9) = 0.379948E-05
+ PKER_SACCRG( 14, 10) = 0.688582E-04
+ PKER_SACCRG( 14, 11) = 0.614350E-04
+ PKER_SACCRG( 14, 12) = 0.337324E-03
+ PKER_SACCRG( 14, 13) = 0.324899E-03
+ PKER_SACCRG( 14, 14) = 0.371520E-03
+ PKER_SACCRG( 14, 15) = 0.478804E-03
+ PKER_SACCRG( 14, 16) = 0.101697E-02
+ PKER_SACCRG( 14, 17) = 0.102728E-02
+ PKER_SACCRG( 14, 18) = 0.147349E-02
+ PKER_SACCRG( 14, 19) = 0.368922E-02
+ PKER_SACCRG( 14, 20) = 0.484994E-02
+ PKER_SACCRG( 14, 21) = 0.109319E-01
+ PKER_SACCRG( 14, 22) = 0.222066E-01
+ PKER_SACCRG( 14, 23) = 0.380174E-01
+ PKER_SACCRG( 14, 24) = 0.622359E-01
+ PKER_SACCRG( 14, 25) = 0.978747E-01
+ PKER_SACCRG( 14, 26) = 0.135839E+00
+ PKER_SACCRG( 14, 27) = 0.174342E+00
+ PKER_SACCRG( 14, 28) = 0.201882E+00
+ PKER_SACCRG( 14, 29) = 0.216326E+00
+ PKER_SACCRG( 14, 30) = 0.222044E+00
+ PKER_SACCRG( 14, 31) = 0.222867E+00
+ PKER_SACCRG( 14, 32) = 0.222379E+00
+ PKER_SACCRG( 14, 33) = 0.221925E+00
+ PKER_SACCRG( 14, 34) = 0.221667E+00
+ PKER_SACCRG( 14, 35) = 0.221502E+00
+ PKER_SACCRG( 14, 36) = 0.221629E+00
PKER_SACCRG( 14, 37) = 0.000000E+00
PKER_SACCRG( 14, 38) = 0.000000E+00
PKER_SACCRG( 14, 39) = 0.000000E+00
@@ -3912,38 +3879,38 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 15, 2) = 0.000000E+00
PKER_SACCRG( 15, 3) = 0.000000E+00
PKER_SACCRG( 15, 4) = 0.000000E+00
- PKER_SACCRG( 15, 5) = 0.109652E-06
- PKER_SACCRG( 15, 6) = 0.193477E-04
- PKER_SACCRG( 15, 7) = 0.584307E-02
- PKER_SACCRG( 15, 8) = 0.557443E-01
- PKER_SACCRG( 15, 9) = 0.510579E-01
- PKER_SACCRG( 15, 10) = 0.495152E-01
- PKER_SACCRG( 15, 11) = 0.593147E-01
- PKER_SACCRG( 15, 12) = 0.123803E+00
- PKER_SACCRG( 15, 13) = 0.126672E+00
- PKER_SACCRG( 15, 14) = 0.138829E+00
- PKER_SACCRG( 15, 15) = 0.155557E+00
- PKER_SACCRG( 15, 16) = 0.212116E+00
- PKER_SACCRG( 15, 17) = 0.273755E+00
- PKER_SACCRG( 15, 18) = 0.368451E+00
- PKER_SACCRG( 15, 19) = 0.422358E+00
- PKER_SACCRG( 15, 20) = 0.460799E+00
- PKER_SACCRG( 15, 21) = 0.442821E+00
- PKER_SACCRG( 15, 22) = 0.407078E+00
- PKER_SACCRG( 15, 23) = 0.367490E+00
- PKER_SACCRG( 15, 24) = 0.329148E+00
- PKER_SACCRG( 15, 25) = 0.297121E+00
- PKER_SACCRG( 15, 26) = 0.270044E+00
- PKER_SACCRG( 15, 27) = 0.247447E+00
- PKER_SACCRG( 15, 28) = 0.233079E+00
- PKER_SACCRG( 15, 29) = 0.221407E+00
- PKER_SACCRG( 15, 30) = 0.211439E+00
- PKER_SACCRG( 15, 31) = 0.205630E+00
- PKER_SACCRG( 15, 32) = 0.202132E+00
- PKER_SACCRG( 15, 33) = 0.199657E+00
- PKER_SACCRG( 15, 34) = 0.198910E+00
- PKER_SACCRG( 15, 35) = 0.197179E+00
- PKER_SACCRG( 15, 36) = 0.194045E+00
+ PKER_SACCRG( 15, 5) = 0.000000E+00
+ PKER_SACCRG( 15, 6) = 0.000000E+00
+ PKER_SACCRG( 15, 7) = 0.000000E+00
+ PKER_SACCRG( 15, 8) = 0.000000E+00
+ PKER_SACCRG( 15, 9) = 0.759585E-07
+ PKER_SACCRG( 15, 10) = 0.374710E-05
+ PKER_SACCRG( 15, 11) = 0.671091E-04
+ PKER_SACCRG( 15, 12) = 0.588014E-04
+ PKER_SACCRG( 15, 13) = 0.311989E-03
+ PKER_SACCRG( 15, 14) = 0.280346E-03
+ PKER_SACCRG( 15, 15) = 0.278888E-03
+ PKER_SACCRG( 15, 16) = 0.181122E-02
+ PKER_SACCRG( 15, 17) = 0.951550E-03
+ PKER_SACCRG( 15, 18) = 0.874685E-03
+ PKER_SACCRG( 15, 19) = 0.341647E-02
+ PKER_SACCRG( 15, 20) = 0.313074E-02
+ PKER_SACCRG( 15, 21) = 0.790628E-02
+ PKER_SACCRG( 15, 22) = 0.167408E-01
+ PKER_SACCRG( 15, 23) = 0.292368E-01
+ PKER_SACCRG( 15, 24) = 0.493019E-01
+ PKER_SACCRG( 15, 25) = 0.846089E-01
+ PKER_SACCRG( 15, 26) = 0.122848E+00
+ PKER_SACCRG( 15, 27) = 0.164348E+00
+ PKER_SACCRG( 15, 28) = 0.195653E+00
+ PKER_SACCRG( 15, 29) = 0.209699E+00
+ PKER_SACCRG( 15, 30) = 0.212297E+00
+ PKER_SACCRG( 15, 31) = 0.209959E+00
+ PKER_SACCRG( 15, 32) = 0.206919E+00
+ PKER_SACCRG( 15, 33) = 0.204381E+00
+ PKER_SACCRG( 15, 34) = 0.203587E+00
+ PKER_SACCRG( 15, 35) = 0.201798E+00
+ PKER_SACCRG( 15, 36) = 0.198561E+00
PKER_SACCRG( 15, 37) = 0.000000E+00
PKER_SACCRG( 15, 38) = 0.000000E+00
PKER_SACCRG( 15, 39) = 0.000000E+00
@@ -3953,37 +3920,37 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 16, 3) = 0.000000E+00
PKER_SACCRG( 16, 4) = 0.000000E+00
PKER_SACCRG( 16, 5) = 0.000000E+00
- PKER_SACCRG( 16, 6) = 0.972460E-06
- PKER_SACCRG( 16, 7) = 0.228784E-02
- PKER_SACCRG( 16, 8) = 0.647400E+00
- PKER_SACCRG( 16, 9) = 0.552575E-01
- PKER_SACCRG( 16, 10) = 0.411267E-01
- PKER_SACCRG( 16, 11) = 0.161183E+00
- PKER_SACCRG( 16, 12) = 0.261228E+00
- PKER_SACCRG( 16, 13) = 0.202736E+00
- PKER_SACCRG( 16, 14) = 0.262748E+00
- PKER_SACCRG( 16, 15) = 0.197646E+00
- PKER_SACCRG( 16, 16) = 0.298342E+00
- PKER_SACCRG( 16, 17) = 0.331468E+00
- PKER_SACCRG( 16, 18) = 0.422266E+00
- PKER_SACCRG( 16, 19) = 0.466303E+00
- PKER_SACCRG( 16, 20) = 0.507007E+00
- PKER_SACCRG( 16, 21) = 0.489040E+00
- PKER_SACCRG( 16, 22) = 0.452353E+00
- PKER_SACCRG( 16, 23) = 0.410554E+00
- PKER_SACCRG( 16, 24) = 0.368910E+00
- PKER_SACCRG( 16, 25) = 0.333049E+00
- PKER_SACCRG( 16, 26) = 0.301496E+00
- PKER_SACCRG( 16, 27) = 0.273789E+00
- PKER_SACCRG( 16, 28) = 0.255515E+00
- PKER_SACCRG( 16, 29) = 0.239769E+00
- PKER_SACCRG( 16, 30) = 0.225328E+00
- PKER_SACCRG( 16, 31) = 0.216494E+00
- PKER_SACCRG( 16, 32) = 0.210970E+00
- PKER_SACCRG( 16, 33) = 0.206931E+00
- PKER_SACCRG( 16, 34) = 0.205729E+00
- PKER_SACCRG( 16, 35) = 0.202827E+00
- PKER_SACCRG( 16, 36) = 0.197412E+00
+ PKER_SACCRG( 16, 6) = 0.000000E+00
+ PKER_SACCRG( 16, 7) = 0.000000E+00
+ PKER_SACCRG( 16, 8) = 0.000000E+00
+ PKER_SACCRG( 16, 9) = 0.000000E+00
+ PKER_SACCRG( 16, 10) = 0.844481E-07
+ PKER_SACCRG( 16, 11) = 0.394811E-05
+ PKER_SACCRG( 16, 12) = 0.696323E-04
+ PKER_SACCRG( 16, 13) = 0.591332E-04
+ PKER_SACCRG( 16, 14) = 0.289674E-03
+ PKER_SACCRG( 16, 15) = 0.202537E-03
+ PKER_SACCRG( 16, 16) = 0.336844E-02
+ PKER_SACCRG( 16, 17) = 0.178312E-02
+ PKER_SACCRG( 16, 18) = 0.868492E-03
+ PKER_SACCRG( 16, 19) = 0.435445E-02
+ PKER_SACCRG( 16, 20) = 0.306476E-02
+ PKER_SACCRG( 16, 21) = 0.776119E-02
+ PKER_SACCRG( 16, 22) = 0.161954E-01
+ PKER_SACCRG( 16, 23) = 0.276331E-01
+ PKER_SACCRG( 16, 24) = 0.458394E-01
+ PKER_SACCRG( 16, 25) = 0.831396E-01
+ PKER_SACCRG( 16, 26) = 0.123760E+00
+ PKER_SACCRG( 16, 27) = 0.170508E+00
+ PKER_SACCRG( 16, 28) = 0.207373E+00
+ PKER_SACCRG( 16, 29) = 0.222851E+00
+ PKER_SACCRG( 16, 30) = 0.224550E+00
+ PKER_SACCRG( 16, 31) = 0.220359E+00
+ PKER_SACCRG( 16, 32) = 0.215498E+00
+ PKER_SACCRG( 16, 33) = 0.211386E+00
+ PKER_SACCRG( 16, 34) = 0.210132E+00
+ PKER_SACCRG( 16, 35) = 0.207094E+00
+ PKER_SACCRG( 16, 36) = 0.201428E+00
PKER_SACCRG( 16, 37) = 0.000000E+00
PKER_SACCRG( 16, 38) = 0.000000E+00
PKER_SACCRG( 16, 39) = 0.000000E+00
@@ -3993,37 +3960,37 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 17, 3) = 0.000000E+00
PKER_SACCRG( 17, 4) = 0.000000E+00
PKER_SACCRG( 17, 5) = 0.000000E+00
- PKER_SACCRG( 17, 6) = 0.189407E-07
- PKER_SACCRG( 17, 7) = 0.710932E-03
- PKER_SACCRG( 17, 8) = 0.686679E+00
- PKER_SACCRG( 17, 9) = 0.586133E-01
- PKER_SACCRG( 17, 10) = 0.128748E+00
- PKER_SACCRG( 17, 11) = 0.170751E+00
- PKER_SACCRG( 17, 12) = 0.276326E+00
- PKER_SACCRG( 17, 13) = 0.356825E+00
- PKER_SACCRG( 17, 14) = 0.413243E+00
- PKER_SACCRG( 17, 15) = 0.328870E+00
- PKER_SACCRG( 17, 16) = 0.360945E+00
- PKER_SACCRG( 17, 17) = 0.399638E+00
- PKER_SACCRG( 17, 18) = 0.491390E+00
- PKER_SACCRG( 17, 19) = 0.514772E+00
- PKER_SACCRG( 17, 20) = 0.548065E+00
- PKER_SACCRG( 17, 21) = 0.528710E+00
- PKER_SACCRG( 17, 22) = 0.492174E+00
- PKER_SACCRG( 17, 23) = 0.450030E+00
- PKER_SACCRG( 17, 24) = 0.407497E+00
- PKER_SACCRG( 17, 25) = 0.370319E+00
- PKER_SACCRG( 17, 26) = 0.336970E+00
- PKER_SACCRG( 17, 27) = 0.306971E+00
- PKER_SACCRG( 17, 28) = 0.286784E+00
- PKER_SACCRG( 17, 29) = 0.268915E+00
- PKER_SACCRG( 17, 30) = 0.251963E+00
- PKER_SACCRG( 17, 31) = 0.241332E+00
- PKER_SACCRG( 17, 32) = 0.234558E+00
- PKER_SACCRG( 17, 33) = 0.229494E+00
- PKER_SACCRG( 17, 34) = 0.228030E+00
- PKER_SACCRG( 17, 35) = 0.224266E+00
- PKER_SACCRG( 17, 36) = 0.216953E+00
+ PKER_SACCRG( 17, 6) = 0.000000E+00
+ PKER_SACCRG( 17, 7) = 0.000000E+00
+ PKER_SACCRG( 17, 8) = 0.000000E+00
+ PKER_SACCRG( 17, 9) = 0.000000E+00
+ PKER_SACCRG( 17, 10) = 0.000000E+00
+ PKER_SACCRG( 17, 11) = 0.102418E-06
+ PKER_SACCRG( 17, 12) = 0.455940E-05
+ PKER_SACCRG( 17, 13) = 0.784312E-04
+ PKER_SACCRG( 17, 14) = 0.614879E-04
+ PKER_SACCRG( 17, 15) = 0.207160E-03
+ PKER_SACCRG( 17, 16) = 0.889438E-02
+ PKER_SACCRG( 17, 17) = 0.339624E-02
+ PKER_SACCRG( 17, 18) = 0.106437E-02
+ PKER_SACCRG( 17, 19) = 0.779689E-02
+ PKER_SACCRG( 17, 20) = 0.404959E-02
+ PKER_SACCRG( 17, 21) = 0.101250E-01
+ PKER_SACCRG( 17, 22) = 0.196042E-01
+ PKER_SACCRG( 17, 23) = 0.307730E-01
+ PKER_SACCRG( 17, 24) = 0.480533E-01
+ PKER_SACCRG( 17, 25) = 0.885797E-01
+ PKER_SACCRG( 17, 26) = 0.132905E+00
+ PKER_SACCRG( 17, 27) = 0.187039E+00
+ PKER_SACCRG( 17, 28) = 0.231099E+00
+ PKER_SACCRG( 17, 29) = 0.249500E+00
+ PKER_SACCRG( 17, 30) = 0.252291E+00
+ PKER_SACCRG( 17, 31) = 0.247487E+00
+ PKER_SACCRG( 17, 32) = 0.241587E+00
+ PKER_SACCRG( 17, 33) = 0.236485E+00
+ PKER_SACCRG( 17, 34) = 0.234962E+00
+ PKER_SACCRG( 17, 35) = 0.231075E+00
+ PKER_SACCRG( 17, 36) = 0.223581E+00
PKER_SACCRG( 17, 37) = 0.000000E+00
PKER_SACCRG( 17, 38) = 0.000000E+00
PKER_SACCRG( 17, 39) = 0.000000E+00
@@ -4034,36 +4001,36 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 18, 4) = 0.000000E+00
PKER_SACCRG( 18, 5) = 0.000000E+00
PKER_SACCRG( 18, 6) = 0.000000E+00
- PKER_SACCRG( 18, 7) = 0.160006E-03
- PKER_SACCRG( 18, 8) = 0.719207E+00
- PKER_SACCRG( 18, 9) = 0.664711E+00
- PKER_SACCRG( 18, 10) = 0.101234E+00
- PKER_SACCRG( 18, 11) = 0.178669E+00
- PKER_SACCRG( 18, 12) = 0.728837E+00
- PKER_SACCRG( 18, 13) = 0.731397E+00
- PKER_SACCRG( 18, 14) = 0.432437E+00
- PKER_SACCRG( 18, 15) = 0.471229E+00
- PKER_SACCRG( 18, 16) = 0.445069E+00
- PKER_SACCRG( 18, 17) = 0.508932E+00
- PKER_SACCRG( 18, 18) = 0.540554E+00
- PKER_SACCRG( 18, 19) = 0.560723E+00
- PKER_SACCRG( 18, 20) = 0.587182E+00
- PKER_SACCRG( 18, 21) = 0.563366E+00
- PKER_SACCRG( 18, 22) = 0.526594E+00
- PKER_SACCRG( 18, 23) = 0.484750E+00
- PKER_SACCRG( 18, 24) = 0.442429E+00
- PKER_SACCRG( 18, 25) = 0.405163E+00
- PKER_SACCRG( 18, 26) = 0.371497E+00
- PKER_SACCRG( 18, 27) = 0.340888E+00
- PKER_SACCRG( 18, 28) = 0.320012E+00
- PKER_SACCRG( 18, 29) = 0.301346E+00
- PKER_SACCRG( 18, 30) = 0.283409E+00
- PKER_SACCRG( 18, 31) = 0.272008E+00
- PKER_SACCRG( 18, 32) = 0.264667E+00
- PKER_SACCRG( 18, 33) = 0.259138E+00
- PKER_SACCRG( 18, 34) = 0.257521E+00
- PKER_SACCRG( 18, 35) = 0.253375E+00
- PKER_SACCRG( 18, 36) = 0.245311E+00
+ PKER_SACCRG( 18, 7) = 0.000000E+00
+ PKER_SACCRG( 18, 8) = 0.000000E+00
+ PKER_SACCRG( 18, 9) = 0.000000E+00
+ PKER_SACCRG( 18, 10) = 0.000000E+00
+ PKER_SACCRG( 18, 11) = 0.000000E+00
+ PKER_SACCRG( 18, 12) = 0.140103E-06
+ PKER_SACCRG( 18, 13) = 0.596643E-05
+ PKER_SACCRG( 18, 14) = 0.955662E-04
+ PKER_SACCRG( 18, 15) = 0.467666E-04
+ PKER_SACCRG( 18, 16) = 0.950209E-02
+ PKER_SACCRG( 18, 17) = 0.886291E-02
+ PKER_SACCRG( 18, 18) = 0.338287E-02
+ PKER_SACCRG( 18, 19) = 0.122056E-01
+ PKER_SACCRG( 18, 20) = 0.719648E-02
+ PKER_SACCRG( 18, 21) = 0.173349E-01
+ PKER_SACCRG( 18, 22) = 0.268718E-01
+ PKER_SACCRG( 18, 23) = 0.384549E-01
+ PKER_SACCRG( 18, 24) = 0.531665E-01
+ PKER_SACCRG( 18, 25) = 0.967650E-01
+ PKER_SACCRG( 18, 26) = 0.143690E+00
+ PKER_SACCRG( 18, 27) = 0.205036E+00
+ PKER_SACCRG( 18, 28) = 0.256245E+00
+ PKER_SACCRG( 18, 29) = 0.278068E+00
+ PKER_SACCRG( 18, 30) = 0.283239E+00
+ PKER_SACCRG( 18, 31) = 0.278809E+00
+ PKER_SACCRG( 18, 32) = 0.272567E+00
+ PKER_SACCRG( 18, 33) = 0.267046E+00
+ PKER_SACCRG( 18, 34) = 0.265383E+00
+ PKER_SACCRG( 18, 35) = 0.261124E+00
+ PKER_SACCRG( 18, 36) = 0.252857E+00
PKER_SACCRG( 18, 37) = 0.000000E+00
PKER_SACCRG( 18, 38) = 0.000000E+00
PKER_SACCRG( 18, 39) = 0.000000E+00
@@ -4074,36 +4041,36 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 19, 4) = 0.000000E+00
PKER_SACCRG( 19, 5) = 0.000000E+00
PKER_SACCRG( 19, 6) = 0.000000E+00
- PKER_SACCRG( 19, 7) = 0.236300E-04
- PKER_SACCRG( 19, 8) = 0.742522E+00
- PKER_SACCRG( 19, 9) = 0.688461E+00
- PKER_SACCRG( 19, 10) = 0.813677E-01
- PKER_SACCRG( 19, 11) = 0.725074E+00
- PKER_SACCRG( 19, 12) = 0.752195E+00
- PKER_SACCRG( 19, 13) = 0.754753E+00
- PKER_SACCRG( 19, 14) = 0.743589E+00
- PKER_SACCRG( 19, 15) = 0.486761E+00
- PKER_SACCRG( 19, 16) = 0.562560E+00
- PKER_SACCRG( 19, 17) = 0.600710E+00
- PKER_SACCRG( 19, 18) = 0.635518E+00
- PKER_SACCRG( 19, 19) = 0.613200E+00
- PKER_SACCRG( 19, 20) = 0.620667E+00
- PKER_SACCRG( 19, 21) = 0.589800E+00
- PKER_SACCRG( 19, 22) = 0.552718E+00
- PKER_SACCRG( 19, 23) = 0.511426E+00
- PKER_SACCRG( 19, 24) = 0.469847E+00
- PKER_SACCRG( 19, 25) = 0.433139E+00
- PKER_SACCRG( 19, 26) = 0.399930E+00
- PKER_SACCRG( 19, 27) = 0.369670E+00
- PKER_SACCRG( 19, 28) = 0.348846E+00
- PKER_SACCRG( 19, 29) = 0.330209E+00
- PKER_SACCRG( 19, 30) = 0.312245E+00
- PKER_SACCRG( 19, 31) = 0.300744E+00
- PKER_SACCRG( 19, 32) = 0.293305E+00
- PKER_SACCRG( 19, 33) = 0.287688E+00
- PKER_SACCRG( 19, 34) = 0.286030E+00
- PKER_SACCRG( 19, 35) = 0.281806E+00
- PKER_SACCRG( 19, 36) = 0.273562E+00
+ PKER_SACCRG( 19, 7) = 0.000000E+00
+ PKER_SACCRG( 19, 8) = 0.000000E+00
+ PKER_SACCRG( 19, 9) = 0.000000E+00
+ PKER_SACCRG( 19, 10) = 0.000000E+00
+ PKER_SACCRG( 19, 11) = 0.000000E+00
+ PKER_SACCRG( 19, 12) = 0.000000E+00
+ PKER_SACCRG( 19, 13) = 0.227778E-06
+ PKER_SACCRG( 19, 14) = 0.900623E-05
+ PKER_SACCRG( 19, 15) = 0.841460E-04
+ PKER_SACCRG( 19, 16) = 0.386383E-01
+ PKER_SACCRG( 19, 17) = 0.931861E-02
+ PKER_SACCRG( 19, 18) = 0.873078E-02
+ PKER_SACCRG( 19, 19) = 0.212263E-01
+ PKER_SACCRG( 19, 20) = 0.110801E-01
+ PKER_SACCRG( 19, 21) = 0.233312E-01
+ PKER_SACCRG( 19, 22) = 0.377998E-01
+ PKER_SACCRG( 19, 23) = 0.473076E-01
+ PKER_SACCRG( 19, 24) = 0.634436E-01
+ PKER_SACCRG( 19, 25) = 0.108864E+00
+ PKER_SACCRG( 19, 26) = 0.154870E+00
+ PKER_SACCRG( 19, 27) = 0.221137E+00
+ PKER_SACCRG( 19, 28) = 0.278289E+00
+ PKER_SACCRG( 19, 29) = 0.303277E+00
+ PKER_SACCRG( 19, 30) = 0.311313E+00
+ PKER_SACCRG( 19, 31) = 0.307763E+00
+ PKER_SACCRG( 19, 32) = 0.301613E+00
+ PKER_SACCRG( 19, 33) = 0.296055E+00
+ PKER_SACCRG( 19, 34) = 0.294365E+00
+ PKER_SACCRG( 19, 35) = 0.290056E+00
+ PKER_SACCRG( 19, 36) = 0.281642E+00
PKER_SACCRG( 19, 37) = 0.000000E+00
PKER_SACCRG( 19, 38) = 0.000000E+00
PKER_SACCRG( 19, 39) = 0.000000E+00
@@ -4114,36 +4081,36 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 20, 4) = 0.000000E+00
PKER_SACCRG( 20, 5) = 0.000000E+00
PKER_SACCRG( 20, 6) = 0.000000E+00
- PKER_SACCRG( 20, 7) = 0.203862E-05
- PKER_SACCRG( 20, 8) = 0.764528E+00
- PKER_SACCRG( 20, 9) = 0.710601E+00
- PKER_SACCRG( 20, 10) = 0.700965E-01
- PKER_SACCRG( 20, 11) = 0.747194E+00
- PKER_SACCRG( 20, 12) = 0.774270E+00
- PKER_SACCRG( 20, 13) = 0.776836E+00
- PKER_SACCRG( 20, 14) = 0.765712E+00
- PKER_SACCRG( 20, 15) = 0.746082E+00
- PKER_SACCRG( 20, 16) = 0.745056E+00
- PKER_SACCRG( 20, 17) = 0.619439E+00
- PKER_SACCRG( 20, 18) = 0.655904E+00
- PKER_SACCRG( 20, 19) = 0.657570E+00
- PKER_SACCRG( 20, 20) = 0.650238E+00
- PKER_SACCRG( 20, 21) = 0.615243E+00
- PKER_SACCRG( 20, 22) = 0.576344E+00
- PKER_SACCRG( 20, 23) = 0.535271E+00
- PKER_SACCRG( 20, 24) = 0.494190E+00
- PKER_SACCRG( 20, 25) = 0.457900E+00
- PKER_SACCRG( 20, 26) = 0.425102E+00
- PKER_SACCRG( 20, 27) = 0.395251E+00
- PKER_SACCRG( 20, 28) = 0.374572E+00
- PKER_SACCRG( 20, 29) = 0.356120E+00
- PKER_SACCRG( 20, 30) = 0.338384E+00
- PKER_SACCRG( 20, 31) = 0.326983E+00
- PKER_SACCRG( 20, 32) = 0.319595E+00
- PKER_SACCRG( 20, 33) = 0.314023E+00
- PKER_SACCRG( 20, 34) = 0.312357E+00
- PKER_SACCRG( 20, 35) = 0.308179E+00
- PKER_SACCRG( 20, 36) = 0.300050E+00
+ PKER_SACCRG( 20, 7) = 0.000000E+00
+ PKER_SACCRG( 20, 8) = 0.000000E+00
+ PKER_SACCRG( 20, 9) = 0.000000E+00
+ PKER_SACCRG( 20, 10) = 0.000000E+00
+ PKER_SACCRG( 20, 11) = 0.000000E+00
+ PKER_SACCRG( 20, 12) = 0.000000E+00
+ PKER_SACCRG( 20, 13) = 0.129560E-08
+ PKER_SACCRG( 20, 14) = 0.461750E-06
+ PKER_SACCRG( 20, 15) = 0.991868E-05
+ PKER_SACCRG( 20, 16) = 0.404619E-01
+ PKER_SACCRG( 20, 17) = 0.376740E-01
+ PKER_SACCRG( 20, 18) = 0.912299E-02
+ PKER_SACCRG( 20, 19) = 0.431984E-01
+ PKER_SACCRG( 20, 20) = 0.191703E-01
+ PKER_SACCRG( 20, 21) = 0.492406E-01
+ PKER_SACCRG( 20, 22) = 0.618254E-01
+ PKER_SACCRG( 20, 23) = 0.738280E-01
+ PKER_SACCRG( 20, 24) = 0.817314E-01
+ PKER_SACCRG( 20, 25) = 0.125224E+00
+ PKER_SACCRG( 20, 26) = 0.171144E+00
+ PKER_SACCRG( 20, 27) = 0.237848E+00
+ PKER_SACCRG( 20, 28) = 0.298348E+00
+ PKER_SACCRG( 20, 29) = 0.325776E+00
+ PKER_SACCRG( 20, 30) = 0.336589E+00
+ PKER_SACCRG( 20, 31) = 0.333991E+00
+ PKER_SACCRG( 20, 32) = 0.328042E+00
+ PKER_SACCRG( 20, 33) = 0.322558E+00
+ PKER_SACCRG( 20, 34) = 0.320859E+00
+ PKER_SACCRG( 20, 35) = 0.316600E+00
+ PKER_SACCRG( 20, 36) = 0.308313E+00
PKER_SACCRG( 20, 37) = 0.000000E+00
PKER_SACCRG( 20, 38) = 0.000000E+00
PKER_SACCRG( 20, 39) = 0.000000E+00
@@ -4154,36 +4121,36 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 21, 4) = 0.000000E+00
PKER_SACCRG( 21, 5) = 0.000000E+00
PKER_SACCRG( 21, 6) = 0.000000E+00
- PKER_SACCRG( 21, 7) = 0.891306E-07
- PKER_SACCRG( 21, 8) = 0.782659E+00
- PKER_SACCRG( 21, 9) = 0.728819E+00
- PKER_SACCRG( 21, 10) = 0.653032E-01
- PKER_SACCRG( 21, 11) = 0.765407E+00
- PKER_SACCRG( 21, 12) = 0.792455E+00
- PKER_SACCRG( 21, 13) = 0.795027E+00
- PKER_SACCRG( 21, 14) = 0.783931E+00
- PKER_SACCRG( 21, 15) = 0.764347E+00
- PKER_SACCRG( 21, 16) = 0.763345E+00
- PKER_SACCRG( 21, 17) = 0.747753E+00
- PKER_SACCRG( 21, 18) = 0.734019E+00
- PKER_SACCRG( 21, 19) = 0.675195E+00
- PKER_SACCRG( 21, 20) = 0.678540E+00
- PKER_SACCRG( 21, 21) = 0.636050E+00
- PKER_SACCRG( 21, 22) = 0.595666E+00
- PKER_SACCRG( 21, 23) = 0.554733E+00
- PKER_SACCRG( 21, 24) = 0.514033E+00
- PKER_SACCRG( 21, 25) = 0.478069E+00
- PKER_SACCRG( 21, 26) = 0.445607E+00
- PKER_SACCRG( 21, 27) = 0.416117E+00
- PKER_SACCRG( 21, 28) = 0.395587E+00
- PKER_SACCRG( 21, 29) = 0.377336E+00
- PKER_SACCRG( 21, 30) = 0.359864E+00
- PKER_SACCRG( 21, 31) = 0.348609E+00
- PKER_SACCRG( 21, 32) = 0.341311E+00
- PKER_SACCRG( 21, 33) = 0.335817E+00
- PKER_SACCRG( 21, 34) = 0.334153E+00
- PKER_SACCRG( 21, 35) = 0.330049E+00
- PKER_SACCRG( 21, 36) = 0.322098E+00
+ PKER_SACCRG( 21, 7) = 0.000000E+00
+ PKER_SACCRG( 21, 8) = 0.000000E+00
+ PKER_SACCRG( 21, 9) = 0.000000E+00
+ PKER_SACCRG( 21, 10) = 0.000000E+00
+ PKER_SACCRG( 21, 11) = 0.000000E+00
+ PKER_SACCRG( 21, 12) = 0.000000E+00
+ PKER_SACCRG( 21, 13) = 0.000000E+00
+ PKER_SACCRG( 21, 14) = 0.944456E-08
+ PKER_SACCRG( 21, 15) = 0.743621E-06
+ PKER_SACCRG( 21, 16) = 0.442453E+00
+ PKER_SACCRG( 21, 17) = 0.391188E-01
+ PKER_SACCRG( 21, 18) = 0.365342E-01
+ PKER_SACCRG( 21, 19) = 0.111999E+00
+ PKER_SACCRG( 21, 20) = 0.388643E-01
+ PKER_SACCRG( 21, 21) = 0.848382E-01
+ PKER_SACCRG( 21, 22) = 0.875713E-01
+ PKER_SACCRG( 21, 23) = 0.938496E-01
+ PKER_SACCRG( 21, 24) = 0.107423E+00
+ PKER_SACCRG( 21, 25) = 0.155062E+00
+ PKER_SACCRG( 21, 26) = 0.191831E+00
+ PKER_SACCRG( 21, 27) = 0.256278E+00
+ PKER_SACCRG( 21, 28) = 0.316744E+00
+ PKER_SACCRG( 21, 29) = 0.344380E+00
+ PKER_SACCRG( 21, 30) = 0.357297E+00
+ PKER_SACCRG( 21, 31) = 0.355528E+00
+ PKER_SACCRG( 21, 32) = 0.349787E+00
+ PKER_SACCRG( 21, 33) = 0.344401E+00
+ PKER_SACCRG( 21, 34) = 0.342705E+00
+ PKER_SACCRG( 21, 35) = 0.338523E+00
+ PKER_SACCRG( 21, 36) = 0.330421E+00
PKER_SACCRG( 21, 37) = 0.000000E+00
PKER_SACCRG( 21, 38) = 0.000000E+00
PKER_SACCRG( 21, 39) = 0.000000E+00
@@ -4194,36 +4161,36 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 22, 4) = 0.000000E+00
PKER_SACCRG( 22, 5) = 0.000000E+00
PKER_SACCRG( 22, 6) = 0.000000E+00
- PKER_SACCRG( 22, 7) = 0.966144E-09
- PKER_SACCRG( 22, 8) = 0.797610E+00
- PKER_SACCRG( 22, 9) = 0.743828E+00
- PKER_SACCRG( 22, 10) = 0.642319E-01
- PKER_SACCRG( 22, 11) = 0.780419E+00
- PKER_SACCRG( 22, 12) = 0.807449E+00
- PKER_SACCRG( 22, 13) = 0.810027E+00
- PKER_SACCRG( 22, 14) = 0.798951E+00
- PKER_SACCRG( 22, 15) = 0.779398E+00
- PKER_SACCRG( 22, 16) = 0.778415E+00
- PKER_SACCRG( 22, 17) = 0.762865E+00
- PKER_SACCRG( 22, 18) = 0.749185E+00
- PKER_SACCRG( 22, 19) = 0.689690E+00
- PKER_SACCRG( 22, 20) = 0.693901E+00
- PKER_SACCRG( 22, 21) = 0.651488E+00
- PKER_SACCRG( 22, 22) = 0.611605E+00
- PKER_SACCRG( 22, 23) = 0.570638E+00
- PKER_SACCRG( 22, 24) = 0.530197E+00
- PKER_SACCRG( 22, 25) = 0.494459E+00
- PKER_SACCRG( 22, 26) = 0.462233E+00
- PKER_SACCRG( 22, 27) = 0.433000E+00
- PKER_SACCRG( 22, 28) = 0.412570E+00
- PKER_SACCRG( 22, 29) = 0.394464E+00
- PKER_SACCRG( 22, 30) = 0.377193E+00
- PKER_SACCRG( 22, 31) = 0.366051E+00
- PKER_SACCRG( 22, 32) = 0.358824E+00
- PKER_SACCRG( 22, 33) = 0.353395E+00
- PKER_SACCRG( 22, 34) = 0.351732E+00
- PKER_SACCRG( 22, 35) = 0.347690E+00
- PKER_SACCRG( 22, 36) = 0.339892E+00
+ PKER_SACCRG( 22, 7) = 0.000000E+00
+ PKER_SACCRG( 22, 8) = 0.000000E+00
+ PKER_SACCRG( 22, 9) = 0.000000E+00
+ PKER_SACCRG( 22, 10) = 0.000000E+00
+ PKER_SACCRG( 22, 11) = 0.000000E+00
+ PKER_SACCRG( 22, 12) = 0.000000E+00
+ PKER_SACCRG( 22, 13) = 0.000000E+00
+ PKER_SACCRG( 22, 14) = 0.000000E+00
+ PKER_SACCRG( 22, 15) = 0.301594E-07
+ PKER_SACCRG( 22, 16) = 0.458593E+00
+ PKER_SACCRG( 22, 17) = 0.425018E+00
+ PKER_SACCRG( 22, 18) = 0.376611E-01
+ PKER_SACCRG( 22, 19) = 0.115562E+00
+ PKER_SACCRG( 22, 20) = 0.101686E+00
+ PKER_SACCRG( 22, 21) = 0.171258E+00
+ PKER_SACCRG( 22, 22) = 0.133854E+00
+ PKER_SACCRG( 22, 23) = 0.170618E+00
+ PKER_SACCRG( 22, 24) = 0.159301E+00
+ PKER_SACCRG( 22, 25) = 0.195009E+00
+ PKER_SACCRG( 22, 26) = 0.229057E+00
+ PKER_SACCRG( 22, 27) = 0.279005E+00
+ PKER_SACCRG( 22, 28) = 0.335986E+00
+ PKER_SACCRG( 22, 29) = 0.360465E+00
+ PKER_SACCRG( 22, 30) = 0.374161E+00
+ PKER_SACCRG( 22, 31) = 0.372873E+00
+ PKER_SACCRG( 22, 32) = 0.367297E+00
+ PKER_SACCRG( 22, 33) = 0.361988E+00
+ PKER_SACCRG( 22, 34) = 0.360293E+00
+ PKER_SACCRG( 22, 35) = 0.356173E+00
+ PKER_SACCRG( 22, 36) = 0.348226E+00
PKER_SACCRG( 22, 37) = 0.000000E+00
PKER_SACCRG( 22, 38) = 0.000000E+00
PKER_SACCRG( 22, 39) = 0.000000E+00
@@ -4235,35 +4202,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 23, 5) = 0.000000E+00
PKER_SACCRG( 23, 6) = 0.000000E+00
PKER_SACCRG( 23, 7) = 0.000000E+00
- PKER_SACCRG( 23, 8) = 0.809950E+00
- PKER_SACCRG( 23, 9) = 0.756206E+00
- PKER_SACCRG( 23, 10) = 0.646488E-01
- PKER_SACCRG( 23, 11) = 0.792804E+00
- PKER_SACCRG( 23, 12) = 0.819823E+00
- PKER_SACCRG( 23, 13) = 0.822406E+00
- PKER_SACCRG( 23, 14) = 0.811343E+00
- PKER_SACCRG( 23, 15) = 0.791813E+00
- PKER_SACCRG( 23, 16) = 0.790844E+00
- PKER_SACCRG( 23, 17) = 0.775323E+00
- PKER_SACCRG( 23, 18) = 0.761683E+00
- PKER_SACCRG( 23, 19) = 0.734770E+00
- PKER_SACCRG( 23, 20) = 0.706539E+00
- PKER_SACCRG( 23, 21) = 0.664171E+00
- PKER_SACCRG( 23, 22) = 0.624455E+00
- PKER_SACCRG( 23, 23) = 0.583644E+00
- PKER_SACCRG( 23, 24) = 0.543394E+00
- PKER_SACCRG( 23, 25) = 0.507808E+00
- PKER_SACCRG( 23, 26) = 0.475738E+00
- PKER_SACCRG( 23, 27) = 0.446677E+00
- PKER_SACCRG( 23, 28) = 0.426302E+00
- PKER_SACCRG( 23, 29) = 0.408285E+00
- PKER_SACCRG( 23, 30) = 0.391148E+00
- PKER_SACCRG( 23, 31) = 0.380079E+00
- PKER_SACCRG( 23, 32) = 0.372897E+00
- PKER_SACCRG( 23, 33) = 0.367509E+00
- PKER_SACCRG( 23, 34) = 0.365844E+00
- PKER_SACCRG( 23, 35) = 0.361844E+00
- PKER_SACCRG( 23, 36) = 0.354155E+00
+ PKER_SACCRG( 23, 8) = 0.000000E+00
+ PKER_SACCRG( 23, 9) = 0.000000E+00
+ PKER_SACCRG( 23, 10) = 0.000000E+00
+ PKER_SACCRG( 23, 11) = 0.000000E+00
+ PKER_SACCRG( 23, 12) = 0.000000E+00
+ PKER_SACCRG( 23, 13) = 0.000000E+00
+ PKER_SACCRG( 23, 14) = 0.000000E+00
+ PKER_SACCRG( 23, 15) = 0.474816E-09
+ PKER_SACCRG( 23, 16) = 0.471716E+00
+ PKER_SACCRG( 23, 17) = 0.438382E+00
+ PKER_SACCRG( 23, 18) = 0.385478E-01
+ PKER_SACCRG( 23, 19) = 0.460661E+00
+ PKER_SACCRG( 23, 20) = 0.104389E+00
+ PKER_SACCRG( 23, 21) = 0.175908E+00
+ PKER_SACCRG( 23, 22) = 0.228218E+00
+ PKER_SACCRG( 23, 23) = 0.262318E+00
+ PKER_SACCRG( 23, 24) = 0.210313E+00
+ PKER_SACCRG( 23, 25) = 0.229302E+00
+ PKER_SACCRG( 23, 26) = 0.277715E+00
+ PKER_SACCRG( 23, 27) = 0.316637E+00
+ PKER_SACCRG( 23, 28) = 0.358767E+00
+ PKER_SACCRG( 23, 29) = 0.376353E+00
+ PKER_SACCRG( 23, 30) = 0.388397E+00
+ PKER_SACCRG( 23, 31) = 0.386871E+00
+ PKER_SACCRG( 23, 32) = 0.381361E+00
+ PKER_SACCRG( 23, 33) = 0.376104E+00
+ PKER_SACCRG( 23, 34) = 0.374406E+00
+ PKER_SACCRG( 23, 35) = 0.370329E+00
+ PKER_SACCRG( 23, 36) = 0.362490E+00
PKER_SACCRG( 23, 37) = 0.000000E+00
PKER_SACCRG( 23, 38) = 0.000000E+00
PKER_SACCRG( 23, 39) = 0.000000E+00
@@ -4275,35 +4242,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 24, 5) = 0.000000E+00
PKER_SACCRG( 24, 6) = 0.000000E+00
PKER_SACCRG( 24, 7) = 0.000000E+00
- PKER_SACCRG( 24, 8) = 0.820142E+00
- PKER_SACCRG( 24, 9) = 0.766421E+00
- PKER_SACCRG( 24, 10) = 0.653914E-01
- PKER_SACCRG( 24, 11) = 0.803028E+00
- PKER_SACCRG( 24, 12) = 0.830041E+00
- PKER_SACCRG( 24, 13) = 0.832627E+00
- PKER_SACCRG( 24, 14) = 0.821575E+00
- PKER_SACCRG( 24, 15) = 0.802060E+00
- PKER_SACCRG( 24, 16) = 0.801102E+00
- PKER_SACCRG( 24, 17) = 0.785603E+00
- PKER_SACCRG( 24, 18) = 0.771992E+00
- PKER_SACCRG( 24, 19) = 0.745123E+00
- PKER_SACCRG( 24, 20) = 0.716949E+00
- PKER_SACCRG( 24, 21) = 0.677488E+00
- PKER_SACCRG( 24, 22) = 0.635018E+00
- PKER_SACCRG( 24, 23) = 0.594312E+00
- PKER_SACCRG( 24, 24) = 0.554195E+00
- PKER_SACCRG( 24, 25) = 0.518710E+00
- PKER_SACCRG( 24, 26) = 0.486743E+00
- PKER_SACCRG( 24, 27) = 0.457793E+00
- PKER_SACCRG( 24, 28) = 0.437444E+00
- PKER_SACCRG( 24, 29) = 0.419480E+00
- PKER_SACCRG( 24, 30) = 0.402426E+00
- PKER_SACCRG( 24, 31) = 0.391400E+00
- PKER_SACCRG( 24, 32) = 0.384242E+00
- PKER_SACCRG( 24, 33) = 0.378879E+00
- PKER_SACCRG( 24, 34) = 0.377210E+00
- PKER_SACCRG( 24, 35) = 0.373238E+00
- PKER_SACCRG( 24, 36) = 0.365620E+00
+ PKER_SACCRG( 24, 8) = 0.000000E+00
+ PKER_SACCRG( 24, 9) = 0.000000E+00
+ PKER_SACCRG( 24, 10) = 0.000000E+00
+ PKER_SACCRG( 24, 11) = 0.000000E+00
+ PKER_SACCRG( 24, 12) = 0.000000E+00
+ PKER_SACCRG( 24, 13) = 0.000000E+00
+ PKER_SACCRG( 24, 14) = 0.000000E+00
+ PKER_SACCRG( 24, 15) = 0.000000E+00
+ PKER_SACCRG( 24, 16) = 0.482421E+00
+ PKER_SACCRG( 24, 17) = 0.449246E+00
+ PKER_SACCRG( 24, 18) = 0.418021E+00
+ PKER_SACCRG( 24, 19) = 0.471528E+00
+ PKER_SACCRG( 24, 20) = 0.106574E+00
+ PKER_SACCRG( 24, 21) = 0.457583E+00
+ PKER_SACCRG( 24, 22) = 0.457441E+00
+ PKER_SACCRG( 24, 23) = 0.268282E+00
+ PKER_SACCRG( 24, 24) = 0.295154E+00
+ PKER_SACCRG( 24, 25) = 0.277246E+00
+ PKER_SACCRG( 24, 26) = 0.318509E+00
+ PKER_SACCRG( 24, 27) = 0.341083E+00
+ PKER_SACCRG( 24, 28) = 0.383566E+00
+ PKER_SACCRG( 24, 29) = 0.393965E+00
+ PKER_SACCRG( 24, 30) = 0.400814E+00
+ PKER_SACCRG( 24, 31) = 0.398325E+00
+ PKER_SACCRG( 24, 32) = 0.392699E+00
+ PKER_SACCRG( 24, 33) = 0.387475E+00
+ PKER_SACCRG( 24, 34) = 0.385773E+00
+ PKER_SACCRG( 24, 35) = 0.381723E+00
+ PKER_SACCRG( 24, 36) = 0.373956E+00
PKER_SACCRG( 24, 37) = 0.000000E+00
PKER_SACCRG( 24, 38) = 0.000000E+00
PKER_SACCRG( 24, 39) = 0.000000E+00
@@ -4315,35 +4282,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 25, 5) = 0.000000E+00
PKER_SACCRG( 25, 6) = 0.000000E+00
PKER_SACCRG( 25, 7) = 0.000000E+00
- PKER_SACCRG( 25, 8) = 0.828562E+00
- PKER_SACCRG( 25, 9) = 0.774858E+00
- PKER_SACCRG( 25, 10) = 0.660824E-01
- PKER_SACCRG( 25, 11) = 0.811473E+00
- PKER_SACCRG( 25, 12) = 0.838483E+00
- PKER_SACCRG( 25, 13) = 0.841072E+00
- PKER_SACCRG( 25, 14) = 0.830027E+00
- PKER_SACCRG( 25, 15) = 0.810523E+00
- PKER_SACCRG( 25, 16) = 0.809573E+00
- PKER_SACCRG( 25, 17) = 0.794090E+00
- PKER_SACCRG( 25, 18) = 0.780501E+00
- PKER_SACCRG( 25, 19) = 0.753664E+00
- PKER_SACCRG( 25, 20) = 0.725532E+00
- PKER_SACCRG( 25, 21) = 0.686127E+00
- PKER_SACCRG( 25, 22) = 0.643712E+00
- PKER_SACCRG( 25, 23) = 0.603078E+00
- PKER_SACCRG( 25, 24) = 0.563054E+00
- PKER_SACCRG( 25, 25) = 0.527636E+00
- PKER_SACCRG( 25, 26) = 0.495736E+00
- PKER_SACCRG( 25, 27) = 0.466859E+00
- PKER_SACCRG( 25, 28) = 0.446518E+00
- PKER_SACCRG( 25, 29) = 0.428582E+00
- PKER_SACCRG( 25, 30) = 0.411579E+00
- PKER_SACCRG( 25, 31) = 0.400576E+00
- PKER_SACCRG( 25, 32) = 0.393431E+00
- PKER_SACCRG( 25, 33) = 0.388081E+00
- PKER_SACCRG( 25, 34) = 0.386408E+00
- PKER_SACCRG( 25, 35) = 0.382451E+00
- PKER_SACCRG( 25, 36) = 0.374880E+00
+ PKER_SACCRG( 25, 8) = 0.000000E+00
+ PKER_SACCRG( 25, 9) = 0.000000E+00
+ PKER_SACCRG( 25, 10) = 0.000000E+00
+ PKER_SACCRG( 25, 11) = 0.000000E+00
+ PKER_SACCRG( 25, 12) = 0.000000E+00
+ PKER_SACCRG( 25, 13) = 0.000000E+00
+ PKER_SACCRG( 25, 14) = 0.000000E+00
+ PKER_SACCRG( 25, 15) = 0.000000E+00
+ PKER_SACCRG( 25, 16) = 0.493305E+00
+ PKER_SACCRG( 25, 17) = 0.460084E+00
+ PKER_SACCRG( 25, 18) = 0.428847E+00
+ PKER_SACCRG( 25, 19) = 0.482480E+00
+ PKER_SACCRG( 25, 20) = 0.457996E+00
+ PKER_SACCRG( 25, 21) = 0.468489E+00
+ PKER_SACCRG( 25, 22) = 0.468385E+00
+ PKER_SACCRG( 25, 23) = 0.465913E+00
+ PKER_SACCRG( 25, 24) = 0.302045E+00
+ PKER_SACCRG( 25, 25) = 0.349681E+00
+ PKER_SACCRG( 25, 26) = 0.375849E+00
+ PKER_SACCRG( 25, 27) = 0.372009E+00
+ PKER_SACCRG( 25, 28) = 0.404973E+00
+ PKER_SACCRG( 25, 29) = 0.408427E+00
+ PKER_SACCRG( 25, 30) = 0.413563E+00
+ PKER_SACCRG( 25, 31) = 0.409638E+00
+ PKER_SACCRG( 25, 32) = 0.403614E+00
+ PKER_SACCRG( 25, 33) = 0.398367E+00
+ PKER_SACCRG( 25, 34) = 0.396652E+00
+ PKER_SACCRG( 25, 35) = 0.392598E+00
+ PKER_SACCRG( 25, 36) = 0.384841E+00
PKER_SACCRG( 25, 37) = 0.000000E+00
PKER_SACCRG( 25, 38) = 0.000000E+00
PKER_SACCRG( 25, 39) = 0.000000E+00
@@ -4355,35 +4322,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 26, 5) = 0.000000E+00
PKER_SACCRG( 26, 6) = 0.000000E+00
PKER_SACCRG( 26, 7) = 0.000000E+00
- PKER_SACCRG( 26, 8) = 0.835522E+00
- PKER_SACCRG( 26, 9) = 0.781829E+00
- PKER_SACCRG( 26, 10) = 0.666630E-01
- PKER_SACCRG( 26, 11) = 0.818452E+00
- PKER_SACCRG( 26, 12) = 0.845460E+00
- PKER_SACCRG( 26, 13) = 0.848051E+00
- PKER_SACCRG( 26, 14) = 0.837011E+00
- PKER_SACCRG( 26, 15) = 0.817515E+00
- PKER_SACCRG( 26, 16) = 0.816572E+00
- PKER_SACCRG( 26, 17) = 0.801101E+00
- PKER_SACCRG( 26, 18) = 0.787528E+00
- PKER_SACCRG( 26, 19) = 0.760715E+00
- PKER_SACCRG( 26, 20) = 0.732614E+00
- PKER_SACCRG( 26, 21) = 0.693249E+00
- PKER_SACCRG( 26, 22) = 0.650875E+00
- PKER_SACCRG( 26, 23) = 0.610290E+00
- PKER_SACCRG( 26, 24) = 0.570332E+00
- PKER_SACCRG( 26, 25) = 0.534960E+00
- PKER_SACCRG( 26, 26) = 0.503102E+00
- PKER_SACCRG( 26, 27) = 0.474272E+00
- PKER_SACCRG( 26, 28) = 0.453930E+00
- PKER_SACCRG( 26, 29) = 0.436008E+00
- PKER_SACCRG( 26, 30) = 0.419035E+00
- PKER_SACCRG( 26, 31) = 0.408042E+00
- PKER_SACCRG( 26, 32) = 0.400902E+00
- PKER_SACCRG( 26, 33) = 0.395559E+00
- PKER_SACCRG( 26, 34) = 0.393881E+00
- PKER_SACCRG( 26, 35) = 0.389934E+00
- PKER_SACCRG( 26, 36) = 0.382393E+00
+ PKER_SACCRG( 26, 8) = 0.000000E+00
+ PKER_SACCRG( 26, 9) = 0.000000E+00
+ PKER_SACCRG( 26, 10) = 0.000000E+00
+ PKER_SACCRG( 26, 11) = 0.000000E+00
+ PKER_SACCRG( 26, 12) = 0.000000E+00
+ PKER_SACCRG( 26, 13) = 0.000000E+00
+ PKER_SACCRG( 26, 14) = 0.000000E+00
+ PKER_SACCRG( 26, 15) = 0.000000E+00
+ PKER_SACCRG( 26, 16) = 0.498360E+00
+ PKER_SACCRG( 26, 17) = 0.465358E+00
+ PKER_SACCRG( 26, 18) = 0.434351E+00
+ PKER_SACCRG( 26, 19) = 0.487671E+00
+ PKER_SACCRG( 26, 20) = 0.463284E+00
+ PKER_SACCRG( 26, 21) = 0.473752E+00
+ PKER_SACCRG( 26, 22) = 0.473679E+00
+ PKER_SACCRG( 26, 23) = 0.471200E+00
+ PKER_SACCRG( 26, 24) = 0.305321E+00
+ PKER_SACCRG( 26, 25) = 0.460272E+00
+ PKER_SACCRG( 26, 26) = 0.380186E+00
+ PKER_SACCRG( 26, 27) = 0.407235E+00
+ PKER_SACCRG( 26, 28) = 0.425703E+00
+ PKER_SACCRG( 26, 29) = 0.419464E+00
+ PKER_SACCRG( 26, 30) = 0.420713E+00
+ PKER_SACCRG( 26, 31) = 0.415965E+00
+ PKER_SACCRG( 26, 32) = 0.409433E+00
+ PKER_SACCRG( 26, 33) = 0.404156E+00
+ PKER_SACCRG( 26, 34) = 0.402444E+00
+ PKER_SACCRG( 26, 35) = 0.398420E+00
+ PKER_SACCRG( 26, 36) = 0.390729E+00
PKER_SACCRG( 26, 37) = 0.000000E+00
PKER_SACCRG( 26, 38) = 0.000000E+00
PKER_SACCRG( 26, 39) = 0.000000E+00
@@ -4395,35 +4362,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 27, 5) = 0.000000E+00
PKER_SACCRG( 27, 6) = 0.000000E+00
PKER_SACCRG( 27, 7) = 0.000000E+00
- PKER_SACCRG( 27, 8) = 0.841277E+00
- PKER_SACCRG( 27, 9) = 0.787591E+00
- PKER_SACCRG( 27, 10) = 0.737216E+00
- PKER_SACCRG( 27, 11) = 0.824221E+00
- PKER_SACCRG( 27, 12) = 0.851228E+00
- PKER_SACCRG( 27, 13) = 0.853821E+00
- PKER_SACCRG( 27, 14) = 0.842785E+00
- PKER_SACCRG( 27, 15) = 0.823295E+00
- PKER_SACCRG( 27, 16) = 0.822357E+00
- PKER_SACCRG( 27, 17) = 0.806894E+00
- PKER_SACCRG( 27, 18) = 0.793334E+00
- PKER_SACCRG( 27, 19) = 0.766539E+00
- PKER_SACCRG( 27, 20) = 0.738460E+00
- PKER_SACCRG( 27, 21) = 0.699126E+00
- PKER_SACCRG( 27, 22) = 0.656782E+00
- PKER_SACCRG( 27, 23) = 0.616230E+00
- PKER_SACCRG( 27, 24) = 0.576319E+00
- PKER_SACCRG( 27, 25) = 0.540977E+00
- PKER_SACCRG( 27, 26) = 0.509148E+00
- PKER_SACCRG( 27, 27) = 0.480347E+00
- PKER_SACCRG( 27, 28) = 0.460000E+00
- PKER_SACCRG( 27, 29) = 0.442082E+00
- PKER_SACCRG( 27, 30) = 0.425126E+00
- PKER_SACCRG( 27, 31) = 0.414137E+00
- PKER_SACCRG( 27, 32) = 0.406997E+00
- PKER_SACCRG( 27, 33) = 0.401657E+00
- PKER_SACCRG( 27, 34) = 0.399974E+00
- PKER_SACCRG( 27, 35) = 0.396033E+00
- PKER_SACCRG( 27, 36) = 0.388511E+00
+ PKER_SACCRG( 27, 8) = 0.000000E+00
+ PKER_SACCRG( 27, 9) = 0.000000E+00
+ PKER_SACCRG( 27, 10) = 0.000000E+00
+ PKER_SACCRG( 27, 11) = 0.000000E+00
+ PKER_SACCRG( 27, 12) = 0.000000E+00
+ PKER_SACCRG( 27, 13) = 0.000000E+00
+ PKER_SACCRG( 27, 14) = 0.000000E+00
+ PKER_SACCRG( 27, 15) = 0.000000E+00
+ PKER_SACCRG( 27, 16) = 0.504260E+00
+ PKER_SACCRG( 27, 17) = 0.471302E+00
+ PKER_SACCRG( 27, 18) = 0.440353E+00
+ PKER_SACCRG( 27, 19) = 0.493636E+00
+ PKER_SACCRG( 27, 20) = 0.469232E+00
+ PKER_SACCRG( 27, 21) = 0.479719E+00
+ PKER_SACCRG( 27, 22) = 0.479669E+00
+ PKER_SACCRG( 27, 23) = 0.477177E+00
+ PKER_SACCRG( 27, 24) = 0.464189E+00
+ PKER_SACCRG( 27, 25) = 0.466286E+00
+ PKER_SACCRG( 27, 26) = 0.385058E+00
+ PKER_SACCRG( 27, 27) = 0.412596E+00
+ PKER_SACCRG( 27, 28) = 0.452611E+00
+ PKER_SACCRG( 27, 29) = 0.433046E+00
+ PKER_SACCRG( 27, 30) = 0.428880E+00
+ PKER_SACCRG( 27, 31) = 0.422050E+00
+ PKER_SACCRG( 27, 32) = 0.415579E+00
+ PKER_SACCRG( 27, 33) = 0.410255E+00
+ PKER_SACCRG( 27, 34) = 0.408538E+00
+ PKER_SACCRG( 27, 35) = 0.404518E+00
+ PKER_SACCRG( 27, 36) = 0.396847E+00
PKER_SACCRG( 27, 37) = 0.000000E+00
PKER_SACCRG( 27, 38) = 0.000000E+00
PKER_SACCRG( 27, 39) = 0.000000E+00
@@ -4435,35 +4402,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 28, 5) = 0.000000E+00
PKER_SACCRG( 28, 6) = 0.000000E+00
PKER_SACCRG( 28, 7) = 0.000000E+00
- PKER_SACCRG( 28, 8) = 0.846037E+00
- PKER_SACCRG( 28, 9) = 0.792355E+00
- PKER_SACCRG( 28, 10) = 0.741987E+00
- PKER_SACCRG( 28, 11) = 0.828991E+00
- PKER_SACCRG( 28, 12) = 0.855999E+00
- PKER_SACCRG( 28, 13) = 0.858593E+00
- PKER_SACCRG( 28, 14) = 0.847560E+00
- PKER_SACCRG( 28, 15) = 0.828074E+00
- PKER_SACCRG( 28, 16) = 0.827139E+00
- PKER_SACCRG( 28, 17) = 0.811684E+00
- PKER_SACCRG( 28, 18) = 0.798132E+00
- PKER_SACCRG( 28, 19) = 0.771351E+00
- PKER_SACCRG( 28, 20) = 0.743290E+00
- PKER_SACCRG( 28, 21) = 0.703977E+00
- PKER_SACCRG( 28, 22) = 0.661655E+00
- PKER_SACCRG( 28, 23) = 0.621127E+00
- PKER_SACCRG( 28, 24) = 0.581251E+00
- PKER_SACCRG( 28, 25) = 0.545929E+00
- PKER_SACCRG( 28, 26) = 0.514118E+00
- PKER_SACCRG( 28, 27) = 0.485336E+00
- PKER_SACCRG( 28, 28) = 0.464980E+00
- PKER_SACCRG( 28, 29) = 0.447062E+00
- PKER_SACCRG( 28, 30) = 0.430115E+00
- PKER_SACCRG( 28, 31) = 0.419126E+00
- PKER_SACCRG( 28, 32) = 0.411984E+00
- PKER_SACCRG( 28, 33) = 0.406644E+00
- PKER_SACCRG( 28, 34) = 0.404957E+00
- PKER_SACCRG( 28, 35) = 0.401019E+00
- PKER_SACCRG( 28, 36) = 0.393508E+00
+ PKER_SACCRG( 28, 8) = 0.000000E+00
+ PKER_SACCRG( 28, 9) = 0.000000E+00
+ PKER_SACCRG( 28, 10) = 0.000000E+00
+ PKER_SACCRG( 28, 11) = 0.000000E+00
+ PKER_SACCRG( 28, 12) = 0.000000E+00
+ PKER_SACCRG( 28, 13) = 0.000000E+00
+ PKER_SACCRG( 28, 14) = 0.000000E+00
+ PKER_SACCRG( 28, 15) = 0.000000E+00
+ PKER_SACCRG( 28, 16) = 0.511289E+00
+ PKER_SACCRG( 28, 17) = 0.478218E+00
+ PKER_SACCRG( 28, 18) = 0.447169E+00
+ PKER_SACCRG( 28, 19) = 0.500667E+00
+ PKER_SACCRG( 28, 20) = 0.476141E+00
+ PKER_SACCRG( 28, 21) = 0.486690E+00
+ PKER_SACCRG( 28, 22) = 0.486657E+00
+ PKER_SACCRG( 28, 23) = 0.484143E+00
+ PKER_SACCRG( 28, 24) = 0.471128E+00
+ PKER_SACCRG( 28, 25) = 0.473232E+00
+ PKER_SACCRG( 28, 26) = 0.467330E+00
+ PKER_SACCRG( 28, 27) = 0.462303E+00
+ PKER_SACCRG( 28, 28) = 0.459518E+00
+ PKER_SACCRG( 28, 29) = 0.439730E+00
+ PKER_SACCRG( 28, 30) = 0.435663E+00
+ PKER_SACCRG( 28, 31) = 0.429350E+00
+ PKER_SACCRG( 28, 32) = 0.422348E+00
+ PKER_SACCRG( 28, 33) = 0.417002E+00
+ PKER_SACCRG( 28, 34) = 0.415273E+00
+ PKER_SACCRG( 28, 35) = 0.411238E+00
+ PKER_SACCRG( 28, 36) = 0.403544E+00
PKER_SACCRG( 28, 37) = 0.000000E+00
PKER_SACCRG( 28, 38) = 0.000000E+00
PKER_SACCRG( 28, 39) = 0.000000E+00
@@ -4475,35 +4442,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 29, 5) = 0.000000E+00
PKER_SACCRG( 29, 6) = 0.000000E+00
PKER_SACCRG( 29, 7) = 0.000000E+00
- PKER_SACCRG( 29, 8) = 0.849975E+00
- PKER_SACCRG( 29, 9) = 0.796296E+00
- PKER_SACCRG( 29, 10) = 0.745931E+00
- PKER_SACCRG( 29, 11) = 0.832937E+00
- PKER_SACCRG( 29, 12) = 0.859944E+00
- PKER_SACCRG( 29, 13) = 0.862540E+00
- PKER_SACCRG( 29, 14) = 0.851509E+00
- PKER_SACCRG( 29, 15) = 0.832026E+00
- PKER_SACCRG( 29, 16) = 0.831095E+00
- PKER_SACCRG( 29, 17) = 0.815644E+00
- PKER_SACCRG( 29, 18) = 0.802100E+00
- PKER_SACCRG( 29, 19) = 0.775329E+00
- PKER_SACCRG( 29, 20) = 0.747280E+00
- PKER_SACCRG( 29, 21) = 0.707984E+00
- PKER_SACCRG( 29, 22) = 0.665678E+00
- PKER_SACCRG( 29, 23) = 0.625168E+00
- PKER_SACCRG( 29, 24) = 0.585315E+00
- PKER_SACCRG( 29, 25) = 0.550007E+00
- PKER_SACCRG( 29, 26) = 0.518209E+00
- PKER_SACCRG( 29, 27) = 0.489438E+00
- PKER_SACCRG( 29, 28) = 0.469073E+00
- PKER_SACCRG( 29, 29) = 0.451153E+00
- PKER_SACCRG( 29, 30) = 0.434209E+00
- PKER_SACCRG( 29, 31) = 0.423218E+00
- PKER_SACCRG( 29, 32) = 0.416073E+00
- PKER_SACCRG( 29, 33) = 0.410733E+00
- PKER_SACCRG( 29, 34) = 0.409042E+00
- PKER_SACCRG( 29, 35) = 0.405105E+00
- PKER_SACCRG( 29, 36) = 0.397602E+00
+ PKER_SACCRG( 29, 8) = 0.000000E+00
+ PKER_SACCRG( 29, 9) = 0.000000E+00
+ PKER_SACCRG( 29, 10) = 0.000000E+00
+ PKER_SACCRG( 29, 11) = 0.000000E+00
+ PKER_SACCRG( 29, 12) = 0.000000E+00
+ PKER_SACCRG( 29, 13) = 0.000000E+00
+ PKER_SACCRG( 29, 14) = 0.000000E+00
+ PKER_SACCRG( 29, 15) = 0.000000E+00
+ PKER_SACCRG( 29, 16) = 0.515299E+00
+ PKER_SACCRG( 29, 17) = 0.482248E+00
+ PKER_SACCRG( 29, 18) = 0.451226E+00
+ PKER_SACCRG( 29, 19) = 0.504714E+00
+ PKER_SACCRG( 29, 20) = 0.480173E+00
+ PKER_SACCRG( 29, 21) = 0.490737E+00
+ PKER_SACCRG( 29, 22) = 0.490717E+00
+ PKER_SACCRG( 29, 23) = 0.488194E+00
+ PKER_SACCRG( 29, 24) = 0.475202E+00
+ PKER_SACCRG( 29, 25) = 0.477303E+00
+ PKER_SACCRG( 29, 26) = 0.471406E+00
+ PKER_SACCRG( 29, 27) = 0.466391E+00
+ PKER_SACCRG( 29, 28) = 0.463606E+00
+ PKER_SACCRG( 29, 29) = 0.443703E+00
+ PKER_SACCRG( 29, 30) = 0.442690E+00
+ PKER_SACCRG( 29, 31) = 0.433456E+00
+ PKER_SACCRG( 29, 32) = 0.426527E+00
+ PKER_SACCRG( 29, 33) = 0.421106E+00
+ PKER_SACCRG( 29, 34) = 0.419373E+00
+ PKER_SACCRG( 29, 35) = 0.415340E+00
+ PKER_SACCRG( 29, 36) = 0.407653E+00
PKER_SACCRG( 29, 37) = 0.000000E+00
PKER_SACCRG( 29, 38) = 0.000000E+00
PKER_SACCRG( 29, 39) = 0.000000E+00
@@ -4515,35 +4482,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 30, 5) = 0.000000E+00
PKER_SACCRG( 30, 6) = 0.000000E+00
PKER_SACCRG( 30, 7) = 0.000000E+00
- PKER_SACCRG( 30, 8) = 0.853233E+00
- PKER_SACCRG( 30, 9) = 0.799555E+00
- PKER_SACCRG( 30, 10) = 0.749193E+00
- PKER_SACCRG( 30, 11) = 0.836201E+00
- PKER_SACCRG( 30, 12) = 0.863209E+00
- PKER_SACCRG( 30, 13) = 0.865805E+00
- PKER_SACCRG( 30, 14) = 0.854776E+00
- PKER_SACCRG( 30, 15) = 0.835295E+00
- PKER_SACCRG( 30, 16) = 0.834366E+00
- PKER_SACCRG( 30, 17) = 0.818919E+00
- PKER_SACCRG( 30, 18) = 0.805380E+00
- PKER_SACCRG( 30, 19) = 0.778617E+00
- PKER_SACCRG( 30, 20) = 0.750578E+00
- PKER_SACCRG( 30, 21) = 0.711295E+00
- PKER_SACCRG( 30, 22) = 0.669000E+00
- PKER_SACCRG( 30, 23) = 0.628503E+00
- PKER_SACCRG( 30, 24) = 0.588668E+00
- PKER_SACCRG( 30, 25) = 0.553370E+00
- PKER_SACCRG( 30, 26) = 0.521579E+00
- PKER_SACCRG( 30, 27) = 0.492816E+00
- PKER_SACCRG( 30, 28) = 0.472442E+00
- PKER_SACCRG( 30, 29) = 0.454518E+00
- PKER_SACCRG( 30, 30) = 0.437575E+00
- PKER_SACCRG( 30, 31) = 0.426581E+00
- PKER_SACCRG( 30, 32) = 0.419433E+00
- PKER_SACCRG( 30, 33) = 0.414091E+00
- PKER_SACCRG( 30, 34) = 0.412397E+00
- PKER_SACCRG( 30, 35) = 0.408460E+00
- PKER_SACCRG( 30, 36) = 0.400961E+00
+ PKER_SACCRG( 30, 8) = 0.000000E+00
+ PKER_SACCRG( 30, 9) = 0.000000E+00
+ PKER_SACCRG( 30, 10) = 0.000000E+00
+ PKER_SACCRG( 30, 11) = 0.000000E+00
+ PKER_SACCRG( 30, 12) = 0.000000E+00
+ PKER_SACCRG( 30, 13) = 0.000000E+00
+ PKER_SACCRG( 30, 14) = 0.000000E+00
+ PKER_SACCRG( 30, 15) = 0.000000E+00
+ PKER_SACCRG( 30, 16) = 0.518606E+00
+ PKER_SACCRG( 30, 17) = 0.485568E+00
+ PKER_SACCRG( 30, 18) = 0.454563E+00
+ PKER_SACCRG( 30, 19) = 0.508049E+00
+ PKER_SACCRG( 30, 20) = 0.483494E+00
+ PKER_SACCRG( 30, 21) = 0.494070E+00
+ PKER_SACCRG( 30, 22) = 0.494061E+00
+ PKER_SACCRG( 30, 23) = 0.491531E+00
+ PKER_SACCRG( 30, 24) = 0.478555E+00
+ PKER_SACCRG( 30, 25) = 0.480655E+00
+ PKER_SACCRG( 30, 26) = 0.474762E+00
+ PKER_SACCRG( 30, 27) = 0.469755E+00
+ PKER_SACCRG( 30, 28) = 0.466968E+00
+ PKER_SACCRG( 30, 29) = 0.457637E+00
+ PKER_SACCRG( 30, 30) = 0.446063E+00
+ PKER_SACCRG( 30, 31) = 0.436830E+00
+ PKER_SACCRG( 30, 32) = 0.429899E+00
+ PKER_SACCRG( 30, 33) = 0.424476E+00
+ PKER_SACCRG( 30, 34) = 0.422741E+00
+ PKER_SACCRG( 30, 35) = 0.418708E+00
+ PKER_SACCRG( 30, 36) = 0.411026E+00
PKER_SACCRG( 30, 37) = 0.000000E+00
PKER_SACCRG( 30, 38) = 0.000000E+00
PKER_SACCRG( 30, 39) = 0.000000E+00
@@ -4555,35 +4522,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 31, 5) = 0.000000E+00
PKER_SACCRG( 31, 6) = 0.000000E+00
PKER_SACCRG( 31, 7) = 0.000000E+00
- PKER_SACCRG( 31, 8) = 0.855928E+00
- PKER_SACCRG( 31, 9) = 0.802252E+00
- PKER_SACCRG( 31, 10) = 0.751891E+00
- PKER_SACCRG( 31, 11) = 0.838902E+00
- PKER_SACCRG( 31, 12) = 0.865910E+00
- PKER_SACCRG( 31, 13) = 0.868507E+00
- PKER_SACCRG( 31, 14) = 0.857479E+00
- PKER_SACCRG( 31, 15) = 0.838000E+00
- PKER_SACCRG( 31, 16) = 0.837072E+00
- PKER_SACCRG( 31, 17) = 0.821628E+00
- PKER_SACCRG( 31, 18) = 0.808094E+00
- PKER_SACCRG( 31, 19) = 0.781336E+00
- PKER_SACCRG( 31, 20) = 0.753305E+00
- PKER_SACCRG( 31, 21) = 0.714031E+00
- PKER_SACCRG( 31, 22) = 0.672170E+00
- PKER_SACCRG( 31, 23) = 0.631257E+00
- PKER_SACCRG( 31, 24) = 0.591436E+00
- PKER_SACCRG( 31, 25) = 0.556144E+00
- PKER_SACCRG( 31, 26) = 0.524358E+00
- PKER_SACCRG( 31, 27) = 0.495599E+00
- PKER_SACCRG( 31, 28) = 0.475218E+00
- PKER_SACCRG( 31, 29) = 0.457289E+00
- PKER_SACCRG( 31, 30) = 0.440347E+00
- PKER_SACCRG( 31, 31) = 0.429349E+00
- PKER_SACCRG( 31, 32) = 0.422197E+00
- PKER_SACCRG( 31, 33) = 0.416853E+00
- PKER_SACCRG( 31, 34) = 0.415157E+00
- PKER_SACCRG( 31, 35) = 0.411220E+00
- PKER_SACCRG( 31, 36) = 0.403724E+00
+ PKER_SACCRG( 31, 8) = 0.000000E+00
+ PKER_SACCRG( 31, 9) = 0.000000E+00
+ PKER_SACCRG( 31, 10) = 0.000000E+00
+ PKER_SACCRG( 31, 11) = 0.000000E+00
+ PKER_SACCRG( 31, 12) = 0.000000E+00
+ PKER_SACCRG( 31, 13) = 0.000000E+00
+ PKER_SACCRG( 31, 14) = 0.000000E+00
+ PKER_SACCRG( 31, 15) = 0.000000E+00
+ PKER_SACCRG( 31, 16) = 0.521335E+00
+ PKER_SACCRG( 31, 17) = 0.488306E+00
+ PKER_SACCRG( 31, 18) = 0.457313E+00
+ PKER_SACCRG( 31, 19) = 0.510799E+00
+ PKER_SACCRG( 31, 20) = 0.486233E+00
+ PKER_SACCRG( 31, 21) = 0.496818E+00
+ PKER_SACCRG( 31, 22) = 0.496818E+00
+ PKER_SACCRG( 31, 23) = 0.494282E+00
+ PKER_SACCRG( 31, 24) = 0.481318E+00
+ PKER_SACCRG( 31, 25) = 0.483417E+00
+ PKER_SACCRG( 31, 26) = 0.477526E+00
+ PKER_SACCRG( 31, 27) = 0.472527E+00
+ PKER_SACCRG( 31, 28) = 0.469738E+00
+ PKER_SACCRG( 31, 29) = 0.460409E+00
+ PKER_SACCRG( 31, 30) = 0.448841E+00
+ PKER_SACCRG( 31, 31) = 0.439607E+00
+ PKER_SACCRG( 31, 32) = 0.432673E+00
+ PKER_SACCRG( 31, 33) = 0.427249E+00
+ PKER_SACCRG( 31, 34) = 0.425511E+00
+ PKER_SACCRG( 31, 35) = 0.421478E+00
+ PKER_SACCRG( 31, 36) = 0.413798E+00
PKER_SACCRG( 31, 37) = 0.000000E+00
PKER_SACCRG( 31, 38) = 0.000000E+00
PKER_SACCRG( 31, 39) = 0.000000E+00
@@ -4595,35 +4562,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 32, 5) = 0.000000E+00
PKER_SACCRG( 32, 6) = 0.000000E+00
PKER_SACCRG( 32, 7) = 0.000000E+00
- PKER_SACCRG( 32, 8) = 0.858159E+00
- PKER_SACCRG( 32, 9) = 0.804484E+00
- PKER_SACCRG( 32, 10) = 0.754124E+00
- PKER_SACCRG( 32, 11) = 0.841136E+00
- PKER_SACCRG( 32, 12) = 0.868144E+00
- PKER_SACCRG( 32, 13) = 0.870742E+00
- PKER_SACCRG( 32, 14) = 0.859715E+00
- PKER_SACCRG( 32, 15) = 0.840237E+00
- PKER_SACCRG( 32, 16) = 0.839311E+00
- PKER_SACCRG( 32, 17) = 0.823869E+00
- PKER_SACCRG( 32, 18) = 0.810338E+00
- PKER_SACCRG( 32, 19) = 0.783585E+00
- PKER_SACCRG( 32, 20) = 0.755560E+00
- PKER_SACCRG( 32, 21) = 0.716293E+00
- PKER_SACCRG( 32, 22) = 0.674440E+00
- PKER_SACCRG( 32, 23) = 0.633532E+00
- PKER_SACCRG( 32, 24) = 0.593721E+00
- PKER_SACCRG( 32, 25) = 0.558434E+00
- PKER_SACCRG( 32, 26) = 0.526651E+00
- PKER_SACCRG( 32, 27) = 0.497895E+00
- PKER_SACCRG( 32, 28) = 0.477506E+00
- PKER_SACCRG( 32, 29) = 0.459574E+00
- PKER_SACCRG( 32, 30) = 0.442630E+00
- PKER_SACCRG( 32, 31) = 0.431629E+00
- PKER_SACCRG( 32, 32) = 0.424475E+00
- PKER_SACCRG( 32, 33) = 0.419129E+00
- PKER_SACCRG( 32, 34) = 0.417430E+00
- PKER_SACCRG( 32, 35) = 0.413493E+00
- PKER_SACCRG( 32, 36) = 0.405998E+00
+ PKER_SACCRG( 32, 8) = 0.000000E+00
+ PKER_SACCRG( 32, 9) = 0.000000E+00
+ PKER_SACCRG( 32, 10) = 0.000000E+00
+ PKER_SACCRG( 32, 11) = 0.000000E+00
+ PKER_SACCRG( 32, 12) = 0.000000E+00
+ PKER_SACCRG( 32, 13) = 0.000000E+00
+ PKER_SACCRG( 32, 14) = 0.000000E+00
+ PKER_SACCRG( 32, 15) = 0.000000E+00
+ PKER_SACCRG( 32, 16) = 0.521382E+00
+ PKER_SACCRG( 32, 17) = 0.488500E+00
+ PKER_SACCRG( 32, 18) = 0.457646E+00
+ PKER_SACCRG( 32, 19) = 0.510908E+00
+ PKER_SACCRG( 32, 20) = 0.486436E+00
+ PKER_SACCRG( 32, 21) = 0.496984E+00
+ PKER_SACCRG( 32, 22) = 0.496990E+00
+ PKER_SACCRG( 32, 23) = 0.494461E+00
+ PKER_SACCRG( 32, 24) = 0.481561E+00
+ PKER_SACCRG( 32, 25) = 0.483650E+00
+ PKER_SACCRG( 32, 26) = 0.477787E+00
+ PKER_SACCRG( 32, 27) = 0.472813E+00
+ PKER_SACCRG( 32, 28) = 0.470036E+00
+ PKER_SACCRG( 32, 29) = 0.460747E+00
+ PKER_SACCRG( 32, 30) = 0.449232E+00
+ PKER_SACCRG( 32, 31) = 0.440036E+00
+ PKER_SACCRG( 32, 32) = 0.433130E+00
+ PKER_SACCRG( 32, 33) = 0.427727E+00
+ PKER_SACCRG( 32, 34) = 0.425995E+00
+ PKER_SACCRG( 32, 35) = 0.421979E+00
+ PKER_SACCRG( 32, 36) = 0.414334E+00
PKER_SACCRG( 32, 37) = 0.000000E+00
PKER_SACCRG( 32, 38) = 0.000000E+00
PKER_SACCRG( 32, 39) = 0.000000E+00
@@ -4635,35 +4602,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 33, 5) = 0.000000E+00
PKER_SACCRG( 33, 6) = 0.000000E+00
PKER_SACCRG( 33, 7) = 0.000000E+00
- PKER_SACCRG( 33, 8) = 0.860005E+00
- PKER_SACCRG( 33, 9) = 0.806330E+00
- PKER_SACCRG( 33, 10) = 0.755971E+00
- PKER_SACCRG( 33, 11) = 0.842985E+00
- PKER_SACCRG( 33, 12) = 0.869994E+00
- PKER_SACCRG( 33, 13) = 0.872592E+00
- PKER_SACCRG( 33, 14) = 0.861566E+00
- PKER_SACCRG( 33, 15) = 0.842089E+00
- PKER_SACCRG( 33, 16) = 0.841164E+00
- PKER_SACCRG( 33, 17) = 0.825724E+00
- PKER_SACCRG( 33, 18) = 0.812195E+00
- PKER_SACCRG( 33, 19) = 0.785446E+00
- PKER_SACCRG( 33, 20) = 0.757425E+00
- PKER_SACCRG( 33, 21) = 0.718163E+00
- PKER_SACCRG( 33, 22) = 0.676316E+00
- PKER_SACCRG( 33, 23) = 0.635413E+00
- PKER_SACCRG( 33, 24) = 0.595609E+00
- PKER_SACCRG( 33, 25) = 0.560325E+00
- PKER_SACCRG( 33, 26) = 0.528544E+00
- PKER_SACCRG( 33, 27) = 0.499789E+00
- PKER_SACCRG( 33, 28) = 0.479395E+00
- PKER_SACCRG( 33, 29) = 0.461459E+00
- PKER_SACCRG( 33, 30) = 0.444514E+00
- PKER_SACCRG( 33, 31) = 0.433510E+00
- PKER_SACCRG( 33, 32) = 0.426353E+00
- PKER_SACCRG( 33, 33) = 0.421005E+00
- PKER_SACCRG( 33, 34) = 0.419305E+00
- PKER_SACCRG( 33, 35) = 0.415367E+00
- PKER_SACCRG( 33, 36) = 0.407873E+00
+ PKER_SACCRG( 33, 8) = 0.000000E+00
+ PKER_SACCRG( 33, 9) = 0.000000E+00
+ PKER_SACCRG( 33, 10) = 0.000000E+00
+ PKER_SACCRG( 33, 11) = 0.000000E+00
+ PKER_SACCRG( 33, 12) = 0.000000E+00
+ PKER_SACCRG( 33, 13) = 0.000000E+00
+ PKER_SACCRG( 33, 14) = 0.000000E+00
+ PKER_SACCRG( 33, 15) = 0.000000E+00
+ PKER_SACCRG( 33, 16) = 0.523239E+00
+ PKER_SACCRG( 33, 17) = 0.490361E+00
+ PKER_SACCRG( 33, 18) = 0.459511E+00
+ PKER_SACCRG( 33, 19) = 0.512778E+00
+ PKER_SACCRG( 33, 20) = 0.488297E+00
+ PKER_SACCRG( 33, 21) = 0.498852E+00
+ PKER_SACCRG( 33, 22) = 0.498864E+00
+ PKER_SACCRG( 33, 23) = 0.496331E+00
+ PKER_SACCRG( 33, 24) = 0.483437E+00
+ PKER_SACCRG( 33, 25) = 0.485525E+00
+ PKER_SACCRG( 33, 26) = 0.479663E+00
+ PKER_SACCRG( 33, 27) = 0.474693E+00
+ PKER_SACCRG( 33, 28) = 0.471915E+00
+ PKER_SACCRG( 33, 29) = 0.462627E+00
+ PKER_SACCRG( 33, 30) = 0.451113E+00
+ PKER_SACCRG( 33, 31) = 0.441917E+00
+ PKER_SACCRG( 33, 32) = 0.435008E+00
+ PKER_SACCRG( 33, 33) = 0.429604E+00
+ PKER_SACCRG( 33, 34) = 0.427870E+00
+ PKER_SACCRG( 33, 35) = 0.423853E+00
+ PKER_SACCRG( 33, 36) = 0.416209E+00
PKER_SACCRG( 33, 37) = 0.000000E+00
PKER_SACCRG( 33, 38) = 0.000000E+00
PKER_SACCRG( 33, 39) = 0.000000E+00
@@ -4675,35 +4642,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 34, 5) = 0.000000E+00
PKER_SACCRG( 34, 6) = 0.000000E+00
PKER_SACCRG( 34, 7) = 0.000000E+00
- PKER_SACCRG( 34, 8) = 0.861533E+00
- PKER_SACCRG( 34, 9) = 0.807859E+00
- PKER_SACCRG( 34, 10) = 0.757500E+00
- PKER_SACCRG( 34, 11) = 0.844515E+00
- PKER_SACCRG( 34, 12) = 0.871524E+00
- PKER_SACCRG( 34, 13) = 0.874123E+00
- PKER_SACCRG( 34, 14) = 0.863097E+00
- PKER_SACCRG( 34, 15) = 0.843621E+00
- PKER_SACCRG( 34, 16) = 0.842697E+00
- PKER_SACCRG( 34, 17) = 0.827258E+00
- PKER_SACCRG( 34, 18) = 0.813732E+00
- PKER_SACCRG( 34, 19) = 0.786985E+00
- PKER_SACCRG( 34, 20) = 0.758967E+00
- PKER_SACCRG( 34, 21) = 0.719710E+00
- PKER_SACCRG( 34, 22) = 0.677867E+00
- PKER_SACCRG( 34, 23) = 0.636967E+00
- PKER_SACCRG( 34, 24) = 0.597169E+00
- PKER_SACCRG( 34, 25) = 0.561887E+00
- PKER_SACCRG( 34, 26) = 0.530107E+00
- PKER_SACCRG( 34, 27) = 0.501353E+00
- PKER_SACCRG( 34, 28) = 0.480954E+00
- PKER_SACCRG( 34, 29) = 0.463015E+00
- PKER_SACCRG( 34, 30) = 0.446068E+00
- PKER_SACCRG( 34, 31) = 0.435062E+00
- PKER_SACCRG( 34, 32) = 0.427902E+00
- PKER_SACCRG( 34, 33) = 0.422553E+00
- PKER_SACCRG( 34, 34) = 0.420852E+00
- PKER_SACCRG( 34, 35) = 0.416913E+00
- PKER_SACCRG( 34, 36) = 0.409420E+00
+ PKER_SACCRG( 34, 8) = 0.000000E+00
+ PKER_SACCRG( 34, 9) = 0.000000E+00
+ PKER_SACCRG( 34, 10) = 0.000000E+00
+ PKER_SACCRG( 34, 11) = 0.000000E+00
+ PKER_SACCRG( 34, 12) = 0.000000E+00
+ PKER_SACCRG( 34, 13) = 0.000000E+00
+ PKER_SACCRG( 34, 14) = 0.000000E+00
+ PKER_SACCRG( 34, 15) = 0.000000E+00
+ PKER_SACCRG( 34, 16) = 0.526989E+00
+ PKER_SACCRG( 34, 17) = 0.493974E+00
+ PKER_SACCRG( 34, 18) = 0.462996E+00
+ PKER_SACCRG( 34, 19) = 0.516493E+00
+ PKER_SACCRG( 34, 20) = 0.491901E+00
+ PKER_SACCRG( 34, 21) = 0.502507E+00
+ PKER_SACCRG( 34, 22) = 0.502522E+00
+ PKER_SACCRG( 34, 23) = 0.499975E+00
+ PKER_SACCRG( 34, 24) = 0.487032E+00
+ PKER_SACCRG( 34, 25) = 0.489128E+00
+ PKER_SACCRG( 34, 26) = 0.483242E+00
+ PKER_SACCRG( 34, 27) = 0.478253E+00
+ PKER_SACCRG( 34, 28) = 0.475463E+00
+ PKER_SACCRG( 34, 29) = 0.466135E+00
+ PKER_SACCRG( 34, 30) = 0.454574E+00
+ PKER_SACCRG( 34, 31) = 0.445337E+00
+ PKER_SACCRG( 34, 32) = 0.438397E+00
+ PKER_SACCRG( 34, 33) = 0.432968E+00
+ PKER_SACCRG( 34, 34) = 0.431225E+00
+ PKER_SACCRG( 34, 35) = 0.427191E+00
+ PKER_SACCRG( 34, 36) = 0.419515E+00
PKER_SACCRG( 34, 37) = 0.000000E+00
PKER_SACCRG( 34, 38) = 0.000000E+00
PKER_SACCRG( 34, 39) = 0.000000E+00
@@ -4715,35 +4682,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 35, 5) = 0.000000E+00
PKER_SACCRG( 35, 6) = 0.000000E+00
PKER_SACCRG( 35, 7) = 0.000000E+00
- PKER_SACCRG( 35, 8) = 0.862798E+00
- PKER_SACCRG( 35, 9) = 0.809124E+00
- PKER_SACCRG( 35, 10) = 0.758765E+00
- PKER_SACCRG( 35, 11) = 0.845782E+00
- PKER_SACCRG( 35, 12) = 0.872791E+00
- PKER_SACCRG( 35, 13) = 0.875390E+00
- PKER_SACCRG( 35, 14) = 0.864365E+00
- PKER_SACCRG( 35, 15) = 0.844889E+00
- PKER_SACCRG( 35, 16) = 0.843966E+00
- PKER_SACCRG( 35, 17) = 0.828528E+00
- PKER_SACCRG( 35, 18) = 0.815003E+00
- PKER_SACCRG( 35, 19) = 0.788258E+00
- PKER_SACCRG( 35, 20) = 0.760243E+00
- PKER_SACCRG( 35, 21) = 0.720989E+00
- PKER_SACCRG( 35, 22) = 0.679150E+00
- PKER_SACCRG( 35, 23) = 0.638252E+00
- PKER_SACCRG( 35, 24) = 0.598458E+00
- PKER_SACCRG( 35, 25) = 0.563178E+00
- PKER_SACCRG( 35, 26) = 0.531399E+00
- PKER_SACCRG( 35, 27) = 0.502645E+00
- PKER_SACCRG( 35, 28) = 0.482242E+00
- PKER_SACCRG( 35, 29) = 0.464300E+00
- PKER_SACCRG( 35, 30) = 0.447352E+00
- PKER_SACCRG( 35, 31) = 0.436343E+00
- PKER_SACCRG( 35, 32) = 0.429182E+00
- PKER_SACCRG( 35, 33) = 0.423832E+00
- PKER_SACCRG( 35, 34) = 0.422129E+00
- PKER_SACCRG( 35, 35) = 0.418190E+00
- PKER_SACCRG( 35, 36) = 0.410697E+00
+ PKER_SACCRG( 35, 8) = 0.000000E+00
+ PKER_SACCRG( 35, 9) = 0.000000E+00
+ PKER_SACCRG( 35, 10) = 0.000000E+00
+ PKER_SACCRG( 35, 11) = 0.000000E+00
+ PKER_SACCRG( 35, 12) = 0.000000E+00
+ PKER_SACCRG( 35, 13) = 0.000000E+00
+ PKER_SACCRG( 35, 14) = 0.000000E+00
+ PKER_SACCRG( 35, 15) = 0.000000E+00
+ PKER_SACCRG( 35, 16) = 0.526044E+00
+ PKER_SACCRG( 35, 17) = 0.493170E+00
+ PKER_SACCRG( 35, 18) = 0.462325E+00
+ PKER_SACCRG( 35, 19) = 0.515600E+00
+ PKER_SACCRG( 35, 20) = 0.491106E+00
+ PKER_SACCRG( 35, 21) = 0.501671E+00
+ PKER_SACCRG( 35, 22) = 0.501689E+00
+ PKER_SACCRG( 35, 23) = 0.499151E+00
+ PKER_SACCRG( 35, 24) = 0.486266E+00
+ PKER_SACCRG( 35, 25) = 0.488354E+00
+ PKER_SACCRG( 35, 26) = 0.482493E+00
+ PKER_SACCRG( 35, 27) = 0.477528E+00
+ PKER_SACCRG( 35, 28) = 0.474748E+00
+ PKER_SACCRG( 35, 29) = 0.465460E+00
+ PKER_SACCRG( 35, 30) = 0.453949E+00
+ PKER_SACCRG( 35, 31) = 0.444750E+00
+ PKER_SACCRG( 35, 32) = 0.437837E+00
+ PKER_SACCRG( 35, 33) = 0.432431E+00
+ PKER_SACCRG( 35, 34) = 0.430694E+00
+ PKER_SACCRG( 35, 35) = 0.426676E+00
+ PKER_SACCRG( 35, 36) = 0.419033E+00
PKER_SACCRG( 35, 37) = 0.000000E+00
PKER_SACCRG( 35, 38) = 0.000000E+00
PKER_SACCRG( 35, 39) = 0.000000E+00
@@ -4755,35 +4722,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 36, 5) = 0.000000E+00
PKER_SACCRG( 36, 6) = 0.000000E+00
PKER_SACCRG( 36, 7) = 0.000000E+00
- PKER_SACCRG( 36, 8) = 0.863844E+00
- PKER_SACCRG( 36, 9) = 0.810171E+00
- PKER_SACCRG( 36, 10) = 0.759812E+00
- PKER_SACCRG( 36, 11) = 0.846830E+00
- PKER_SACCRG( 36, 12) = 0.873839E+00
- PKER_SACCRG( 36, 13) = 0.876439E+00
- PKER_SACCRG( 36, 14) = 0.865414E+00
- PKER_SACCRG( 36, 15) = 0.845938E+00
- PKER_SACCRG( 36, 16) = 0.845016E+00
- PKER_SACCRG( 36, 17) = 0.829579E+00
- PKER_SACCRG( 36, 18) = 0.816055E+00
- PKER_SACCRG( 36, 19) = 0.789312E+00
- PKER_SACCRG( 36, 20) = 0.761299E+00
- PKER_SACCRG( 36, 21) = 0.722047E+00
- PKER_SACCRG( 36, 22) = 0.680211E+00
- PKER_SACCRG( 36, 23) = 0.639315E+00
- PKER_SACCRG( 36, 24) = 0.599524E+00
- PKER_SACCRG( 36, 25) = 0.564245E+00
- PKER_SACCRG( 36, 26) = 0.532466E+00
- PKER_SACCRG( 36, 27) = 0.503713E+00
- PKER_SACCRG( 36, 28) = 0.483307E+00
- PKER_SACCRG( 36, 29) = 0.465362E+00
- PKER_SACCRG( 36, 30) = 0.448413E+00
- PKER_SACCRG( 36, 31) = 0.437402E+00
- PKER_SACCRG( 36, 32) = 0.430239E+00
- PKER_SACCRG( 36, 33) = 0.424888E+00
- PKER_SACCRG( 36, 34) = 0.423185E+00
- PKER_SACCRG( 36, 35) = 0.419245E+00
- PKER_SACCRG( 36, 36) = 0.411751E+00
+ PKER_SACCRG( 36, 8) = 0.000000E+00
+ PKER_SACCRG( 36, 9) = 0.000000E+00
+ PKER_SACCRG( 36, 10) = 0.000000E+00
+ PKER_SACCRG( 36, 11) = 0.000000E+00
+ PKER_SACCRG( 36, 12) = 0.000000E+00
+ PKER_SACCRG( 36, 13) = 0.000000E+00
+ PKER_SACCRG( 36, 14) = 0.000000E+00
+ PKER_SACCRG( 36, 15) = 0.000000E+00
+ PKER_SACCRG( 36, 16) = 0.527094E+00
+ PKER_SACCRG( 36, 17) = 0.494221E+00
+ PKER_SACCRG( 36, 18) = 0.463377E+00
+ PKER_SACCRG( 36, 19) = 0.516656E+00
+ PKER_SACCRG( 36, 20) = 0.492157E+00
+ PKER_SACCRG( 36, 21) = 0.502726E+00
+ PKER_SACCRG( 36, 22) = 0.502746E+00
+ PKER_SACCRG( 36, 23) = 0.500207E+00
+ PKER_SACCRG( 36, 24) = 0.487324E+00
+ PKER_SACCRG( 36, 25) = 0.489412E+00
+ PKER_SACCRG( 36, 26) = 0.483551E+00
+ PKER_SACCRG( 36, 27) = 0.478587E+00
+ PKER_SACCRG( 36, 28) = 0.475807E+00
+ PKER_SACCRG( 36, 29) = 0.466519E+00
+ PKER_SACCRG( 36, 30) = 0.455008E+00
+ PKER_SACCRG( 36, 31) = 0.445809E+00
+ PKER_SACCRG( 36, 32) = 0.438895E+00
+ PKER_SACCRG( 36, 33) = 0.433487E+00
+ PKER_SACCRG( 36, 34) = 0.431749E+00
+ PKER_SACCRG( 36, 35) = 0.427731E+00
+ PKER_SACCRG( 36, 36) = 0.420087E+00
PKER_SACCRG( 36, 37) = 0.000000E+00
PKER_SACCRG( 36, 38) = 0.000000E+00
PKER_SACCRG( 36, 39) = 0.000000E+00
@@ -4795,35 +4762,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 37, 5) = 0.000000E+00
PKER_SACCRG( 37, 6) = 0.000000E+00
PKER_SACCRG( 37, 7) = 0.000000E+00
- PKER_SACCRG( 37, 8) = 0.864711E+00
- PKER_SACCRG( 37, 9) = 0.811037E+00
- PKER_SACCRG( 37, 10) = 0.760679E+00
- PKER_SACCRG( 37, 11) = 0.847698E+00
- PKER_SACCRG( 37, 12) = 0.874707E+00
- PKER_SACCRG( 37, 13) = 0.877306E+00
- PKER_SACCRG( 37, 14) = 0.866282E+00
- PKER_SACCRG( 37, 15) = 0.846807E+00
- PKER_SACCRG( 37, 16) = 0.845885E+00
- PKER_SACCRG( 37, 17) = 0.830448E+00
- PKER_SACCRG( 37, 18) = 0.816925E+00
- PKER_SACCRG( 37, 19) = 0.790183E+00
- PKER_SACCRG( 37, 20) = 0.762172E+00
- PKER_SACCRG( 37, 21) = 0.722922E+00
- PKER_SACCRG( 37, 22) = 0.681089E+00
- PKER_SACCRG( 37, 23) = 0.640194E+00
- PKER_SACCRG( 37, 24) = 0.600405E+00
- PKER_SACCRG( 37, 25) = 0.565127E+00
- PKER_SACCRG( 37, 26) = 0.533348E+00
- PKER_SACCRG( 37, 27) = 0.504595E+00
- PKER_SACCRG( 37, 28) = 0.484186E+00
- PKER_SACCRG( 37, 29) = 0.466240E+00
- PKER_SACCRG( 37, 30) = 0.449290E+00
- PKER_SACCRG( 37, 31) = 0.438277E+00
- PKER_SACCRG( 37, 32) = 0.431113E+00
- PKER_SACCRG( 37, 33) = 0.425761E+00
- PKER_SACCRG( 37, 34) = 0.424057E+00
- PKER_SACCRG( 37, 35) = 0.420117E+00
- PKER_SACCRG( 37, 36) = 0.412623E+00
+ PKER_SACCRG( 37, 8) = 0.000000E+00
+ PKER_SACCRG( 37, 9) = 0.000000E+00
+ PKER_SACCRG( 37, 10) = 0.000000E+00
+ PKER_SACCRG( 37, 11) = 0.000000E+00
+ PKER_SACCRG( 37, 12) = 0.000000E+00
+ PKER_SACCRG( 37, 13) = 0.000000E+00
+ PKER_SACCRG( 37, 14) = 0.000000E+00
+ PKER_SACCRG( 37, 15) = 0.000000E+00
+ PKER_SACCRG( 37, 16) = 0.527963E+00
+ PKER_SACCRG( 37, 17) = 0.495090E+00
+ PKER_SACCRG( 37, 18) = 0.464247E+00
+ PKER_SACCRG( 37, 19) = 0.517529E+00
+ PKER_SACCRG( 37, 20) = 0.493026E+00
+ PKER_SACCRG( 37, 21) = 0.503598E+00
+ PKER_SACCRG( 37, 22) = 0.503620E+00
+ PKER_SACCRG( 37, 23) = 0.501079E+00
+ PKER_SACCRG( 37, 24) = 0.488199E+00
+ PKER_SACCRG( 37, 25) = 0.490286E+00
+ PKER_SACCRG( 37, 26) = 0.484426E+00
+ PKER_SACCRG( 37, 27) = 0.479463E+00
+ PKER_SACCRG( 37, 28) = 0.476683E+00
+ PKER_SACCRG( 37, 29) = 0.467394E+00
+ PKER_SACCRG( 37, 30) = 0.455884E+00
+ PKER_SACCRG( 37, 31) = 0.446684E+00
+ PKER_SACCRG( 37, 32) = 0.439768E+00
+ PKER_SACCRG( 37, 33) = 0.434360E+00
+ PKER_SACCRG( 37, 34) = 0.432621E+00
+ PKER_SACCRG( 37, 35) = 0.428603E+00
+ PKER_SACCRG( 37, 36) = 0.420959E+00
PKER_SACCRG( 37, 37) = 0.000000E+00
PKER_SACCRG( 37, 38) = 0.000000E+00
PKER_SACCRG( 37, 39) = 0.000000E+00
@@ -4835,35 +4802,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 38, 5) = 0.000000E+00
PKER_SACCRG( 38, 6) = 0.000000E+00
PKER_SACCRG( 38, 7) = 0.000000E+00
- PKER_SACCRG( 38, 8) = 0.869064E+00
- PKER_SACCRG( 38, 9) = 0.815165E+00
- PKER_SACCRG( 38, 10) = 0.764596E+00
- PKER_SACCRG( 38, 11) = 0.851980E+00
- PKER_SACCRG( 38, 12) = 0.879103E+00
- PKER_SACCRG( 38, 13) = 0.881713E+00
- PKER_SACCRG( 38, 14) = 0.870642E+00
- PKER_SACCRG( 38, 15) = 0.851086E+00
- PKER_SACCRG( 38, 16) = 0.850161E+00
- PKER_SACCRG( 38, 17) = 0.834660E+00
- PKER_SACCRG( 38, 18) = 0.821081E+00
- PKER_SACCRG( 38, 19) = 0.794228E+00
- PKER_SACCRG( 38, 20) = 0.766101E+00
- PKER_SACCRG( 38, 21) = 0.726688E+00
- PKER_SACCRG( 38, 22) = 0.684680E+00
- PKER_SACCRG( 38, 23) = 0.643615E+00
- PKER_SACCRG( 38, 24) = 0.603661E+00
- PKER_SACCRG( 38, 25) = 0.568235E+00
- PKER_SACCRG( 38, 26) = 0.536323E+00
- PKER_SACCRG( 38, 27) = 0.507449E+00
- PKER_SACCRG( 38, 28) = 0.486952E+00
- PKER_SACCRG( 38, 29) = 0.468929E+00
- PKER_SACCRG( 38, 30) = 0.451906E+00
- PKER_SACCRG( 38, 31) = 0.440846E+00
- PKER_SACCRG( 38, 32) = 0.433651E+00
- PKER_SACCRG( 38, 33) = 0.428275E+00
- PKER_SACCRG( 38, 34) = 0.426563E+00
- PKER_SACCRG( 38, 35) = 0.422606E+00
- PKER_SACCRG( 38, 36) = 0.415081E+00
+ PKER_SACCRG( 38, 8) = 0.000000E+00
+ PKER_SACCRG( 38, 9) = 0.000000E+00
+ PKER_SACCRG( 38, 10) = 0.000000E+00
+ PKER_SACCRG( 38, 11) = 0.000000E+00
+ PKER_SACCRG( 38, 12) = 0.000000E+00
+ PKER_SACCRG( 38, 13) = 0.000000E+00
+ PKER_SACCRG( 38, 14) = 0.000000E+00
+ PKER_SACCRG( 38, 15) = 0.000000E+00
+ PKER_SACCRG( 38, 16) = 0.530904E+00
+ PKER_SACCRG( 38, 17) = 0.497893E+00
+ PKER_SACCRG( 38, 18) = 0.466921E+00
+ PKER_SACCRG( 38, 19) = 0.520430E+00
+ PKER_SACCRG( 38, 20) = 0.495821E+00
+ PKER_SACCRG( 38, 21) = 0.506439E+00
+ PKER_SACCRG( 38, 22) = 0.506463E+00
+ PKER_SACCRG( 38, 23) = 0.503910E+00
+ PKER_SACCRG( 38, 24) = 0.490978E+00
+ PKER_SACCRG( 38, 25) = 0.493073E+00
+ PKER_SACCRG( 38, 26) = 0.487189E+00
+ PKER_SACCRG( 38, 27) = 0.482206E+00
+ PKER_SACCRG( 38, 28) = 0.479414E+00
+ PKER_SACCRG( 38, 29) = 0.470086E+00
+ PKER_SACCRG( 38, 30) = 0.458527E+00
+ PKER_SACCRG( 38, 31) = 0.449287E+00
+ PKER_SACCRG( 38, 32) = 0.442342E+00
+ PKER_SACCRG( 38, 33) = 0.436910E+00
+ PKER_SACCRG( 38, 34) = 0.435164E+00
+ PKER_SACCRG( 38, 35) = 0.431128E+00
+ PKER_SACCRG( 38, 36) = 0.423452E+00
PKER_SACCRG( 38, 37) = 0.000000E+00
PKER_SACCRG( 38, 38) = 0.000000E+00
PKER_SACCRG( 38, 39) = 0.000000E+00
@@ -4875,35 +4842,35 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 39, 5) = 0.000000E+00
PKER_SACCRG( 39, 6) = 0.000000E+00
PKER_SACCRG( 39, 7) = 0.000000E+00
- PKER_SACCRG( 39, 8) = 0.866022E+00
- PKER_SACCRG( 39, 9) = 0.812348E+00
- PKER_SACCRG( 39, 10) = 0.761990E+00
- PKER_SACCRG( 39, 11) = 0.849010E+00
- PKER_SACCRG( 39, 12) = 0.876020E+00
- PKER_SACCRG( 39, 13) = 0.878620E+00
- PKER_SACCRG( 39, 14) = 0.867595E+00
- PKER_SACCRG( 39, 15) = 0.848121E+00
- PKER_SACCRG( 39, 16) = 0.847199E+00
- PKER_SACCRG( 39, 17) = 0.831764E+00
- PKER_SACCRG( 39, 18) = 0.818242E+00
- PKER_SACCRG( 39, 19) = 0.791502E+00
- PKER_SACCRG( 39, 20) = 0.763493E+00
- PKER_SACCRG( 39, 21) = 0.724246E+00
- PKER_SACCRG( 39, 22) = 0.682415E+00
- PKER_SACCRG( 39, 23) = 0.641522E+00
- PKER_SACCRG( 39, 24) = 0.601737E+00
- PKER_SACCRG( 39, 25) = 0.566459E+00
- PKER_SACCRG( 39, 26) = 0.534681E+00
- PKER_SACCRG( 39, 27) = 0.505928E+00
- PKER_SACCRG( 39, 28) = 0.485515E+00
- PKER_SACCRG( 39, 29) = 0.467566E+00
- PKER_SACCRG( 39, 30) = 0.450614E+00
- PKER_SACCRG( 39, 31) = 0.439599E+00
- PKER_SACCRG( 39, 32) = 0.432433E+00
- PKER_SACCRG( 39, 33) = 0.427080E+00
- PKER_SACCRG( 39, 34) = 0.425374E+00
- PKER_SACCRG( 39, 35) = 0.421434E+00
- PKER_SACCRG( 39, 36) = 0.413940E+00
+ PKER_SACCRG( 39, 8) = 0.000000E+00
+ PKER_SACCRG( 39, 9) = 0.000000E+00
+ PKER_SACCRG( 39, 10) = 0.000000E+00
+ PKER_SACCRG( 39, 11) = 0.000000E+00
+ PKER_SACCRG( 39, 12) = 0.000000E+00
+ PKER_SACCRG( 39, 13) = 0.000000E+00
+ PKER_SACCRG( 39, 14) = 0.000000E+00
+ PKER_SACCRG( 39, 15) = 0.000000E+00
+ PKER_SACCRG( 39, 16) = 0.531500E+00
+ PKER_SACCRG( 39, 17) = 0.498490E+00
+ PKER_SACCRG( 39, 18) = 0.467518E+00
+ PKER_SACCRG( 39, 19) = 0.521029E+00
+ PKER_SACCRG( 39, 20) = 0.496417E+00
+ PKER_SACCRG( 39, 21) = 0.507037E+00
+ PKER_SACCRG( 39, 22) = 0.507063E+00
+ PKER_SACCRG( 39, 23) = 0.504509E+00
+ PKER_SACCRG( 39, 24) = 0.491577E+00
+ PKER_SACCRG( 39, 25) = 0.493673E+00
+ PKER_SACCRG( 39, 26) = 0.487788E+00
+ PKER_SACCRG( 39, 27) = 0.482807E+00
+ PKER_SACCRG( 39, 28) = 0.480014E+00
+ PKER_SACCRG( 39, 29) = 0.470686E+00
+ PKER_SACCRG( 39, 30) = 0.459128E+00
+ PKER_SACCRG( 39, 31) = 0.449887E+00
+ PKER_SACCRG( 39, 32) = 0.442941E+00
+ PKER_SACCRG( 39, 33) = 0.437508E+00
+ PKER_SACCRG( 39, 34) = 0.435762E+00
+ PKER_SACCRG( 39, 35) = 0.431726E+00
+ PKER_SACCRG( 39, 36) = 0.424049E+00
PKER_SACCRG( 39, 37) = 0.000000E+00
PKER_SACCRG( 39, 38) = 0.000000E+00
PKER_SACCRG( 39, 39) = 0.000000E+00
@@ -4915,39 +4882,41 @@ IF( PRESENT(PKER_SACCRG) ) THEN
PKER_SACCRG( 40, 5) = 0.000000E+00
PKER_SACCRG( 40, 6) = 0.000000E+00
PKER_SACCRG( 40, 7) = 0.000000E+00
- PKER_SACCRG( 40, 8) = 0.866514E+00
- PKER_SACCRG( 40, 9) = 0.812840E+00
- PKER_SACCRG( 40, 10) = 0.762482E+00
- PKER_SACCRG( 40, 11) = 0.849502E+00
- PKER_SACCRG( 40, 12) = 0.876512E+00
- PKER_SACCRG( 40, 13) = 0.879112E+00
- PKER_SACCRG( 40, 14) = 0.868087E+00
- PKER_SACCRG( 40, 15) = 0.848613E+00
- PKER_SACCRG( 40, 16) = 0.847692E+00
- PKER_SACCRG( 40, 17) = 0.832257E+00
- PKER_SACCRG( 40, 18) = 0.818736E+00
- PKER_SACCRG( 40, 19) = 0.791996E+00
- PKER_SACCRG( 40, 20) = 0.763988E+00
- PKER_SACCRG( 40, 21) = 0.724741E+00
- PKER_SACCRG( 40, 22) = 0.682912E+00
- PKER_SACCRG( 40, 23) = 0.642019E+00
- PKER_SACCRG( 40, 24) = 0.602235E+00
- PKER_SACCRG( 40, 25) = 0.566958E+00
- PKER_SACCRG( 40, 26) = 0.535180E+00
- PKER_SACCRG( 40, 27) = 0.506427E+00
- PKER_SACCRG( 40, 28) = 0.486012E+00
- PKER_SACCRG( 40, 29) = 0.468062E+00
- PKER_SACCRG( 40, 30) = 0.451110E+00
- PKER_SACCRG( 40, 31) = 0.440094E+00
- PKER_SACCRG( 40, 32) = 0.432927E+00
- PKER_SACCRG( 40, 33) = 0.427573E+00
- PKER_SACCRG( 40, 34) = 0.425868E+00
- PKER_SACCRG( 40, 35) = 0.421927E+00
- PKER_SACCRG( 40, 36) = 0.414433E+00
+ PKER_SACCRG( 40, 8) = 0.000000E+00
+ PKER_SACCRG( 40, 9) = 0.000000E+00
+ PKER_SACCRG( 40, 10) = 0.000000E+00
+ PKER_SACCRG( 40, 11) = 0.000000E+00
+ PKER_SACCRG( 40, 12) = 0.000000E+00
+ PKER_SACCRG( 40, 13) = 0.000000E+00
+ PKER_SACCRG( 40, 14) = 0.000000E+00
+ PKER_SACCRG( 40, 15) = 0.000000E+00
+ PKER_SACCRG( 40, 16) = 0.531993E+00
+ PKER_SACCRG( 40, 17) = 0.498983E+00
+ PKER_SACCRG( 40, 18) = 0.468012E+00
+ PKER_SACCRG( 40, 19) = 0.521524E+00
+ PKER_SACCRG( 40, 20) = 0.496911E+00
+ PKER_SACCRG( 40, 21) = 0.507532E+00
+ PKER_SACCRG( 40, 22) = 0.507558E+00
+ PKER_SACCRG( 40, 23) = 0.505004E+00
+ PKER_SACCRG( 40, 24) = 0.492073E+00
+ PKER_SACCRG( 40, 25) = 0.494169E+00
+ PKER_SACCRG( 40, 26) = 0.488284E+00
+ PKER_SACCRG( 40, 27) = 0.483303E+00
+ PKER_SACCRG( 40, 28) = 0.480510E+00
+ PKER_SACCRG( 40, 29) = 0.471182E+00
+ PKER_SACCRG( 40, 30) = 0.459624E+00
+ PKER_SACCRG( 40, 31) = 0.450383E+00
+ PKER_SACCRG( 40, 32) = 0.443437E+00
+ PKER_SACCRG( 40, 33) = 0.438004E+00
+ PKER_SACCRG( 40, 34) = 0.436256E+00
+ PKER_SACCRG( 40, 35) = 0.432220E+00
+ PKER_SACCRG( 40, 36) = 0.424544E+00
PKER_SACCRG( 40, 37) = 0.000000E+00
PKER_SACCRG( 40, 38) = 0.000000E+00
PKER_SACCRG( 40, 39) = 0.000000E+00
PKER_SACCRG( 40, 40) = 0.000000E+00
END IF
!
+IF (LHOOK) CALL DR_HOOK('READ_XKER_RACCS',1,ZHOOK_HANDLE)
END SUBROUTINE READ_XKER_RACCS
+END MODULE MODE_READ_XKER_RACCS
diff --git a/src/PHYEX/micro/mode_read_xker_rdryg.f90 b/src/PHYEX/micro/mode_read_xker_rdryg.f90
index e0c67b505d36b060deac5a59930696a6e04463c7..4ab0f47df6a4fd4cc7d263dacdc8385ddf49d8d0 100644
--- a/src/PHYEX/micro/mode_read_xker_rdryg.f90
+++ b/src/PHYEX/micro/mode_read_xker_rdryg.f90
@@ -9,43 +9,17 @@
! MASDEV4_7 init 2006/05/18 13:07:25
!-----------------------------------------------------------------
! ###########################
- MODULE MODI_READ_XKER_RDRYG
+ MODULE MODE_READ_XKER_RDRYG
! ###########################
-!
-INTERFACE
- SUBROUTINE READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
- PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
- PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
- PFDINFTY,PKER_RDRYG )
-!
-INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAR
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PALPHAR
-REAL, INTENT(OUT) :: PNUR
-REAL, INTENT(OUT) :: PEGR
-REAL, INTENT(OUT) :: PBR
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PCR
-REAL, INTENT(OUT) :: PDR
-REAL, INTENT(OUT) :: PDRYLBDAG_MAX
-REAL, INTENT(OUT) :: PDRYLBDAR_MAX
-REAL, INTENT(OUT) :: PDRYLBDAG_MIN
-REAL, INTENT(OUT) :: PDRYLBDAR_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RDRYG
-!
-END SUBROUTINE
-!
-END INTERFACE
-!
-END MODULE MODI_READ_XKER_RDRYG
-! ########################################################################
+IMPLICIT NONE
+CONTAINS
SUBROUTINE READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
PFDINFTY,PKER_RDRYG )
+!DEC$ OPTIMIZE:0
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-graupel dry growth process
@@ -80,6 +54,7 @@ END MODULE MODI_READ_XKER_RDRYG
!! MODIFICATIONS
!! -------------
!! Original 09/04/96
+!! 14-Feb-2014 R. El Khatib optimise for compile time on Intel
!!
!-------------------------------------------------------------------------------
!
@@ -111,6 +86,8 @@ REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RDRYG
! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
! ###################################################################
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('READ_XKER_RDRYG',0,ZHOOK_HANDLE)
KND= 50
KDRYLBDAG= 40
KDRYLBDAR= 40
@@ -1733,4 +1710,6 @@ IF( PRESENT(PKER_RDRYG) ) THEN
PKER_RDRYG( 40, 40) = 0.484891E-02
END IF
!
+IF (LHOOK) CALL DR_HOOK('READ_XKER_RDRYG',1,ZHOOK_HANDLE)
END SUBROUTINE READ_XKER_RDRYG
+END MODULE MODE_READ_XKER_RDRYG
diff --git a/src/PHYEX/micro/mode_read_xker_rweth.f90 b/src/PHYEX/micro/mode_read_xker_rweth.f90
index 8093eeb0d81ae3d6232e4a6dc7471c98459892ef..9f04157ad7bf94878e24ab0bc57ccb2c8438a3b9 100644
--- a/src/PHYEX/micro/mode_read_xker_rweth.f90
+++ b/src/PHYEX/micro/mode_read_xker_rweth.f90
@@ -2,46 +2,18 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! ######spl
- MODULE MODI_READ_XKER_RWETH
+! #####s#####################
+ MODULE MODE_READ_XKER_RWETH
! ###########################
-!
-INTERFACE
- SUBROUTINE READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
- PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
- PWETLBDAH_MAX,PWETLBDAR_MAX,PWETLBDAH_MIN,PWETLBDAR_MIN, &
- PFDINFTY,PKER_RWETH )
-!
IMPLICIT NONE
-INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAR
-REAL, INTENT(OUT) :: PALPHAH
-REAL, INTENT(OUT) :: PNUH
-REAL, INTENT(OUT) :: PALPHAR
-REAL, INTENT(OUT) :: PNUR
-REAL, INTENT(OUT) :: PEHR
-REAL, INTENT(OUT) :: PBR
-REAL, INTENT(OUT) :: PCH
-REAL, INTENT(OUT) :: PDH
-REAL, INTENT(OUT) :: PCR
-REAL, INTENT(OUT) :: PDR
-REAL, INTENT(OUT) :: PWETLBDAH_MAX
-REAL, INTENT(OUT) :: PWETLBDAR_MAX
-REAL, INTENT(OUT) :: PWETLBDAH_MIN
-REAL, INTENT(OUT) :: PWETLBDAR_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RWETH
-!
-END SUBROUTINE
-!
-END INTERFACE
-!
-END MODULE MODI_READ_XKER_RWETH
-! ######spl
+CONTAINS
SUBROUTINE READ_XKER_RWETH (KWETLBDAH,KWETLBDAR,KND, &
PALPHAH,PNUH,PALPHAR,PNUR,PEHR,PBR,PCH,PDH,PCR,PDR, &
PWETLBDAH_MAX,PWETLBDAR_MAX,PWETLBDAH_MIN,PWETLBDAR_MIN, &
PFDINFTY,PKER_RWETH )
!DEC$ OPTIMIZE:0
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the rain-hail wet growth process
@@ -108,6 +80,8 @@ REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_RWETH
! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
! ###################################################################
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('READ_XKER_RWETH',0,ZHOOK_HANDLE)
KND= 50
KWETLBDAH= 40
KWETLBDAR= 40
@@ -1730,4 +1704,6 @@ IF( PRESENT(PKER_RWETH) ) THEN
PKER_RWETH( 40, 40) = 0.210656E-01
END IF
!
+IF (LHOOK) CALL DR_HOOK('READ_XKER_RWETH',1,ZHOOK_HANDLE)
END SUBROUTINE READ_XKER_RWETH
+END MODULE MODE_READ_XKER_RWETH
diff --git a/src/PHYEX/micro/mode_read_xker_sdryg.f90 b/src/PHYEX/micro/mode_read_xker_sdryg.f90
index 4bedc2ff04d6e86a35600aea898cd7398d5cdf89..088e569cd1b552ed48b8007d4fec57c04537ab2d 100644
--- a/src/PHYEX/micro/mode_read_xker_sdryg.f90
+++ b/src/PHYEX/micro/mode_read_xker_sdryg.f90
@@ -2,51 +2,18 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###########################
- MODULE MODI_READ_XKER_SDRYG
+ MODULE MODE_READ_XKER_SDRYG
! ###########################
-!
-INTERFACE
- SUBROUTINE READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
- PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
- PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
- PFDINFTY,PKER_SDRYG )
-!
-INTEGER, INTENT(OUT) :: KND,KDRYLBDAG,KDRYLBDAS
-REAL, INTENT(OUT) :: PALPHAG
-REAL, INTENT(OUT) :: PNUG
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PEGS
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PCG
-REAL, INTENT(OUT) :: PDG
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PDRYLBDAG_MAX
-REAL, INTENT(OUT) :: PDRYLBDAS_MAX
-REAL, INTENT(OUT) :: PDRYLBDAG_MIN
-REAL, INTENT(OUT) :: PDRYLBDAS_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SDRYG
-!
-END SUBROUTINE
-!
-END INTERFACE
-!
-END MODULE MODI_READ_XKER_SDRYG
-! ########################################################################
+IMPLICIT NONE
+CONTAINS
SUBROUTINE READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS,PFVELOS, &
PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
PFDINFTY,PKER_SDRYG )
+!DEC$ OPTIMIZE:0
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-graupel dry growth process
@@ -82,6 +49,7 @@ END MODULE MODI_READ_XKER_SDRYG
!! MODIFICATIONS
!! -------------
!! Original 09/04/96
+!! 14-Feb-2014 R. El Khatib optimise for compile time on Intel
!!
!-------------------------------------------------------------------------------
!
@@ -114,6 +82,8 @@ REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SDRYG
! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE IF THE KERNELS ARE UPDATED#
! ###################################################################
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('READ_XKER_SDRYG',0,ZHOOK_HANDLE)
KND= 50
KDRYLBDAG= 40
KDRYLBDAS= 80
@@ -125,7 +95,7 @@ PEGS= 0.100000E+01
PBS= 0.190000E+01
PCG= 0.124000E+03
PDG= 0.660000E+00
-PCS= 0.500000E+01
+PCS= 0.510000E+01
PDS= 0.270000E+00
PFVELOS= 0.000000E+00
PDRYLBDAG_MAX= 0.100000E+08
@@ -135,3206 +105,3208 @@ PDRYLBDAS_MIN= 0.250000E+02
PFDINFTY= 0.200000E+02
!
IF( PRESENT(PKER_SDRYG) ) THEN
-PKER_SDRYG( 1, 1) = 0.179391E+01
-PKER_SDRYG( 1, 2) = 0.161383E+01
-PKER_SDRYG( 1, 3) = 0.144937E+01
-PKER_SDRYG( 1, 4) = 0.130038E+01
-PKER_SDRYG( 1, 5) = 0.116678E+01
-PKER_SDRYG( 1, 6) = 0.104872E+01
-PKER_SDRYG( 1, 7) = 0.946086E+00
-PKER_SDRYG( 1, 8) = 0.858936E+00
-PKER_SDRYG( 1, 9) = 0.787555E+00
-PKER_SDRYG( 1, 10) = 0.732043E+00
-PKER_SDRYG( 1, 11) = 0.692949E+00
-PKER_SDRYG( 1, 12) = 0.670766E+00
-PKER_SDRYG( 1, 13) = 0.666033E+00
-PKER_SDRYG( 1, 14) = 0.679917E+00
-PKER_SDRYG( 1, 15) = 0.713017E+00
-PKER_SDRYG( 1, 16) = 0.765480E+00
-PKER_SDRYG( 1, 17) = 0.837470E+00
-PKER_SDRYG( 1, 18) = 0.927804E+00
-PKER_SDRYG( 1, 19) = 0.103365E+01
-PKER_SDRYG( 1, 20) = 0.115023E+01
-PKER_SDRYG( 1, 21) = 0.127173E+01
-PKER_SDRYG( 1, 22) = 0.139286E+01
-PKER_SDRYG( 1, 23) = 0.150953E+01
-PKER_SDRYG( 1, 24) = 0.161852E+01
-PKER_SDRYG( 1, 25) = 0.171787E+01
-PKER_SDRYG( 1, 26) = 0.180660E+01
-PKER_SDRYG( 1, 27) = 0.188461E+01
-PKER_SDRYG( 1, 28) = 0.195257E+01
-PKER_SDRYG( 1, 29) = 0.201159E+01
-PKER_SDRYG( 1, 30) = 0.206294E+01
-PKER_SDRYG( 1, 31) = 0.210781E+01
-PKER_SDRYG( 1, 32) = 0.214724E+01
-PKER_SDRYG( 1, 33) = 0.218211E+01
-PKER_SDRYG( 1, 34) = 0.221314E+01
-PKER_SDRYG( 1, 35) = 0.224092E+01
-PKER_SDRYG( 1, 36) = 0.226594E+01
-PKER_SDRYG( 1, 37) = 0.228858E+01
-PKER_SDRYG( 1, 38) = 0.230917E+01
-PKER_SDRYG( 1, 39) = 0.232798E+01
-PKER_SDRYG( 1, 40) = 0.234523E+01
-PKER_SDRYG( 1, 41) = 0.236110E+01
-PKER_SDRYG( 1, 42) = 0.237574E+01
-PKER_SDRYG( 1, 43) = 0.238929E+01
-PKER_SDRYG( 1, 44) = 0.240185E+01
-PKER_SDRYG( 1, 45) = 0.241352E+01
-PKER_SDRYG( 1, 46) = 0.242437E+01
-PKER_SDRYG( 1, 47) = 0.243449E+01
-PKER_SDRYG( 1, 48) = 0.244392E+01
-PKER_SDRYG( 1, 49) = 0.245273E+01
-PKER_SDRYG( 1, 50) = 0.246096E+01
-PKER_SDRYG( 1, 51) = 0.246866E+01
-PKER_SDRYG( 1, 52) = 0.247587E+01
-PKER_SDRYG( 1, 53) = 0.248262E+01
-PKER_SDRYG( 1, 54) = 0.248894E+01
-PKER_SDRYG( 1, 55) = 0.249486E+01
-PKER_SDRYG( 1, 56) = 0.250041E+01
-PKER_SDRYG( 1, 57) = 0.250561E+01
-PKER_SDRYG( 1, 58) = 0.251050E+01
-PKER_SDRYG( 1, 59) = 0.251507E+01
-PKER_SDRYG( 1, 60) = 0.251937E+01
-PKER_SDRYG( 1, 61) = 0.252340E+01
-PKER_SDRYG( 1, 62) = 0.252718E+01
-PKER_SDRYG( 1, 63) = 0.253073E+01
-PKER_SDRYG( 1, 64) = 0.253407E+01
-PKER_SDRYG( 1, 65) = 0.253719E+01
-PKER_SDRYG( 1, 66) = 0.254013E+01
-PKER_SDRYG( 1, 67) = 0.254289E+01
-PKER_SDRYG( 1, 68) = 0.254547E+01
-PKER_SDRYG( 1, 69) = 0.254790E+01
-PKER_SDRYG( 1, 70) = 0.255018E+01
-PKER_SDRYG( 1, 71) = 0.255232E+01
-PKER_SDRYG( 1, 72) = 0.255433E+01
-PKER_SDRYG( 1, 73) = 0.255622E+01
-PKER_SDRYG( 1, 74) = 0.255799E+01
-PKER_SDRYG( 1, 75) = 0.255965E+01
-PKER_SDRYG( 1, 76) = 0.256122E+01
-PKER_SDRYG( 1, 77) = 0.256268E+01
-PKER_SDRYG( 1, 78) = 0.256406E+01
-PKER_SDRYG( 1, 79) = 0.256535E+01
-PKER_SDRYG( 1, 80) = 0.256657E+01
-PKER_SDRYG( 2, 1) = 0.197244E+01
-PKER_SDRYG( 2, 2) = 0.178433E+01
-PKER_SDRYG( 2, 3) = 0.160995E+01
-PKER_SDRYG( 2, 4) = 0.144900E+01
-PKER_SDRYG( 2, 5) = 0.130154E+01
-PKER_SDRYG( 2, 6) = 0.116741E+01
-PKER_SDRYG( 2, 7) = 0.104657E+01
-PKER_SDRYG( 2, 8) = 0.939263E+00
-PKER_SDRYG( 2, 9) = 0.845532E+00
-PKER_SDRYG( 2, 10) = 0.765603E+00
-PKER_SDRYG( 2, 11) = 0.699905E+00
-PKER_SDRYG( 2, 12) = 0.648751E+00
-PKER_SDRYG( 2, 13) = 0.612852E+00
-PKER_SDRYG( 2, 14) = 0.592964E+00
-PKER_SDRYG( 2, 15) = 0.589919E+00
-PKER_SDRYG( 2, 16) = 0.604538E+00
-PKER_SDRYG( 2, 17) = 0.637401E+00
-PKER_SDRYG( 2, 18) = 0.688500E+00
-PKER_SDRYG( 2, 19) = 0.756789E+00
-PKER_SDRYG( 2, 20) = 0.840298E+00
-PKER_SDRYG( 2, 21) = 0.935466E+00
-PKER_SDRYG( 2, 22) = 0.103741E+01
-PKER_SDRYG( 2, 23) = 0.114073E+01
-PKER_SDRYG( 2, 24) = 0.124096E+01
-PKER_SDRYG( 2, 25) = 0.133504E+01
-PKER_SDRYG( 2, 26) = 0.142130E+01
-PKER_SDRYG( 2, 27) = 0.149896E+01
-PKER_SDRYG( 2, 28) = 0.156797E+01
-PKER_SDRYG( 2, 29) = 0.162869E+01
-PKER_SDRYG( 2, 30) = 0.168183E+01
-PKER_SDRYG( 2, 31) = 0.172830E+01
-PKER_SDRYG( 2, 32) = 0.176906E+01
-PKER_SDRYG( 2, 33) = 0.180500E+01
-PKER_SDRYG( 2, 34) = 0.183688E+01
-PKER_SDRYG( 2, 35) = 0.186533E+01
-PKER_SDRYG( 2, 36) = 0.189087E+01
-PKER_SDRYG( 2, 37) = 0.191393E+01
-PKER_SDRYG( 2, 38) = 0.193485E+01
-PKER_SDRYG( 2, 39) = 0.195392E+01
-PKER_SDRYG( 2, 40) = 0.197137E+01
-PKER_SDRYG( 2, 41) = 0.198740E+01
-PKER_SDRYG( 2, 42) = 0.200216E+01
-PKER_SDRYG( 2, 43) = 0.201581E+01
-PKER_SDRYG( 2, 44) = 0.202844E+01
-PKER_SDRYG( 2, 45) = 0.204017E+01
-PKER_SDRYG( 2, 46) = 0.205107E+01
-PKER_SDRYG( 2, 47) = 0.206123E+01
-PKER_SDRYG( 2, 48) = 0.207069E+01
-PKER_SDRYG( 2, 49) = 0.207952E+01
-PKER_SDRYG( 2, 50) = 0.208777E+01
-PKER_SDRYG( 2, 51) = 0.209549E+01
-PKER_SDRYG( 2, 52) = 0.210270E+01
-PKER_SDRYG( 2, 53) = 0.210946E+01
-PKER_SDRYG( 2, 54) = 0.211579E+01
-PKER_SDRYG( 2, 55) = 0.212171E+01
-PKER_SDRYG( 2, 56) = 0.212727E+01
-PKER_SDRYG( 2, 57) = 0.213248E+01
-PKER_SDRYG( 2, 58) = 0.213736E+01
-PKER_SDRYG( 2, 59) = 0.214194E+01
-PKER_SDRYG( 2, 60) = 0.214624E+01
-PKER_SDRYG( 2, 61) = 0.215027E+01
-PKER_SDRYG( 2, 62) = 0.215406E+01
-PKER_SDRYG( 2, 63) = 0.215761E+01
-PKER_SDRYG( 2, 64) = 0.216094E+01
-PKER_SDRYG( 2, 65) = 0.216407E+01
-PKER_SDRYG( 2, 66) = 0.216701E+01
-PKER_SDRYG( 2, 67) = 0.216976E+01
-PKER_SDRYG( 2, 68) = 0.217235E+01
-PKER_SDRYG( 2, 69) = 0.217478E+01
-PKER_SDRYG( 2, 70) = 0.217706E+01
-PKER_SDRYG( 2, 71) = 0.217920E+01
-PKER_SDRYG( 2, 72) = 0.218121E+01
-PKER_SDRYG( 2, 73) = 0.218310E+01
-PKER_SDRYG( 2, 74) = 0.218487E+01
-PKER_SDRYG( 2, 75) = 0.218653E+01
-PKER_SDRYG( 2, 76) = 0.218809E+01
-PKER_SDRYG( 2, 77) = 0.218956E+01
-PKER_SDRYG( 2, 78) = 0.219094E+01
-PKER_SDRYG( 2, 79) = 0.219223E+01
-PKER_SDRYG( 2, 80) = 0.219345E+01
-PKER_SDRYG( 3, 1) = 0.213704E+01
-PKER_SDRYG( 3, 2) = 0.194532E+01
-PKER_SDRYG( 3, 3) = 0.176611E+01
-PKER_SDRYG( 3, 4) = 0.159902E+01
-PKER_SDRYG( 3, 5) = 0.144369E+01
-PKER_SDRYG( 3, 6) = 0.130005E+01
-PKER_SDRYG( 3, 7) = 0.116784E+01
-PKER_SDRYG( 3, 8) = 0.104716E+01
-PKER_SDRYG( 3, 9) = 0.938049E+00
-PKER_SDRYG( 3, 10) = 0.840610E+00
-PKER_SDRYG( 3, 11) = 0.755216E+00
-PKER_SDRYG( 3, 12) = 0.682119E+00
-PKER_SDRYG( 3, 13) = 0.621766E+00
-PKER_SDRYG( 3, 14) = 0.574997E+00
-PKER_SDRYG( 3, 15) = 0.542388E+00
-PKER_SDRYG( 3, 16) = 0.524985E+00
-PKER_SDRYG( 3, 17) = 0.523732E+00
-PKER_SDRYG( 3, 18) = 0.539136E+00
-PKER_SDRYG( 3, 19) = 0.571765E+00
-PKER_SDRYG( 3, 20) = 0.620851E+00
-PKER_SDRYG( 3, 21) = 0.684483E+00
-PKER_SDRYG( 3, 22) = 0.759908E+00
-PKER_SDRYG( 3, 23) = 0.843252E+00
-PKER_SDRYG( 3, 24) = 0.930008E+00
-PKER_SDRYG( 3, 25) = 0.101578E+01
-PKER_SDRYG( 3, 26) = 0.109713E+01
-PKER_SDRYG( 3, 27) = 0.117211E+01
-PKER_SDRYG( 3, 28) = 0.123999E+01
-PKER_SDRYG( 3, 29) = 0.130070E+01
-PKER_SDRYG( 3, 30) = 0.135461E+01
-PKER_SDRYG( 3, 31) = 0.140226E+01
-PKER_SDRYG( 3, 32) = 0.144426E+01
-PKER_SDRYG( 3, 33) = 0.148133E+01
-PKER_SDRYG( 3, 34) = 0.151413E+01
-PKER_SDRYG( 3, 35) = 0.154333E+01
-PKER_SDRYG( 3, 36) = 0.156945E+01
-PKER_SDRYG( 3, 37) = 0.159297E+01
-PKER_SDRYG( 3, 38) = 0.161425E+01
-PKER_SDRYG( 3, 39) = 0.163361E+01
-PKER_SDRYG( 3, 40) = 0.165128E+01
-PKER_SDRYG( 3, 41) = 0.166748E+01
-PKER_SDRYG( 3, 42) = 0.168239E+01
-PKER_SDRYG( 3, 43) = 0.169614E+01
-PKER_SDRYG( 3, 44) = 0.170886E+01
-PKER_SDRYG( 3, 45) = 0.172066E+01
-PKER_SDRYG( 3, 46) = 0.173161E+01
-PKER_SDRYG( 3, 47) = 0.174180E+01
-PKER_SDRYG( 3, 48) = 0.175130E+01
-PKER_SDRYG( 3, 49) = 0.176016E+01
-PKER_SDRYG( 3, 50) = 0.176843E+01
-PKER_SDRYG( 3, 51) = 0.177616E+01
-PKER_SDRYG( 3, 52) = 0.178339E+01
-PKER_SDRYG( 3, 53) = 0.179015E+01
-PKER_SDRYG( 3, 54) = 0.179649E+01
-PKER_SDRYG( 3, 55) = 0.180242E+01
-PKER_SDRYG( 3, 56) = 0.180798E+01
-PKER_SDRYG( 3, 57) = 0.181319E+01
-PKER_SDRYG( 3, 58) = 0.181808E+01
-PKER_SDRYG( 3, 59) = 0.182267E+01
-PKER_SDRYG( 3, 60) = 0.182696E+01
-PKER_SDRYG( 3, 61) = 0.183100E+01
-PKER_SDRYG( 3, 62) = 0.183478E+01
-PKER_SDRYG( 3, 63) = 0.183834E+01
-PKER_SDRYG( 3, 64) = 0.184167E+01
-PKER_SDRYG( 3, 65) = 0.184480E+01
-PKER_SDRYG( 3, 66) = 0.184773E+01
-PKER_SDRYG( 3, 67) = 0.185049E+01
-PKER_SDRYG( 3, 68) = 0.185308E+01
-PKER_SDRYG( 3, 69) = 0.185551E+01
-PKER_SDRYG( 3, 70) = 0.185779E+01
-PKER_SDRYG( 3, 71) = 0.185993E+01
-PKER_SDRYG( 3, 72) = 0.186194E+01
-PKER_SDRYG( 3, 73) = 0.186383E+01
-PKER_SDRYG( 3, 74) = 0.186560E+01
-PKER_SDRYG( 3, 75) = 0.186726E+01
-PKER_SDRYG( 3, 76) = 0.186882E+01
-PKER_SDRYG( 3, 77) = 0.187029E+01
-PKER_SDRYG( 3, 78) = 0.187167E+01
-PKER_SDRYG( 3, 79) = 0.187296E+01
-PKER_SDRYG( 3, 80) = 0.187418E+01
-PKER_SDRYG( 4, 1) = 0.228260E+01
-PKER_SDRYG( 4, 2) = 0.208970E+01
-PKER_SDRYG( 4, 3) = 0.190870E+01
-PKER_SDRYG( 4, 4) = 0.173902E+01
-PKER_SDRYG( 4, 5) = 0.158018E+01
-PKER_SDRYG( 4, 6) = 0.143175E+01
-PKER_SDRYG( 4, 7) = 0.129350E+01
-PKER_SDRYG( 4, 8) = 0.116524E+01
-PKER_SDRYG( 4, 9) = 0.104679E+01
-PKER_SDRYG( 4, 10) = 0.938293E+00
-PKER_SDRYG( 4, 11) = 0.839779E+00
-PKER_SDRYG( 4, 12) = 0.751411E+00
-PKER_SDRYG( 4, 13) = 0.673624E+00
-PKER_SDRYG( 4, 14) = 0.606890E+00
-PKER_SDRYG( 4, 15) = 0.551804E+00
-PKER_SDRYG( 4, 16) = 0.509206E+00
-PKER_SDRYG( 4, 17) = 0.479980E+00
-PKER_SDRYG( 4, 18) = 0.465261E+00
-PKER_SDRYG( 4, 19) = 0.465721E+00
-PKER_SDRYG( 4, 20) = 0.482008E+00
-PKER_SDRYG( 4, 21) = 0.513844E+00
-PKER_SDRYG( 4, 22) = 0.559906E+00
-PKER_SDRYG( 4, 23) = 0.617887E+00
-PKER_SDRYG( 4, 24) = 0.684319E+00
-PKER_SDRYG( 4, 25) = 0.755493E+00
-PKER_SDRYG( 4, 26) = 0.827648E+00
-PKER_SDRYG( 4, 27) = 0.897498E+00
-PKER_SDRYG( 4, 28) = 0.962696E+00
-PKER_SDRYG( 4, 29) = 0.102211E+01
-PKER_SDRYG( 4, 30) = 0.107552E+01
-PKER_SDRYG( 4, 31) = 0.112323E+01
-PKER_SDRYG( 4, 32) = 0.116572E+01
-PKER_SDRYG( 4, 33) = 0.120353E+01
-PKER_SDRYG( 4, 34) = 0.123716E+01
-PKER_SDRYG( 4, 35) = 0.126712E+01
-PKER_SDRYG( 4, 36) = 0.129388E+01
-PKER_SDRYG( 4, 37) = 0.131791E+01
-PKER_SDRYG( 4, 38) = 0.133960E+01
-PKER_SDRYG( 4, 39) = 0.135926E+01
-PKER_SDRYG( 4, 40) = 0.137719E+01
-PKER_SDRYG( 4, 41) = 0.139358E+01
-PKER_SDRYG( 4, 42) = 0.140864E+01
-PKER_SDRYG( 4, 43) = 0.142251E+01
-PKER_SDRYG( 4, 44) = 0.143533E+01
-PKER_SDRYG( 4, 45) = 0.144719E+01
-PKER_SDRYG( 4, 46) = 0.145821E+01
-PKER_SDRYG( 4, 47) = 0.146844E+01
-PKER_SDRYG( 4, 48) = 0.147798E+01
-PKER_SDRYG( 4, 49) = 0.148686E+01
-PKER_SDRYG( 4, 50) = 0.149515E+01
-PKER_SDRYG( 4, 51) = 0.150290E+01
-PKER_SDRYG( 4, 52) = 0.151015E+01
-PKER_SDRYG( 4, 53) = 0.151692E+01
-PKER_SDRYG( 4, 54) = 0.152326E+01
-PKER_SDRYG( 4, 55) = 0.152921E+01
-PKER_SDRYG( 4, 56) = 0.153477E+01
-PKER_SDRYG( 4, 57) = 0.153999E+01
-PKER_SDRYG( 4, 58) = 0.154488E+01
-PKER_SDRYG( 4, 59) = 0.154946E+01
-PKER_SDRYG( 4, 60) = 0.155377E+01
-PKER_SDRYG( 4, 61) = 0.155780E+01
-PKER_SDRYG( 4, 62) = 0.156159E+01
-PKER_SDRYG( 4, 63) = 0.156514E+01
-PKER_SDRYG( 4, 64) = 0.156847E+01
-PKER_SDRYG( 4, 65) = 0.157160E+01
-PKER_SDRYG( 4, 66) = 0.157454E+01
-PKER_SDRYG( 4, 67) = 0.157730E+01
-PKER_SDRYG( 4, 68) = 0.157989E+01
-PKER_SDRYG( 4, 69) = 0.158231E+01
-PKER_SDRYG( 4, 70) = 0.158460E+01
-PKER_SDRYG( 4, 71) = 0.158674E+01
-PKER_SDRYG( 4, 72) = 0.158875E+01
-PKER_SDRYG( 4, 73) = 0.159063E+01
-PKER_SDRYG( 4, 74) = 0.159241E+01
-PKER_SDRYG( 4, 75) = 0.159407E+01
-PKER_SDRYG( 4, 76) = 0.159563E+01
-PKER_SDRYG( 4, 77) = 0.159710E+01
-PKER_SDRYG( 4, 78) = 0.159848E+01
-PKER_SDRYG( 4, 79) = 0.159977E+01
-PKER_SDRYG( 4, 80) = 0.160098E+01
-PKER_SDRYG( 5, 1) = 0.240858E+01
-PKER_SDRYG( 5, 2) = 0.221548E+01
-PKER_SDRYG( 5, 3) = 0.203408E+01
-PKER_SDRYG( 5, 4) = 0.186367E+01
-PKER_SDRYG( 5, 5) = 0.170364E+01
-PKER_SDRYG( 5, 6) = 0.155346E+01
-PKER_SDRYG( 5, 7) = 0.141265E+01
-PKER_SDRYG( 5, 8) = 0.128086E+01
-PKER_SDRYG( 5, 9) = 0.115781E+01
-PKER_SDRYG( 5, 10) = 0.104325E+01
-PKER_SDRYG( 5, 11) = 0.937212E+00
-PKER_SDRYG( 5, 12) = 0.839592E+00
-PKER_SDRYG( 5, 13) = 0.750616E+00
-PKER_SDRYG( 5, 14) = 0.670555E+00
-PKER_SDRYG( 5, 15) = 0.599783E+00
-PKER_SDRYG( 5, 16) = 0.538995E+00
-PKER_SDRYG( 5, 17) = 0.488851E+00
-PKER_SDRYG( 5, 18) = 0.450272E+00
-PKER_SDRYG( 5, 19) = 0.424473E+00
-PKER_SDRYG( 5, 20) = 0.412258E+00
-PKER_SDRYG( 5, 21) = 0.414378E+00
-PKER_SDRYG( 5, 22) = 0.431094E+00
-PKER_SDRYG( 5, 23) = 0.461458E+00
-PKER_SDRYG( 5, 24) = 0.503777E+00
-PKER_SDRYG( 5, 25) = 0.555215E+00
-PKER_SDRYG( 5, 26) = 0.612308E+00
-PKER_SDRYG( 5, 27) = 0.671758E+00
-PKER_SDRYG( 5, 28) = 0.730702E+00
-PKER_SDRYG( 5, 29) = 0.786858E+00
-PKER_SDRYG( 5, 30) = 0.838809E+00
-PKER_SDRYG( 5, 31) = 0.885908E+00
-PKER_SDRYG( 5, 32) = 0.928193E+00
-PKER_SDRYG( 5, 33) = 0.966036E+00
-PKER_SDRYG( 5, 34) = 0.999917E+00
-PKER_SDRYG( 5, 35) = 0.103030E+01
-PKER_SDRYG( 5, 36) = 0.105757E+01
-PKER_SDRYG( 5, 37) = 0.108209E+01
-PKER_SDRYG( 5, 38) = 0.110421E+01
-PKER_SDRYG( 5, 39) = 0.112423E+01
-PKER_SDRYG( 5, 40) = 0.114242E+01
-PKER_SDRYG( 5, 41) = 0.115904E+01
-PKER_SDRYG( 5, 42) = 0.117426E+01
-PKER_SDRYG( 5, 43) = 0.118827E+01
-PKER_SDRYG( 5, 44) = 0.120118E+01
-PKER_SDRYG( 5, 45) = 0.121313E+01
-PKER_SDRYG( 5, 46) = 0.122421E+01
-PKER_SDRYG( 5, 47) = 0.123450E+01
-PKER_SDRYG( 5, 48) = 0.124407E+01
-PKER_SDRYG( 5, 49) = 0.125299E+01
-PKER_SDRYG( 5, 50) = 0.126130E+01
-PKER_SDRYG( 5, 51) = 0.126907E+01
-PKER_SDRYG( 5, 52) = 0.127633E+01
-PKER_SDRYG( 5, 53) = 0.128312E+01
-PKER_SDRYG( 5, 54) = 0.128947E+01
-PKER_SDRYG( 5, 55) = 0.129542E+01
-PKER_SDRYG( 5, 56) = 0.130099E+01
-PKER_SDRYG( 5, 57) = 0.130621E+01
-PKER_SDRYG( 5, 58) = 0.131110E+01
-PKER_SDRYG( 5, 59) = 0.131569E+01
-PKER_SDRYG( 5, 60) = 0.132000E+01
-PKER_SDRYG( 5, 61) = 0.132403E+01
-PKER_SDRYG( 5, 62) = 0.132782E+01
-PKER_SDRYG( 5, 63) = 0.133137E+01
-PKER_SDRYG( 5, 64) = 0.133471E+01
-PKER_SDRYG( 5, 65) = 0.133784E+01
-PKER_SDRYG( 5, 66) = 0.134078E+01
-PKER_SDRYG( 5, 67) = 0.134353E+01
-PKER_SDRYG( 5, 68) = 0.134612E+01
-PKER_SDRYG( 5, 69) = 0.134855E+01
-PKER_SDRYG( 5, 70) = 0.135083E+01
-PKER_SDRYG( 5, 71) = 0.135297E+01
-PKER_SDRYG( 5, 72) = 0.135498E+01
-PKER_SDRYG( 5, 73) = 0.135687E+01
-PKER_SDRYG( 5, 74) = 0.135864E+01
-PKER_SDRYG( 5, 75) = 0.136031E+01
-PKER_SDRYG( 5, 76) = 0.136187E+01
-PKER_SDRYG( 5, 77) = 0.136334E+01
-PKER_SDRYG( 5, 78) = 0.136471E+01
-PKER_SDRYG( 5, 79) = 0.136601E+01
-PKER_SDRYG( 5, 80) = 0.136722E+01
-PKER_SDRYG( 6, 1) = 0.251664E+01
-PKER_SDRYG( 6, 2) = 0.232364E+01
-PKER_SDRYG( 6, 3) = 0.214228E+01
-PKER_SDRYG( 6, 4) = 0.197185E+01
-PKER_SDRYG( 6, 5) = 0.181167E+01
-PKER_SDRYG( 6, 6) = 0.166111E+01
-PKER_SDRYG( 6, 7) = 0.151961E+01
-PKER_SDRYG( 6, 8) = 0.138667E+01
-PKER_SDRYG( 6, 9) = 0.126184E+01
-PKER_SDRYG( 6, 10) = 0.114478E+01
-PKER_SDRYG( 6, 11) = 0.103517E+01
-PKER_SDRYG( 6, 12) = 0.932888E+00
-PKER_SDRYG( 6, 13) = 0.837834E+00
-PKER_SDRYG( 6, 14) = 0.750023E+00
-PKER_SDRYG( 6, 15) = 0.669669E+00
-PKER_SDRYG( 6, 16) = 0.597089E+00
-PKER_SDRYG( 6, 17) = 0.532745E+00
-PKER_SDRYG( 6, 18) = 0.477348E+00
-PKER_SDRYG( 6, 19) = 0.431871E+00
-PKER_SDRYG( 6, 20) = 0.397271E+00
-PKER_SDRYG( 6, 21) = 0.374617E+00
-PKER_SDRYG( 6, 22) = 0.364824E+00
-PKER_SDRYG( 6, 23) = 0.368476E+00
-PKER_SDRYG( 6, 24) = 0.384983E+00
-PKER_SDRYG( 6, 25) = 0.413313E+00
-PKER_SDRYG( 6, 26) = 0.451161E+00
-PKER_SDRYG( 6, 27) = 0.495571E+00
-PKER_SDRYG( 6, 28) = 0.543614E+00
-PKER_SDRYG( 6, 29) = 0.592449E+00
-PKER_SDRYG( 6, 30) = 0.640035E+00
-PKER_SDRYG( 6, 31) = 0.684955E+00
-PKER_SDRYG( 6, 32) = 0.726348E+00
-PKER_SDRYG( 6, 33) = 0.763874E+00
-PKER_SDRYG( 6, 34) = 0.797647E+00
-PKER_SDRYG( 6, 35) = 0.828001E+00
-PKER_SDRYG( 6, 36) = 0.855366E+00
-PKER_SDRYG( 6, 37) = 0.880090E+00
-PKER_SDRYG( 6, 38) = 0.902487E+00
-PKER_SDRYG( 6, 39) = 0.922812E+00
-PKER_SDRYG( 6, 40) = 0.941292E+00
-PKER_SDRYG( 6, 41) = 0.958141E+00
-PKER_SDRYG( 6, 42) = 0.973555E+00
-PKER_SDRYG( 6, 43) = 0.987707E+00
-PKER_SDRYG( 6, 44) = 0.100074E+01
-PKER_SDRYG( 6, 45) = 0.101278E+01
-PKER_SDRYG( 6, 46) = 0.102393E+01
-PKER_SDRYG( 6, 47) = 0.103427E+01
-PKER_SDRYG( 6, 48) = 0.104388E+01
-PKER_SDRYG( 6, 49) = 0.105284E+01
-PKER_SDRYG( 6, 50) = 0.106118E+01
-PKER_SDRYG( 6, 51) = 0.106897E+01
-PKER_SDRYG( 6, 52) = 0.107624E+01
-PKER_SDRYG( 6, 53) = 0.108304E+01
-PKER_SDRYG( 6, 54) = 0.108941E+01
-PKER_SDRYG( 6, 55) = 0.109536E+01
-PKER_SDRYG( 6, 56) = 0.110094E+01
-PKER_SDRYG( 6, 57) = 0.110617E+01
-PKER_SDRYG( 6, 58) = 0.111106E+01
-PKER_SDRYG( 6, 59) = 0.111566E+01
-PKER_SDRYG( 6, 60) = 0.111996E+01
-PKER_SDRYG( 6, 61) = 0.112400E+01
-PKER_SDRYG( 6, 62) = 0.112779E+01
-PKER_SDRYG( 6, 63) = 0.113135E+01
-PKER_SDRYG( 6, 64) = 0.113468E+01
-PKER_SDRYG( 6, 65) = 0.113781E+01
-PKER_SDRYG( 6, 66) = 0.114075E+01
-PKER_SDRYG( 6, 67) = 0.114351E+01
-PKER_SDRYG( 6, 68) = 0.114610E+01
-PKER_SDRYG( 6, 69) = 0.114853E+01
-PKER_SDRYG( 6, 70) = 0.115081E+01
-PKER_SDRYG( 6, 71) = 0.115295E+01
-PKER_SDRYG( 6, 72) = 0.115496E+01
-PKER_SDRYG( 6, 73) = 0.115685E+01
-PKER_SDRYG( 6, 74) = 0.115862E+01
-PKER_SDRYG( 6, 75) = 0.116028E+01
-PKER_SDRYG( 6, 76) = 0.116185E+01
-PKER_SDRYG( 6, 77) = 0.116331E+01
-PKER_SDRYG( 6, 78) = 0.116469E+01
-PKER_SDRYG( 6, 79) = 0.116598E+01
-PKER_SDRYG( 6, 80) = 0.116720E+01
-PKER_SDRYG( 7, 1) = 0.260907E+01
-PKER_SDRYG( 7, 2) = 0.241619E+01
-PKER_SDRYG( 7, 3) = 0.223498E+01
-PKER_SDRYG( 7, 4) = 0.206469E+01
-PKER_SDRYG( 7, 5) = 0.190465E+01
-PKER_SDRYG( 7, 6) = 0.175420E+01
-PKER_SDRYG( 7, 7) = 0.161273E+01
-PKER_SDRYG( 7, 8) = 0.147968E+01
-PKER_SDRYG( 7, 9) = 0.135452E+01
-PKER_SDRYG( 7, 10) = 0.123679E+01
-PKER_SDRYG( 7, 11) = 0.112608E+01
-PKER_SDRYG( 7, 12) = 0.102203E+01
-PKER_SDRYG( 7, 13) = 0.924395E+00
-PKER_SDRYG( 7, 14) = 0.832994E+00
-PKER_SDRYG( 7, 15) = 0.747686E+00
-PKER_SDRYG( 7, 16) = 0.668663E+00
-PKER_SDRYG( 7, 17) = 0.595982E+00
-PKER_SDRYG( 7, 18) = 0.530112E+00
-PKER_SDRYG( 7, 19) = 0.471656E+00
-PKER_SDRYG( 7, 20) = 0.421355E+00
-PKER_SDRYG( 7, 21) = 0.380242E+00
-PKER_SDRYG( 7, 22) = 0.349372E+00
-PKER_SDRYG( 7, 23) = 0.329791E+00
-PKER_SDRYG( 7, 24) = 0.322253E+00
-PKER_SDRYG( 7, 25) = 0.326826E+00
-PKER_SDRYG( 7, 26) = 0.342721E+00
-PKER_SDRYG( 7, 27) = 0.368356E+00
-PKER_SDRYG( 7, 28) = 0.401308E+00
-PKER_SDRYG( 7, 29) = 0.438909E+00
-PKER_SDRYG( 7, 30) = 0.478603E+00
-PKER_SDRYG( 7, 31) = 0.518292E+00
-PKER_SDRYG( 7, 32) = 0.556526E+00
-PKER_SDRYG( 7, 33) = 0.592460E+00
-PKER_SDRYG( 7, 34) = 0.625570E+00
-PKER_SDRYG( 7, 35) = 0.655722E+00
-PKER_SDRYG( 7, 36) = 0.683000E+00
-PKER_SDRYG( 7, 37) = 0.707678E+00
-PKER_SDRYG( 7, 38) = 0.730054E+00
-PKER_SDRYG( 7, 39) = 0.750429E+00
-PKER_SDRYG( 7, 40) = 0.769036E+00
-PKER_SDRYG( 7, 41) = 0.786057E+00
-PKER_SDRYG( 7, 42) = 0.801649E+00
-PKER_SDRYG( 7, 43) = 0.815958E+00
-PKER_SDRYG( 7, 44) = 0.829120E+00
-PKER_SDRYG( 7, 45) = 0.841259E+00
-PKER_SDRYG( 7, 46) = 0.852485E+00
-PKER_SDRYG( 7, 47) = 0.862890E+00
-PKER_SDRYG( 7, 48) = 0.872553E+00
-PKER_SDRYG( 7, 49) = 0.881542E+00
-PKER_SDRYG( 7, 50) = 0.889916E+00
-PKER_SDRYG( 7, 51) = 0.897727E+00
-PKER_SDRYG( 7, 52) = 0.905020E+00
-PKER_SDRYG( 7, 53) = 0.911835E+00
-PKER_SDRYG( 7, 54) = 0.918209E+00
-PKER_SDRYG( 7, 55) = 0.924174E+00
-PKER_SDRYG( 7, 56) = 0.929759E+00
-PKER_SDRYG( 7, 57) = 0.934991E+00
-PKER_SDRYG( 7, 58) = 0.939893E+00
-PKER_SDRYG( 7, 59) = 0.944489E+00
-PKER_SDRYG( 7, 60) = 0.948798E+00
-PKER_SDRYG( 7, 61) = 0.952839E+00
-PKER_SDRYG( 7, 62) = 0.956630E+00
-PKER_SDRYG( 7, 63) = 0.960186E+00
-PKER_SDRYG( 7, 64) = 0.963523E+00
-PKER_SDRYG( 7, 65) = 0.966654E+00
-PKER_SDRYG( 7, 66) = 0.969593E+00
-PKER_SDRYG( 7, 67) = 0.972351E+00
-PKER_SDRYG( 7, 68) = 0.974940E+00
-PKER_SDRYG( 7, 69) = 0.977371E+00
-PKER_SDRYG( 7, 70) = 0.979652E+00
-PKER_SDRYG( 7, 71) = 0.981794E+00
-PKER_SDRYG( 7, 72) = 0.983805E+00
-PKER_SDRYG( 7, 73) = 0.985693E+00
-PKER_SDRYG( 7, 74) = 0.987465E+00
-PKER_SDRYG( 7, 75) = 0.989129E+00
-PKER_SDRYG( 7, 76) = 0.990691E+00
-PKER_SDRYG( 7, 77) = 0.992158E+00
-PKER_SDRYG( 7, 78) = 0.993536E+00
-PKER_SDRYG( 7, 79) = 0.994829E+00
-PKER_SDRYG( 7, 80) = 0.996043E+00
-PKER_SDRYG( 8, 1) = 0.268808E+01
-PKER_SDRYG( 8, 2) = 0.249531E+01
-PKER_SDRYG( 8, 3) = 0.231421E+01
-PKER_SDRYG( 8, 4) = 0.214408E+01
-PKER_SDRYG( 8, 5) = 0.198420E+01
-PKER_SDRYG( 8, 6) = 0.183395E+01
-PKER_SDRYG( 8, 7) = 0.169269E+01
-PKER_SDRYG( 8, 8) = 0.155984E+01
-PKER_SDRYG( 8, 9) = 0.143487E+01
-PKER_SDRYG( 8, 10) = 0.131725E+01
-PKER_SDRYG( 8, 11) = 0.120650E+01
-PKER_SDRYG( 8, 12) = 0.110220E+01
-PKER_SDRYG( 8, 13) = 0.100394E+01
-PKER_SDRYG( 8, 14) = 0.911405E+00
-PKER_SDRYG( 8, 15) = 0.824324E+00
-PKER_SDRYG( 8, 16) = 0.742517E+00
-PKER_SDRYG( 8, 17) = 0.665933E+00
-PKER_SDRYG( 8, 18) = 0.594638E+00
-PKER_SDRYG( 8, 19) = 0.528884E+00
-PKER_SDRYG( 8, 20) = 0.469090E+00
-PKER_SDRYG( 8, 21) = 0.415957E+00
-PKER_SDRYG( 8, 22) = 0.370337E+00
-PKER_SDRYG( 8, 23) = 0.333242E+00
-PKER_SDRYG( 8, 24) = 0.305950E+00
-PKER_SDRYG( 8, 25) = 0.289249E+00
-PKER_SDRYG( 8, 26) = 0.283562E+00
-PKER_SDRYG( 8, 27) = 0.288698E+00
-PKER_SDRYG( 8, 28) = 0.303569E+00
-PKER_SDRYG( 8, 29) = 0.326080E+00
-PKER_SDRYG( 8, 30) = 0.354197E+00
-PKER_SDRYG( 8, 31) = 0.385476E+00
-PKER_SDRYG( 8, 32) = 0.417888E+00
-PKER_SDRYG( 8, 33) = 0.450012E+00
-PKER_SDRYG( 8, 34) = 0.480758E+00
-PKER_SDRYG( 8, 35) = 0.509615E+00
-PKER_SDRYG( 8, 36) = 0.536330E+00
-PKER_SDRYG( 8, 37) = 0.560806E+00
-PKER_SDRYG( 8, 38) = 0.583098E+00
-PKER_SDRYG( 8, 39) = 0.603393E+00
-PKER_SDRYG( 8, 40) = 0.621917E+00
-PKER_SDRYG( 8, 41) = 0.638900E+00
-PKER_SDRYG( 8, 42) = 0.654515E+00
-PKER_SDRYG( 8, 43) = 0.668899E+00
-PKER_SDRYG( 8, 44) = 0.682163E+00
-PKER_SDRYG( 8, 45) = 0.694403E+00
-PKER_SDRYG( 8, 46) = 0.705715E+00
-PKER_SDRYG( 8, 47) = 0.716188E+00
-PKER_SDRYG( 8, 48) = 0.725905E+00
-PKER_SDRYG( 8, 49) = 0.734936E+00
-PKER_SDRYG( 8, 50) = 0.743343E+00
-PKER_SDRYG( 8, 51) = 0.751180E+00
-PKER_SDRYG( 8, 52) = 0.758493E+00
-PKER_SDRYG( 8, 53) = 0.765324E+00
-PKER_SDRYG( 8, 54) = 0.771711E+00
-PKER_SDRYG( 8, 55) = 0.777685E+00
-PKER_SDRYG( 8, 56) = 0.783278E+00
-PKER_SDRYG( 8, 57) = 0.788516E+00
-PKER_SDRYG( 8, 58) = 0.793423E+00
-PKER_SDRYG( 8, 59) = 0.798022E+00
-PKER_SDRYG( 8, 60) = 0.802334E+00
-PKER_SDRYG( 8, 61) = 0.806378E+00
-PKER_SDRYG( 8, 62) = 0.810170E+00
-PKER_SDRYG( 8, 63) = 0.813728E+00
-PKER_SDRYG( 8, 64) = 0.817066E+00
-PKER_SDRYG( 8, 65) = 0.820198E+00
-PKER_SDRYG( 8, 66) = 0.823138E+00
-PKER_SDRYG( 8, 67) = 0.825897E+00
-PKER_SDRYG( 8, 68) = 0.828486E+00
-PKER_SDRYG( 8, 69) = 0.830917E+00
-PKER_SDRYG( 8, 70) = 0.833199E+00
-PKER_SDRYG( 8, 71) = 0.835341E+00
-PKER_SDRYG( 8, 72) = 0.837352E+00
-PKER_SDRYG( 8, 73) = 0.839240E+00
-PKER_SDRYG( 8, 74) = 0.841012E+00
-PKER_SDRYG( 8, 75) = 0.842676E+00
-PKER_SDRYG( 8, 76) = 0.844239E+00
-PKER_SDRYG( 8, 77) = 0.845706E+00
-PKER_SDRYG( 8, 78) = 0.847083E+00
-PKER_SDRYG( 8, 79) = 0.848376E+00
-PKER_SDRYG( 8, 80) = 0.849590E+00
-PKER_SDRYG( 9, 1) = 0.275564E+01
-PKER_SDRYG( 9, 2) = 0.256293E+01
-PKER_SDRYG( 9, 3) = 0.238193E+01
-PKER_SDRYG( 9, 4) = 0.221190E+01
-PKER_SDRYG( 9, 5) = 0.205217E+01
-PKER_SDRYG( 9, 6) = 0.190207E+01
-PKER_SDRYG( 9, 7) = 0.176101E+01
-PKER_SDRYG( 9, 8) = 0.162840E+01
-PKER_SDRYG( 9, 9) = 0.150369E+01
-PKER_SDRYG( 9, 10) = 0.138636E+01
-PKER_SDRYG( 9, 11) = 0.127591E+01
-PKER_SDRYG( 9, 12) = 0.117189E+01
-PKER_SDRYG( 9, 13) = 0.107383E+01
-PKER_SDRYG( 9, 14) = 0.981348E+00
-PKER_SDRYG( 9, 15) = 0.894068E+00
-PKER_SDRYG( 9, 16) = 0.811669E+00
-PKER_SDRYG( 9, 17) = 0.733887E+00
-PKER_SDRYG( 9, 18) = 0.660583E+00
-PKER_SDRYG( 9, 19) = 0.591697E+00
-PKER_SDRYG( 9, 20) = 0.527256E+00
-PKER_SDRYG( 9, 21) = 0.467682E+00
-PKER_SDRYG( 9, 22) = 0.413317E+00
-PKER_SDRYG( 9, 23) = 0.365031E+00
-PKER_SDRYG( 9, 24) = 0.323791E+00
-PKER_SDRYG( 9, 25) = 0.290658E+00
-PKER_SDRYG( 9, 26) = 0.266690E+00
-PKER_SDRYG( 9, 27) = 0.252585E+00
-PKER_SDRYG( 9, 28) = 0.248523E+00
-PKER_SDRYG( 9, 29) = 0.253813E+00
-PKER_SDRYG( 9, 30) = 0.267126E+00
-PKER_SDRYG( 9, 31) = 0.286549E+00
-PKER_SDRYG( 9, 32) = 0.310052E+00
-PKER_SDRYG( 9, 33) = 0.335770E+00
-PKER_SDRYG( 9, 34) = 0.362148E+00
-PKER_SDRYG( 9, 35) = 0.388099E+00
-PKER_SDRYG( 9, 36) = 0.412943E+00
-PKER_SDRYG( 9, 37) = 0.436301E+00
-PKER_SDRYG( 9, 38) = 0.458056E+00
-PKER_SDRYG( 9, 39) = 0.478119E+00
-PKER_SDRYG( 9, 40) = 0.496541E+00
-PKER_SDRYG( 9, 41) = 0.513430E+00
-PKER_SDRYG( 9, 42) = 0.528947E+00
-PKER_SDRYG( 9, 43) = 0.543240E+00
-PKER_SDRYG( 9, 44) = 0.556460E+00
-PKER_SDRYG( 9, 45) = 0.568710E+00
-PKER_SDRYG( 9, 46) = 0.580067E+00
-PKER_SDRYG( 9, 47) = 0.590600E+00
-PKER_SDRYG( 9, 48) = 0.600373E+00
-PKER_SDRYG( 9, 49) = 0.609450E+00
-PKER_SDRYG( 9, 50) = 0.617894E+00
-PKER_SDRYG( 9, 51) = 0.625759E+00
-PKER_SDRYG( 9, 52) = 0.633095E+00
-PKER_SDRYG( 9, 53) = 0.639944E+00
-PKER_SDRYG( 9, 54) = 0.646345E+00
-PKER_SDRYG( 9, 55) = 0.652330E+00
-PKER_SDRYG( 9, 56) = 0.657931E+00
-PKER_SDRYG( 9, 57) = 0.663176E+00
-PKER_SDRYG( 9, 58) = 0.668088E+00
-PKER_SDRYG( 9, 59) = 0.672692E+00
-PKER_SDRYG( 9, 60) = 0.677007E+00
-PKER_SDRYG( 9, 61) = 0.681053E+00
-PKER_SDRYG( 9, 62) = 0.684847E+00
-PKER_SDRYG( 9, 63) = 0.688406E+00
-PKER_SDRYG( 9, 64) = 0.691746E+00
-PKER_SDRYG( 9, 65) = 0.694879E+00
-PKER_SDRYG( 9, 66) = 0.697819E+00
-PKER_SDRYG( 9, 67) = 0.700579E+00
-PKER_SDRYG( 9, 68) = 0.703169E+00
-PKER_SDRYG( 9, 69) = 0.705600E+00
-PKER_SDRYG( 9, 70) = 0.707882E+00
-PKER_SDRYG( 9, 71) = 0.710024E+00
-PKER_SDRYG( 9, 72) = 0.712035E+00
-PKER_SDRYG( 9, 73) = 0.713923E+00
-PKER_SDRYG( 9, 74) = 0.715696E+00
-PKER_SDRYG( 9, 75) = 0.717360E+00
-PKER_SDRYG( 9, 76) = 0.718923E+00
-PKER_SDRYG( 9, 77) = 0.720390E+00
-PKER_SDRYG( 9, 78) = 0.721767E+00
-PKER_SDRYG( 9, 79) = 0.723060E+00
-PKER_SDRYG( 9, 80) = 0.724275E+00
-PKER_SDRYG( 10, 1) = 0.281339E+01
-PKER_SDRYG( 10, 2) = 0.262074E+01
-PKER_SDRYG( 10, 3) = 0.243980E+01
-PKER_SDRYG( 10, 4) = 0.226986E+01
-PKER_SDRYG( 10, 5) = 0.211022E+01
-PKER_SDRYG( 10, 6) = 0.196025E+01
-PKER_SDRYG( 10, 7) = 0.181933E+01
-PKER_SDRYG( 10, 8) = 0.168691E+01
-PKER_SDRYG( 10, 9) = 0.156242E+01
-PKER_SDRYG( 10, 10) = 0.144536E+01
-PKER_SDRYG( 10, 11) = 0.133523E+01
-PKER_SDRYG( 10, 12) = 0.123156E+01
-PKER_SDRYG( 10, 13) = 0.113391E+01
-PKER_SDRYG( 10, 14) = 0.104185E+01
-PKER_SDRYG( 10, 15) = 0.954965E+00
-PKER_SDRYG( 10, 16) = 0.872886E+00
-PKER_SDRYG( 10, 17) = 0.795260E+00
-PKER_SDRYG( 10, 18) = 0.721777E+00
-PKER_SDRYG( 10, 19) = 0.652200E+00
-PKER_SDRYG( 10, 20) = 0.586370E+00
-PKER_SDRYG( 10, 21) = 0.524237E+00
-PKER_SDRYG( 10, 22) = 0.465940E+00
-PKER_SDRYG( 10, 23) = 0.411811E+00
-PKER_SDRYG( 10, 24) = 0.362455E+00
-PKER_SDRYG( 10, 25) = 0.318654E+00
-PKER_SDRYG( 10, 26) = 0.281514E+00
-PKER_SDRYG( 10, 27) = 0.252070E+00
-PKER_SDRYG( 10, 28) = 0.231143E+00
-PKER_SDRYG( 10, 29) = 0.219455E+00
-PKER_SDRYG( 10, 30) = 0.216610E+00
-PKER_SDRYG( 10, 31) = 0.221694E+00
-PKER_SDRYG( 10, 32) = 0.233350E+00
-PKER_SDRYG( 10, 33) = 0.249808E+00
-PKER_SDRYG( 10, 34) = 0.269212E+00
-PKER_SDRYG( 10, 35) = 0.290255E+00
-PKER_SDRYG( 10, 36) = 0.311688E+00
-PKER_SDRYG( 10, 37) = 0.332740E+00
-PKER_SDRYG( 10, 38) = 0.352968E+00
-PKER_SDRYG( 10, 39) = 0.372057E+00
-PKER_SDRYG( 10, 40) = 0.389931E+00
-PKER_SDRYG( 10, 41) = 0.406557E+00
-PKER_SDRYG( 10, 42) = 0.421943E+00
-PKER_SDRYG( 10, 43) = 0.436139E+00
-PKER_SDRYG( 10, 44) = 0.449248E+00
-PKER_SDRYG( 10, 45) = 0.461385E+00
-PKER_SDRYG( 10, 46) = 0.472660E+00
-PKER_SDRYG( 10, 47) = 0.483158E+00
-PKER_SDRYG( 10, 48) = 0.492934E+00
-PKER_SDRYG( 10, 49) = 0.502040E+00
-PKER_SDRYG( 10, 50) = 0.510518E+00
-PKER_SDRYG( 10, 51) = 0.518414E+00
-PKER_SDRYG( 10, 52) = 0.525775E+00
-PKER_SDRYG( 10, 53) = 0.532644E+00
-PKER_SDRYG( 10, 54) = 0.539059E+00
-PKER_SDRYG( 10, 55) = 0.545057E+00
-PKER_SDRYG( 10, 56) = 0.550668E+00
-PKER_SDRYG( 10, 57) = 0.555919E+00
-PKER_SDRYG( 10, 58) = 0.560838E+00
-PKER_SDRYG( 10, 59) = 0.565446E+00
-PKER_SDRYG( 10, 60) = 0.569764E+00
-PKER_SDRYG( 10, 61) = 0.573813E+00
-PKER_SDRYG( 10, 62) = 0.577610E+00
-PKER_SDRYG( 10, 63) = 0.581171E+00
-PKER_SDRYG( 10, 64) = 0.584512E+00
-PKER_SDRYG( 10, 65) = 0.587646E+00
-PKER_SDRYG( 10, 66) = 0.590587E+00
-PKER_SDRYG( 10, 67) = 0.593347E+00
-PKER_SDRYG( 10, 68) = 0.595938E+00
-PKER_SDRYG( 10, 69) = 0.598369E+00
-PKER_SDRYG( 10, 70) = 0.600652E+00
-PKER_SDRYG( 10, 71) = 0.602794E+00
-PKER_SDRYG( 10, 72) = 0.604806E+00
-PKER_SDRYG( 10, 73) = 0.606694E+00
-PKER_SDRYG( 10, 74) = 0.608466E+00
-PKER_SDRYG( 10, 75) = 0.610131E+00
-PKER_SDRYG( 10, 76) = 0.611693E+00
-PKER_SDRYG( 10, 77) = 0.613160E+00
-PKER_SDRYG( 10, 78) = 0.614538E+00
-PKER_SDRYG( 10, 79) = 0.615831E+00
-PKER_SDRYG( 10, 80) = 0.617046E+00
-PKER_SDRYG( 11, 1) = 0.286279E+01
-PKER_SDRYG( 11, 2) = 0.267017E+01
-PKER_SDRYG( 11, 3) = 0.248928E+01
-PKER_SDRYG( 11, 4) = 0.231939E+01
-PKER_SDRYG( 11, 5) = 0.215982E+01
-PKER_SDRYG( 11, 6) = 0.200994E+01
-PKER_SDRYG( 11, 7) = 0.186913E+01
-PKER_SDRYG( 11, 8) = 0.173684E+01
-PKER_SDRYG( 11, 9) = 0.161251E+01
-PKER_SDRYG( 11, 10) = 0.149565E+01
-PKER_SDRYG( 11, 11) = 0.138577E+01
-PKER_SDRYG( 11, 12) = 0.128240E+01
-PKER_SDRYG( 11, 13) = 0.118511E+01
-PKER_SDRYG( 11, 14) = 0.109347E+01
-PKER_SDRYG( 11, 15) = 0.100708E+01
-PKER_SDRYG( 11, 16) = 0.925546E+00
-PKER_SDRYG( 11, 17) = 0.848487E+00
-PKER_SDRYG( 11, 18) = 0.775551E+00
-PKER_SDRYG( 11, 19) = 0.706400E+00
-PKER_SDRYG( 11, 20) = 0.640753E+00
-PKER_SDRYG( 11, 21) = 0.578370E+00
-PKER_SDRYG( 11, 22) = 0.519096E+00
-PKER_SDRYG( 11, 23) = 0.462949E+00
-PKER_SDRYG( 11, 24) = 0.410097E+00
-PKER_SDRYG( 11, 25) = 0.360879E+00
-PKER_SDRYG( 11, 26) = 0.316082E+00
-PKER_SDRYG( 11, 27) = 0.276453E+00
-PKER_SDRYG( 11, 28) = 0.243203E+00
-PKER_SDRYG( 11, 29) = 0.217282E+00
-PKER_SDRYG( 11, 30) = 0.199406E+00
-PKER_SDRYG( 11, 31) = 0.189721E+00
-PKER_SDRYG( 11, 32) = 0.187743E+00
-PKER_SDRYG( 11, 33) = 0.192493E+00
-PKER_SDRYG( 11, 34) = 0.202438E+00
-PKER_SDRYG( 11, 35) = 0.216099E+00
-PKER_SDRYG( 11, 36) = 0.232081E+00
-PKER_SDRYG( 11, 37) = 0.249224E+00
-PKER_SDRYG( 11, 38) = 0.266689E+00
-PKER_SDRYG( 11, 39) = 0.283887E+00
-PKER_SDRYG( 11, 40) = 0.300456E+00
-PKER_SDRYG( 11, 41) = 0.316204E+00
-PKER_SDRYG( 11, 42) = 0.331029E+00
-PKER_SDRYG( 11, 43) = 0.344935E+00
-PKER_SDRYG( 11, 44) = 0.357888E+00
-PKER_SDRYG( 11, 45) = 0.369919E+00
-PKER_SDRYG( 11, 46) = 0.381090E+00
-PKER_SDRYG( 11, 47) = 0.391476E+00
-PKER_SDRYG( 11, 48) = 0.401151E+00
-PKER_SDRYG( 11, 49) = 0.410193E+00
-PKER_SDRYG( 11, 50) = 0.418645E+00
-PKER_SDRYG( 11, 51) = 0.426545E+00
-PKER_SDRYG( 11, 52) = 0.433924E+00
-PKER_SDRYG( 11, 53) = 0.440812E+00
-PKER_SDRYG( 11, 54) = 0.447244E+00
-PKER_SDRYG( 11, 55) = 0.453255E+00
-PKER_SDRYG( 11, 56) = 0.458876E+00
-PKER_SDRYG( 11, 57) = 0.464136E+00
-PKER_SDRYG( 11, 58) = 0.469061E+00
-PKER_SDRYG( 11, 59) = 0.473674E+00
-PKER_SDRYG( 11, 60) = 0.477997E+00
-PKER_SDRYG( 11, 61) = 0.482049E+00
-PKER_SDRYG( 11, 62) = 0.485848E+00
-PKER_SDRYG( 11, 63) = 0.489411E+00
-PKER_SDRYG( 11, 64) = 0.492753E+00
-PKER_SDRYG( 11, 65) = 0.495889E+00
-PKER_SDRYG( 11, 66) = 0.498831E+00
-PKER_SDRYG( 11, 67) = 0.501592E+00
-PKER_SDRYG( 11, 68) = 0.504183E+00
-PKER_SDRYG( 11, 69) = 0.506615E+00
-PKER_SDRYG( 11, 70) = 0.508897E+00
-PKER_SDRYG( 11, 71) = 0.511040E+00
-PKER_SDRYG( 11, 72) = 0.513052E+00
-PKER_SDRYG( 11, 73) = 0.514940E+00
-PKER_SDRYG( 11, 74) = 0.516713E+00
-PKER_SDRYG( 11, 75) = 0.518377E+00
-PKER_SDRYG( 11, 76) = 0.519940E+00
-PKER_SDRYG( 11, 77) = 0.521407E+00
-PKER_SDRYG( 11, 78) = 0.522785E+00
-PKER_SDRYG( 11, 79) = 0.524078E+00
-PKER_SDRYG( 11, 80) = 0.525292E+00
-PKER_SDRYG( 12, 1) = 0.290503E+01
-PKER_SDRYG( 12, 2) = 0.271244E+01
-PKER_SDRYG( 12, 3) = 0.253159E+01
-PKER_SDRYG( 12, 4) = 0.236174E+01
-PKER_SDRYG( 12, 5) = 0.220222E+01
-PKER_SDRYG( 12, 6) = 0.205240E+01
-PKER_SDRYG( 12, 7) = 0.191167E+01
-PKER_SDRYG( 12, 8) = 0.177947E+01
-PKER_SDRYG( 12, 9) = 0.165526E+01
-PKER_SDRYG( 12, 10) = 0.153854E+01
-PKER_SDRYG( 12, 11) = 0.142884E+01
-PKER_SDRYG( 12, 12) = 0.132569E+01
-PKER_SDRYG( 12, 13) = 0.122867E+01
-PKER_SDRYG( 12, 14) = 0.113737E+01
-PKER_SDRYG( 12, 15) = 0.105138E+01
-PKER_SDRYG( 12, 16) = 0.970330E+00
-PKER_SDRYG( 12, 17) = 0.893842E+00
-PKER_SDRYG( 12, 18) = 0.821558E+00
-PKER_SDRYG( 12, 19) = 0.753126E+00
-PKER_SDRYG( 12, 20) = 0.688212E+00
-PKER_SDRYG( 12, 21) = 0.626503E+00
-PKER_SDRYG( 12, 22) = 0.567718E+00
-PKER_SDRYG( 12, 23) = 0.511639E+00
-PKER_SDRYG( 12, 24) = 0.458154E+00
-PKER_SDRYG( 12, 25) = 0.407296E+00
-PKER_SDRYG( 12, 26) = 0.359273E+00
-PKER_SDRYG( 12, 27) = 0.314578E+00
-PKER_SDRYG( 12, 28) = 0.273965E+00
-PKER_SDRYG( 12, 29) = 0.238418E+00
-PKER_SDRYG( 12, 30) = 0.208881E+00
-PKER_SDRYG( 12, 31) = 0.186324E+00
-PKER_SDRYG( 12, 32) = 0.171136E+00
-PKER_SDRYG( 12, 33) = 0.163113E+00
-PKER_SDRYG( 12, 34) = 0.161842E+00
-PKER_SDRYG( 12, 35) = 0.166025E+00
-PKER_SDRYG( 12, 36) = 0.174355E+00
-PKER_SDRYG( 12, 37) = 0.185633E+00
-PKER_SDRYG( 12, 38) = 0.198742E+00
-PKER_SDRYG( 12, 39) = 0.212721E+00
-PKER_SDRYG( 12, 40) = 0.227030E+00
-PKER_SDRYG( 12, 41) = 0.241162E+00
-PKER_SDRYG( 12, 42) = 0.254861E+00
-PKER_SDRYG( 12, 43) = 0.267967E+00
-PKER_SDRYG( 12, 44) = 0.280379E+00
-PKER_SDRYG( 12, 45) = 0.292088E+00
-PKER_SDRYG( 12, 46) = 0.303077E+00
-PKER_SDRYG( 12, 47) = 0.313351E+00
-PKER_SDRYG( 12, 48) = 0.322928E+00
-PKER_SDRYG( 12, 49) = 0.331860E+00
-PKER_SDRYG( 12, 50) = 0.340209E+00
-PKER_SDRYG( 12, 51) = 0.348028E+00
-PKER_SDRYG( 12, 52) = 0.355361E+00
-PKER_SDRYG( 12, 53) = 0.362233E+00
-PKER_SDRYG( 12, 54) = 0.368670E+00
-PKER_SDRYG( 12, 55) = 0.374691E+00
-PKER_SDRYG( 12, 56) = 0.380324E+00
-PKER_SDRYG( 12, 57) = 0.385593E+00
-PKER_SDRYG( 12, 58) = 0.390524E+00
-PKER_SDRYG( 12, 59) = 0.395143E+00
-PKER_SDRYG( 12, 60) = 0.399470E+00
-PKER_SDRYG( 12, 61) = 0.403526E+00
-PKER_SDRYG( 12, 62) = 0.407327E+00
-PKER_SDRYG( 12, 63) = 0.410893E+00
-PKER_SDRYG( 12, 64) = 0.414236E+00
-PKER_SDRYG( 12, 65) = 0.417373E+00
-PKER_SDRYG( 12, 66) = 0.420316E+00
-PKER_SDRYG( 12, 67) = 0.423078E+00
-PKER_SDRYG( 12, 68) = 0.425670E+00
-PKER_SDRYG( 12, 69) = 0.428102E+00
-PKER_SDRYG( 12, 70) = 0.430385E+00
-PKER_SDRYG( 12, 71) = 0.432529E+00
-PKER_SDRYG( 12, 72) = 0.434540E+00
-PKER_SDRYG( 12, 73) = 0.436429E+00
-PKER_SDRYG( 12, 74) = 0.438202E+00
-PKER_SDRYG( 12, 75) = 0.439866E+00
-PKER_SDRYG( 12, 76) = 0.441429E+00
-PKER_SDRYG( 12, 77) = 0.442896E+00
-PKER_SDRYG( 12, 78) = 0.444274E+00
-PKER_SDRYG( 12, 79) = 0.445567E+00
-PKER_SDRYG( 12, 80) = 0.446782E+00
-PKER_SDRYG( 13, 1) = 0.294116E+01
-PKER_SDRYG( 13, 2) = 0.274860E+01
-PKER_SDRYG( 13, 3) = 0.256776E+01
-PKER_SDRYG( 13, 4) = 0.239794E+01
-PKER_SDRYG( 13, 5) = 0.223846E+01
-PKER_SDRYG( 13, 6) = 0.208868E+01
-PKER_SDRYG( 13, 7) = 0.194801E+01
-PKER_SDRYG( 13, 8) = 0.181587E+01
-PKER_SDRYG( 13, 9) = 0.169175E+01
-PKER_SDRYG( 13, 10) = 0.157514E+01
-PKER_SDRYG( 13, 11) = 0.146556E+01
-PKER_SDRYG( 13, 12) = 0.136257E+01
-PKER_SDRYG( 13, 13) = 0.126575E+01
-PKER_SDRYG( 13, 14) = 0.117468E+01
-PKER_SDRYG( 13, 15) = 0.108900E+01
-PKER_SDRYG( 13, 16) = 0.100831E+01
-PKER_SDRYG( 13, 17) = 0.932272E+00
-PKER_SDRYG( 13, 18) = 0.860531E+00
-PKER_SDRYG( 13, 19) = 0.792747E+00
-PKER_SDRYG( 13, 20) = 0.728588E+00
-PKER_SDRYG( 13, 21) = 0.667726E+00
-PKER_SDRYG( 13, 22) = 0.609845E+00
-PKER_SDRYG( 13, 23) = 0.554648E+00
-PKER_SDRYG( 13, 24) = 0.501871E+00
-PKER_SDRYG( 13, 25) = 0.451333E+00
-PKER_SDRYG( 13, 26) = 0.402944E+00
-PKER_SDRYG( 13, 27) = 0.356772E+00
-PKER_SDRYG( 13, 28) = 0.313151E+00
-PKER_SDRYG( 13, 29) = 0.272660E+00
-PKER_SDRYG( 13, 30) = 0.236041E+00
-PKER_SDRYG( 13, 31) = 0.204371E+00
-PKER_SDRYG( 13, 32) = 0.178425E+00
-PKER_SDRYG( 13, 33) = 0.159000E+00
-PKER_SDRYG( 13, 34) = 0.146216E+00
-PKER_SDRYG( 13, 35) = 0.139774E+00
-PKER_SDRYG( 13, 36) = 0.138831E+00
-PKER_SDRYG( 13, 37) = 0.142350E+00
-PKER_SDRYG( 13, 38) = 0.149306E+00
-PKER_SDRYG( 13, 39) = 0.158537E+00
-PKER_SDRYG( 13, 40) = 0.169222E+00
-PKER_SDRYG( 13, 41) = 0.180703E+00
-PKER_SDRYG( 13, 42) = 0.192460E+00
-PKER_SDRYG( 13, 43) = 0.204154E+00
-PKER_SDRYG( 13, 44) = 0.215558E+00
-PKER_SDRYG( 13, 45) = 0.226529E+00
-PKER_SDRYG( 13, 46) = 0.237000E+00
-PKER_SDRYG( 13, 47) = 0.246921E+00
-PKER_SDRYG( 13, 48) = 0.256303E+00
-PKER_SDRYG( 13, 49) = 0.265115E+00
-PKER_SDRYG( 13, 50) = 0.273367E+00
-PKER_SDRYG( 13, 51) = 0.281092E+00
-PKER_SDRYG( 13, 52) = 0.288326E+00
-PKER_SDRYG( 13, 53) = 0.295112E+00
-PKER_SDRYG( 13, 54) = 0.301489E+00
-PKER_SDRYG( 13, 55) = 0.307481E+00
-PKER_SDRYG( 13, 56) = 0.313105E+00
-PKER_SDRYG( 13, 57) = 0.318378E+00
-PKER_SDRYG( 13, 58) = 0.323316E+00
-PKER_SDRYG( 13, 59) = 0.327941E+00
-PKER_SDRYG( 13, 60) = 0.332273E+00
-PKER_SDRYG( 13, 61) = 0.336332E+00
-PKER_SDRYG( 13, 62) = 0.340137E+00
-PKER_SDRYG( 13, 63) = 0.343705E+00
-PKER_SDRYG( 13, 64) = 0.347050E+00
-PKER_SDRYG( 13, 65) = 0.350189E+00
-PKER_SDRYG( 13, 66) = 0.353133E+00
-PKER_SDRYG( 13, 67) = 0.355895E+00
-PKER_SDRYG( 13, 68) = 0.358488E+00
-PKER_SDRYG( 13, 69) = 0.360921E+00
-PKER_SDRYG( 13, 70) = 0.363204E+00
-PKER_SDRYG( 13, 71) = 0.365348E+00
-PKER_SDRYG( 13, 72) = 0.367360E+00
-PKER_SDRYG( 13, 73) = 0.369249E+00
-PKER_SDRYG( 13, 74) = 0.371022E+00
-PKER_SDRYG( 13, 75) = 0.372687E+00
-PKER_SDRYG( 13, 76) = 0.374249E+00
-PKER_SDRYG( 13, 77) = 0.375717E+00
-PKER_SDRYG( 13, 78) = 0.377094E+00
-PKER_SDRYG( 13, 79) = 0.378388E+00
-PKER_SDRYG( 13, 80) = 0.379602E+00
-PKER_SDRYG( 14, 1) = 0.297207E+01
-PKER_SDRYG( 14, 2) = 0.277952E+01
-PKER_SDRYG( 14, 3) = 0.259870E+01
-PKER_SDRYG( 14, 4) = 0.242890E+01
-PKER_SDRYG( 14, 5) = 0.226945E+01
-PKER_SDRYG( 14, 6) = 0.211970E+01
-PKER_SDRYG( 14, 7) = 0.197907E+01
-PKER_SDRYG( 14, 8) = 0.184698E+01
-PKER_SDRYG( 14, 9) = 0.172292E+01
-PKER_SDRYG( 14, 10) = 0.160638E+01
-PKER_SDRYG( 14, 11) = 0.149689E+01
-PKER_SDRYG( 14, 12) = 0.139402E+01
-PKER_SDRYG( 14, 13) = 0.129733E+01
-PKER_SDRYG( 14, 14) = 0.120644E+01
-PKER_SDRYG( 14, 15) = 0.112096E+01
-PKER_SDRYG( 14, 16) = 0.104054E+01
-PKER_SDRYG( 14, 17) = 0.964829E+00
-PKER_SDRYG( 14, 18) = 0.893490E+00
-PKER_SDRYG( 14, 19) = 0.826201E+00
-PKER_SDRYG( 14, 20) = 0.762643E+00
-PKER_SDRYG( 14, 21) = 0.702504E+00
-PKER_SDRYG( 14, 22) = 0.645473E+00
-PKER_SDRYG( 14, 23) = 0.591245E+00
-PKER_SDRYG( 14, 24) = 0.539521E+00
-PKER_SDRYG( 14, 25) = 0.490023E+00
-PKER_SDRYG( 14, 26) = 0.442518E+00
-PKER_SDRYG( 14, 27) = 0.396845E+00
-PKER_SDRYG( 14, 28) = 0.352973E+00
-PKER_SDRYG( 14, 29) = 0.311060E+00
-PKER_SDRYG( 14, 30) = 0.271520E+00
-PKER_SDRYG( 14, 31) = 0.234965E+00
-PKER_SDRYG( 14, 32) = 0.202244E+00
-PKER_SDRYG( 14, 33) = 0.174293E+00
-PKER_SDRYG( 14, 34) = 0.151865E+00
-PKER_SDRYG( 14, 35) = 0.135292E+00
-PKER_SDRYG( 14, 36) = 0.124633E+00
-PKER_SDRYG( 14, 37) = 0.119330E+00
-PKER_SDRYG( 14, 38) = 0.118542E+00
-PKER_SDRYG( 14, 39) = 0.121495E+00
-PKER_SDRYG( 14, 40) = 0.127159E+00
-PKER_SDRYG( 14, 41) = 0.134675E+00
-PKER_SDRYG( 14, 42) = 0.143414E+00
-PKER_SDRYG( 14, 43) = 0.152859E+00
-PKER_SDRYG( 14, 44) = 0.162557E+00
-PKER_SDRYG( 14, 45) = 0.172292E+00
-PKER_SDRYG( 14, 46) = 0.181843E+00
-PKER_SDRYG( 14, 47) = 0.191099E+00
-PKER_SDRYG( 14, 48) = 0.199979E+00
-PKER_SDRYG( 14, 49) = 0.208440E+00
-PKER_SDRYG( 14, 50) = 0.216475E+00
-PKER_SDRYG( 14, 51) = 0.224064E+00
-PKER_SDRYG( 14, 52) = 0.231208E+00
-PKER_SDRYG( 14, 53) = 0.237909E+00
-PKER_SDRYG( 14, 54) = 0.244196E+00
-PKER_SDRYG( 14, 55) = 0.250103E+00
-PKER_SDRYG( 14, 56) = 0.255661E+00
-PKER_SDRYG( 14, 57) = 0.260893E+00
-PKER_SDRYG( 14, 58) = 0.265814E+00
-PKER_SDRYG( 14, 59) = 0.270436E+00
-PKER_SDRYG( 14, 60) = 0.274770E+00
-PKER_SDRYG( 14, 61) = 0.278833E+00
-PKER_SDRYG( 14, 62) = 0.282641E+00
-PKER_SDRYG( 14, 63) = 0.286212E+00
-PKER_SDRYG( 14, 64) = 0.289559E+00
-PKER_SDRYG( 14, 65) = 0.292699E+00
-PKER_SDRYG( 14, 66) = 0.295645E+00
-PKER_SDRYG( 14, 67) = 0.298408E+00
-PKER_SDRYG( 14, 68) = 0.301002E+00
-PKER_SDRYG( 14, 69) = 0.303435E+00
-PKER_SDRYG( 14, 70) = 0.305719E+00
-PKER_SDRYG( 14, 71) = 0.307863E+00
-PKER_SDRYG( 14, 72) = 0.309875E+00
-PKER_SDRYG( 14, 73) = 0.311764E+00
-PKER_SDRYG( 14, 74) = 0.313538E+00
-PKER_SDRYG( 14, 75) = 0.315203E+00
-PKER_SDRYG( 14, 76) = 0.316766E+00
-PKER_SDRYG( 14, 77) = 0.318233E+00
-PKER_SDRYG( 14, 78) = 0.319611E+00
-PKER_SDRYG( 14, 79) = 0.320904E+00
-PKER_SDRYG( 14, 80) = 0.322119E+00
-PKER_SDRYG( 15, 1) = 0.299851E+01
-PKER_SDRYG( 15, 2) = 0.280597E+01
-PKER_SDRYG( 15, 3) = 0.262516E+01
-PKER_SDRYG( 15, 4) = 0.245538E+01
-PKER_SDRYG( 15, 5) = 0.229594E+01
-PKER_SDRYG( 15, 6) = 0.214622E+01
-PKER_SDRYG( 15, 7) = 0.200561E+01
-PKER_SDRYG( 15, 8) = 0.187356E+01
-PKER_SDRYG( 15, 9) = 0.174954E+01
-PKER_SDRYG( 15, 10) = 0.163306E+01
-PKER_SDRYG( 15, 11) = 0.152364E+01
-PKER_SDRYG( 15, 12) = 0.142084E+01
-PKER_SDRYG( 15, 13) = 0.132426E+01
-PKER_SDRYG( 15, 14) = 0.123349E+01
-PKER_SDRYG( 15, 15) = 0.114816E+01
-PKER_SDRYG( 15, 16) = 0.106793E+01
-PKER_SDRYG( 15, 17) = 0.992448E+00
-PKER_SDRYG( 15, 18) = 0.921397E+00
-PKER_SDRYG( 15, 19) = 0.854464E+00
-PKER_SDRYG( 15, 20) = 0.791346E+00
-PKER_SDRYG( 15, 21) = 0.731749E+00
-PKER_SDRYG( 15, 22) = 0.675379E+00
-PKER_SDRYG( 15, 23) = 0.621947E+00
-PKER_SDRYG( 15, 24) = 0.571164E+00
-PKER_SDRYG( 15, 25) = 0.522742E+00
-PKER_SDRYG( 15, 26) = 0.476405E+00
-PKER_SDRYG( 15, 27) = 0.431900E+00
-PKER_SDRYG( 15, 28) = 0.389024E+00
-PKER_SDRYG( 15, 29) = 0.347667E+00
-PKER_SDRYG( 15, 30) = 0.307875E+00
-PKER_SDRYG( 15, 31) = 0.269889E+00
-PKER_SDRYG( 15, 32) = 0.234170E+00
-PKER_SDRYG( 15, 33) = 0.201437E+00
-PKER_SDRYG( 15, 34) = 0.172542E+00
-PKER_SDRYG( 15, 35) = 0.148167E+00
-PKER_SDRYG( 15, 36) = 0.128950E+00
-PKER_SDRYG( 15, 37) = 0.114938E+00
-PKER_SDRYG( 15, 38) = 0.106032E+00
-PKER_SDRYG( 15, 39) = 0.101607E+00
-PKER_SDRYG( 15, 40) = 0.100983E+00
-PKER_SDRYG( 15, 41) = 0.103298E+00
-PKER_SDRYG( 15, 42) = 0.107818E+00
-PKER_SDRYG( 15, 43) = 0.113963E+00
-PKER_SDRYG( 15, 44) = 0.121100E+00
-PKER_SDRYG( 15, 45) = 0.128845E+00
-PKER_SDRYG( 15, 46) = 0.136912E+00
-PKER_SDRYG( 15, 47) = 0.145044E+00
-PKER_SDRYG( 15, 48) = 0.153081E+00
-PKER_SDRYG( 15, 49) = 0.160916E+00
-PKER_SDRYG( 15, 50) = 0.168474E+00
-PKER_SDRYG( 15, 51) = 0.175721E+00
-PKER_SDRYG( 15, 52) = 0.182625E+00
-PKER_SDRYG( 15, 53) = 0.189185E+00
-PKER_SDRYG( 15, 54) = 0.195380E+00
-PKER_SDRYG( 15, 55) = 0.201210E+00
-PKER_SDRYG( 15, 56) = 0.206690E+00
-PKER_SDRYG( 15, 57) = 0.211845E+00
-PKER_SDRYG( 15, 58) = 0.216698E+00
-PKER_SDRYG( 15, 59) = 0.221272E+00
-PKER_SDRYG( 15, 60) = 0.225581E+00
-PKER_SDRYG( 15, 61) = 0.229635E+00
-PKER_SDRYG( 15, 62) = 0.233442E+00
-PKER_SDRYG( 15, 63) = 0.237014E+00
-PKER_SDRYG( 15, 64) = 0.240364E+00
-PKER_SDRYG( 15, 65) = 0.243506E+00
-PKER_SDRYG( 15, 66) = 0.246453E+00
-PKER_SDRYG( 15, 67) = 0.249217E+00
-PKER_SDRYG( 15, 68) = 0.251811E+00
-PKER_SDRYG( 15, 69) = 0.254246E+00
-PKER_SDRYG( 15, 70) = 0.256530E+00
-PKER_SDRYG( 15, 71) = 0.258674E+00
-PKER_SDRYG( 15, 72) = 0.260687E+00
-PKER_SDRYG( 15, 73) = 0.262576E+00
-PKER_SDRYG( 15, 74) = 0.264350E+00
-PKER_SDRYG( 15, 75) = 0.266015E+00
-PKER_SDRYG( 15, 76) = 0.267578E+00
-PKER_SDRYG( 15, 77) = 0.269046E+00
-PKER_SDRYG( 15, 78) = 0.270423E+00
-PKER_SDRYG( 15, 79) = 0.271717E+00
-PKER_SDRYG( 15, 80) = 0.272931E+00
-PKER_SDRYG( 16, 1) = 0.302113E+01
-PKER_SDRYG( 16, 2) = 0.282859E+01
-PKER_SDRYG( 16, 3) = 0.264780E+01
-PKER_SDRYG( 16, 4) = 0.247803E+01
-PKER_SDRYG( 16, 5) = 0.231860E+01
-PKER_SDRYG( 16, 6) = 0.216890E+01
-PKER_SDRYG( 16, 7) = 0.202831E+01
-PKER_SDRYG( 16, 8) = 0.189629E+01
-PKER_SDRYG( 16, 9) = 0.177230E+01
-PKER_SDRYG( 16, 10) = 0.165585E+01
-PKER_SDRYG( 16, 11) = 0.154648E+01
-PKER_SDRYG( 16, 12) = 0.144374E+01
-PKER_SDRYG( 16, 13) = 0.134723E+01
-PKER_SDRYG( 16, 14) = 0.125655E+01
-PKER_SDRYG( 16, 15) = 0.117133E+01
-PKER_SDRYG( 16, 16) = 0.109123E+01
-PKER_SDRYG( 16, 17) = 0.101591E+01
-PKER_SDRYG( 16, 18) = 0.945067E+00
-PKER_SDRYG( 16, 19) = 0.878387E+00
-PKER_SDRYG( 16, 20) = 0.815584E+00
-PKER_SDRYG( 16, 21) = 0.756375E+00
-PKER_SDRYG( 16, 22) = 0.700485E+00
-PKER_SDRYG( 16, 23) = 0.647644E+00
-PKER_SDRYG( 16, 24) = 0.597582E+00
-PKER_SDRYG( 16, 25) = 0.550030E+00
-PKER_SDRYG( 16, 26) = 0.504717E+00
-PKER_SDRYG( 16, 27) = 0.461377E+00
-PKER_SDRYG( 16, 28) = 0.419758E+00
-PKER_SDRYG( 16, 29) = 0.379637E+00
-PKER_SDRYG( 16, 30) = 0.340859E+00
-PKER_SDRYG( 16, 31) = 0.303384E+00
-PKER_SDRYG( 16, 32) = 0.267331E+00
-PKER_SDRYG( 16, 33) = 0.233033E+00
-PKER_SDRYG( 16, 34) = 0.201036E+00
-PKER_SDRYG( 16, 35) = 0.172070E+00
-PKER_SDRYG( 16, 36) = 0.146800E+00
-PKER_SDRYG( 16, 37) = 0.125823E+00
-PKER_SDRYG( 16, 38) = 0.109499E+00
-PKER_SDRYG( 16, 39) = 0.977545E-01
-PKER_SDRYG( 16, 40) = 0.902514E-01
-PKER_SDRYG( 16, 41) = 0.865078E-01
-PKER_SDRYG( 16, 42) = 0.858300E-01
-PKER_SDRYG( 16, 43) = 0.875594E-01
-PKER_SDRYG( 16, 44) = 0.911743E-01
-PKER_SDRYG( 16, 45) = 0.961123E-01
-PKER_SDRYG( 16, 46) = 0.101929E+00
-PKER_SDRYG( 16, 47) = 0.108313E+00
-PKER_SDRYG( 16, 48) = 0.115025E+00
-PKER_SDRYG( 16, 49) = 0.121828E+00
-PKER_SDRYG( 16, 50) = 0.128615E+00
-PKER_SDRYG( 16, 51) = 0.135272E+00
-PKER_SDRYG( 16, 52) = 0.141739E+00
-PKER_SDRYG( 16, 53) = 0.147959E+00
-PKER_SDRYG( 16, 54) = 0.153911E+00
-PKER_SDRYG( 16, 55) = 0.159588E+00
-PKER_SDRYG( 16, 56) = 0.164969E+00
-PKER_SDRYG( 16, 57) = 0.170053E+00
-PKER_SDRYG( 16, 58) = 0.174839E+00
-PKER_SDRYG( 16, 59) = 0.179343E+00
-PKER_SDRYG( 16, 60) = 0.183588E+00
-PKER_SDRYG( 16, 61) = 0.187590E+00
-PKER_SDRYG( 16, 62) = 0.191366E+00
-PKER_SDRYG( 16, 63) = 0.194923E+00
-PKER_SDRYG( 16, 64) = 0.198269E+00
-PKER_SDRYG( 16, 65) = 0.201411E+00
-PKER_SDRYG( 16, 66) = 0.204359E+00
-PKER_SDRYG( 16, 67) = 0.207125E+00
-PKER_SDRYG( 16, 68) = 0.209720E+00
-PKER_SDRYG( 16, 69) = 0.212155E+00
-PKER_SDRYG( 16, 70) = 0.214440E+00
-PKER_SDRYG( 16, 71) = 0.216585E+00
-PKER_SDRYG( 16, 72) = 0.218598E+00
-PKER_SDRYG( 16, 73) = 0.220487E+00
-PKER_SDRYG( 16, 74) = 0.222261E+00
-PKER_SDRYG( 16, 75) = 0.223926E+00
-PKER_SDRYG( 16, 76) = 0.225489E+00
-PKER_SDRYG( 16, 77) = 0.226957E+00
-PKER_SDRYG( 16, 78) = 0.228335E+00
-PKER_SDRYG( 16, 79) = 0.229629E+00
-PKER_SDRYG( 16, 80) = 0.230843E+00
-PKER_SDRYG( 17, 1) = 0.304048E+01
-PKER_SDRYG( 17, 2) = 0.284795E+01
-PKER_SDRYG( 17, 3) = 0.266716E+01
-PKER_SDRYG( 17, 4) = 0.249740E+01
-PKER_SDRYG( 17, 5) = 0.233798E+01
-PKER_SDRYG( 17, 6) = 0.218829E+01
-PKER_SDRYG( 17, 7) = 0.204772E+01
-PKER_SDRYG( 17, 8) = 0.191572E+01
-PKER_SDRYG( 17, 9) = 0.179175E+01
-PKER_SDRYG( 17, 10) = 0.167533E+01
-PKER_SDRYG( 17, 11) = 0.156599E+01
-PKER_SDRYG( 17, 12) = 0.146329E+01
-PKER_SDRYG( 17, 13) = 0.136683E+01
-PKER_SDRYG( 17, 14) = 0.127621E+01
-PKER_SDRYG( 17, 15) = 0.119108E+01
-PKER_SDRYG( 17, 16) = 0.111107E+01
-PKER_SDRYG( 17, 17) = 0.103588E+01
-PKER_SDRYG( 17, 18) = 0.965175E+00
-PKER_SDRYG( 17, 19) = 0.898676E+00
-PKER_SDRYG( 17, 20) = 0.836095E+00
-PKER_SDRYG( 17, 21) = 0.777163E+00
-PKER_SDRYG( 17, 22) = 0.721616E+00
-PKER_SDRYG( 17, 23) = 0.669199E+00
-PKER_SDRYG( 17, 24) = 0.619660E+00
-PKER_SDRYG( 17, 25) = 0.572750E+00
-PKER_SDRYG( 17, 26) = 0.528218E+00
-PKER_SDRYG( 17, 27) = 0.485815E+00
-PKER_SDRYG( 17, 28) = 0.445290E+00
-PKER_SDRYG( 17, 29) = 0.406400E+00
-PKER_SDRYG( 17, 30) = 0.368923E+00
-PKER_SDRYG( 17, 31) = 0.332681E+00
-PKER_SDRYG( 17, 32) = 0.297582E+00
-PKER_SDRYG( 17, 33) = 0.263663E+00
-PKER_SDRYG( 17, 34) = 0.231136E+00
-PKER_SDRYG( 17, 35) = 0.200408E+00
-PKER_SDRYG( 17, 36) = 0.172052E+00
-PKER_SDRYG( 17, 37) = 0.146670E+00
-PKER_SDRYG( 17, 38) = 0.124843E+00
-PKER_SDRYG( 17, 39) = 0.107010E+00
-PKER_SDRYG( 17, 40) = 0.931832E-01
-PKER_SDRYG( 17, 41) = 0.832930E-01
-PKER_SDRYG( 17, 42) = 0.769058E-01
-PKER_SDRYG( 17, 43) = 0.736320E-01
-PKER_SDRYG( 17, 44) = 0.728568E-01
-PKER_SDRYG( 17, 45) = 0.741306E-01
-PKER_SDRYG( 17, 46) = 0.769296E-01
-PKER_SDRYG( 17, 47) = 0.808406E-01
-PKER_SDRYG( 17, 48) = 0.856037E-01
-PKER_SDRYG( 17, 49) = 0.908616E-01
-PKER_SDRYG( 17, 50) = 0.964228E-01
-PKER_SDRYG( 17, 51) = 0.102150E+00
-PKER_SDRYG( 17, 52) = 0.107893E+00
-PKER_SDRYG( 17, 53) = 0.113560E+00
-PKER_SDRYG( 17, 54) = 0.119093E+00
-PKER_SDRYG( 17, 55) = 0.124441E+00
-PKER_SDRYG( 17, 56) = 0.129585E+00
-PKER_SDRYG( 17, 57) = 0.134501E+00
-PKER_SDRYG( 17, 58) = 0.139185E+00
-PKER_SDRYG( 17, 59) = 0.143620E+00
-PKER_SDRYG( 17, 60) = 0.147804E+00
-PKER_SDRYG( 17, 61) = 0.151748E+00
-PKER_SDRYG( 17, 62) = 0.155465E+00
-PKER_SDRYG( 17, 63) = 0.158971E+00
-PKER_SDRYG( 17, 64) = 0.162280E+00
-PKER_SDRYG( 17, 65) = 0.165402E+00
-PKER_SDRYG( 17, 66) = 0.168343E+00
-PKER_SDRYG( 17, 67) = 0.171107E+00
-PKER_SDRYG( 17, 68) = 0.173702E+00
-PKER_SDRYG( 17, 69) = 0.176138E+00
-PKER_SDRYG( 17, 70) = 0.178424E+00
-PKER_SDRYG( 17, 71) = 0.180569E+00
-PKER_SDRYG( 17, 72) = 0.182583E+00
-PKER_SDRYG( 17, 73) = 0.184473E+00
-PKER_SDRYG( 17, 74) = 0.186247E+00
-PKER_SDRYG( 17, 75) = 0.187912E+00
-PKER_SDRYG( 17, 76) = 0.189475E+00
-PKER_SDRYG( 17, 77) = 0.190943E+00
-PKER_SDRYG( 17, 78) = 0.192321E+00
-PKER_SDRYG( 17, 79) = 0.193615E+00
-PKER_SDRYG( 17, 80) = 0.194829E+00
-PKER_SDRYG( 18, 1) = 0.305703E+01
-PKER_SDRYG( 18, 2) = 0.286451E+01
-PKER_SDRYG( 18, 3) = 0.268372E+01
-PKER_SDRYG( 18, 4) = 0.251397E+01
-PKER_SDRYG( 18, 5) = 0.235456E+01
-PKER_SDRYG( 18, 6) = 0.220488E+01
-PKER_SDRYG( 18, 7) = 0.206432E+01
-PKER_SDRYG( 18, 8) = 0.193233E+01
-PKER_SDRYG( 18, 9) = 0.180838E+01
-PKER_SDRYG( 18, 10) = 0.169198E+01
-PKER_SDRYG( 18, 11) = 0.158266E+01
-PKER_SDRYG( 18, 12) = 0.148000E+01
-PKER_SDRYG( 18, 13) = 0.138357E+01
-PKER_SDRYG( 18, 14) = 0.129300E+01
-PKER_SDRYG( 18, 15) = 0.120792E+01
-PKER_SDRYG( 18, 16) = 0.112799E+01
-PKER_SDRYG( 18, 17) = 0.105287E+01
-PKER_SDRYG( 18, 18) = 0.982278E+00
-PKER_SDRYG( 18, 19) = 0.915908E+00
-PKER_SDRYG( 18, 20) = 0.853488E+00
-PKER_SDRYG( 18, 21) = 0.794753E+00
-PKER_SDRYG( 18, 22) = 0.739449E+00
-PKER_SDRYG( 18, 23) = 0.687334E+00
-PKER_SDRYG( 18, 24) = 0.638168E+00
-PKER_SDRYG( 18, 25) = 0.591719E+00
-PKER_SDRYG( 18, 26) = 0.547755E+00
-PKER_SDRYG( 18, 27) = 0.506046E+00
-PKER_SDRYG( 18, 28) = 0.466360E+00
-PKER_SDRYG( 18, 29) = 0.428465E+00
-PKER_SDRYG( 18, 30) = 0.392134E+00
-PKER_SDRYG( 18, 31) = 0.357151E+00
-PKER_SDRYG( 18, 32) = 0.323336E+00
-PKER_SDRYG( 18, 33) = 0.290570E+00
-PKER_SDRYG( 18, 34) = 0.258835E+00
-PKER_SDRYG( 18, 35) = 0.228251E+00
-PKER_SDRYG( 18, 36) = 0.199115E+00
-PKER_SDRYG( 18, 37) = 0.171857E+00
-PKER_SDRYG( 18, 38) = 0.147000E+00
-PKER_SDRYG( 18, 39) = 0.125067E+00
-PKER_SDRYG( 18, 40) = 0.106465E+00
-PKER_SDRYG( 18, 41) = 0.913253E-01
-PKER_SDRYG( 18, 42) = 0.796434E-01
-PKER_SDRYG( 18, 43) = 0.712627E-01
-PKER_SDRYG( 18, 44) = 0.657661E-01
-PKER_SDRYG( 18, 45) = 0.627916E-01
-PKER_SDRYG( 18, 46) = 0.619257E-01
-PKER_SDRYG( 18, 47) = 0.627161E-01
-PKER_SDRYG( 18, 48) = 0.648191E-01
-PKER_SDRYG( 18, 49) = 0.679342E-01
-PKER_SDRYG( 18, 50) = 0.717663E-01
-PKER_SDRYG( 18, 51) = 0.760826E-01
-PKER_SDRYG( 18, 52) = 0.807078E-01
-PKER_SDRYG( 18, 53) = 0.855177E-01
-PKER_SDRYG( 18, 54) = 0.903701E-01
-PKER_SDRYG( 18, 55) = 0.951997E-01
-PKER_SDRYG( 18, 56) = 0.999416E-01
-PKER_SDRYG( 18, 57) = 0.104556E+00
-PKER_SDRYG( 18, 58) = 0.109000E+00
-PKER_SDRYG( 18, 59) = 0.113265E+00
-PKER_SDRYG( 18, 60) = 0.117340E+00
-PKER_SDRYG( 18, 61) = 0.121211E+00
-PKER_SDRYG( 18, 62) = 0.124875E+00
-PKER_SDRYG( 18, 63) = 0.128330E+00
-PKER_SDRYG( 18, 64) = 0.131587E+00
-PKER_SDRYG( 18, 65) = 0.134661E+00
-PKER_SDRYG( 18, 66) = 0.137564E+00
-PKER_SDRYG( 18, 67) = 0.140304E+00
-PKER_SDRYG( 18, 68) = 0.142888E+00
-PKER_SDRYG( 18, 69) = 0.145320E+00
-PKER_SDRYG( 18, 70) = 0.147606E+00
-PKER_SDRYG( 18, 71) = 0.149751E+00
-PKER_SDRYG( 18, 72) = 0.151765E+00
-PKER_SDRYG( 18, 73) = 0.153655E+00
-PKER_SDRYG( 18, 74) = 0.155430E+00
-PKER_SDRYG( 18, 75) = 0.157095E+00
-PKER_SDRYG( 18, 76) = 0.158659E+00
-PKER_SDRYG( 18, 77) = 0.160127E+00
-PKER_SDRYG( 18, 78) = 0.161505E+00
-PKER_SDRYG( 18, 79) = 0.162799E+00
-PKER_SDRYG( 18, 80) = 0.164013E+00
-PKER_SDRYG( 19, 1) = 0.307120E+01
-PKER_SDRYG( 19, 2) = 0.287867E+01
-PKER_SDRYG( 19, 3) = 0.269789E+01
-PKER_SDRYG( 19, 4) = 0.252814E+01
-PKER_SDRYG( 19, 5) = 0.236874E+01
-PKER_SDRYG( 19, 6) = 0.221907E+01
-PKER_SDRYG( 19, 7) = 0.207852E+01
-PKER_SDRYG( 19, 8) = 0.194653E+01
-PKER_SDRYG( 19, 9) = 0.182260E+01
-PKER_SDRYG( 19, 10) = 0.170621E+01
-PKER_SDRYG( 19, 11) = 0.159692E+01
-PKER_SDRYG( 19, 12) = 0.149427E+01
-PKER_SDRYG( 19, 13) = 0.139788E+01
-PKER_SDRYG( 19, 14) = 0.130734E+01
-PKER_SDRYG( 19, 15) = 0.122230E+01
-PKER_SDRYG( 19, 16) = 0.114241E+01
-PKER_SDRYG( 19, 17) = 0.106736E+01
-PKER_SDRYG( 19, 18) = 0.996842E+00
-PKER_SDRYG( 19, 19) = 0.930565E+00
-PKER_SDRYG( 19, 20) = 0.868259E+00
-PKER_SDRYG( 19, 21) = 0.809665E+00
-PKER_SDRYG( 19, 22) = 0.754536E+00
-PKER_SDRYG( 19, 23) = 0.702636E+00
-PKER_SDRYG( 19, 24) = 0.653737E+00
-PKER_SDRYG( 19, 25) = 0.607617E+00
-PKER_SDRYG( 19, 26) = 0.564059E+00
-PKER_SDRYG( 19, 27) = 0.522851E+00
-PKER_SDRYG( 19, 28) = 0.483777E+00
-PKER_SDRYG( 19, 29) = 0.446626E+00
-PKER_SDRYG( 19, 30) = 0.411183E+00
-PKER_SDRYG( 19, 31) = 0.377237E+00
-PKER_SDRYG( 19, 32) = 0.344587E+00
-PKER_SDRYG( 19, 33) = 0.313058E+00
-PKER_SDRYG( 19, 34) = 0.282521E+00
-PKER_SDRYG( 19, 35) = 0.252926E+00
-PKER_SDRYG( 19, 36) = 0.224339E+00
-PKER_SDRYG( 19, 37) = 0.196959E+00
-PKER_SDRYG( 19, 38) = 0.171116E+00
-PKER_SDRYG( 19, 39) = 0.147232E+00
-PKER_SDRYG( 19, 40) = 0.125729E+00
-PKER_SDRYG( 19, 41) = 0.106981E+00
-PKER_SDRYG( 19, 42) = 0.911640E-01
-PKER_SDRYG( 19, 43) = 0.783313E-01
-PKER_SDRYG( 19, 44) = 0.684689E-01
-PKER_SDRYG( 19, 45) = 0.612441E-01
-PKER_SDRYG( 19, 46) = 0.564257E-01
-PKER_SDRYG( 19, 47) = 0.536623E-01
-PKER_SDRYG( 19, 48) = 0.526683E-01
-PKER_SDRYG( 19, 49) = 0.530578E-01
-PKER_SDRYG( 19, 50) = 0.546132E-01
-PKER_SDRYG( 19, 51) = 0.570295E-01
-PKER_SDRYG( 19, 52) = 0.600747E-01
-PKER_SDRYG( 19, 53) = 0.636298E-01
-PKER_SDRYG( 19, 54) = 0.674690E-01
-PKER_SDRYG( 19, 55) = 0.714859E-01
-PKER_SDRYG( 19, 56) = 0.756040E-01
-PKER_SDRYG( 19, 57) = 0.797240E-01
-PKER_SDRYG( 19, 58) = 0.837879E-01
-PKER_SDRYG( 19, 59) = 0.877591E-01
-PKER_SDRYG( 19, 60) = 0.916038E-01
-PKER_SDRYG( 19, 61) = 0.953044E-01
-PKER_SDRYG( 19, 62) = 0.988499E-01
-PKER_SDRYG( 19, 63) = 0.102231E+00
-PKER_SDRYG( 19, 64) = 0.105437E+00
-PKER_SDRYG( 19, 65) = 0.108467E+00
-PKER_SDRYG( 19, 66) = 0.111324E+00
-PKER_SDRYG( 19, 67) = 0.114021E+00
-PKER_SDRYG( 19, 68) = 0.116567E+00
-PKER_SDRYG( 19, 69) = 0.118973E+00
-PKER_SDRYG( 19, 70) = 0.121244E+00
-PKER_SDRYG( 19, 71) = 0.123383E+00
-PKER_SDRYG( 19, 72) = 0.125396E+00
-PKER_SDRYG( 19, 73) = 0.127286E+00
-PKER_SDRYG( 19, 74) = 0.129060E+00
-PKER_SDRYG( 19, 75) = 0.130726E+00
-PKER_SDRYG( 19, 76) = 0.132290E+00
-PKER_SDRYG( 19, 77) = 0.133758E+00
-PKER_SDRYG( 19, 78) = 0.135136E+00
-PKER_SDRYG( 19, 79) = 0.136430E+00
-PKER_SDRYG( 19, 80) = 0.137645E+00
-PKER_SDRYG( 20, 1) = 0.308331E+01
-PKER_SDRYG( 20, 2) = 0.289079E+01
-PKER_SDRYG( 20, 3) = 0.271002E+01
-PKER_SDRYG( 20, 4) = 0.254027E+01
-PKER_SDRYG( 20, 5) = 0.238087E+01
-PKER_SDRYG( 20, 6) = 0.223120E+01
-PKER_SDRYG( 20, 7) = 0.209066E+01
-PKER_SDRYG( 20, 8) = 0.195868E+01
-PKER_SDRYG( 20, 9) = 0.183476E+01
-PKER_SDRYG( 20, 10) = 0.171838E+01
-PKER_SDRYG( 20, 11) = 0.160910E+01
-PKER_SDRYG( 20, 12) = 0.150647E+01
-PKER_SDRYG( 20, 13) = 0.141010E+01
-PKER_SDRYG( 20, 14) = 0.131958E+01
-PKER_SDRYG( 20, 15) = 0.123457E+01
-PKER_SDRYG( 20, 16) = 0.115472E+01
-PKER_SDRYG( 20, 17) = 0.107972E+01
-PKER_SDRYG( 20, 18) = 0.100925E+01
-PKER_SDRYG( 20, 19) = 0.943044E+00
-PKER_SDRYG( 20, 20) = 0.880821E+00
-PKER_SDRYG( 20, 21) = 0.822329E+00
-PKER_SDRYG( 20, 22) = 0.767325E+00
-PKER_SDRYG( 20, 23) = 0.715580E+00
-PKER_SDRYG( 20, 24) = 0.666871E+00
-PKER_SDRYG( 20, 25) = 0.620986E+00
-PKER_SDRYG( 20, 26) = 0.577719E+00
-PKER_SDRYG( 20, 27) = 0.536869E+00
-PKER_SDRYG( 20, 28) = 0.498236E+00
-PKER_SDRYG( 20, 29) = 0.461625E+00
-PKER_SDRYG( 20, 30) = 0.426838E+00
-PKER_SDRYG( 20, 31) = 0.393679E+00
-PKER_SDRYG( 20, 32) = 0.361954E+00
-PKER_SDRYG( 20, 33) = 0.331476E+00
-PKER_SDRYG( 20, 34) = 0.302080E+00
-PKER_SDRYG( 20, 35) = 0.273637E+00
-PKER_SDRYG( 20, 36) = 0.246085E+00
-PKER_SDRYG( 20, 37) = 0.219450E+00
-PKER_SDRYG( 20, 38) = 0.193871E+00
-PKER_SDRYG( 20, 39) = 0.169593E+00
-PKER_SDRYG( 20, 40) = 0.146939E+00
-PKER_SDRYG( 20, 41) = 0.126261E+00
-PKER_SDRYG( 20, 42) = 0.107850E+00
-PKER_SDRYG( 20, 43) = 0.919096E-01
-PKER_SDRYG( 20, 44) = 0.785336E-01
-PKER_SDRYG( 20, 45) = 0.677010E-01
-PKER_SDRYG( 20, 46) = 0.592333E-01
-PKER_SDRYG( 20, 47) = 0.529464E-01
-PKER_SDRYG( 20, 48) = 0.486665E-01
-PKER_SDRYG( 20, 49) = 0.460540E-01
-PKER_SDRYG( 20, 50) = 0.449115E-01
-PKER_SDRYG( 20, 51) = 0.449944E-01
-PKER_SDRYG( 20, 52) = 0.460393E-01
-PKER_SDRYG( 20, 53) = 0.478675E-01
-PKER_SDRYG( 20, 54) = 0.503008E-01
-PKER_SDRYG( 20, 55) = 0.531708E-01
-PKER_SDRYG( 20, 56) = 0.563427E-01
-PKER_SDRYG( 20, 57) = 0.597035E-01
-PKER_SDRYG( 20, 58) = 0.631818E-01
-PKER_SDRYG( 20, 59) = 0.666850E-01
-PKER_SDRYG( 20, 60) = 0.701651E-01
-PKER_SDRYG( 20, 61) = 0.735872E-01
-PKER_SDRYG( 20, 62) = 0.769178E-01
-PKER_SDRYG( 20, 63) = 0.801281E-01
-PKER_SDRYG( 20, 64) = 0.832130E-01
-PKER_SDRYG( 20, 65) = 0.861638E-01
-PKER_SDRYG( 20, 66) = 0.889685E-01
-PKER_SDRYG( 20, 67) = 0.916266E-01
-PKER_SDRYG( 20, 68) = 0.941350E-01
-PKER_SDRYG( 20, 69) = 0.965012E-01
-PKER_SDRYG( 20, 70) = 0.987370E-01
-PKER_SDRYG( 20, 71) = 0.100849E+00
-PKER_SDRYG( 20, 72) = 0.102844E+00
-PKER_SDRYG( 20, 73) = 0.104726E+00
-PKER_SDRYG( 20, 74) = 0.106497E+00
-PKER_SDRYG( 20, 75) = 0.108163E+00
-PKER_SDRYG( 20, 76) = 0.109727E+00
-PKER_SDRYG( 20, 77) = 0.111195E+00
-PKER_SDRYG( 20, 78) = 0.112573E+00
-PKER_SDRYG( 20, 79) = 0.113867E+00
-PKER_SDRYG( 20, 80) = 0.115082E+00
-PKER_SDRYG( 21, 1) = 0.309368E+01
-PKER_SDRYG( 21, 2) = 0.290116E+01
-PKER_SDRYG( 21, 3) = 0.272039E+01
-PKER_SDRYG( 21, 4) = 0.255064E+01
-PKER_SDRYG( 21, 5) = 0.239125E+01
-PKER_SDRYG( 21, 6) = 0.224158E+01
-PKER_SDRYG( 21, 7) = 0.210104E+01
-PKER_SDRYG( 21, 8) = 0.196908E+01
-PKER_SDRYG( 21, 9) = 0.184515E+01
-PKER_SDRYG( 21, 10) = 0.172879E+01
-PKER_SDRYG( 21, 11) = 0.161952E+01
-PKER_SDRYG( 21, 12) = 0.151690E+01
-PKER_SDRYG( 21, 13) = 0.142054E+01
-PKER_SDRYG( 21, 14) = 0.133005E+01
-PKER_SDRYG( 21, 15) = 0.124506E+01
-PKER_SDRYG( 21, 16) = 0.116524E+01
-PKER_SDRYG( 21, 17) = 0.109026E+01
-PKER_SDRYG( 21, 18) = 0.101984E+01
-PKER_SDRYG( 21, 19) = 0.953678E+00
-PKER_SDRYG( 21, 20) = 0.891515E+00
-PKER_SDRYG( 21, 21) = 0.833096E+00
-PKER_SDRYG( 21, 22) = 0.778184E+00
-PKER_SDRYG( 21, 23) = 0.726550E+00
-PKER_SDRYG( 21, 24) = 0.677978E+00
-PKER_SDRYG( 21, 25) = 0.632262E+00
-PKER_SDRYG( 21, 26) = 0.589204E+00
-PKER_SDRYG( 21, 27) = 0.548610E+00
-PKER_SDRYG( 21, 28) = 0.510294E+00
-PKER_SDRYG( 21, 29) = 0.474072E+00
-PKER_SDRYG( 21, 30) = 0.439762E+00
-PKER_SDRYG( 21, 31) = 0.407182E+00
-PKER_SDRYG( 21, 32) = 0.376150E+00
-PKER_SDRYG( 21, 33) = 0.346490E+00
-PKER_SDRYG( 21, 34) = 0.318030E+00
-PKER_SDRYG( 21, 35) = 0.290615E+00
-PKER_SDRYG( 21, 36) = 0.264123E+00
-PKER_SDRYG( 21, 37) = 0.238487E+00
-PKER_SDRYG( 21, 38) = 0.213712E+00
-PKER_SDRYG( 21, 39) = 0.189895E+00
-PKER_SDRYG( 21, 40) = 0.167221E+00
-PKER_SDRYG( 21, 41) = 0.145942E+00
-PKER_SDRYG( 21, 42) = 0.126328E+00
-PKER_SDRYG( 21, 43) = 0.108615E+00
-PKER_SDRYG( 21, 44) = 0.929833E-01
-PKER_SDRYG( 21, 45) = 0.794926E-01
-PKER_SDRYG( 21, 46) = 0.681701E-01
-PKER_SDRYG( 21, 47) = 0.589018E-01
-PKER_SDRYG( 21, 48) = 0.515595E-01
-PKER_SDRYG( 21, 49) = 0.460713E-01
-PKER_SDRYG( 21, 50) = 0.421587E-01
-PKER_SDRYG( 21, 51) = 0.396695E-01
-PKER_SDRYG( 21, 52) = 0.384096E-01
-PKER_SDRYG( 21, 53) = 0.382118E-01
-PKER_SDRYG( 21, 54) = 0.388485E-01
-PKER_SDRYG( 21, 55) = 0.402037E-01
-PKER_SDRYG( 21, 56) = 0.421013E-01
-PKER_SDRYG( 21, 57) = 0.443963E-01
-PKER_SDRYG( 21, 58) = 0.470176E-01
-PKER_SDRYG( 21, 59) = 0.498214E-01
-PKER_SDRYG( 21, 60) = 0.527437E-01
-PKER_SDRYG( 21, 61) = 0.557270E-01
-PKER_SDRYG( 21, 62) = 0.587109E-01
-PKER_SDRYG( 21, 63) = 0.616539E-01
-PKER_SDRYG( 21, 64) = 0.645294E-01
-PKER_SDRYG( 21, 65) = 0.673161E-01
-PKER_SDRYG( 21, 66) = 0.699993E-01
-PKER_SDRYG( 21, 67) = 0.725721E-01
-PKER_SDRYG( 21, 68) = 0.750271E-01
-PKER_SDRYG( 21, 69) = 0.773567E-01
-PKER_SDRYG( 21, 70) = 0.795588E-01
-PKER_SDRYG( 21, 71) = 0.816377E-01
-PKER_SDRYG( 21, 72) = 0.836001E-01
-PKER_SDRYG( 21, 73) = 0.854546E-01
-PKER_SDRYG( 21, 74) = 0.872071E-01
-PKER_SDRYG( 21, 75) = 0.888618E-01
-PKER_SDRYG( 21, 76) = 0.904212E-01
-PKER_SDRYG( 21, 77) = 0.918882E-01
-PKER_SDRYG( 21, 78) = 0.932663E-01
-PKER_SDRYG( 21, 79) = 0.945604E-01
-PKER_SDRYG( 21, 80) = 0.957753E-01
-PKER_SDRYG( 22, 1) = 0.310255E+01
-PKER_SDRYG( 22, 2) = 0.291003E+01
-PKER_SDRYG( 22, 3) = 0.272926E+01
-PKER_SDRYG( 22, 4) = 0.255952E+01
-PKER_SDRYG( 22, 5) = 0.240013E+01
-PKER_SDRYG( 22, 6) = 0.225046E+01
-PKER_SDRYG( 22, 7) = 0.210993E+01
-PKER_SDRYG( 22, 8) = 0.197796E+01
-PKER_SDRYG( 22, 9) = 0.185405E+01
-PKER_SDRYG( 22, 10) = 0.173769E+01
-PKER_SDRYG( 22, 11) = 0.162842E+01
-PKER_SDRYG( 22, 12) = 0.152582E+01
-PKER_SDRYG( 22, 13) = 0.142947E+01
-PKER_SDRYG( 22, 14) = 0.133899E+01
-PKER_SDRYG( 22, 15) = 0.125401E+01
-PKER_SDRYG( 22, 16) = 0.117421E+01
-PKER_SDRYG( 22, 17) = 0.109927E+01
-PKER_SDRYG( 22, 18) = 0.102887E+01
-PKER_SDRYG( 22, 19) = 0.962746E+00
-PKER_SDRYG( 22, 20) = 0.900627E+00
-PKER_SDRYG( 22, 21) = 0.842262E+00
-PKER_SDRYG( 22, 22) = 0.787415E+00
-PKER_SDRYG( 22, 23) = 0.735862E+00
-PKER_SDRYG( 22, 24) = 0.687390E+00
-PKER_SDRYG( 22, 25) = 0.641796E+00
-PKER_SDRYG( 22, 26) = 0.598888E+00
-PKER_SDRYG( 22, 27) = 0.558479E+00
-PKER_SDRYG( 22, 28) = 0.520391E+00
-PKER_SDRYG( 22, 29) = 0.484449E+00
-PKER_SDRYG( 22, 30) = 0.450483E+00
-PKER_SDRYG( 22, 31) = 0.418323E+00
-PKER_SDRYG( 22, 32) = 0.387803E+00
-PKER_SDRYG( 22, 33) = 0.358755E+00
-PKER_SDRYG( 22, 34) = 0.331015E+00
-PKER_SDRYG( 22, 35) = 0.304428E+00
-PKER_SDRYG( 22, 36) = 0.278850E+00
-PKER_SDRYG( 22, 37) = 0.254168E+00
-PKER_SDRYG( 22, 38) = 0.230313E+00
-PKER_SDRYG( 22, 39) = 0.207280E+00
-PKER_SDRYG( 22, 40) = 0.185140E+00
-PKER_SDRYG( 22, 41) = 0.164036E+00
-PKER_SDRYG( 22, 42) = 0.144162E+00
-PKER_SDRYG( 22, 43) = 0.125732E+00
-PKER_SDRYG( 22, 44) = 0.108925E+00
-PKER_SDRYG( 22, 45) = 0.938726E-01
-PKER_SDRYG( 22, 46) = 0.806371E-01
-PKER_SDRYG( 22, 47) = 0.692156E-01
-PKER_SDRYG( 22, 48) = 0.595621E-01
-PKER_SDRYG( 22, 49) = 0.516004E-01
-PKER_SDRYG( 22, 50) = 0.452423E-01
-PKER_SDRYG( 22, 51) = 0.403296E-01
-PKER_SDRYG( 22, 52) = 0.367261E-01
-PKER_SDRYG( 22, 53) = 0.343587E-01
-PKER_SDRYG( 22, 54) = 0.329959E-01
-PKER_SDRYG( 22, 55) = 0.325520E-01
-PKER_SDRYG( 22, 56) = 0.328785E-01
-PKER_SDRYG( 22, 57) = 0.338152E-01
-PKER_SDRYG( 22, 58) = 0.352601E-01
-PKER_SDRYG( 22, 59) = 0.370970E-01
-PKER_SDRYG( 22, 60) = 0.392214E-01
-PKER_SDRYG( 22, 61) = 0.415492E-01
-PKER_SDRYG( 22, 62) = 0.440004E-01
-PKER_SDRYG( 22, 63) = 0.465304E-01
-PKER_SDRYG( 22, 64) = 0.490772E-01
-PKER_SDRYG( 22, 65) = 0.516040E-01
-PKER_SDRYG( 22, 66) = 0.540894E-01
-PKER_SDRYG( 22, 67) = 0.565082E-01
-PKER_SDRYG( 22, 68) = 0.588410E-01
-PKER_SDRYG( 22, 69) = 0.610833E-01
-PKER_SDRYG( 22, 70) = 0.632289E-01
-PKER_SDRYG( 22, 71) = 0.652695E-01
-PKER_SDRYG( 22, 72) = 0.672038E-01
-PKER_SDRYG( 22, 73) = 0.690300E-01
-PKER_SDRYG( 22, 74) = 0.707537E-01
-PKER_SDRYG( 22, 75) = 0.723828E-01
-PKER_SDRYG( 22, 76) = 0.739222E-01
-PKER_SDRYG( 22, 77) = 0.753766E-01
-PKER_SDRYG( 22, 78) = 0.767488E-01
-PKER_SDRYG( 22, 79) = 0.780408E-01
-PKER_SDRYG( 22, 80) = 0.792553E-01
-PKER_SDRYG( 23, 1) = 0.311014E+01
-PKER_SDRYG( 23, 2) = 0.291762E+01
-PKER_SDRYG( 23, 3) = 0.273685E+01
-PKER_SDRYG( 23, 4) = 0.256711E+01
-PKER_SDRYG( 23, 5) = 0.240772E+01
-PKER_SDRYG( 23, 6) = 0.225806E+01
-PKER_SDRYG( 23, 7) = 0.211753E+01
-PKER_SDRYG( 23, 8) = 0.198557E+01
-PKER_SDRYG( 23, 9) = 0.186166E+01
-PKER_SDRYG( 23, 10) = 0.174530E+01
-PKER_SDRYG( 23, 11) = 0.163604E+01
-PKER_SDRYG( 23, 12) = 0.153345E+01
-PKER_SDRYG( 23, 13) = 0.143710E+01
-PKER_SDRYG( 23, 14) = 0.134663E+01
-PKER_SDRYG( 23, 15) = 0.126167E+01
-PKER_SDRYG( 23, 16) = 0.118188E+01
-PKER_SDRYG( 23, 17) = 0.110695E+01
-PKER_SDRYG( 23, 18) = 0.103658E+01
-PKER_SDRYG( 23, 19) = 0.970482E+00
-PKER_SDRYG( 23, 20) = 0.908396E+00
-PKER_SDRYG( 23, 21) = 0.850071E+00
-PKER_SDRYG( 23, 22) = 0.795272E+00
-PKER_SDRYG( 23, 23) = 0.743778E+00
-PKER_SDRYG( 23, 24) = 0.695378E+00
-PKER_SDRYG( 23, 25) = 0.649873E+00
-PKER_SDRYG( 23, 26) = 0.607074E+00
-PKER_SDRYG( 23, 27) = 0.566799E+00
-PKER_SDRYG( 23, 28) = 0.528875E+00
-PKER_SDRYG( 23, 29) = 0.493136E+00
-PKER_SDRYG( 23, 30) = 0.459418E+00
-PKER_SDRYG( 23, 31) = 0.427563E+00
-PKER_SDRYG( 23, 32) = 0.397414E+00
-PKER_SDRYG( 23, 33) = 0.368818E+00
-PKER_SDRYG( 23, 34) = 0.341619E+00
-PKER_SDRYG( 23, 35) = 0.315668E+00
-PKER_SDRYG( 23, 36) = 0.290820E+00
-PKER_SDRYG( 23, 37) = 0.266945E+00
-PKER_SDRYG( 23, 38) = 0.243937E+00
-PKER_SDRYG( 23, 39) = 0.221731E+00
-PKER_SDRYG( 23, 40) = 0.200315E+00
-PKER_SDRYG( 23, 41) = 0.179743E+00
-PKER_SDRYG( 23, 42) = 0.160130E+00
-PKER_SDRYG( 23, 43) = 0.141633E+00
-PKER_SDRYG( 23, 44) = 0.124415E+00
-PKER_SDRYG( 23, 45) = 0.108617E+00
-PKER_SDRYG( 23, 46) = 0.943318E-01
-PKER_SDRYG( 23, 47) = 0.815931E-01
-PKER_SDRYG( 23, 48) = 0.703932E-01
-PKER_SDRYG( 23, 49) = 0.607019E-01
-PKER_SDRYG( 23, 50) = 0.524332E-01
-PKER_SDRYG( 23, 51) = 0.455452E-01
-PKER_SDRYG( 23, 52) = 0.399288E-01
-PKER_SDRYG( 23, 53) = 0.354866E-01
-PKER_SDRYG( 23, 54) = 0.321934E-01
-PKER_SDRYG( 23, 55) = 0.298828E-01
-PKER_SDRYG( 23, 56) = 0.284626E-01
-PKER_SDRYG( 23, 57) = 0.278307E-01
-PKER_SDRYG( 23, 58) = 0.278872E-01
-PKER_SDRYG( 23, 59) = 0.284870E-01
-PKER_SDRYG( 23, 60) = 0.295587E-01
-PKER_SDRYG( 23, 61) = 0.309990E-01
-PKER_SDRYG( 23, 62) = 0.327084E-01
-PKER_SDRYG( 23, 63) = 0.346330E-01
-PKER_SDRYG( 23, 64) = 0.366844E-01
-PKER_SDRYG( 23, 65) = 0.388198E-01
-PKER_SDRYG( 23, 66) = 0.409907E-01
-PKER_SDRYG( 23, 67) = 0.431629E-01
-PKER_SDRYG( 23, 68) = 0.453050E-01
-PKER_SDRYG( 23, 69) = 0.473969E-01
-PKER_SDRYG( 23, 70) = 0.494254E-01
-PKER_SDRYG( 23, 71) = 0.513786E-01
-PKER_SDRYG( 23, 72) = 0.532517E-01
-PKER_SDRYG( 23, 73) = 0.550394E-01
-PKER_SDRYG( 23, 74) = 0.567364E-01
-PKER_SDRYG( 23, 75) = 0.583408E-01
-PKER_SDRYG( 23, 76) = 0.598558E-01
-PKER_SDRYG( 23, 77) = 0.612862E-01
-PKER_SDRYG( 23, 78) = 0.626386E-01
-PKER_SDRYG( 23, 79) = 0.639167E-01
-PKER_SDRYG( 23, 80) = 0.651237E-01
-PKER_SDRYG( 24, 1) = 0.311663E+01
-PKER_SDRYG( 24, 2) = 0.292412E+01
-PKER_SDRYG( 24, 3) = 0.274335E+01
-PKER_SDRYG( 24, 4) = 0.257361E+01
-PKER_SDRYG( 24, 5) = 0.241422E+01
-PKER_SDRYG( 24, 6) = 0.226456E+01
-PKER_SDRYG( 24, 7) = 0.212403E+01
-PKER_SDRYG( 24, 8) = 0.199207E+01
-PKER_SDRYG( 24, 9) = 0.186816E+01
-PKER_SDRYG( 24, 10) = 0.175181E+01
-PKER_SDRYG( 24, 11) = 0.164256E+01
-PKER_SDRYG( 24, 12) = 0.153997E+01
-PKER_SDRYG( 24, 13) = 0.144363E+01
-PKER_SDRYG( 24, 14) = 0.135316E+01
-PKER_SDRYG( 24, 15) = 0.126821E+01
-PKER_SDRYG( 24, 16) = 0.118844E+01
-PKER_SDRYG( 24, 17) = 0.111352E+01
-PKER_SDRYG( 24, 18) = 0.104316E+01
-PKER_SDRYG( 24, 19) = 0.977086E+00
-PKER_SDRYG( 24, 20) = 0.915024E+00
-PKER_SDRYG( 24, 21) = 0.856728E+00
-PKER_SDRYG( 24, 22) = 0.801965E+00
-PKER_SDRYG( 24, 23) = 0.750514E+00
-PKER_SDRYG( 24, 24) = 0.702168E+00
-PKER_SDRYG( 24, 25) = 0.656727E+00
-PKER_SDRYG( 24, 26) = 0.614007E+00
-PKER_SDRYG( 24, 27) = 0.573830E+00
-PKER_SDRYG( 24, 28) = 0.536025E+00
-PKER_SDRYG( 24, 29) = 0.500432E+00
-PKER_SDRYG( 24, 30) = 0.466894E+00
-PKER_SDRYG( 24, 31) = 0.435260E+00
-PKER_SDRYG( 24, 32) = 0.405382E+00
-PKER_SDRYG( 24, 33) = 0.377115E+00
-PKER_SDRYG( 24, 34) = 0.350316E+00
-PKER_SDRYG( 24, 35) = 0.324843E+00
-PKER_SDRYG( 24, 36) = 0.300557E+00
-PKER_SDRYG( 24, 37) = 0.277326E+00
-PKER_SDRYG( 24, 38) = 0.255030E+00
-PKER_SDRYG( 24, 39) = 0.233571E+00
-PKER_SDRYG( 24, 40) = 0.212888E+00
-PKER_SDRYG( 24, 41) = 0.192967E+00
-PKER_SDRYG( 24, 42) = 0.173849E+00
-PKER_SDRYG( 24, 43) = 0.155631E+00
-PKER_SDRYG( 24, 44) = 0.138439E+00
-PKER_SDRYG( 24, 45) = 0.122408E+00
-PKER_SDRYG( 24, 46) = 0.107642E+00
-PKER_SDRYG( 24, 47) = 0.942057E-01
-PKER_SDRYG( 24, 48) = 0.821124E-01
-PKER_SDRYG( 24, 49) = 0.713379E-01
-PKER_SDRYG( 24, 50) = 0.618399E-01
-PKER_SDRYG( 24, 51) = 0.535557E-01
-PKER_SDRYG( 24, 52) = 0.464286E-01
-PKER_SDRYG( 24, 53) = 0.404041E-01
-PKER_SDRYG( 24, 54) = 0.354220E-01
-PKER_SDRYG( 24, 55) = 0.314413E-01
-PKER_SDRYG( 24, 56) = 0.283724E-01
-PKER_SDRYG( 24, 57) = 0.261267E-01
-PKER_SDRYG( 24, 58) = 0.246911E-01
-PKER_SDRYG( 24, 59) = 0.239037E-01
-PKER_SDRYG( 24, 60) = 0.237308E-01
-PKER_SDRYG( 24, 61) = 0.240736E-01
-PKER_SDRYG( 24, 62) = 0.248278E-01
-PKER_SDRYG( 24, 63) = 0.259302E-01
-PKER_SDRYG( 24, 64) = 0.272985E-01
-PKER_SDRYG( 24, 65) = 0.288644E-01
-PKER_SDRYG( 24, 66) = 0.305735E-01
-PKER_SDRYG( 24, 67) = 0.323665E-01
-PKER_SDRYG( 24, 68) = 0.342120E-01
-PKER_SDRYG( 24, 69) = 0.360703E-01
-PKER_SDRYG( 24, 70) = 0.379121E-01
-PKER_SDRYG( 24, 71) = 0.397234E-01
-PKER_SDRYG( 24, 72) = 0.414856E-01
-PKER_SDRYG( 24, 73) = 0.431857E-01
-PKER_SDRYG( 24, 74) = 0.448197E-01
-PKER_SDRYG( 24, 75) = 0.463836E-01
-PKER_SDRYG( 24, 76) = 0.478710E-01
-PKER_SDRYG( 24, 77) = 0.492809E-01
-PKER_SDRYG( 24, 78) = 0.506124E-01
-PKER_SDRYG( 24, 79) = 0.518695E-01
-PKER_SDRYG( 24, 80) = 0.530577E-01
-PKER_SDRYG( 25, 1) = 0.312219E+01
-PKER_SDRYG( 25, 2) = 0.292967E+01
-PKER_SDRYG( 25, 3) = 0.274891E+01
-PKER_SDRYG( 25, 4) = 0.257917E+01
-PKER_SDRYG( 25, 5) = 0.241978E+01
-PKER_SDRYG( 25, 6) = 0.227012E+01
-PKER_SDRYG( 25, 7) = 0.212959E+01
-PKER_SDRYG( 25, 8) = 0.199764E+01
-PKER_SDRYG( 25, 9) = 0.187373E+01
-PKER_SDRYG( 25, 10) = 0.175738E+01
-PKER_SDRYG( 25, 11) = 0.164813E+01
-PKER_SDRYG( 25, 12) = 0.154554E+01
-PKER_SDRYG( 25, 13) = 0.144921E+01
-PKER_SDRYG( 25, 14) = 0.135875E+01
-PKER_SDRYG( 25, 15) = 0.127381E+01
-PKER_SDRYG( 25, 16) = 0.119404E+01
-PKER_SDRYG( 25, 17) = 0.111913E+01
-PKER_SDRYG( 25, 18) = 0.104879E+01
-PKER_SDRYG( 25, 19) = 0.982726E+00
-PKER_SDRYG( 25, 20) = 0.920681E+00
-PKER_SDRYG( 25, 21) = 0.862407E+00
-PKER_SDRYG( 25, 22) = 0.807670E+00
-PKER_SDRYG( 25, 23) = 0.756252E+00
-PKER_SDRYG( 25, 24) = 0.707944E+00
-PKER_SDRYG( 25, 25) = 0.662552E+00
-PKER_SDRYG( 25, 26) = 0.619890E+00
-PKER_SDRYG( 25, 27) = 0.579783E+00
-PKER_SDRYG( 25, 28) = 0.542066E+00
-PKER_SDRYG( 25, 29) = 0.506580E+00
-PKER_SDRYG( 25, 30) = 0.473173E+00
-PKER_SDRYG( 25, 31) = 0.441699E+00
-PKER_SDRYG( 25, 32) = 0.412018E+00
-PKER_SDRYG( 25, 33) = 0.383992E+00
-PKER_SDRYG( 25, 34) = 0.357485E+00
-PKER_SDRYG( 25, 35) = 0.332366E+00
-PKER_SDRYG( 25, 36) = 0.308504E+00
-PKER_SDRYG( 25, 37) = 0.285770E+00
-PKER_SDRYG( 25, 38) = 0.264042E+00
-PKER_SDRYG( 25, 39) = 0.243211E+00
-PKER_SDRYG( 25, 40) = 0.223187E+00
-PKER_SDRYG( 25, 41) = 0.203911E+00
-PKER_SDRYG( 25, 42) = 0.185368E+00
-PKER_SDRYG( 25, 43) = 0.167593E+00
-PKER_SDRYG( 25, 44) = 0.150666E+00
-PKER_SDRYG( 25, 45) = 0.134695E+00
-PKER_SDRYG( 25, 46) = 0.119790E+00
-PKER_SDRYG( 25, 47) = 0.106033E+00
-PKER_SDRYG( 25, 48) = 0.934668E-01
-PKER_SDRYG( 25, 49) = 0.820875E-01
-PKER_SDRYG( 25, 50) = 0.718598E-01
-PKER_SDRYG( 25, 51) = 0.627311E-01
-PKER_SDRYG( 25, 52) = 0.546359E-01
-PKER_SDRYG( 25, 53) = 0.475217E-01
-PKER_SDRYG( 25, 54) = 0.413477E-01
-PKER_SDRYG( 25, 55) = 0.360518E-01
-PKER_SDRYG( 25, 56) = 0.316174E-01
-PKER_SDRYG( 25, 57) = 0.279901E-01
-PKER_SDRYG( 25, 58) = 0.251116E-01
-PKER_SDRYG( 25, 59) = 0.229826E-01
-PKER_SDRYG( 25, 60) = 0.215081E-01
-PKER_SDRYG( 25, 61) = 0.206268E-01
-PKER_SDRYG( 25, 62) = 0.202780E-01
-PKER_SDRYG( 25, 63) = 0.204007E-01
-PKER_SDRYG( 25, 64) = 0.208961E-01
-PKER_SDRYG( 25, 65) = 0.217125E-01
-PKER_SDRYG( 25, 66) = 0.227907E-01
-PKER_SDRYG( 25, 67) = 0.240570E-01
-PKER_SDRYG( 25, 68) = 0.254690E-01
-PKER_SDRYG( 25, 69) = 0.269718E-01
-PKER_SDRYG( 25, 70) = 0.285356E-01
-PKER_SDRYG( 25, 71) = 0.301195E-01
-PKER_SDRYG( 25, 72) = 0.317052E-01
-PKER_SDRYG( 25, 73) = 0.332684E-01
-PKER_SDRYG( 25, 74) = 0.347939E-01
-PKER_SDRYG( 25, 75) = 0.362738E-01
-PKER_SDRYG( 25, 76) = 0.376983E-01
-PKER_SDRYG( 25, 77) = 0.390643E-01
-PKER_SDRYG( 25, 78) = 0.403681E-01
-PKER_SDRYG( 25, 79) = 0.416059E-01
-PKER_SDRYG( 25, 80) = 0.427760E-01
-PKER_SDRYG( 26, 1) = 0.312694E+01
-PKER_SDRYG( 26, 2) = 0.293443E+01
-PKER_SDRYG( 26, 3) = 0.275366E+01
-PKER_SDRYG( 26, 4) = 0.258392E+01
-PKER_SDRYG( 26, 5) = 0.242454E+01
-PKER_SDRYG( 26, 6) = 0.227488E+01
-PKER_SDRYG( 26, 7) = 0.213435E+01
-PKER_SDRYG( 26, 8) = 0.200240E+01
-PKER_SDRYG( 26, 9) = 0.187849E+01
-PKER_SDRYG( 26, 10) = 0.176215E+01
-PKER_SDRYG( 26, 11) = 0.165290E+01
-PKER_SDRYG( 26, 12) = 0.155031E+01
-PKER_SDRYG( 26, 13) = 0.145398E+01
-PKER_SDRYG( 26, 14) = 0.136353E+01
-PKER_SDRYG( 26, 15) = 0.127859E+01
-PKER_SDRYG( 26, 16) = 0.119883E+01
-PKER_SDRYG( 26, 17) = 0.112393E+01
-PKER_SDRYG( 26, 18) = 0.105359E+01
-PKER_SDRYG( 26, 19) = 0.987542E+00
-PKER_SDRYG( 26, 20) = 0.925511E+00
-PKER_SDRYG( 26, 21) = 0.867254E+00
-PKER_SDRYG( 26, 22) = 0.812537E+00
-PKER_SDRYG( 26, 23) = 0.761142E+00
-PKER_SDRYG( 26, 24) = 0.712863E+00
-PKER_SDRYG( 26, 25) = 0.667506E+00
-PKER_SDRYG( 26, 26) = 0.624887E+00
-PKER_SDRYG( 26, 27) = 0.584833E+00
-PKER_SDRYG( 26, 28) = 0.547180E+00
-PKER_SDRYG( 26, 29) = 0.511772E+00
-PKER_SDRYG( 26, 30) = 0.478460E+00
-PKER_SDRYG( 26, 31) = 0.447104E+00
-PKER_SDRYG( 26, 32) = 0.417566E+00
-PKER_SDRYG( 26, 33) = 0.389716E+00
-PKER_SDRYG( 26, 34) = 0.363424E+00
-PKER_SDRYG( 26, 35) = 0.338565E+00
-PKER_SDRYG( 26, 36) = 0.315018E+00
-PKER_SDRYG( 26, 37) = 0.292659E+00
-PKER_SDRYG( 26, 38) = 0.271372E+00
-PKER_SDRYG( 26, 39) = 0.251045E+00
-PKER_SDRYG( 26, 40) = 0.231574E+00
-PKER_SDRYG( 26, 41) = 0.212879E+00
-PKER_SDRYG( 26, 42) = 0.194903E+00
-PKER_SDRYG( 26, 43) = 0.177633E+00
-PKER_SDRYG( 26, 44) = 0.161095E+00
-PKER_SDRYG( 26, 45) = 0.145360E+00
-PKER_SDRYG( 26, 46) = 0.130519E+00
-PKER_SDRYG( 26, 47) = 0.116666E+00
-PKER_SDRYG( 26, 48) = 0.103866E+00
-PKER_SDRYG( 26, 49) = 0.921482E-01
-PKER_SDRYG( 26, 50) = 0.814979E-01
-PKER_SDRYG( 26, 51) = 0.718712E-01
-PKER_SDRYG( 26, 52) = 0.632052E-01
-PKER_SDRYG( 26, 53) = 0.554342E-01
-PKER_SDRYG( 26, 54) = 0.484997E-01
-PKER_SDRYG( 26, 55) = 0.423584E-01
-PKER_SDRYG( 26, 56) = 0.369623E-01
-PKER_SDRYG( 26, 57) = 0.322885E-01
-PKER_SDRYG( 26, 58) = 0.283154E-01
-PKER_SDRYG( 26, 59) = 0.250077E-01
-PKER_SDRYG( 26, 60) = 0.223595E-01
-PKER_SDRYG( 26, 61) = 0.203223E-01
-PKER_SDRYG( 26, 62) = 0.188304E-01
-PKER_SDRYG( 26, 63) = 0.178989E-01
-PKER_SDRYG( 26, 64) = 0.174069E-01
-PKER_SDRYG( 26, 65) = 0.173438E-01
-PKER_SDRYG( 26, 66) = 0.176393E-01
-PKER_SDRYG( 26, 67) = 0.182225E-01
-PKER_SDRYG( 26, 68) = 0.190509E-01
-PKER_SDRYG( 26, 69) = 0.200644E-01
-PKER_SDRYG( 26, 70) = 0.212177E-01
-PKER_SDRYG( 26, 71) = 0.224723E-01
-PKER_SDRYG( 26, 72) = 0.237862E-01
-PKER_SDRYG( 26, 73) = 0.251344E-01
-PKER_SDRYG( 26, 74) = 0.264927E-01
-PKER_SDRYG( 26, 75) = 0.278385E-01
-PKER_SDRYG( 26, 76) = 0.291602E-01
-PKER_SDRYG( 26, 77) = 0.304461E-01
-PKER_SDRYG( 26, 78) = 0.316870E-01
-PKER_SDRYG( 26, 79) = 0.328792E-01
-PKER_SDRYG( 26, 80) = 0.340205E-01
-PKER_SDRYG( 27, 1) = 0.313101E+01
-PKER_SDRYG( 27, 2) = 0.293850E+01
-PKER_SDRYG( 27, 3) = 0.275773E+01
-PKER_SDRYG( 27, 4) = 0.258799E+01
-PKER_SDRYG( 27, 5) = 0.242861E+01
-PKER_SDRYG( 27, 6) = 0.227895E+01
-PKER_SDRYG( 27, 7) = 0.213842E+01
-PKER_SDRYG( 27, 8) = 0.200647E+01
-PKER_SDRYG( 27, 9) = 0.188257E+01
-PKER_SDRYG( 27, 10) = 0.176622E+01
-PKER_SDRYG( 27, 11) = 0.165697E+01
-PKER_SDRYG( 27, 12) = 0.155439E+01
-PKER_SDRYG( 27, 13) = 0.145807E+01
-PKER_SDRYG( 27, 14) = 0.136761E+01
-PKER_SDRYG( 27, 15) = 0.128268E+01
-PKER_SDRYG( 27, 16) = 0.120292E+01
-PKER_SDRYG( 27, 17) = 0.112803E+01
-PKER_SDRYG( 27, 18) = 0.105770E+01
-PKER_SDRYG( 27, 19) = 0.991658E+00
-PKER_SDRYG( 27, 20) = 0.929637E+00
-PKER_SDRYG( 27, 21) = 0.871391E+00
-PKER_SDRYG( 27, 22) = 0.816689E+00
-PKER_SDRYG( 27, 23) = 0.765313E+00
-PKER_SDRYG( 27, 24) = 0.717055E+00
-PKER_SDRYG( 27, 25) = 0.671724E+00
-PKER_SDRYG( 27, 26) = 0.629137E+00
-PKER_SDRYG( 27, 27) = 0.589122E+00
-PKER_SDRYG( 27, 28) = 0.551516E+00
-PKER_SDRYG( 27, 29) = 0.516166E+00
-PKER_SDRYG( 27, 30) = 0.482925E+00
-PKER_SDRYG( 27, 31) = 0.451654E+00
-PKER_SDRYG( 27, 32) = 0.422222E+00
-PKER_SDRYG( 27, 33) = 0.394499E+00
-PKER_SDRYG( 27, 34) = 0.368365E+00
-PKER_SDRYG( 27, 35) = 0.343698E+00
-PKER_SDRYG( 27, 36) = 0.320383E+00
-PKER_SDRYG( 27, 37) = 0.298305E+00
-PKER_SDRYG( 27, 38) = 0.277352E+00
-PKER_SDRYG( 27, 39) = 0.257415E+00
-PKER_SDRYG( 27, 40) = 0.238391E+00
-PKER_SDRYG( 27, 41) = 0.220186E+00
-PKER_SDRYG( 27, 42) = 0.202722E+00
-PKER_SDRYG( 27, 43) = 0.185950E+00
-PKER_SDRYG( 27, 44) = 0.169854E+00
-PKER_SDRYG( 27, 45) = 0.154458E+00
-PKER_SDRYG( 27, 46) = 0.139820E+00
-PKER_SDRYG( 27, 47) = 0.126022E+00
-PKER_SDRYG( 27, 48) = 0.113143E+00
-PKER_SDRYG( 27, 49) = 0.101238E+00
-PKER_SDRYG( 27, 50) = 0.903254E-01
-PKER_SDRYG( 27, 51) = 0.803854E-01
-PKER_SDRYG( 27, 52) = 0.713689E-01
-PKER_SDRYG( 27, 53) = 0.632101E-01
-PKER_SDRYG( 27, 54) = 0.558396E-01
-PKER_SDRYG( 27, 55) = 0.491953E-01
-PKER_SDRYG( 27, 56) = 0.432272E-01
-PKER_SDRYG( 27, 57) = 0.378924E-01
-PKER_SDRYG( 27, 58) = 0.331656E-01
-PKER_SDRYG( 27, 59) = 0.290311E-01
-PKER_SDRYG( 27, 60) = 0.254617E-01
-PKER_SDRYG( 27, 61) = 0.224578E-01
-PKER_SDRYG( 27, 62) = 0.199937E-01
-PKER_SDRYG( 27, 63) = 0.180372E-01
-PKER_SDRYG( 27, 64) = 0.165903E-01
-PKER_SDRYG( 27, 65) = 0.155977E-01
-PKER_SDRYG( 27, 66) = 0.150213E-01
-PKER_SDRYG( 27, 67) = 0.148130E-01
-PKER_SDRYG( 27, 68) = 0.149387E-01
-PKER_SDRYG( 27, 69) = 0.153282E-01
-PKER_SDRYG( 27, 70) = 0.159403E-01
-PKER_SDRYG( 27, 71) = 0.167423E-01
-PKER_SDRYG( 27, 72) = 0.176783E-01
-PKER_SDRYG( 27, 73) = 0.187141E-01
-PKER_SDRYG( 27, 74) = 0.198160E-01
-PKER_SDRYG( 27, 75) = 0.209625E-01
-PKER_SDRYG( 27, 76) = 0.221197E-01
-PKER_SDRYG( 27, 77) = 0.232789E-01
-PKER_SDRYG( 27, 78) = 0.244211E-01
-PKER_SDRYG( 27, 79) = 0.255350E-01
-PKER_SDRYG( 27, 80) = 0.266159E-01
-PKER_SDRYG( 28, 1) = 0.313449E+01
-PKER_SDRYG( 28, 2) = 0.294198E+01
-PKER_SDRYG( 28, 3) = 0.276121E+01
-PKER_SDRYG( 28, 4) = 0.259147E+01
-PKER_SDRYG( 28, 5) = 0.243209E+01
-PKER_SDRYG( 28, 6) = 0.228243E+01
-PKER_SDRYG( 28, 7) = 0.214191E+01
-PKER_SDRYG( 28, 8) = 0.200995E+01
-PKER_SDRYG( 28, 9) = 0.188605E+01
-PKER_SDRYG( 28, 10) = 0.176971E+01
-PKER_SDRYG( 28, 11) = 0.166046E+01
-PKER_SDRYG( 28, 12) = 0.155788E+01
-PKER_SDRYG( 28, 13) = 0.146156E+01
-PKER_SDRYG( 28, 14) = 0.137111E+01
-PKER_SDRYG( 28, 15) = 0.128618E+01
-PKER_SDRYG( 28, 16) = 0.120643E+01
-PKER_SDRYG( 28, 17) = 0.113154E+01
-PKER_SDRYG( 28, 18) = 0.106121E+01
-PKER_SDRYG( 28, 19) = 0.995175E+00
-PKER_SDRYG( 28, 20) = 0.933162E+00
-PKER_SDRYG( 28, 21) = 0.874925E+00
-PKER_SDRYG( 28, 22) = 0.820234E+00
-PKER_SDRYG( 28, 23) = 0.768871E+00
-PKER_SDRYG( 28, 24) = 0.720630E+00
-PKER_SDRYG( 28, 25) = 0.675319E+00
-PKER_SDRYG( 28, 26) = 0.632756E+00
-PKER_SDRYG( 28, 27) = 0.592769E+00
-PKER_SDRYG( 28, 28) = 0.555199E+00
-PKER_SDRYG( 28, 29) = 0.519891E+00
-PKER_SDRYG( 28, 30) = 0.486702E+00
-PKER_SDRYG( 28, 31) = 0.455495E+00
-PKER_SDRYG( 28, 32) = 0.426139E+00
-PKER_SDRYG( 28, 33) = 0.398512E+00
-PKER_SDRYG( 28, 34) = 0.372492E+00
-PKER_SDRYG( 28, 35) = 0.347966E+00
-PKER_SDRYG( 28, 36) = 0.324823E+00
-PKER_SDRYG( 28, 37) = 0.302953E+00
-PKER_SDRYG( 28, 38) = 0.282250E+00
-PKER_SDRYG( 28, 39) = 0.262611E+00
-PKER_SDRYG( 28, 40) = 0.243935E+00
-PKER_SDRYG( 28, 41) = 0.226126E+00
-PKER_SDRYG( 28, 42) = 0.209097E+00
-PKER_SDRYG( 28, 43) = 0.192777E+00
-PKER_SDRYG( 28, 44) = 0.177120E+00
-PKER_SDRYG( 28, 45) = 0.162110E+00
-PKER_SDRYG( 28, 46) = 0.147766E+00
-PKER_SDRYG( 28, 47) = 0.134140E+00
-PKER_SDRYG( 28, 48) = 0.121302E+00
-PKER_SDRYG( 28, 49) = 0.109322E+00
-PKER_SDRYG( 28, 50) = 0.982464E-01
-PKER_SDRYG( 28, 51) = 0.880870E-01
-PKER_SDRYG( 28, 52) = 0.788209E-01
-PKER_SDRYG( 28, 53) = 0.703976E-01
-PKER_SDRYG( 28, 54) = 0.627508E-01
-PKER_SDRYG( 28, 55) = 0.558103E-01
-PKER_SDRYG( 28, 56) = 0.495129E-01
-PKER_SDRYG( 28, 57) = 0.438028E-01
-PKER_SDRYG( 28, 58) = 0.386362E-01
-PKER_SDRYG( 28, 59) = 0.339854E-01
-PKER_SDRYG( 28, 60) = 0.298313E-01
-PKER_SDRYG( 28, 61) = 0.261519E-01
-PKER_SDRYG( 28, 62) = 0.229499E-01
-PKER_SDRYG( 28, 63) = 0.202149E-01
-PKER_SDRYG( 28, 64) = 0.179260E-01
-PKER_SDRYG( 28, 65) = 0.160947E-01
-PKER_SDRYG( 28, 66) = 0.146898E-01
-PKER_SDRYG( 28, 67) = 0.136599E-01
-PKER_SDRYG( 28, 68) = 0.130306E-01
-PKER_SDRYG( 28, 69) = 0.127078E-01
-PKER_SDRYG( 28, 70) = 0.126904E-01
-PKER_SDRYG( 28, 71) = 0.129286E-01
-PKER_SDRYG( 28, 72) = 0.133730E-01
-PKER_SDRYG( 28, 73) = 0.139895E-01
-PKER_SDRYG( 28, 74) = 0.147384E-01
-PKER_SDRYG( 28, 75) = 0.155886E-01
-PKER_SDRYG( 28, 76) = 0.165083E-01
-PKER_SDRYG( 28, 77) = 0.174717E-01
-PKER_SDRYG( 28, 78) = 0.184586E-01
-PKER_SDRYG( 28, 79) = 0.194515E-01
-PKER_SDRYG( 28, 80) = 0.204357E-01
-PKER_SDRYG( 29, 1) = 0.313747E+01
-PKER_SDRYG( 29, 2) = 0.294496E+01
-PKER_SDRYG( 29, 3) = 0.276419E+01
-PKER_SDRYG( 29, 4) = 0.259445E+01
-PKER_SDRYG( 29, 5) = 0.243507E+01
-PKER_SDRYG( 29, 6) = 0.228541E+01
-PKER_SDRYG( 29, 7) = 0.214489E+01
-PKER_SDRYG( 29, 8) = 0.201293E+01
-PKER_SDRYG( 29, 9) = 0.188903E+01
-PKER_SDRYG( 29, 10) = 0.177269E+01
-PKER_SDRYG( 29, 11) = 0.166345E+01
-PKER_SDRYG( 29, 12) = 0.156087E+01
-PKER_SDRYG( 29, 13) = 0.146454E+01
-PKER_SDRYG( 29, 14) = 0.137410E+01
-PKER_SDRYG( 29, 15) = 0.128917E+01
-PKER_SDRYG( 29, 16) = 0.120942E+01
-PKER_SDRYG( 29, 17) = 0.113453E+01
-PKER_SDRYG( 29, 18) = 0.106421E+01
-PKER_SDRYG( 29, 19) = 0.998181E+00
-PKER_SDRYG( 29, 20) = 0.936174E+00
-PKER_SDRYG( 29, 21) = 0.877944E+00
-PKER_SDRYG( 29, 22) = 0.823262E+00
-PKER_SDRYG( 29, 23) = 0.771909E+00
-PKER_SDRYG( 29, 24) = 0.723680E+00
-PKER_SDRYG( 29, 25) = 0.678384E+00
-PKER_SDRYG( 29, 26) = 0.635838E+00
-PKER_SDRYG( 29, 27) = 0.595874E+00
-PKER_SDRYG( 29, 28) = 0.558329E+00
-PKER_SDRYG( 29, 29) = 0.523053E+00
-PKER_SDRYG( 29, 30) = 0.489903E+00
-PKER_SDRYG( 29, 31) = 0.458743E+00
-PKER_SDRYG( 29, 32) = 0.429445E+00
-PKER_SDRYG( 29, 33) = 0.401887E+00
-PKER_SDRYG( 29, 34) = 0.375952E+00
-PKER_SDRYG( 29, 35) = 0.351530E+00
-PKER_SDRYG( 29, 36) = 0.328513E+00
-PKER_SDRYG( 29, 37) = 0.306797E+00
-PKER_SDRYG( 29, 38) = 0.286281E+00
-PKER_SDRYG( 29, 39) = 0.266866E+00
-PKER_SDRYG( 29, 40) = 0.248456E+00
-PKER_SDRYG( 29, 41) = 0.230957E+00
-PKER_SDRYG( 29, 42) = 0.214280E+00
-PKER_SDRYG( 29, 43) = 0.198346E+00
-PKER_SDRYG( 29, 44) = 0.183090E+00
-PKER_SDRYG( 29, 45) = 0.168466E+00
-PKER_SDRYG( 29, 46) = 0.154460E+00
-PKER_SDRYG( 29, 47) = 0.141088E+00
-PKER_SDRYG( 29, 48) = 0.128395E+00
-PKER_SDRYG( 29, 49) = 0.116443E+00
-PKER_SDRYG( 29, 50) = 0.105292E+00
-PKER_SDRYG( 29, 51) = 0.949826E-01
-PKER_SDRYG( 29, 52) = 0.855219E-01
-PKER_SDRYG( 29, 53) = 0.768860E-01
-PKER_SDRYG( 29, 54) = 0.690252E-01
-PKER_SDRYG( 29, 55) = 0.618752E-01
-PKER_SDRYG( 29, 56) = 0.553676E-01
-PKER_SDRYG( 29, 57) = 0.494383E-01
-PKER_SDRYG( 29, 58) = 0.440308E-01
-PKER_SDRYG( 29, 59) = 0.391006E-01
-PKER_SDRYG( 29, 60) = 0.346133E-01
-PKER_SDRYG( 29, 61) = 0.305457E-01
-PKER_SDRYG( 29, 62) = 0.268814E-01
-PKER_SDRYG( 29, 63) = 0.236136E-01
-PKER_SDRYG( 29, 64) = 0.207396E-01
-PKER_SDRYG( 29, 65) = 0.182488E-01
-PKER_SDRYG( 29, 66) = 0.161470E-01
-PKER_SDRYG( 29, 67) = 0.144221E-01
-PKER_SDRYG( 29, 68) = 0.130541E-01
-PKER_SDRYG( 29, 69) = 0.120420E-01
-PKER_SDRYG( 29, 70) = 0.113535E-01
-PKER_SDRYG( 29, 71) = 0.109639E-01
-PKER_SDRYG( 29, 72) = 0.108336E-01
-PKER_SDRYG( 29, 73) = 0.109439E-01
-PKER_SDRYG( 29, 74) = 0.112436E-01
-PKER_SDRYG( 29, 75) = 0.116990E-01
-PKER_SDRYG( 29, 76) = 0.122946E-01
-PKER_SDRYG( 29, 77) = 0.129851E-01
-PKER_SDRYG( 29, 78) = 0.137450E-01
-PKER_SDRYG( 29, 79) = 0.145540E-01
-PKER_SDRYG( 29, 80) = 0.153942E-01
-PKER_SDRYG( 30, 1) = 0.314002E+01
-PKER_SDRYG( 30, 2) = 0.294750E+01
-PKER_SDRYG( 30, 3) = 0.276674E+01
-PKER_SDRYG( 30, 4) = 0.259700E+01
-PKER_SDRYG( 30, 5) = 0.243762E+01
-PKER_SDRYG( 30, 6) = 0.228796E+01
-PKER_SDRYG( 30, 7) = 0.214744E+01
-PKER_SDRYG( 30, 8) = 0.201548E+01
-PKER_SDRYG( 30, 9) = 0.189158E+01
-PKER_SDRYG( 30, 10) = 0.177524E+01
-PKER_SDRYG( 30, 11) = 0.166600E+01
-PKER_SDRYG( 30, 12) = 0.156342E+01
-PKER_SDRYG( 30, 13) = 0.146710E+01
-PKER_SDRYG( 30, 14) = 0.137665E+01
-PKER_SDRYG( 30, 15) = 0.129173E+01
-PKER_SDRYG( 30, 16) = 0.121198E+01
-PKER_SDRYG( 30, 17) = 0.113710E+01
-PKER_SDRYG( 30, 18) = 0.106678E+01
-PKER_SDRYG( 30, 19) = 0.100075E+01
-PKER_SDRYG( 30, 20) = 0.938748E+00
-PKER_SDRYG( 30, 21) = 0.880524E+00
-PKER_SDRYG( 30, 22) = 0.825848E+00
-PKER_SDRYG( 30, 23) = 0.774502E+00
-PKER_SDRYG( 30, 24) = 0.726283E+00
-PKER_SDRYG( 30, 25) = 0.680998E+00
-PKER_SDRYG( 30, 26) = 0.638466E+00
-PKER_SDRYG( 30, 27) = 0.598518E+00
-PKER_SDRYG( 30, 28) = 0.560993E+00
-PKER_SDRYG( 30, 29) = 0.525741E+00
-PKER_SDRYG( 30, 30) = 0.492619E+00
-PKER_SDRYG( 30, 31) = 0.461494E+00
-PKER_SDRYG( 30, 32) = 0.432239E+00
-PKER_SDRYG( 30, 33) = 0.404733E+00
-PKER_SDRYG( 30, 34) = 0.378861E+00
-PKER_SDRYG( 30, 35) = 0.354516E+00
-PKER_SDRYG( 30, 36) = 0.331593E+00
-PKER_SDRYG( 30, 37) = 0.309990E+00
-PKER_SDRYG( 30, 38) = 0.289613E+00
-PKER_SDRYG( 30, 39) = 0.270365E+00
-PKER_SDRYG( 30, 40) = 0.252155E+00
-PKER_SDRYG( 30, 41) = 0.234894E+00
-PKER_SDRYG( 30, 42) = 0.218495E+00
-PKER_SDRYG( 30, 43) = 0.202876E+00
-PKER_SDRYG( 30, 44) = 0.187963E+00
-PKER_SDRYG( 30, 45) = 0.173695E+00
-PKER_SDRYG( 30, 46) = 0.160030E+00
-PKER_SDRYG( 30, 47) = 0.146955E+00
-PKER_SDRYG( 30, 48) = 0.134481E+00
-PKER_SDRYG( 30, 49) = 0.122650E+00
-PKER_SDRYG( 30, 50) = 0.111515E+00
-PKER_SDRYG( 30, 51) = 0.101129E+00
-PKER_SDRYG( 30, 52) = 0.915257E-01
-PKER_SDRYG( 30, 53) = 0.827114E-01
-PKER_SDRYG( 30, 54) = 0.746610E-01
-PKER_SDRYG( 30, 55) = 0.673269E-01
-PKER_SDRYG( 30, 56) = 0.606477E-01
-PKER_SDRYG( 30, 57) = 0.545580E-01
-PKER_SDRYG( 30, 58) = 0.489958E-01
-PKER_SDRYG( 30, 59) = 0.439055E-01
-PKER_SDRYG( 30, 60) = 0.392404E-01
-PKER_SDRYG( 30, 61) = 0.349660E-01
-PKER_SDRYG( 30, 62) = 0.310541E-01
-PKER_SDRYG( 30, 63) = 0.274846E-01
-PKER_SDRYG( 30, 64) = 0.242506E-01
-PKER_SDRYG( 30, 65) = 0.213448E-01
-PKER_SDRYG( 30, 66) = 0.187586E-01
-PKER_SDRYG( 30, 67) = 0.165035E-01
-PKER_SDRYG( 30, 68) = 0.145721E-01
-PKER_SDRYG( 30, 69) = 0.129515E-01
-PKER_SDRYG( 30, 70) = 0.116577E-01
-PKER_SDRYG( 30, 71) = 0.106667E-01
-PKER_SDRYG( 30, 72) = 0.994280E-02
-PKER_SDRYG( 30, 73) = 0.950649E-02
-PKER_SDRYG( 30, 74) = 0.928866E-02
-PKER_SDRYG( 30, 75) = 0.929150E-02
-PKER_SDRYG( 30, 76) = 0.947736E-02
-PKER_SDRYG( 30, 77) = 0.981262E-02
-PKER_SDRYG( 30, 78) = 0.102704E-01
-PKER_SDRYG( 30, 79) = 0.108228E-01
-PKER_SDRYG( 30, 80) = 0.114493E-01
-PKER_SDRYG( 31, 1) = 0.314220E+01
-PKER_SDRYG( 31, 2) = 0.294968E+01
-PKER_SDRYG( 31, 3) = 0.276892E+01
-PKER_SDRYG( 31, 4) = 0.259918E+01
-PKER_SDRYG( 31, 5) = 0.243980E+01
-PKER_SDRYG( 31, 6) = 0.229014E+01
-PKER_SDRYG( 31, 7) = 0.214962E+01
-PKER_SDRYG( 31, 8) = 0.201767E+01
-PKER_SDRYG( 31, 9) = 0.189377E+01
-PKER_SDRYG( 31, 10) = 0.177743E+01
-PKER_SDRYG( 31, 11) = 0.166818E+01
-PKER_SDRYG( 31, 12) = 0.156560E+01
-PKER_SDRYG( 31, 13) = 0.146928E+01
-PKER_SDRYG( 31, 14) = 0.137884E+01
-PKER_SDRYG( 31, 15) = 0.129391E+01
-PKER_SDRYG( 31, 16) = 0.121417E+01
-PKER_SDRYG( 31, 17) = 0.113929E+01
-PKER_SDRYG( 31, 18) = 0.106897E+01
-PKER_SDRYG( 31, 19) = 0.100295E+01
-PKER_SDRYG( 31, 20) = 0.940948E+00
-PKER_SDRYG( 31, 21) = 0.882728E+00
-PKER_SDRYG( 31, 22) = 0.828057E+00
-PKER_SDRYG( 31, 23) = 0.776718E+00
-PKER_SDRYG( 31, 24) = 0.728505E+00
-PKER_SDRYG( 31, 25) = 0.683229E+00
-PKER_SDRYG( 31, 26) = 0.640707E+00
-PKER_SDRYG( 31, 27) = 0.600771E+00
-PKER_SDRYG( 31, 28) = 0.563261E+00
-PKER_SDRYG( 31, 29) = 0.528027E+00
-PKER_SDRYG( 31, 30) = 0.494928E+00
-PKER_SDRYG( 31, 31) = 0.463829E+00
-PKER_SDRYG( 31, 32) = 0.434605E+00
-PKER_SDRYG( 31, 33) = 0.407138E+00
-PKER_SDRYG( 31, 34) = 0.381314E+00
-PKER_SDRYG( 31, 35) = 0.357025E+00
-PKER_SDRYG( 31, 36) = 0.334171E+00
-PKER_SDRYG( 31, 37) = 0.312654E+00
-PKER_SDRYG( 31, 38) = 0.292379E+00
-PKER_SDRYG( 31, 39) = 0.273255E+00
-PKER_SDRYG( 31, 40) = 0.255196E+00
-PKER_SDRYG( 31, 41) = 0.238116E+00
-PKER_SDRYG( 31, 42) = 0.221930E+00
-PKER_SDRYG( 31, 43) = 0.206560E+00
-PKER_SDRYG( 31, 44) = 0.191928E+00
-PKER_SDRYG( 31, 45) = 0.177966E+00
-PKER_SDRYG( 31, 46) = 0.164617E+00
-PKER_SDRYG( 31, 47) = 0.151844E+00
-PKER_SDRYG( 31, 48) = 0.139631E+00
-PKER_SDRYG( 31, 49) = 0.127989E+00
-PKER_SDRYG( 31, 50) = 0.116954E+00
-PKER_SDRYG( 31, 51) = 0.106573E+00
-PKER_SDRYG( 31, 52) = 0.968931E-01
-PKER_SDRYG( 31, 53) = 0.879432E-01
-PKER_SDRYG( 31, 54) = 0.797263E-01
-PKER_SDRYG( 31, 55) = 0.722185E-01
-PKER_SDRYG( 31, 56) = 0.653743E-01
-PKER_SDRYG( 31, 57) = 0.591361E-01
-PKER_SDRYG( 31, 58) = 0.534422E-01
-PKER_SDRYG( 31, 59) = 0.482336E-01
-PKER_SDRYG( 31, 60) = 0.434570E-01
-PKER_SDRYG( 31, 61) = 0.390673E-01
-PKER_SDRYG( 31, 62) = 0.350274E-01
-PKER_SDRYG( 31, 63) = 0.313081E-01
-PKER_SDRYG( 31, 64) = 0.278888E-01
-PKER_SDRYG( 31, 65) = 0.247544E-01
-PKER_SDRYG( 31, 66) = 0.218960E-01
-PKER_SDRYG( 31, 67) = 0.193088E-01
-PKER_SDRYG( 31, 68) = 0.169937E-01
-PKER_SDRYG( 31, 69) = 0.149516E-01
-PKER_SDRYG( 31, 70) = 0.131790E-01
-PKER_SDRYG( 31, 71) = 0.116819E-01
-PKER_SDRYG( 31, 72) = 0.104551E-01
-PKER_SDRYG( 31, 73) = 0.948321E-02
-PKER_SDRYG( 31, 74) = 0.876425E-02
-PKER_SDRYG( 31, 75) = 0.827997E-02
-PKER_SDRYG( 31, 76) = 0.801127E-02
-PKER_SDRYG( 31, 77) = 0.792771E-02
-PKER_SDRYG( 31, 78) = 0.801896E-02
-PKER_SDRYG( 31, 79) = 0.824709E-02
-PKER_SDRYG( 31, 80) = 0.858541E-02
-PKER_SDRYG( 32, 1) = 0.314406E+01
-PKER_SDRYG( 32, 2) = 0.295155E+01
-PKER_SDRYG( 32, 3) = 0.277078E+01
-PKER_SDRYG( 32, 4) = 0.260105E+01
-PKER_SDRYG( 32, 5) = 0.244167E+01
-PKER_SDRYG( 32, 6) = 0.229201E+01
-PKER_SDRYG( 32, 7) = 0.215148E+01
-PKER_SDRYG( 32, 8) = 0.201953E+01
-PKER_SDRYG( 32, 9) = 0.189563E+01
-PKER_SDRYG( 32, 10) = 0.177929E+01
-PKER_SDRYG( 32, 11) = 0.167005E+01
-PKER_SDRYG( 32, 12) = 0.156747E+01
-PKER_SDRYG( 32, 13) = 0.147115E+01
-PKER_SDRYG( 32, 14) = 0.138071E+01
-PKER_SDRYG( 32, 15) = 0.129579E+01
-PKER_SDRYG( 32, 16) = 0.121604E+01
-PKER_SDRYG( 32, 17) = 0.114116E+01
-PKER_SDRYG( 32, 18) = 0.107085E+01
-PKER_SDRYG( 32, 19) = 0.100483E+01
-PKER_SDRYG( 32, 20) = 0.942829E+00
-PKER_SDRYG( 32, 21) = 0.884612E+00
-PKER_SDRYG( 32, 22) = 0.829945E+00
-PKER_SDRYG( 32, 23) = 0.778610E+00
-PKER_SDRYG( 32, 24) = 0.730403E+00
-PKER_SDRYG( 32, 25) = 0.685133E+00
-PKER_SDRYG( 32, 26) = 0.642619E+00
-PKER_SDRYG( 32, 27) = 0.602693E+00
-PKER_SDRYG( 32, 28) = 0.565194E+00
-PKER_SDRYG( 32, 29) = 0.529974E+00
-PKER_SDRYG( 32, 30) = 0.496891E+00
-PKER_SDRYG( 32, 31) = 0.465812E+00
-PKER_SDRYG( 32, 32) = 0.436612E+00
-PKER_SDRYG( 32, 33) = 0.409174E+00
-PKER_SDRYG( 32, 34) = 0.383385E+00
-PKER_SDRYG( 32, 35) = 0.359139E+00
-PKER_SDRYG( 32, 36) = 0.336337E+00
-PKER_SDRYG( 32, 37) = 0.314882E+00
-PKER_SDRYG( 32, 38) = 0.294684E+00
-PKER_SDRYG( 32, 39) = 0.275654E+00
-PKER_SDRYG( 32, 40) = 0.257707E+00
-PKER_SDRYG( 32, 41) = 0.240762E+00
-PKER_SDRYG( 32, 42) = 0.224739E+00
-PKER_SDRYG( 32, 43) = 0.209560E+00
-PKER_SDRYG( 32, 44) = 0.195151E+00
-PKER_SDRYG( 32, 45) = 0.181441E+00
-PKER_SDRYG( 32, 46) = 0.168366E+00
-PKER_SDRYG( 32, 47) = 0.155875E+00
-PKER_SDRYG( 32, 48) = 0.143930E+00
-PKER_SDRYG( 32, 49) = 0.132518E+00
-PKER_SDRYG( 32, 50) = 0.121647E+00
-PKER_SDRYG( 32, 51) = 0.111348E+00
-PKER_SDRYG( 32, 52) = 0.101665E+00
-PKER_SDRYG( 32, 53) = 0.926375E-01
-PKER_SDRYG( 32, 54) = 0.842909E-01
-PKER_SDRYG( 32, 55) = 0.766266E-01
-PKER_SDRYG( 32, 56) = 0.696211E-01
-PKER_SDRYG( 32, 57) = 0.632317E-01
-PKER_SDRYG( 32, 58) = 0.574042E-01
-PKER_SDRYG( 32, 59) = 0.520813E-01
-PKER_SDRYG( 32, 60) = 0.472072E-01
-PKER_SDRYG( 32, 61) = 0.427319E-01
-PKER_SDRYG( 32, 62) = 0.386118E-01
-PKER_SDRYG( 32, 63) = 0.348110E-01
-PKER_SDRYG( 32, 64) = 0.312996E-01
-PKER_SDRYG( 32, 65) = 0.280543E-01
-PKER_SDRYG( 32, 66) = 0.250591E-01
-PKER_SDRYG( 32, 67) = 0.223013E-01
-PKER_SDRYG( 32, 68) = 0.197725E-01
-PKER_SDRYG( 32, 69) = 0.174730E-01
-PKER_SDRYG( 32, 70) = 0.154004E-01
-PKER_SDRYG( 32, 71) = 0.135520E-01
-PKER_SDRYG( 32, 72) = 0.119388E-01
-PKER_SDRYG( 32, 73) = 0.105563E-01
-PKER_SDRYG( 32, 74) = 0.939655E-02
-PKER_SDRYG( 32, 75) = 0.846973E-02
-PKER_SDRYG( 32, 76) = 0.776301E-02
-PKER_SDRYG( 32, 77) = 0.725013E-02
-PKER_SDRYG( 32, 78) = 0.694243E-02
-PKER_SDRYG( 32, 79) = 0.679372E-02
-PKER_SDRYG( 32, 80) = 0.680548E-02
-PKER_SDRYG( 33, 1) = 0.314566E+01
-PKER_SDRYG( 33, 2) = 0.295315E+01
-PKER_SDRYG( 33, 3) = 0.277238E+01
-PKER_SDRYG( 33, 4) = 0.260264E+01
-PKER_SDRYG( 33, 5) = 0.244326E+01
-PKER_SDRYG( 33, 6) = 0.229361E+01
-PKER_SDRYG( 33, 7) = 0.215308E+01
-PKER_SDRYG( 33, 8) = 0.202113E+01
-PKER_SDRYG( 33, 9) = 0.189723E+01
-PKER_SDRYG( 33, 10) = 0.178089E+01
-PKER_SDRYG( 33, 11) = 0.167165E+01
-PKER_SDRYG( 33, 12) = 0.156907E+01
-PKER_SDRYG( 33, 13) = 0.147275E+01
-PKER_SDRYG( 33, 14) = 0.138231E+01
-PKER_SDRYG( 33, 15) = 0.129739E+01
-PKER_SDRYG( 33, 16) = 0.121764E+01
-PKER_SDRYG( 33, 17) = 0.114277E+01
-PKER_SDRYG( 33, 18) = 0.107245E+01
-PKER_SDRYG( 33, 19) = 0.100643E+01
-PKER_SDRYG( 33, 20) = 0.944437E+00
-PKER_SDRYG( 33, 21) = 0.886223E+00
-PKER_SDRYG( 33, 22) = 0.831559E+00
-PKER_SDRYG( 33, 23) = 0.780227E+00
-PKER_SDRYG( 33, 24) = 0.732025E+00
-PKER_SDRYG( 33, 25) = 0.686759E+00
-PKER_SDRYG( 33, 26) = 0.644252E+00
-PKER_SDRYG( 33, 27) = 0.604332E+00
-PKER_SDRYG( 33, 28) = 0.566842E+00
-PKER_SDRYG( 33, 29) = 0.531632E+00
-PKER_SDRYG( 33, 30) = 0.498562E+00
-PKER_SDRYG( 33, 31) = 0.467498E+00
-PKER_SDRYG( 33, 32) = 0.438317E+00
-PKER_SDRYG( 33, 33) = 0.410900E+00
-PKER_SDRYG( 33, 34) = 0.385137E+00
-PKER_SDRYG( 33, 35) = 0.360924E+00
-PKER_SDRYG( 33, 36) = 0.338161E+00
-PKER_SDRYG( 33, 37) = 0.316753E+00
-PKER_SDRYG( 33, 38) = 0.296612E+00
-PKER_SDRYG( 33, 39) = 0.277651E+00
-PKER_SDRYG( 33, 40) = 0.259788E+00
-PKER_SDRYG( 33, 41) = 0.242945E+00
-PKER_SDRYG( 33, 42) = 0.227045E+00
-PKER_SDRYG( 33, 43) = 0.212013E+00
-PKER_SDRYG( 33, 44) = 0.197777E+00
-PKER_SDRYG( 33, 45) = 0.184267E+00
-PKER_SDRYG( 33, 46) = 0.171418E+00
-PKER_SDRYG( 33, 47) = 0.159172E+00
-PKER_SDRYG( 33, 48) = 0.147479E+00
-PKER_SDRYG( 33, 49) = 0.136305E+00
-PKER_SDRYG( 33, 50) = 0.125636E+00
-PKER_SDRYG( 33, 51) = 0.115480E+00
-PKER_SDRYG( 33, 52) = 0.105865E+00
-PKER_SDRYG( 33, 53) = 0.968269E-01
-PKER_SDRYG( 33, 54) = 0.884030E-01
-PKER_SDRYG( 33, 55) = 0.806146E-01
-PKER_SDRYG( 33, 56) = 0.734617E-01
-PKER_SDRYG( 33, 57) = 0.669216E-01
-PKER_SDRYG( 33, 58) = 0.609541E-01
-PKER_SDRYG( 33, 59) = 0.555086E-01
-PKER_SDRYG( 33, 60) = 0.505315E-01
-PKER_SDRYG( 33, 61) = 0.459711E-01
-PKER_SDRYG( 33, 62) = 0.417804E-01
-PKER_SDRYG( 33, 63) = 0.379185E-01
-PKER_SDRYG( 33, 64) = 0.343507E-01
-PKER_SDRYG( 33, 65) = 0.310480E-01
-PKER_SDRYG( 33, 66) = 0.279873E-01
-PKER_SDRYG( 33, 67) = 0.251500E-01
-PKER_SDRYG( 33, 68) = 0.225217E-01
-PKER_SDRYG( 33, 69) = 0.200934E-01
-PKER_SDRYG( 33, 70) = 0.178587E-01
-PKER_SDRYG( 33, 71) = 0.158140E-01
-PKER_SDRYG( 33, 72) = 0.139592E-01
-PKER_SDRYG( 33, 73) = 0.122971E-01
-PKER_SDRYG( 33, 74) = 0.108290E-01
-PKER_SDRYG( 33, 75) = 0.955466E-02
-PKER_SDRYG( 33, 76) = 0.847794E-02
-PKER_SDRYG( 33, 77) = 0.759796E-02
-PKER_SDRYG( 33, 78) = 0.690209E-02
-PKER_SDRYG( 33, 79) = 0.638733E-02
-PKER_SDRYG( 33, 80) = 0.604388E-02
-PKER_SDRYG( 34, 1) = 0.314703E+01
-PKER_SDRYG( 34, 2) = 0.295451E+01
-PKER_SDRYG( 34, 3) = 0.277375E+01
-PKER_SDRYG( 34, 4) = 0.260401E+01
-PKER_SDRYG( 34, 5) = 0.244463E+01
-PKER_SDRYG( 34, 6) = 0.229497E+01
-PKER_SDRYG( 34, 7) = 0.215445E+01
-PKER_SDRYG( 34, 8) = 0.202250E+01
-PKER_SDRYG( 34, 9) = 0.189860E+01
-PKER_SDRYG( 34, 10) = 0.178226E+01
-PKER_SDRYG( 34, 11) = 0.167302E+01
-PKER_SDRYG( 34, 12) = 0.157044E+01
-PKER_SDRYG( 34, 13) = 0.147412E+01
-PKER_SDRYG( 34, 14) = 0.138368E+01
-PKER_SDRYG( 34, 15) = 0.129876E+01
-PKER_SDRYG( 34, 16) = 0.121901E+01
-PKER_SDRYG( 34, 17) = 0.114414E+01
-PKER_SDRYG( 34, 18) = 0.107383E+01
-PKER_SDRYG( 34, 19) = 0.100781E+01
-PKER_SDRYG( 34, 20) = 0.945813E+00
-PKER_SDRYG( 34, 21) = 0.887600E+00
-PKER_SDRYG( 34, 22) = 0.832938E+00
-PKER_SDRYG( 34, 23) = 0.781609E+00
-PKER_SDRYG( 34, 24) = 0.733410E+00
-PKER_SDRYG( 34, 25) = 0.688148E+00
-PKER_SDRYG( 34, 26) = 0.645645E+00
-PKER_SDRYG( 34, 27) = 0.605732E+00
-PKER_SDRYG( 34, 28) = 0.568248E+00
-PKER_SDRYG( 34, 29) = 0.533046E+00
-PKER_SDRYG( 34, 30) = 0.499985E+00
-PKER_SDRYG( 34, 31) = 0.468933E+00
-PKER_SDRYG( 34, 32) = 0.439765E+00
-PKER_SDRYG( 34, 33) = 0.412365E+00
-PKER_SDRYG( 34, 34) = 0.386623E+00
-PKER_SDRYG( 34, 35) = 0.362434E+00
-PKER_SDRYG( 34, 36) = 0.339699E+00
-PKER_SDRYG( 34, 37) = 0.318327E+00
-PKER_SDRYG( 34, 38) = 0.298229E+00
-PKER_SDRYG( 34, 39) = 0.279320E+00
-PKER_SDRYG( 34, 40) = 0.261520E+00
-PKER_SDRYG( 34, 41) = 0.244754E+00
-PKER_SDRYG( 34, 42) = 0.228946E+00
-PKER_SDRYG( 34, 43) = 0.214024E+00
-PKER_SDRYG( 34, 44) = 0.199921E+00
-PKER_SDRYG( 34, 45) = 0.186567E+00
-PKER_SDRYG( 34, 46) = 0.173900E+00
-PKER_SDRYG( 34, 47) = 0.161857E+00
-PKER_SDRYG( 34, 48) = 0.150383E+00
-PKER_SDRYG( 34, 49) = 0.139434E+00
-PKER_SDRYG( 34, 50) = 0.128978E+00
-PKER_SDRYG( 34, 51) = 0.119001E+00
-PKER_SDRYG( 34, 52) = 0.109510E+00
-PKER_SDRYG( 34, 53) = 0.100527E+00
-PKER_SDRYG( 34, 54) = 0.920877E-01
-PKER_SDRYG( 34, 55) = 0.842228E-01
-PKER_SDRYG( 34, 56) = 0.769515E-01
-PKER_SDRYG( 34, 57) = 0.702724E-01
-PKER_SDRYG( 34, 58) = 0.641637E-01
-PKER_SDRYG( 34, 59) = 0.585877E-01
-PKER_SDRYG( 34, 60) = 0.534972E-01
-PKER_SDRYG( 34, 61) = 0.488422E-01
-PKER_SDRYG( 34, 62) = 0.445748E-01
-PKER_SDRYG( 34, 63) = 0.406510E-01
-PKER_SDRYG( 34, 64) = 0.370327E-01
-PKER_SDRYG( 34, 65) = 0.336871E-01
-PKER_SDRYG( 34, 66) = 0.305868E-01
-PKER_SDRYG( 34, 67) = 0.277087E-01
-PKER_SDRYG( 34, 68) = 0.250345E-01
-PKER_SDRYG( 34, 69) = 0.225489E-01
-PKER_SDRYG( 34, 70) = 0.202402E-01
-PKER_SDRYG( 34, 71) = 0.181005E-01
-PKER_SDRYG( 34, 72) = 0.161241E-01
-PKER_SDRYG( 34, 73) = 0.143076E-01
-PKER_SDRYG( 34, 74) = 0.126525E-01
-PKER_SDRYG( 34, 75) = 0.111588E-01
-PKER_SDRYG( 34, 76) = 0.982625E-02
-PKER_SDRYG( 34, 77) = 0.866264E-02
-PKER_SDRYG( 34, 78) = 0.766601E-02
-PKER_SDRYG( 34, 79) = 0.683101E-02
-PKER_SDRYG( 34, 80) = 0.616298E-02
-PKER_SDRYG( 35, 1) = 0.314819E+01
-PKER_SDRYG( 35, 2) = 0.295568E+01
-PKER_SDRYG( 35, 3) = 0.277491E+01
-PKER_SDRYG( 35, 4) = 0.260518E+01
-PKER_SDRYG( 35, 5) = 0.244580E+01
-PKER_SDRYG( 35, 6) = 0.229614E+01
-PKER_SDRYG( 35, 7) = 0.215562E+01
-PKER_SDRYG( 35, 8) = 0.202367E+01
-PKER_SDRYG( 35, 9) = 0.189977E+01
-PKER_SDRYG( 35, 10) = 0.178343E+01
-PKER_SDRYG( 35, 11) = 0.167419E+01
-PKER_SDRYG( 35, 12) = 0.157161E+01
-PKER_SDRYG( 35, 13) = 0.147529E+01
-PKER_SDRYG( 35, 14) = 0.138485E+01
-PKER_SDRYG( 35, 15) = 0.129993E+01
-PKER_SDRYG( 35, 16) = 0.122019E+01
-PKER_SDRYG( 35, 17) = 0.114531E+01
-PKER_SDRYG( 35, 18) = 0.107500E+01
-PKER_SDRYG( 35, 19) = 0.100898E+01
-PKER_SDRYG( 35, 20) = 0.946989E+00
-PKER_SDRYG( 35, 21) = 0.888778E+00
-PKER_SDRYG( 35, 22) = 0.834117E+00
-PKER_SDRYG( 35, 23) = 0.782790E+00
-PKER_SDRYG( 35, 24) = 0.734594E+00
-PKER_SDRYG( 35, 25) = 0.689335E+00
-PKER_SDRYG( 35, 26) = 0.646836E+00
-PKER_SDRYG( 35, 27) = 0.606926E+00
-PKER_SDRYG( 35, 28) = 0.569448E+00
-PKER_SDRYG( 35, 29) = 0.534252E+00
-PKER_SDRYG( 35, 30) = 0.501198E+00
-PKER_SDRYG( 35, 31) = 0.470155E+00
-PKER_SDRYG( 35, 32) = 0.440998E+00
-PKER_SDRYG( 35, 33) = 0.413610E+00
-PKER_SDRYG( 35, 34) = 0.387883E+00
-PKER_SDRYG( 35, 35) = 0.363712E+00
-PKER_SDRYG( 35, 36) = 0.341000E+00
-PKER_SDRYG( 35, 37) = 0.319655E+00
-PKER_SDRYG( 35, 38) = 0.299589E+00
-PKER_SDRYG( 35, 39) = 0.280719E+00
-PKER_SDRYG( 35, 40) = 0.262967E+00
-PKER_SDRYG( 35, 41) = 0.246258E+00
-PKER_SDRYG( 35, 42) = 0.230519E+00
-PKER_SDRYG( 35, 43) = 0.215681E+00
-PKER_SDRYG( 35, 44) = 0.201679E+00
-PKER_SDRYG( 35, 45) = 0.188445E+00
-PKER_SDRYG( 35, 46) = 0.175919E+00
-PKER_SDRYG( 35, 47) = 0.164039E+00
-PKER_SDRYG( 35, 48) = 0.152749E+00
-PKER_SDRYG( 35, 49) = 0.141998E+00
-PKER_SDRYG( 35, 50) = 0.131744E+00
-PKER_SDRYG( 35, 51) = 0.121957E+00
-PKER_SDRYG( 35, 52) = 0.112623E+00
-PKER_SDRYG( 35, 53) = 0.103749E+00
-PKER_SDRYG( 35, 54) = 0.953543E-01
-PKER_SDRYG( 35, 55) = 0.874697E-01
-PKER_SDRYG( 35, 56) = 0.801232E-01
-PKER_SDRYG( 35, 57) = 0.733311E-01
-PKER_SDRYG( 35, 58) = 0.670914E-01
-PKER_SDRYG( 35, 59) = 0.613831E-01
-PKER_SDRYG( 35, 60) = 0.561707E-01
-PKER_SDRYG( 35, 61) = 0.514102E-01
-PKER_SDRYG( 35, 62) = 0.470552E-01
-PKER_SDRYG( 35, 63) = 0.430609E-01
-PKER_SDRYG( 35, 64) = 0.393866E-01
-PKER_SDRYG( 35, 65) = 0.359968E-01
-PKER_SDRYG( 35, 66) = 0.328608E-01
-PKER_SDRYG( 35, 67) = 0.299528E-01
-PKER_SDRYG( 35, 68) = 0.272510E-01
-PKER_SDRYG( 35, 69) = 0.247371E-01
-PKER_SDRYG( 35, 70) = 0.223960E-01
-PKER_SDRYG( 35, 71) = 0.202156E-01
-PKER_SDRYG( 35, 72) = 0.181861E-01
-PKER_SDRYG( 35, 73) = 0.162998E-01
-PKER_SDRYG( 35, 74) = 0.145526E-01
-PKER_SDRYG( 35, 75) = 0.129416E-01
-PKER_SDRYG( 35, 76) = 0.114654E-01
-PKER_SDRYG( 35, 77) = 0.101249E-01
-PKER_SDRYG( 35, 78) = 0.892317E-02
-PKER_SDRYG( 35, 79) = 0.786144E-02
-PKER_SDRYG( 35, 80) = 0.694063E-02
-PKER_SDRYG( 36, 1) = 0.314919E+01
-PKER_SDRYG( 36, 2) = 0.295668E+01
-PKER_SDRYG( 36, 3) = 0.277592E+01
-PKER_SDRYG( 36, 4) = 0.260618E+01
-PKER_SDRYG( 36, 5) = 0.244680E+01
-PKER_SDRYG( 36, 6) = 0.229714E+01
-PKER_SDRYG( 36, 7) = 0.215662E+01
-PKER_SDRYG( 36, 8) = 0.202467E+01
-PKER_SDRYG( 36, 9) = 0.190077E+01
-PKER_SDRYG( 36, 10) = 0.178443E+01
-PKER_SDRYG( 36, 11) = 0.167519E+01
-PKER_SDRYG( 36, 12) = 0.157261E+01
-PKER_SDRYG( 36, 13) = 0.147629E+01
-PKER_SDRYG( 36, 14) = 0.138585E+01
-PKER_SDRYG( 36, 15) = 0.130093E+01
-PKER_SDRYG( 36, 16) = 0.122119E+01
-PKER_SDRYG( 36, 17) = 0.114631E+01
-PKER_SDRYG( 36, 18) = 0.107600E+01
-PKER_SDRYG( 36, 19) = 0.100999E+01
-PKER_SDRYG( 36, 20) = 0.947994E+00
-PKER_SDRYG( 36, 21) = 0.889785E+00
-PKER_SDRYG( 36, 22) = 0.835126E+00
-PKER_SDRYG( 36, 23) = 0.783800E+00
-PKER_SDRYG( 36, 24) = 0.735605E+00
-PKER_SDRYG( 36, 25) = 0.690349E+00
-PKER_SDRYG( 36, 26) = 0.647852E+00
-PKER_SDRYG( 36, 27) = 0.607946E+00
-PKER_SDRYG( 36, 28) = 0.570472E+00
-PKER_SDRYG( 36, 29) = 0.535281E+00
-PKER_SDRYG( 36, 30) = 0.502232E+00
-PKER_SDRYG( 36, 31) = 0.471196E+00
-PKER_SDRYG( 36, 32) = 0.442047E+00
-PKER_SDRYG( 36, 33) = 0.414669E+00
-PKER_SDRYG( 36, 34) = 0.388953E+00
-PKER_SDRYG( 36, 35) = 0.364797E+00
-PKER_SDRYG( 36, 36) = 0.342101E+00
-PKER_SDRYG( 36, 37) = 0.320776E+00
-PKER_SDRYG( 36, 38) = 0.300735E+00
-PKER_SDRYG( 36, 39) = 0.281895E+00
-PKER_SDRYG( 36, 40) = 0.264179E+00
-PKER_SDRYG( 36, 41) = 0.247512E+00
-PKER_SDRYG( 36, 42) = 0.231826E+00
-PKER_SDRYG( 36, 43) = 0.217052E+00
-PKER_SDRYG( 36, 44) = 0.203125E+00
-PKER_SDRYG( 36, 45) = 0.189983E+00
-PKER_SDRYG( 36, 46) = 0.177566E+00
-PKER_SDRYG( 36, 47) = 0.165814E+00
-PKER_SDRYG( 36, 48) = 0.154672E+00
-PKER_SDRYG( 36, 49) = 0.144087E+00
-PKER_SDRYG( 36, 50) = 0.134011E+00
-PKER_SDRYG( 36, 51) = 0.124406E+00
-PKER_SDRYG( 36, 52) = 0.115242E+00
-PKER_SDRYG( 36, 53) = 0.106508E+00
-PKER_SDRYG( 36, 54) = 0.982075E-01
-PKER_SDRYG( 36, 55) = 0.903591E-01
-PKER_SDRYG( 36, 56) = 0.829896E-01
-PKER_SDRYG( 36, 57) = 0.761242E-01
-PKER_SDRYG( 36, 58) = 0.697770E-01
-PKER_SDRYG( 36, 59) = 0.639452E-01
-PKER_SDRYG( 36, 60) = 0.586088E-01
-PKER_SDRYG( 36, 61) = 0.537344E-01
-PKER_SDRYG( 36, 62) = 0.492809E-01
-PKER_SDRYG( 36, 63) = 0.452052E-01
-PKER_SDRYG( 36, 64) = 0.414655E-01
-PKER_SDRYG( 36, 65) = 0.380242E-01
-PKER_SDRYG( 36, 66) = 0.348481E-01
-PKER_SDRYG( 36, 67) = 0.319088E-01
-PKER_SDRYG( 36, 68) = 0.291820E-01
-PKER_SDRYG( 36, 69) = 0.266472E-01
-PKER_SDRYG( 36, 70) = 0.242871E-01
-PKER_SDRYG( 36, 71) = 0.220870E-01
-PKER_SDRYG( 36, 72) = 0.200347E-01
-PKER_SDRYG( 36, 73) = 0.181198E-01
-PKER_SDRYG( 36, 74) = 0.163341E-01
-PKER_SDRYG( 36, 75) = 0.146713E-01
-PKER_SDRYG( 36, 76) = 0.131269E-01
-PKER_SDRYG( 36, 77) = 0.116980E-01
-PKER_SDRYG( 36, 78) = 0.103837E-01
-PKER_SDRYG( 36, 79) = 0.918509E-02
-PKER_SDRYG( 36, 80) = 0.810270E-02
-PKER_SDRYG( 37, 1) = 0.315005E+01
-PKER_SDRYG( 37, 2) = 0.295754E+01
-PKER_SDRYG( 37, 3) = 0.277677E+01
-PKER_SDRYG( 37, 4) = 0.260703E+01
-PKER_SDRYG( 37, 5) = 0.244765E+01
-PKER_SDRYG( 37, 6) = 0.229800E+01
-PKER_SDRYG( 37, 7) = 0.215747E+01
-PKER_SDRYG( 37, 8) = 0.202552E+01
-PKER_SDRYG( 37, 9) = 0.190162E+01
-PKER_SDRYG( 37, 10) = 0.178528E+01
-PKER_SDRYG( 37, 11) = 0.167604E+01
-PKER_SDRYG( 37, 12) = 0.157347E+01
-PKER_SDRYG( 37, 13) = 0.147715E+01
-PKER_SDRYG( 37, 14) = 0.138671E+01
-PKER_SDRYG( 37, 15) = 0.130179E+01
-PKER_SDRYG( 37, 16) = 0.122205E+01
-PKER_SDRYG( 37, 17) = 0.114717E+01
-PKER_SDRYG( 37, 18) = 0.107686E+01
-PKER_SDRYG( 37, 19) = 0.101085E+01
-PKER_SDRYG( 37, 20) = 0.948855E+00
-PKER_SDRYG( 37, 21) = 0.890646E+00
-PKER_SDRYG( 37, 22) = 0.835988E+00
-PKER_SDRYG( 37, 23) = 0.784664E+00
-PKER_SDRYG( 37, 24) = 0.736470E+00
-PKER_SDRYG( 37, 25) = 0.691216E+00
-PKER_SDRYG( 37, 26) = 0.648721E+00
-PKER_SDRYG( 37, 27) = 0.608817E+00
-PKER_SDRYG( 37, 28) = 0.571346E+00
-PKER_SDRYG( 37, 29) = 0.536158E+00
-PKER_SDRYG( 37, 30) = 0.503115E+00
-PKER_SDRYG( 37, 31) = 0.472083E+00
-PKER_SDRYG( 37, 32) = 0.442940E+00
-PKER_SDRYG( 37, 33) = 0.415570E+00
-PKER_SDRYG( 37, 34) = 0.389863E+00
-PKER_SDRYG( 37, 35) = 0.365717E+00
-PKER_SDRYG( 37, 36) = 0.343035E+00
-PKER_SDRYG( 37, 37) = 0.321726E+00
-PKER_SDRYG( 37, 38) = 0.301703E+00
-PKER_SDRYG( 37, 39) = 0.282885E+00
-PKER_SDRYG( 37, 40) = 0.265196E+00
-PKER_SDRYG( 37, 41) = 0.248563E+00
-PKER_SDRYG( 37, 42) = 0.232916E+00
-PKER_SDRYG( 37, 43) = 0.218189E+00
-PKER_SDRYG( 37, 44) = 0.204320E+00
-PKER_SDRYG( 37, 45) = 0.191248E+00
-PKER_SDRYG( 37, 46) = 0.178914E+00
-PKER_SDRYG( 37, 47) = 0.167261E+00
-PKER_SDRYG( 37, 48) = 0.156236E+00
-PKER_SDRYG( 37, 49) = 0.145785E+00
-PKER_SDRYG( 37, 50) = 0.135859E+00
-PKER_SDRYG( 37, 51) = 0.126415E+00
-PKER_SDRYG( 37, 52) = 0.117415E+00
-PKER_SDRYG( 37, 53) = 0.108833E+00
-PKER_SDRYG( 37, 54) = 0.100657E+00
-PKER_SDRYG( 37, 55) = 0.928910E-01
-PKER_SDRYG( 37, 56) = 0.855506E-01
-PKER_SDRYG( 37, 57) = 0.786599E-01
-PKER_SDRYG( 37, 58) = 0.722415E-01
-PKER_SDRYG( 37, 59) = 0.663075E-01
-PKER_SDRYG( 37, 60) = 0.608547E-01
-PKER_SDRYG( 37, 61) = 0.558640E-01
-PKER_SDRYG( 37, 62) = 0.513040E-01
-PKER_SDRYG( 37, 63) = 0.471363E-01
-PKER_SDRYG( 37, 64) = 0.433208E-01
-PKER_SDRYG( 37, 65) = 0.398187E-01
-PKER_SDRYG( 37, 66) = 0.365949E-01
-PKER_SDRYG( 37, 67) = 0.336186E-01
-PKER_SDRYG( 37, 68) = 0.308633E-01
-PKER_SDRYG( 37, 69) = 0.283065E-01
-PKER_SDRYG( 37, 70) = 0.259290E-01
-PKER_SDRYG( 37, 71) = 0.237144E-01
-PKER_SDRYG( 37, 72) = 0.216489E-01
-PKER_SDRYG( 37, 73) = 0.197205E-01
-PKER_SDRYG( 37, 74) = 0.179190E-01
-PKER_SDRYG( 37, 75) = 0.162359E-01
-PKER_SDRYG( 37, 76) = 0.146642E-01
-PKER_SDRYG( 37, 77) = 0.131981E-01
-PKER_SDRYG( 37, 78) = 0.118333E-01
-PKER_SDRYG( 37, 79) = 0.105676E-01
-PKER_SDRYG( 37, 80) = 0.939960E-02
-PKER_SDRYG( 38, 1) = 0.315078E+01
-PKER_SDRYG( 38, 2) = 0.295827E+01
-PKER_SDRYG( 38, 3) = 0.277750E+01
-PKER_SDRYG( 38, 4) = 0.260777E+01
-PKER_SDRYG( 38, 5) = 0.244839E+01
-PKER_SDRYG( 38, 6) = 0.229873E+01
-PKER_SDRYG( 38, 7) = 0.215821E+01
-PKER_SDRYG( 38, 8) = 0.202626E+01
-PKER_SDRYG( 38, 9) = 0.190236E+01
-PKER_SDRYG( 38, 10) = 0.178602E+01
-PKER_SDRYG( 38, 11) = 0.167678E+01
-PKER_SDRYG( 38, 12) = 0.157420E+01
-PKER_SDRYG( 38, 13) = 0.147788E+01
-PKER_SDRYG( 38, 14) = 0.138744E+01
-PKER_SDRYG( 38, 15) = 0.130252E+01
-PKER_SDRYG( 38, 16) = 0.122278E+01
-PKER_SDRYG( 38, 17) = 0.114791E+01
-PKER_SDRYG( 38, 18) = 0.107760E+01
-PKER_SDRYG( 38, 19) = 0.101158E+01
-PKER_SDRYG( 38, 20) = 0.949590E+00
-PKER_SDRYG( 38, 21) = 0.891382E+00
-PKER_SDRYG( 38, 22) = 0.836725E+00
-PKER_SDRYG( 38, 23) = 0.785402E+00
-PKER_SDRYG( 38, 24) = 0.737209E+00
-PKER_SDRYG( 38, 25) = 0.691956E+00
-PKER_SDRYG( 38, 26) = 0.649463E+00
-PKER_SDRYG( 38, 27) = 0.609562E+00
-PKER_SDRYG( 38, 28) = 0.572093E+00
-PKER_SDRYG( 38, 29) = 0.536908E+00
-PKER_SDRYG( 38, 30) = 0.503867E+00
-PKER_SDRYG( 38, 31) = 0.472840E+00
-PKER_SDRYG( 38, 32) = 0.443702E+00
-PKER_SDRYG( 38, 33) = 0.416338E+00
-PKER_SDRYG( 38, 34) = 0.390638E+00
-PKER_SDRYG( 38, 35) = 0.366500E+00
-PKER_SDRYG( 38, 36) = 0.343828E+00
-PKER_SDRYG( 38, 37) = 0.322530E+00
-PKER_SDRYG( 38, 38) = 0.302521E+00
-PKER_SDRYG( 38, 39) = 0.283721E+00
-PKER_SDRYG( 38, 40) = 0.266052E+00
-PKER_SDRYG( 38, 41) = 0.249444E+00
-PKER_SDRYG( 38, 42) = 0.233827E+00
-PKER_SDRYG( 38, 43) = 0.219137E+00
-PKER_SDRYG( 38, 44) = 0.205312E+00
-PKER_SDRYG( 38, 45) = 0.192292E+00
-PKER_SDRYG( 38, 46) = 0.180021E+00
-PKER_SDRYG( 38, 47) = 0.168445E+00
-PKER_SDRYG( 38, 48) = 0.157509E+00
-PKER_SDRYG( 38, 49) = 0.147164E+00
-PKER_SDRYG( 38, 50) = 0.137361E+00
-PKER_SDRYG( 38, 51) = 0.128052E+00
-PKER_SDRYG( 38, 52) = 0.119198E+00
-PKER_SDRYG( 38, 53) = 0.110764E+00
-PKER_SDRYG( 38, 54) = 0.102726E+00
-PKER_SDRYG( 38, 55) = 0.950708E-01
-PKER_SDRYG( 38, 56) = 0.878022E-01
-PKER_SDRYG( 38, 57) = 0.809345E-01
-PKER_SDRYG( 38, 58) = 0.744892E-01
-PKER_SDRYG( 38, 59) = 0.684863E-01
-PKER_SDRYG( 38, 60) = 0.629365E-01
-PKER_SDRYG( 38, 61) = 0.578361E-01
-PKER_SDRYG( 38, 62) = 0.531670E-01
-PKER_SDRYG( 38, 63) = 0.488997E-01
-PKER_SDRYG( 38, 64) = 0.449983E-01
-PKER_SDRYG( 38, 65) = 0.414255E-01
-PKER_SDRYG( 38, 66) = 0.381450E-01
-PKER_SDRYG( 38, 67) = 0.351244E-01
-PKER_SDRYG( 38, 68) = 0.323348E-01
-PKER_SDRYG( 38, 69) = 0.297517E-01
-PKER_SDRYG( 38, 70) = 0.273541E-01
-PKER_SDRYG( 38, 71) = 0.251241E-01
-PKER_SDRYG( 38, 72) = 0.230465E-01
-PKER_SDRYG( 38, 73) = 0.211080E-01
-PKER_SDRYG( 38, 74) = 0.192975E-01
-PKER_SDRYG( 38, 75) = 0.176052E-01
-PKER_SDRYG( 38, 76) = 0.160225E-01
-PKER_SDRYG( 38, 77) = 0.145422E-01
-PKER_SDRYG( 38, 78) = 0.131581E-01
-PKER_SDRYG( 38, 79) = 0.118652E-01
-PKER_SDRYG( 38, 80) = 0.106600E-01
-PKER_SDRYG( 39, 1) = 0.315141E+01
-PKER_SDRYG( 39, 2) = 0.295890E+01
-PKER_SDRYG( 39, 3) = 0.277813E+01
-PKER_SDRYG( 39, 4) = 0.260839E+01
-PKER_SDRYG( 39, 5) = 0.244901E+01
-PKER_SDRYG( 39, 6) = 0.229936E+01
-PKER_SDRYG( 39, 7) = 0.215883E+01
-PKER_SDRYG( 39, 8) = 0.202688E+01
-PKER_SDRYG( 39, 9) = 0.190298E+01
-PKER_SDRYG( 39, 10) = 0.178664E+01
-PKER_SDRYG( 39, 11) = 0.167740E+01
-PKER_SDRYG( 39, 12) = 0.157483E+01
-PKER_SDRYG( 39, 13) = 0.147851E+01
-PKER_SDRYG( 39, 14) = 0.138807E+01
-PKER_SDRYG( 39, 15) = 0.130315E+01
-PKER_SDRYG( 39, 16) = 0.122341E+01
-PKER_SDRYG( 39, 17) = 0.114853E+01
-PKER_SDRYG( 39, 18) = 0.107823E+01
-PKER_SDRYG( 39, 19) = 0.101221E+01
-PKER_SDRYG( 39, 20) = 0.950219E+00
-PKER_SDRYG( 39, 21) = 0.892012E+00
-PKER_SDRYG( 39, 22) = 0.837355E+00
-PKER_SDRYG( 39, 23) = 0.786033E+00
-PKER_SDRYG( 39, 24) = 0.737841E+00
-PKER_SDRYG( 39, 25) = 0.692590E+00
-PKER_SDRYG( 39, 26) = 0.650098E+00
-PKER_SDRYG( 39, 27) = 0.610198E+00
-PKER_SDRYG( 39, 28) = 0.572730E+00
-PKER_SDRYG( 39, 29) = 0.537548E+00
-PKER_SDRYG( 39, 30) = 0.504510E+00
-PKER_SDRYG( 39, 31) = 0.473486E+00
-PKER_SDRYG( 39, 32) = 0.444351E+00
-PKER_SDRYG( 39, 33) = 0.416991E+00
-PKER_SDRYG( 39, 34) = 0.391297E+00
-PKER_SDRYG( 39, 35) = 0.367165E+00
-PKER_SDRYG( 39, 36) = 0.344501E+00
-PKER_SDRYG( 39, 37) = 0.323212E+00
-PKER_SDRYG( 39, 38) = 0.303214E+00
-PKER_SDRYG( 39, 39) = 0.284427E+00
-PKER_SDRYG( 39, 40) = 0.266774E+00
-PKER_SDRYG( 39, 41) = 0.250185E+00
-PKER_SDRYG( 39, 42) = 0.234591E+00
-PKER_SDRYG( 39, 43) = 0.219929E+00
-PKER_SDRYG( 39, 44) = 0.206137E+00
-PKER_SDRYG( 39, 45) = 0.193157E+00
-PKER_SDRYG( 39, 46) = 0.180935E+00
-PKER_SDRYG( 39, 47) = 0.169416E+00
-PKER_SDRYG( 39, 48) = 0.158550E+00
-PKER_SDRYG( 39, 49) = 0.148287E+00
-PKER_SDRYG( 39, 50) = 0.138580E+00
-PKER_SDRYG( 39, 51) = 0.129383E+00
-PKER_SDRYG( 39, 52) = 0.120653E+00
-PKER_SDRYG( 39, 53) = 0.112351E+00
-PKER_SDRYG( 39, 54) = 0.104446E+00
-PKER_SDRYG( 39, 55) = 0.969146E-01
-PKER_SDRYG( 39, 56) = 0.897457E-01
-PKER_SDRYG( 39, 57) = 0.829410E-01
-PKER_SDRYG( 39, 58) = 0.765136E-01
-PKER_SDRYG( 39, 59) = 0.704828E-01
-PKER_SDRYG( 39, 60) = 0.648666E-01
-PKER_SDRYG( 39, 61) = 0.596743E-01
-PKER_SDRYG( 39, 62) = 0.549019E-01
-PKER_SDRYG( 39, 63) = 0.505322E-01
-PKER_SDRYG( 39, 64) = 0.465375E-01
-PKER_SDRYG( 39, 65) = 0.428845E-01
-PKER_SDRYG( 39, 66) = 0.395380E-01
-PKER_SDRYG( 39, 67) = 0.364645E-01
-PKER_SDRYG( 39, 68) = 0.336336E-01
-PKER_SDRYG( 39, 69) = 0.310186E-01
-PKER_SDRYG( 39, 70) = 0.285966E-01
-PKER_SDRYG( 39, 71) = 0.263481E-01
-PKER_SDRYG( 39, 72) = 0.242564E-01
-PKER_SDRYG( 39, 73) = 0.223072E-01
-PKER_SDRYG( 39, 74) = 0.204882E-01
-PKER_SDRYG( 39, 75) = 0.187890E-01
-PKER_SDRYG( 39, 76) = 0.172000E-01
-PKER_SDRYG( 39, 77) = 0.157134E-01
-PKER_SDRYG( 39, 78) = 0.143218E-01
-PKER_SDRYG( 39, 79) = 0.130192E-01
-PKER_SDRYG( 39, 80) = 0.118001E-01
-PKER_SDRYG( 40, 1) = 0.315194E+01
-PKER_SDRYG( 40, 2) = 0.295943E+01
-PKER_SDRYG( 40, 3) = 0.277867E+01
-PKER_SDRYG( 40, 4) = 0.260893E+01
-PKER_SDRYG( 40, 5) = 0.244955E+01
-PKER_SDRYG( 40, 6) = 0.229989E+01
-PKER_SDRYG( 40, 7) = 0.215937E+01
-PKER_SDRYG( 40, 8) = 0.202742E+01
-PKER_SDRYG( 40, 9) = 0.190352E+01
-PKER_SDRYG( 40, 10) = 0.178718E+01
-PKER_SDRYG( 40, 11) = 0.167794E+01
-PKER_SDRYG( 40, 12) = 0.157536E+01
-PKER_SDRYG( 40, 13) = 0.147905E+01
-PKER_SDRYG( 40, 14) = 0.138861E+01
-PKER_SDRYG( 40, 15) = 0.130369E+01
-PKER_SDRYG( 40, 16) = 0.122395E+01
-PKER_SDRYG( 40, 17) = 0.114907E+01
-PKER_SDRYG( 40, 18) = 0.107876E+01
-PKER_SDRYG( 40, 19) = 0.101275E+01
-PKER_SDRYG( 40, 20) = 0.950758E+00
-PKER_SDRYG( 40, 21) = 0.892550E+00
-PKER_SDRYG( 40, 22) = 0.837894E+00
-PKER_SDRYG( 40, 23) = 0.786573E+00
-PKER_SDRYG( 40, 24) = 0.738382E+00
-PKER_SDRYG( 40, 25) = 0.693131E+00
-PKER_SDRYG( 40, 26) = 0.650640E+00
-PKER_SDRYG( 40, 27) = 0.610741E+00
-PKER_SDRYG( 40, 28) = 0.573275E+00
-PKER_SDRYG( 40, 29) = 0.538094E+00
-PKER_SDRYG( 40, 30) = 0.505059E+00
-PKER_SDRYG( 40, 31) = 0.474037E+00
-PKER_SDRYG( 40, 32) = 0.444905E+00
-PKER_SDRYG( 40, 33) = 0.417549E+00
-PKER_SDRYG( 40, 34) = 0.391858E+00
-PKER_SDRYG( 40, 35) = 0.367732E+00
-PKER_SDRYG( 40, 36) = 0.345073E+00
-PKER_SDRYG( 40, 37) = 0.323791E+00
-PKER_SDRYG( 40, 38) = 0.303802E+00
-PKER_SDRYG( 40, 39) = 0.285025E+00
-PKER_SDRYG( 40, 40) = 0.267384E+00
-PKER_SDRYG( 40, 41) = 0.250810E+00
-PKER_SDRYG( 40, 42) = 0.235233E+00
-PKER_SDRYG( 40, 43) = 0.220592E+00
-PKER_SDRYG( 40, 44) = 0.206825E+00
-PKER_SDRYG( 40, 45) = 0.193876E+00
-PKER_SDRYG( 40, 46) = 0.181690E+00
-PKER_SDRYG( 40, 47) = 0.170216E+00
-PKER_SDRYG( 40, 48) = 0.159403E+00
-PKER_SDRYG( 40, 49) = 0.149204E+00
-PKER_SDRYG( 40, 50) = 0.139572E+00
-PKER_SDRYG( 40, 51) = 0.130463E+00
-PKER_SDRYG( 40, 52) = 0.121834E+00
-PKER_SDRYG( 40, 53) = 0.113645E+00
-PKER_SDRYG( 40, 54) = 0.105861E+00
-PKER_SDRYG( 40, 55) = 0.984504E-01
-PKER_SDRYG( 40, 56) = 0.913930E-01
-PKER_SDRYG( 40, 57) = 0.846776E-01
-PKER_SDRYG( 40, 58) = 0.783055E-01
-PKER_SDRYG( 40, 59) = 0.722885E-01
-PKER_SDRYG( 40, 60) = 0.666438E-01
-PKER_SDRYG( 40, 61) = 0.613877E-01
-PKER_SDRYG( 40, 62) = 0.565282E-01
-PKER_SDRYG( 40, 63) = 0.520613E-01
-PKER_SDRYG( 40, 64) = 0.479706E-01
-PKER_SDRYG( 40, 65) = 0.442301E-01
-PKER_SDRYG( 40, 66) = 0.408086E-01
-PKER_SDRYG( 40, 67) = 0.376734E-01
-PKER_SDRYG( 40, 68) = 0.347932E-01
-PKER_SDRYG( 40, 69) = 0.321397E-01
-PKER_SDRYG( 40, 70) = 0.296880E-01
-PKER_SDRYG( 40, 71) = 0.274168E-01
-PKER_SDRYG( 40, 72) = 0.253078E-01
-PKER_SDRYG( 40, 73) = 0.233456E-01
-PKER_SDRYG( 40, 74) = 0.215168E-01
-PKER_SDRYG( 40, 75) = 0.198100E-01
-PKER_SDRYG( 40, 76) = 0.182153E-01
-PKER_SDRYG( 40, 77) = 0.167239E-01
-PKER_SDRYG( 40, 78) = 0.153280E-01
-PKER_SDRYG( 40, 79) = 0.140211E-01
-PKER_SDRYG( 40, 80) = 0.127968E-01
+ PKER_SDRYG( 1, 1) = 0.185306E+01
+ PKER_SDRYG( 1, 2) = 0.166801E+01
+ PKER_SDRYG( 1, 3) = 0.149854E+01
+ PKER_SDRYG( 1, 4) = 0.134462E+01
+ PKER_SDRYG( 1, 5) = 0.120619E+01
+ PKER_SDRYG( 1, 6) = 0.108309E+01
+ PKER_SDRYG( 1, 7) = 0.975739E+00
+ PKER_SDRYG( 1, 8) = 0.883962E+00
+ PKER_SDRYG( 1, 9) = 0.807898E+00
+ PKER_SDRYG( 1, 10) = 0.748063E+00
+ PKER_SDRYG( 1, 11) = 0.704887E+00
+ PKER_SDRYG( 1, 12) = 0.678484E+00
+ PKER_SDRYG( 1, 13) = 0.670243E+00
+ PKER_SDRYG( 1, 14) = 0.680669E+00
+ PKER_SDRYG( 1, 15) = 0.710449E+00
+ PKER_SDRYG( 1, 16) = 0.760420E+00
+ PKER_SDRYG( 1, 17) = 0.829980E+00
+ PKER_SDRYG( 1, 18) = 0.918211E+00
+ PKER_SDRYG( 1, 19) = 0.102260E+01
+ PKER_SDRYG( 1, 20) = 0.113834E+01
+ PKER_SDRYG( 1, 21) = 0.125954E+01
+ PKER_SDRYG( 1, 22) = 0.138067E+01
+ PKER_SDRYG( 1, 23) = 0.149733E+01
+ PKER_SDRYG( 1, 24) = 0.160649E+01
+ PKER_SDRYG( 1, 25) = 0.170617E+01
+ PKER_SDRYG( 1, 26) = 0.179534E+01
+ PKER_SDRYG( 1, 27) = 0.187393E+01
+ PKER_SDRYG( 1, 28) = 0.194253E+01
+ PKER_SDRYG( 1, 29) = 0.200219E+01
+ PKER_SDRYG( 1, 30) = 0.205413E+01
+ PKER_SDRYG( 1, 31) = 0.209956E+01
+ PKER_SDRYG( 1, 32) = 0.213951E+01
+ PKER_SDRYG( 1, 33) = 0.217487E+01
+ PKER_SDRYG( 1, 34) = 0.220635E+01
+ PKER_SDRYG( 1, 35) = 0.223455E+01
+ PKER_SDRYG( 1, 36) = 0.225995E+01
+ PKER_SDRYG( 1, 37) = 0.228296E+01
+ PKER_SDRYG( 1, 38) = 0.230390E+01
+ PKER_SDRYG( 1, 39) = 0.232304E+01
+ PKER_SDRYG( 1, 40) = 0.234059E+01
+ PKER_SDRYG( 1, 41) = 0.235674E+01
+ PKER_SDRYG( 1, 42) = 0.237165E+01
+ PKER_SDRYG( 1, 43) = 0.238545E+01
+ PKER_SDRYG( 1, 44) = 0.239825E+01
+ PKER_SDRYG( 1, 45) = 0.241013E+01
+ PKER_SDRYG( 1, 46) = 0.242119E+01
+ PKER_SDRYG( 1, 47) = 0.243150E+01
+ PKER_SDRYG( 1, 48) = 0.244112E+01
+ PKER_SDRYG( 1, 49) = 0.245010E+01
+ PKER_SDRYG( 1, 50) = 0.245849E+01
+ PKER_SDRYG( 1, 51) = 0.246634E+01
+ PKER_SDRYG( 1, 52) = 0.247369E+01
+ PKER_SDRYG( 1, 53) = 0.248057E+01
+ PKER_SDRYG( 1, 54) = 0.248702E+01
+ PKER_SDRYG( 1, 55) = 0.249305E+01
+ PKER_SDRYG( 1, 56) = 0.249872E+01
+ PKER_SDRYG( 1, 57) = 0.250402E+01
+ PKER_SDRYG( 1, 58) = 0.250900E+01
+ PKER_SDRYG( 1, 59) = 0.251367E+01
+ PKER_SDRYG( 1, 60) = 0.251805E+01
+ PKER_SDRYG( 1, 61) = 0.252217E+01
+ PKER_SDRYG( 1, 62) = 0.252602E+01
+ PKER_SDRYG( 1, 63) = 0.252964E+01
+ PKER_SDRYG( 1, 64) = 0.253304E+01
+ PKER_SDRYG( 1, 65) = 0.253623E+01
+ PKER_SDRYG( 1, 66) = 0.253923E+01
+ PKER_SDRYG( 1, 67) = 0.254204E+01
+ PKER_SDRYG( 1, 68) = 0.254468E+01
+ PKER_SDRYG( 1, 69) = 0.254715E+01
+ PKER_SDRYG( 1, 70) = 0.254948E+01
+ PKER_SDRYG( 1, 71) = 0.255166E+01
+ PKER_SDRYG( 1, 72) = 0.255371E+01
+ PKER_SDRYG( 1, 73) = 0.255564E+01
+ PKER_SDRYG( 1, 74) = 0.255745E+01
+ PKER_SDRYG( 1, 75) = 0.255914E+01
+ PKER_SDRYG( 1, 76) = 0.256074E+01
+ PKER_SDRYG( 1, 77) = 0.256223E+01
+ PKER_SDRYG( 1, 78) = 0.256364E+01
+ PKER_SDRYG( 1, 79) = 0.256496E+01
+ PKER_SDRYG( 1, 80) = 0.256619E+01
+ PKER_SDRYG( 2, 1) = 0.203397E+01
+ PKER_SDRYG( 2, 2) = 0.184139E+01
+ PKER_SDRYG( 2, 3) = 0.166253E+01
+ PKER_SDRYG( 2, 4) = 0.149734E+01
+ PKER_SDRYG( 2, 5) = 0.134545E+01
+ PKER_SDRYG( 2, 6) = 0.120699E+01
+ PKER_SDRYG( 2, 7) = 0.108196E+01
+ PKER_SDRYG( 2, 8) = 0.970394E+00
+ PKER_SDRYG( 2, 9) = 0.872467E+00
+ PKER_SDRYG( 2, 10) = 0.788381E+00
+ PKER_SDRYG( 2, 11) = 0.718584E+00
+ PKER_SDRYG( 2, 12) = 0.663446E+00
+ PKER_SDRYG( 2, 13) = 0.623736E+00
+ PKER_SDRYG( 2, 14) = 0.600108E+00
+ PKER_SDRYG( 2, 15) = 0.593535E+00
+ PKER_SDRYG( 2, 16) = 0.605004E+00
+ PKER_SDRYG( 2, 17) = 0.635005E+00
+ PKER_SDRYG( 2, 18) = 0.683561E+00
+ PKER_SDRYG( 2, 19) = 0.749784E+00
+ PKER_SDRYG( 2, 20) = 0.831464E+00
+ PKER_SDRYG( 2, 21) = 0.925362E+00
+ PKER_SDRYG( 2, 22) = 0.102652E+01
+ PKER_SDRYG( 2, 23) = 0.112960E+01
+ PKER_SDRYG( 2, 24) = 0.122990E+01
+ PKER_SDRYG( 2, 25) = 0.132422E+01
+ PKER_SDRYG( 2, 26) = 0.141069E+01
+ PKER_SDRYG( 2, 27) = 0.148870E+01
+ PKER_SDRYG( 2, 28) = 0.155812E+01
+ PKER_SDRYG( 2, 29) = 0.161933E+01
+ PKER_SDRYG( 2, 30) = 0.167302E+01
+ PKER_SDRYG( 2, 31) = 0.172003E+01
+ PKER_SDRYG( 2, 32) = 0.176131E+01
+ PKER_SDRYG( 2, 33) = 0.179774E+01
+ PKER_SDRYG( 2, 34) = 0.183007E+01
+ PKER_SDRYG( 2, 35) = 0.185895E+01
+ PKER_SDRYG( 2, 36) = 0.188489E+01
+ PKER_SDRYG( 2, 37) = 0.190831E+01
+ PKER_SDRYG( 2, 38) = 0.192958E+01
+ PKER_SDRYG( 2, 39) = 0.194897E+01
+ PKER_SDRYG( 2, 40) = 0.196672E+01
+ PKER_SDRYG( 2, 41) = 0.198304E+01
+ PKER_SDRYG( 2, 42) = 0.199807E+01
+ PKER_SDRYG( 2, 43) = 0.201197E+01
+ PKER_SDRYG( 2, 44) = 0.202484E+01
+ PKER_SDRYG( 2, 45) = 0.203679E+01
+ PKER_SDRYG( 2, 46) = 0.204790E+01
+ PKER_SDRYG( 2, 47) = 0.205824E+01
+ PKER_SDRYG( 2, 48) = 0.206789E+01
+ PKER_SDRYG( 2, 49) = 0.207689E+01
+ PKER_SDRYG( 2, 50) = 0.208530E+01
+ PKER_SDRYG( 2, 51) = 0.209317E+01
+ PKER_SDRYG( 2, 52) = 0.210053E+01
+ PKER_SDRYG( 2, 53) = 0.210741E+01
+ PKER_SDRYG( 2, 54) = 0.211387E+01
+ PKER_SDRYG( 2, 55) = 0.211991E+01
+ PKER_SDRYG( 2, 56) = 0.212558E+01
+ PKER_SDRYG( 2, 57) = 0.213089E+01
+ PKER_SDRYG( 2, 58) = 0.213587E+01
+ PKER_SDRYG( 2, 59) = 0.214054E+01
+ PKER_SDRYG( 2, 60) = 0.214493E+01
+ PKER_SDRYG( 2, 61) = 0.214904E+01
+ PKER_SDRYG( 2, 62) = 0.215290E+01
+ PKER_SDRYG( 2, 63) = 0.215652E+01
+ PKER_SDRYG( 2, 64) = 0.215992E+01
+ PKER_SDRYG( 2, 65) = 0.216311E+01
+ PKER_SDRYG( 2, 66) = 0.216610E+01
+ PKER_SDRYG( 2, 67) = 0.216891E+01
+ PKER_SDRYG( 2, 68) = 0.217155E+01
+ PKER_SDRYG( 2, 69) = 0.217403E+01
+ PKER_SDRYG( 2, 70) = 0.217636E+01
+ PKER_SDRYG( 2, 71) = 0.217854E+01
+ PKER_SDRYG( 2, 72) = 0.218059E+01
+ PKER_SDRYG( 2, 73) = 0.218252E+01
+ PKER_SDRYG( 2, 74) = 0.218432E+01
+ PKER_SDRYG( 2, 75) = 0.218602E+01
+ PKER_SDRYG( 2, 76) = 0.218761E+01
+ PKER_SDRYG( 2, 77) = 0.218911E+01
+ PKER_SDRYG( 2, 78) = 0.219051E+01
+ PKER_SDRYG( 2, 79) = 0.219183E+01
+ PKER_SDRYG( 2, 80) = 0.219307E+01
+ PKER_SDRYG( 3, 1) = 0.219960E+01
+ PKER_SDRYG( 3, 2) = 0.200376E+01
+ PKER_SDRYG( 3, 3) = 0.182057E+01
+ PKER_SDRYG( 3, 4) = 0.164957E+01
+ PKER_SDRYG( 3, 5) = 0.149045E+01
+ PKER_SDRYG( 3, 6) = 0.134297E+01
+ PKER_SDRYG( 3, 7) = 0.120706E+01
+ PKER_SDRYG( 3, 8) = 0.108261E+01
+ PKER_SDRYG( 3, 9) = 0.969749E+00
+ PKER_SDRYG( 3, 10) = 0.868633E+00
+ PKER_SDRYG( 3, 11) = 0.779309E+00
+ PKER_SDRYG( 3, 12) = 0.702567E+00
+ PKER_SDRYG( 3, 13) = 0.638634E+00
+ PKER_SDRYG( 3, 14) = 0.588095E+00
+ PKER_SDRYG( 3, 15) = 0.552053E+00
+ PKER_SDRYG( 3, 16) = 0.531341E+00
+ PKER_SDRYG( 3, 17) = 0.526715E+00
+ PKER_SDRYG( 3, 18) = 0.539327E+00
+ PKER_SDRYG( 3, 19) = 0.569229E+00
+ PKER_SDRYG( 3, 20) = 0.615927E+00
+ PKER_SDRYG( 3, 21) = 0.677810E+00
+ PKER_SDRYG( 3, 22) = 0.751743E+00
+ PKER_SDRYG( 3, 23) = 0.834002E+00
+ PKER_SDRYG( 3, 24) = 0.920162E+00
+ PKER_SDRYG( 3, 25) = 0.100577E+01
+ PKER_SDRYG( 3, 26) = 0.108725E+01
+ PKER_SDRYG( 3, 27) = 0.116248E+01
+ PKER_SDRYG( 3, 28) = 0.123064E+01
+ PKER_SDRYG( 3, 29) = 0.129168E+01
+ PKER_SDRYG( 3, 30) = 0.134598E+01
+ PKER_SDRYG( 3, 31) = 0.139406E+01
+ PKER_SDRYG( 3, 32) = 0.143653E+01
+ PKER_SDRYG( 3, 33) = 0.147406E+01
+ PKER_SDRYG( 3, 34) = 0.150732E+01
+ PKER_SDRYG( 3, 35) = 0.153694E+01
+ PKER_SDRYG( 3, 36) = 0.156346E+01
+ PKER_SDRYG( 3, 37) = 0.158735E+01
+ PKER_SDRYG( 3, 38) = 0.160898E+01
+ PKER_SDRYG( 3, 39) = 0.162866E+01
+ PKER_SDRYG( 3, 40) = 0.164664E+01
+ PKER_SDRYG( 3, 41) = 0.166312E+01
+ PKER_SDRYG( 3, 42) = 0.167830E+01
+ PKER_SDRYG( 3, 43) = 0.169230E+01
+ PKER_SDRYG( 3, 44) = 0.170526E+01
+ PKER_SDRYG( 3, 45) = 0.171727E+01
+ PKER_SDRYG( 3, 46) = 0.172843E+01
+ PKER_SDRYG( 3, 47) = 0.173882E+01
+ PKER_SDRYG( 3, 48) = 0.174850E+01
+ PKER_SDRYG( 3, 49) = 0.175753E+01
+ PKER_SDRYG( 3, 50) = 0.176596E+01
+ PKER_SDRYG( 3, 51) = 0.177384E+01
+ PKER_SDRYG( 3, 52) = 0.178121E+01
+ PKER_SDRYG( 3, 53) = 0.178811E+01
+ PKER_SDRYG( 3, 54) = 0.179457E+01
+ PKER_SDRYG( 3, 55) = 0.180062E+01
+ PKER_SDRYG( 3, 56) = 0.180629E+01
+ PKER_SDRYG( 3, 57) = 0.181160E+01
+ PKER_SDRYG( 3, 58) = 0.181659E+01
+ PKER_SDRYG( 3, 59) = 0.182126E+01
+ PKER_SDRYG( 3, 60) = 0.182565E+01
+ PKER_SDRYG( 3, 61) = 0.182976E+01
+ PKER_SDRYG( 3, 62) = 0.183362E+01
+ PKER_SDRYG( 3, 63) = 0.183725E+01
+ PKER_SDRYG( 3, 64) = 0.184065E+01
+ PKER_SDRYG( 3, 65) = 0.184384E+01
+ PKER_SDRYG( 3, 66) = 0.184683E+01
+ PKER_SDRYG( 3, 67) = 0.184964E+01
+ PKER_SDRYG( 3, 68) = 0.185228E+01
+ PKER_SDRYG( 3, 69) = 0.185476E+01
+ PKER_SDRYG( 3, 70) = 0.185709E+01
+ PKER_SDRYG( 3, 71) = 0.185927E+01
+ PKER_SDRYG( 3, 72) = 0.186132E+01
+ PKER_SDRYG( 3, 73) = 0.186325E+01
+ PKER_SDRYG( 3, 74) = 0.186505E+01
+ PKER_SDRYG( 3, 75) = 0.186675E+01
+ PKER_SDRYG( 3, 76) = 0.186834E+01
+ PKER_SDRYG( 3, 77) = 0.186984E+01
+ PKER_SDRYG( 3, 78) = 0.187124E+01
+ PKER_SDRYG( 3, 79) = 0.187256E+01
+ PKER_SDRYG( 3, 80) = 0.187380E+01
+ PKER_SDRYG( 4, 1) = 0.234554E+01
+ PKER_SDRYG( 4, 2) = 0.214868E+01
+ PKER_SDRYG( 4, 3) = 0.196393E+01
+ PKER_SDRYG( 4, 4) = 0.179065E+01
+ PKER_SDRYG( 4, 5) = 0.162831E+01
+ PKER_SDRYG( 4, 6) = 0.147653E+01
+ PKER_SDRYG( 4, 7) = 0.133498E+01
+ PKER_SDRYG( 4, 8) = 0.120339E+01
+ PKER_SDRYG( 4, 9) = 0.108174E+01
+ PKER_SDRYG( 4, 10) = 0.969881E+00
+ PKER_SDRYG( 4, 11) = 0.868067E+00
+ PKER_SDRYG( 4, 12) = 0.776438E+00
+ PKER_SDRYG( 4, 13) = 0.695367E+00
+ PKER_SDRYG( 4, 14) = 0.625282E+00
+ PKER_SDRYG( 4, 15) = 0.566838E+00
+ PKER_SDRYG( 4, 16) = 0.521003E+00
+ PKER_SDRYG( 4, 17) = 0.488550E+00
+ PKER_SDRYG( 4, 18) = 0.470631E+00
+ PKER_SDRYG( 4, 19) = 0.468163E+00
+ PKER_SDRYG( 4, 20) = 0.481689E+00
+ PKER_SDRYG( 4, 21) = 0.511098E+00
+ PKER_SDRYG( 4, 22) = 0.555153E+00
+ PKER_SDRYG( 4, 23) = 0.611456E+00
+ PKER_SDRYG( 4, 24) = 0.676720E+00
+ PKER_SDRYG( 4, 25) = 0.747017E+00
+ PKER_SDRYG( 4, 26) = 0.818743E+00
+ PKER_SDRYG( 4, 27) = 0.888470E+00
+ PKER_SDRYG( 4, 28) = 0.953813E+00
+ PKER_SDRYG( 4, 29) = 0.101352E+01
+ PKER_SDRYG( 4, 30) = 0.106728E+01
+ PKER_SDRYG( 4, 31) = 0.111531E+01
+ PKER_SDRYG( 4, 32) = 0.115816E+01
+ PKER_SDRYG( 4, 33) = 0.119634E+01
+ PKER_SDRYG( 4, 34) = 0.123037E+01
+ PKER_SDRYG( 4, 35) = 0.126073E+01
+ PKER_SDRYG( 4, 36) = 0.128788E+01
+ PKER_SDRYG( 4, 37) = 0.131229E+01
+ PKER_SDRYG( 4, 38) = 0.133432E+01
+ PKER_SDRYG( 4, 39) = 0.135431E+01
+ PKER_SDRYG( 4, 40) = 0.137254E+01
+ PKER_SDRYG( 4, 41) = 0.138922E+01
+ PKER_SDRYG( 4, 42) = 0.140455E+01
+ PKER_SDRYG( 4, 43) = 0.141867E+01
+ PKER_SDRYG( 4, 44) = 0.143172E+01
+ PKER_SDRYG( 4, 45) = 0.144381E+01
+ PKER_SDRYG( 4, 46) = 0.145503E+01
+ PKER_SDRYG( 4, 47) = 0.146546E+01
+ PKER_SDRYG( 4, 48) = 0.147517E+01
+ PKER_SDRYG( 4, 49) = 0.148423E+01
+ PKER_SDRYG( 4, 50) = 0.149268E+01
+ PKER_SDRYG( 4, 51) = 0.150058E+01
+ PKER_SDRYG( 4, 52) = 0.150797E+01
+ PKER_SDRYG( 4, 53) = 0.151488E+01
+ PKER_SDRYG( 4, 54) = 0.152134E+01
+ PKER_SDRYG( 4, 55) = 0.152740E+01
+ PKER_SDRYG( 4, 56) = 0.153308E+01
+ PKER_SDRYG( 4, 57) = 0.153840E+01
+ PKER_SDRYG( 4, 58) = 0.154339E+01
+ PKER_SDRYG( 4, 59) = 0.154806E+01
+ PKER_SDRYG( 4, 60) = 0.155245E+01
+ PKER_SDRYG( 4, 61) = 0.155657E+01
+ PKER_SDRYG( 4, 62) = 0.156043E+01
+ PKER_SDRYG( 4, 63) = 0.156405E+01
+ PKER_SDRYG( 4, 64) = 0.156745E+01
+ PKER_SDRYG( 4, 65) = 0.157064E+01
+ PKER_SDRYG( 4, 66) = 0.157364E+01
+ PKER_SDRYG( 4, 67) = 0.157645E+01
+ PKER_SDRYG( 4, 68) = 0.157909E+01
+ PKER_SDRYG( 4, 69) = 0.158157E+01
+ PKER_SDRYG( 4, 70) = 0.158389E+01
+ PKER_SDRYG( 4, 71) = 0.158608E+01
+ PKER_SDRYG( 4, 72) = 0.158813E+01
+ PKER_SDRYG( 4, 73) = 0.159005E+01
+ PKER_SDRYG( 4, 74) = 0.159186E+01
+ PKER_SDRYG( 4, 75) = 0.159356E+01
+ PKER_SDRYG( 4, 76) = 0.159515E+01
+ PKER_SDRYG( 4, 77) = 0.159665E+01
+ PKER_SDRYG( 4, 78) = 0.159805E+01
+ PKER_SDRYG( 4, 79) = 0.159937E+01
+ PKER_SDRYG( 4, 80) = 0.160061E+01
+ PKER_SDRYG( 5, 1) = 0.247163E+01
+ PKER_SDRYG( 5, 2) = 0.227466E+01
+ PKER_SDRYG( 5, 3) = 0.208958E+01
+ PKER_SDRYG( 5, 4) = 0.191571E+01
+ PKER_SDRYG( 5, 5) = 0.175239E+01
+ PKER_SDRYG( 5, 6) = 0.159906E+01
+ PKER_SDRYG( 5, 7) = 0.145522E+01
+ PKER_SDRYG( 5, 8) = 0.132049E+01
+ PKER_SDRYG( 5, 9) = 0.119453E+01
+ PKER_SDRYG( 5, 10) = 0.107714E+01
+ PKER_SDRYG( 5, 11) = 0.968196E+00
+ PKER_SDRYG( 5, 12) = 0.867771E+00
+ PKER_SDRYG( 5, 13) = 0.775878E+00
+ PKER_SDRYG( 5, 14) = 0.692883E+00
+ PKER_SDRYG( 5, 15) = 0.619198E+00
+ PKER_SDRYG( 5, 16) = 0.555232E+00
+ PKER_SDRYG( 5, 17) = 0.502129E+00
+ PKER_SDRYG( 5, 18) = 0.460636E+00
+ PKER_SDRYG( 5, 19) = 0.431732E+00
+ PKER_SDRYG( 5, 20) = 0.416649E+00
+ PKER_SDRYG( 5, 21) = 0.416143E+00
+ PKER_SDRYG( 5, 22) = 0.430263E+00
+ PKER_SDRYG( 5, 23) = 0.458530E+00
+ PKER_SDRYG( 5, 24) = 0.499025E+00
+ PKER_SDRYG( 5, 25) = 0.549068E+00
+ PKER_SDRYG( 5, 26) = 0.605236E+00
+ PKER_SDRYG( 5, 27) = 0.664063E+00
+ PKER_SDRYG( 5, 28) = 0.722681E+00
+ PKER_SDRYG( 5, 29) = 0.778798E+00
+ PKER_SDRYG( 5, 30) = 0.830925E+00
+ PKER_SDRYG( 5, 31) = 0.878310E+00
+ PKER_SDRYG( 5, 32) = 0.920907E+00
+ PKER_SDRYG( 5, 33) = 0.959072E+00
+ PKER_SDRYG( 5, 34) = 0.993274E+00
+ PKER_SDRYG( 5, 35) = 0.102398E+01
+ PKER_SDRYG( 5, 36) = 0.105160E+01
+ PKER_SDRYG( 5, 37) = 0.107647E+01
+ PKER_SDRYG( 5, 38) = 0.109893E+01
+ PKER_SDRYG( 5, 39) = 0.111927E+01
+ PKER_SDRYG( 5, 40) = 0.113777E+01
+ PKER_SDRYG( 5, 41) = 0.115467E+01
+ PKER_SDRYG( 5, 42) = 0.117017E+01
+ PKER_SDRYG( 5, 43) = 0.118442E+01
+ PKER_SDRYG( 5, 44) = 0.119758E+01
+ PKER_SDRYG( 5, 45) = 0.120975E+01
+ PKER_SDRYG( 5, 46) = 0.122103E+01
+ PKER_SDRYG( 5, 47) = 0.123151E+01
+ PKER_SDRYG( 5, 48) = 0.124127E+01
+ PKER_SDRYG( 5, 49) = 0.125035E+01
+ PKER_SDRYG( 5, 50) = 0.125883E+01
+ PKER_SDRYG( 5, 51) = 0.126675E+01
+ PKER_SDRYG( 5, 52) = 0.127415E+01
+ PKER_SDRYG( 5, 53) = 0.128107E+01
+ PKER_SDRYG( 5, 54) = 0.128755E+01
+ PKER_SDRYG( 5, 55) = 0.129361E+01
+ PKER_SDRYG( 5, 56) = 0.129929E+01
+ PKER_SDRYG( 5, 57) = 0.130462E+01
+ PKER_SDRYG( 5, 58) = 0.130961E+01
+ PKER_SDRYG( 5, 59) = 0.131429E+01
+ PKER_SDRYG( 5, 60) = 0.131868E+01
+ PKER_SDRYG( 5, 61) = 0.132280E+01
+ PKER_SDRYG( 5, 62) = 0.132666E+01
+ PKER_SDRYG( 5, 63) = 0.133028E+01
+ PKER_SDRYG( 5, 64) = 0.133369E+01
+ PKER_SDRYG( 5, 65) = 0.133688E+01
+ PKER_SDRYG( 5, 66) = 0.133987E+01
+ PKER_SDRYG( 5, 67) = 0.134269E+01
+ PKER_SDRYG( 5, 68) = 0.134533E+01
+ PKER_SDRYG( 5, 69) = 0.134781E+01
+ PKER_SDRYG( 5, 70) = 0.135013E+01
+ PKER_SDRYG( 5, 71) = 0.135232E+01
+ PKER_SDRYG( 5, 72) = 0.135437E+01
+ PKER_SDRYG( 5, 73) = 0.135629E+01
+ PKER_SDRYG( 5, 74) = 0.135810E+01
+ PKER_SDRYG( 5, 75) = 0.135980E+01
+ PKER_SDRYG( 5, 76) = 0.136139E+01
+ PKER_SDRYG( 5, 77) = 0.136289E+01
+ PKER_SDRYG( 5, 78) = 0.136429E+01
+ PKER_SDRYG( 5, 79) = 0.136561E+01
+ PKER_SDRYG( 5, 80) = 0.136685E+01
+ PKER_SDRYG( 6, 1) = 0.257972E+01
+ PKER_SDRYG( 6, 2) = 0.238286E+01
+ PKER_SDRYG( 6, 3) = 0.219787E+01
+ PKER_SDRYG( 6, 4) = 0.202403E+01
+ PKER_SDRYG( 6, 5) = 0.186062E+01
+ PKER_SDRYG( 6, 6) = 0.170702E+01
+ PKER_SDRYG( 6, 7) = 0.156262E+01
+ PKER_SDRYG( 6, 8) = 0.142692E+01
+ PKER_SDRYG( 6, 9) = 0.129944E+01
+ PKER_SDRYG( 6, 10) = 0.117979E+01
+ PKER_SDRYG( 6, 11) = 0.106768E+01
+ PKER_SDRYG( 6, 12) = 0.962918E+00
+ PKER_SDRYG( 6, 13) = 0.865347E+00
+ PKER_SDRYG( 6, 14) = 0.775045E+00
+ PKER_SDRYG( 6, 15) = 0.692083E+00
+ PKER_SDRYG( 6, 16) = 0.616878E+00
+ PKER_SDRYG( 6, 17) = 0.549875E+00
+ PKER_SDRYG( 6, 18) = 0.491835E+00
+ PKER_SDRYG( 6, 19) = 0.443555E+00
+ PKER_SDRYG( 6, 20) = 0.406127E+00
+ PKER_SDRYG( 6, 21) = 0.380824E+00
+ PKER_SDRYG( 6, 22) = 0.368387E+00
+ PKER_SDRYG( 6, 23) = 0.369445E+00
+ PKER_SDRYG( 6, 24) = 0.383806E+00
+ PKER_SDRYG( 6, 25) = 0.410216E+00
+ PKER_SDRYG( 6, 26) = 0.446510E+00
+ PKER_SDRYG( 6, 27) = 0.489828E+00
+ PKER_SDRYG( 6, 28) = 0.537058E+00
+ PKER_SDRYG( 6, 29) = 0.585473E+00
+ PKER_SDRYG( 6, 30) = 0.632833E+00
+ PKER_SDRYG( 6, 31) = 0.677778E+00
+ PKER_SDRYG( 6, 32) = 0.719331E+00
+ PKER_SDRYG( 6, 33) = 0.757120E+00
+ PKER_SDRYG( 6, 34) = 0.791204E+00
+ PKER_SDRYG( 6, 35) = 0.821879E+00
+ PKER_SDRYG( 6, 36) = 0.849531E+00
+ PKER_SDRYG( 6, 37) = 0.874550E+00
+ PKER_SDRYG( 6, 38) = 0.897242E+00
+ PKER_SDRYG( 6, 39) = 0.917866E+00
+ PKER_SDRYG( 6, 40) = 0.936642E+00
+ PKER_SDRYG( 6, 41) = 0.953775E+00
+ PKER_SDRYG( 6, 42) = 0.969458E+00
+ PKER_SDRYG( 6, 43) = 0.983861E+00
+ PKER_SDRYG( 6, 44) = 0.997132E+00
+ PKER_SDRYG( 6, 45) = 0.100939E+01
+ PKER_SDRYG( 6, 46) = 0.102075E+01
+ PKER_SDRYG( 6, 47) = 0.103128E+01
+ PKER_SDRYG( 6, 48) = 0.104108E+01
+ PKER_SDRYG( 6, 49) = 0.105020E+01
+ PKER_SDRYG( 6, 50) = 0.105871E+01
+ PKER_SDRYG( 6, 51) = 0.106665E+01
+ PKER_SDRYG( 6, 52) = 0.107406E+01
+ PKER_SDRYG( 6, 53) = 0.108100E+01
+ PKER_SDRYG( 6, 54) = 0.108749E+01
+ PKER_SDRYG( 6, 55) = 0.109356E+01
+ PKER_SDRYG( 6, 56) = 0.109925E+01
+ PKER_SDRYG( 6, 57) = 0.110458E+01
+ PKER_SDRYG( 6, 58) = 0.110957E+01
+ PKER_SDRYG( 6, 59) = 0.111425E+01
+ PKER_SDRYG( 6, 60) = 0.111865E+01
+ PKER_SDRYG( 6, 61) = 0.112277E+01
+ PKER_SDRYG( 6, 62) = 0.112663E+01
+ PKER_SDRYG( 6, 63) = 0.113026E+01
+ PKER_SDRYG( 6, 64) = 0.113366E+01
+ PKER_SDRYG( 6, 65) = 0.113685E+01
+ PKER_SDRYG( 6, 66) = 0.113985E+01
+ PKER_SDRYG( 6, 67) = 0.114266E+01
+ PKER_SDRYG( 6, 68) = 0.114530E+01
+ PKER_SDRYG( 6, 69) = 0.114778E+01
+ PKER_SDRYG( 6, 70) = 0.115011E+01
+ PKER_SDRYG( 6, 71) = 0.115229E+01
+ PKER_SDRYG( 6, 72) = 0.115434E+01
+ PKER_SDRYG( 6, 73) = 0.115627E+01
+ PKER_SDRYG( 6, 74) = 0.115808E+01
+ PKER_SDRYG( 6, 75) = 0.115977E+01
+ PKER_SDRYG( 6, 76) = 0.116137E+01
+ PKER_SDRYG( 6, 77) = 0.116286E+01
+ PKER_SDRYG( 6, 78) = 0.116427E+01
+ PKER_SDRYG( 6, 79) = 0.116559E+01
+ PKER_SDRYG( 6, 80) = 0.116682E+01
+ PKER_SDRYG( 7, 1) = 0.267216E+01
+ PKER_SDRYG( 7, 2) = 0.247542E+01
+ PKER_SDRYG( 7, 3) = 0.229059E+01
+ PKER_SDRYG( 7, 4) = 0.211690E+01
+ PKER_SDRYG( 7, 5) = 0.195366E+01
+ PKER_SDRYG( 7, 6) = 0.180020E+01
+ PKER_SDRYG( 7, 7) = 0.165590E+01
+ PKER_SDRYG( 7, 8) = 0.152016E+01
+ PKER_SDRYG( 7, 9) = 0.139247E+01
+ PKER_SDRYG( 7, 10) = 0.127232E+01
+ PKER_SDRYG( 7, 11) = 0.115928E+01
+ PKER_SDRYG( 7, 12) = 0.105298E+01
+ PKER_SDRYG( 7, 13) = 0.953147E+00
+ PKER_SDRYG( 7, 14) = 0.859548E+00
+ PKER_SDRYG( 7, 15) = 0.772080E+00
+ PKER_SDRYG( 7, 16) = 0.690795E+00
+ PKER_SDRYG( 7, 17) = 0.615899E+00
+ PKER_SDRYG( 7, 18) = 0.547689E+00
+ PKER_SDRYG( 7, 19) = 0.486803E+00
+ PKER_SDRYG( 7, 20) = 0.434037E+00
+ PKER_SDRYG( 7, 21) = 0.390298E+00
+ PKER_SDRYG( 7, 22) = 0.356884E+00
+ PKER_SDRYG( 7, 23) = 0.334845E+00
+ PKER_SDRYG( 7, 24) = 0.324836E+00
+ PKER_SDRYG( 7, 25) = 0.327158E+00
+ PKER_SDRYG( 7, 26) = 0.341163E+00
+ PKER_SDRYG( 7, 27) = 0.365112E+00
+ PKER_SDRYG( 7, 28) = 0.396807E+00
+ PKER_SDRYG( 7, 29) = 0.433487E+00
+ PKER_SDRYG( 7, 30) = 0.472612E+00
+ PKER_SDRYG( 7, 31) = 0.511994E+00
+ PKER_SDRYG( 7, 32) = 0.550118E+00
+ PKER_SDRYG( 7, 33) = 0.586089E+00
+ PKER_SDRYG( 7, 34) = 0.619363E+00
+ PKER_SDRYG( 7, 35) = 0.649769E+00
+ PKER_SDRYG( 7, 36) = 0.677330E+00
+ PKER_SDRYG( 7, 37) = 0.702279E+00
+ PKER_SDRYG( 7, 38) = 0.724930E+00
+ PKER_SDRYG( 7, 39) = 0.745565E+00
+ PKER_SDRYG( 7, 40) = 0.764428E+00
+ PKER_SDRYG( 7, 41) = 0.781707E+00
+ PKER_SDRYG( 7, 42) = 0.797555E+00
+ PKER_SDRYG( 7, 43) = 0.812112E+00
+ PKER_SDRYG( 7, 44) = 0.825509E+00
+ PKER_SDRYG( 7, 45) = 0.837870E+00
+ PKER_SDRYG( 7, 46) = 0.849304E+00
+ PKER_SDRYG( 7, 47) = 0.859904E+00
+ PKER_SDRYG( 7, 48) = 0.869749E+00
+ PKER_SDRYG( 7, 49) = 0.878910E+00
+ PKER_SDRYG( 7, 50) = 0.887445E+00
+ PKER_SDRYG( 7, 51) = 0.895407E+00
+ PKER_SDRYG( 7, 52) = 0.902841E+00
+ PKER_SDRYG( 7, 53) = 0.909790E+00
+ PKER_SDRYG( 7, 54) = 0.916289E+00
+ PKER_SDRYG( 7, 55) = 0.922371E+00
+ PKER_SDRYG( 7, 56) = 0.928066E+00
+ PKER_SDRYG( 7, 57) = 0.933401E+00
+ PKER_SDRYG( 7, 58) = 0.938401E+00
+ PKER_SDRYG( 7, 59) = 0.943087E+00
+ PKER_SDRYG( 7, 60) = 0.947482E+00
+ PKER_SDRYG( 7, 61) = 0.951603E+00
+ PKER_SDRYG( 7, 62) = 0.955469E+00
+ PKER_SDRYG( 7, 63) = 0.959096E+00
+ PKER_SDRYG( 7, 64) = 0.962500E+00
+ PKER_SDRYG( 7, 65) = 0.965694E+00
+ PKER_SDRYG( 7, 66) = 0.968691E+00
+ PKER_SDRYG( 7, 67) = 0.971504E+00
+ PKER_SDRYG( 7, 68) = 0.974145E+00
+ PKER_SDRYG( 7, 69) = 0.976624E+00
+ PKER_SDRYG( 7, 70) = 0.978951E+00
+ PKER_SDRYG( 7, 71) = 0.981136E+00
+ PKER_SDRYG( 7, 72) = 0.983187E+00
+ PKER_SDRYG( 7, 73) = 0.985112E+00
+ PKER_SDRYG( 7, 74) = 0.986920E+00
+ PKER_SDRYG( 7, 75) = 0.988617E+00
+ PKER_SDRYG( 7, 76) = 0.990211E+00
+ PKER_SDRYG( 7, 77) = 0.991707E+00
+ PKER_SDRYG( 7, 78) = 0.993112E+00
+ PKER_SDRYG( 7, 79) = 0.994431E+00
+ PKER_SDRYG( 7, 80) = 0.995669E+00
+ PKER_SDRYG( 8, 1) = 0.275117E+01
+ PKER_SDRYG( 8, 2) = 0.255454E+01
+ PKER_SDRYG( 8, 3) = 0.236983E+01
+ PKER_SDRYG( 8, 4) = 0.219630E+01
+ PKER_SDRYG( 8, 5) = 0.203323E+01
+ PKER_SDRYG( 8, 6) = 0.187998E+01
+ PKER_SDRYG( 8, 7) = 0.173590E+01
+ PKER_SDRYG( 8, 8) = 0.160040E+01
+ PKER_SDRYG( 8, 9) = 0.147293E+01
+ PKER_SDRYG( 8, 10) = 0.135295E+01
+ PKER_SDRYG( 8, 11) = 0.123996E+01
+ PKER_SDRYG( 8, 12) = 0.113353E+01
+ PKER_SDRYG( 8, 13) = 0.103324E+01
+ PKER_SDRYG( 8, 14) = 0.938726E+00
+ PKER_SDRYG( 8, 15) = 0.849707E+00
+ PKER_SDRYG( 8, 16) = 0.765984E+00
+ PKER_SDRYG( 8, 17) = 0.687490E+00
+ PKER_SDRYG( 8, 18) = 0.614228E+00
+ PKER_SDRYG( 8, 19) = 0.546445E+00
+ PKER_SDRYG( 8, 20) = 0.484521E+00
+ PKER_SDRYG( 8, 21) = 0.429191E+00
+ PKER_SDRYG( 8, 22) = 0.381279E+00
+ PKER_SDRYG( 8, 23) = 0.341954E+00
+ PKER_SDRYG( 8, 24) = 0.312266E+00
+ PKER_SDRYG( 8, 25) = 0.293197E+00
+ PKER_SDRYG( 8, 26) = 0.285436E+00
+ PKER_SDRYG( 8, 27) = 0.288590E+00
+ PKER_SDRYG( 8, 28) = 0.301647E+00
+ PKER_SDRYG( 8, 29) = 0.322883E+00
+ PKER_SDRYG( 8, 30) = 0.349944E+00
+ PKER_SDRYG( 8, 31) = 0.380489E+00
+ PKER_SDRYG( 8, 32) = 0.412492E+00
+ PKER_SDRYG( 8, 33) = 0.444350E+00
+ PKER_SDRYG( 8, 34) = 0.475064E+00
+ PKER_SDRYG( 8, 35) = 0.503980E+00
+ PKER_SDRYG( 8, 36) = 0.530853E+00
+ PKER_SDRYG( 8, 37) = 0.555542E+00
+ PKER_SDRYG( 8, 38) = 0.578083E+00
+ PKER_SDRYG( 8, 39) = 0.598637E+00
+ PKER_SDRYG( 8, 40) = 0.617414E+00
+ PKER_SDRYG( 8, 41) = 0.634627E+00
+ PKER_SDRYG( 8, 42) = 0.650467E+00
+ PKER_SDRYG( 8, 43) = 0.665074E+00
+ PKER_SDRYG( 8, 44) = 0.678558E+00
+ PKER_SDRYG( 8, 45) = 0.691015E+00
+ PKER_SDRYG( 8, 46) = 0.702533E+00
+ PKER_SDRYG( 8, 47) = 0.713201E+00
+ PKER_SDRYG( 8, 48) = 0.723101E+00
+ PKER_SDRYG( 8, 49) = 0.732303E+00
+ PKER_SDRYG( 8, 50) = 0.740871E+00
+ PKER_SDRYG( 8, 51) = 0.748859E+00
+ PKER_SDRYG( 8, 52) = 0.756314E+00
+ PKER_SDRYG( 8, 53) = 0.763279E+00
+ PKER_SDRYG( 8, 54) = 0.769790E+00
+ PKER_SDRYG( 8, 55) = 0.775882E+00
+ PKER_SDRYG( 8, 56) = 0.781585E+00
+ PKER_SDRYG( 8, 57) = 0.786926E+00
+ PKER_SDRYG( 8, 58) = 0.791930E+00
+ PKER_SDRYG( 8, 59) = 0.796621E+00
+ PKER_SDRYG( 8, 60) = 0.801018E+00
+ PKER_SDRYG( 8, 61) = 0.805142E+00
+ PKER_SDRYG( 8, 62) = 0.809010E+00
+ PKER_SDRYG( 8, 63) = 0.812638E+00
+ PKER_SDRYG( 8, 64) = 0.816043E+00
+ PKER_SDRYG( 8, 65) = 0.819238E+00
+ PKER_SDRYG( 8, 66) = 0.822236E+00
+ PKER_SDRYG( 8, 67) = 0.825050E+00
+ PKER_SDRYG( 8, 68) = 0.827691E+00
+ PKER_SDRYG( 8, 69) = 0.830170E+00
+ PKER_SDRYG( 8, 70) = 0.832497E+00
+ PKER_SDRYG( 8, 71) = 0.834682E+00
+ PKER_SDRYG( 8, 72) = 0.836733E+00
+ PKER_SDRYG( 8, 73) = 0.838659E+00
+ PKER_SDRYG( 8, 74) = 0.840467E+00
+ PKER_SDRYG( 8, 75) = 0.842164E+00
+ PKER_SDRYG( 8, 76) = 0.843758E+00
+ PKER_SDRYG( 8, 77) = 0.845254E+00
+ PKER_SDRYG( 8, 78) = 0.846659E+00
+ PKER_SDRYG( 8, 79) = 0.847978E+00
+ PKER_SDRYG( 8, 80) = 0.849217E+00
+ PKER_SDRYG( 9, 1) = 0.281873E+01
+ PKER_SDRYG( 9, 2) = 0.262217E+01
+ PKER_SDRYG( 9, 3) = 0.243755E+01
+ PKER_SDRYG( 9, 4) = 0.226413E+01
+ PKER_SDRYG( 9, 5) = 0.210120E+01
+ PKER_SDRYG( 9, 6) = 0.194811E+01
+ PKER_SDRYG( 9, 7) = 0.180423E+01
+ PKER_SDRYG( 9, 8) = 0.166898E+01
+ PKER_SDRYG( 9, 9) = 0.154178E+01
+ PKER_SDRYG( 9, 10) = 0.142211E+01
+ PKER_SDRYG( 9, 11) = 0.130946E+01
+ PKER_SDRYG( 9, 12) = 0.120336E+01
+ PKER_SDRYG( 9, 13) = 0.110334E+01
+ PKER_SDRYG( 9, 14) = 0.100898E+01
+ PKER_SDRYG( 9, 15) = 0.919904E+00
+ PKER_SDRYG( 9, 16) = 0.835767E+00
+ PKER_SDRYG( 9, 17) = 0.756296E+00
+ PKER_SDRYG( 9, 18) = 0.681312E+00
+ PKER_SDRYG( 9, 19) = 0.610704E+00
+ PKER_SDRYG( 9, 20) = 0.544549E+00
+ PKER_SDRYG( 9, 21) = 0.483126E+00
+ PKER_SDRYG( 9, 22) = 0.426903E+00
+ PKER_SDRYG( 9, 23) = 0.376623E+00
+ PKER_SDRYG( 9, 24) = 0.333280E+00
+ PKER_SDRYG( 9, 25) = 0.297980E+00
+ PKER_SDRYG( 9, 26) = 0.271818E+00
+ PKER_SDRYG( 9, 27) = 0.255645E+00
+ PKER_SDRYG( 9, 28) = 0.249649E+00
+ PKER_SDRYG( 9, 29) = 0.253211E+00
+ PKER_SDRYG( 9, 30) = 0.265062E+00
+ PKER_SDRYG( 9, 31) = 0.283396E+00
+ PKER_SDRYG( 9, 32) = 0.306054E+00
+ PKER_SDRYG( 9, 33) = 0.331204E+00
+ PKER_SDRYG( 9, 34) = 0.357250E+00
+ PKER_SDRYG( 9, 35) = 0.383076E+00
+ PKER_SDRYG( 9, 36) = 0.407898E+00
+ PKER_SDRYG( 9, 37) = 0.431335E+00
+ PKER_SDRYG( 9, 38) = 0.453229E+00
+ PKER_SDRYG( 9, 39) = 0.473481E+00
+ PKER_SDRYG( 9, 40) = 0.492133E+00
+ PKER_SDRYG( 9, 41) = 0.509252E+00
+ PKER_SDRYG( 9, 42) = 0.524980E+00
+ PKER_SDRYG( 9, 43) = 0.539487E+00
+ PKER_SDRYG( 9, 44) = 0.552905E+00
+ PKER_SDRYG( 9, 45) = 0.565346E+00
+ PKER_SDRYG( 9, 46) = 0.576895E+00
+ PKER_SDRYG( 9, 47) = 0.587615E+00
+ PKER_SDRYG( 9, 48) = 0.597569E+00
+ PKER_SDRYG( 9, 49) = 0.606817E+00
+ PKER_SDRYG( 9, 50) = 0.615422E+00
+ PKER_SDRYG( 9, 51) = 0.623439E+00
+ PKER_SDRYG( 9, 52) = 0.630916E+00
+ PKER_SDRYG( 9, 53) = 0.637899E+00
+ PKER_SDRYG( 9, 54) = 0.644424E+00
+ PKER_SDRYG( 9, 55) = 0.650527E+00
+ PKER_SDRYG( 9, 56) = 0.656238E+00
+ PKER_SDRYG( 9, 57) = 0.661586E+00
+ PKER_SDRYG( 9, 58) = 0.666595E+00
+ PKER_SDRYG( 9, 59) = 0.671290E+00
+ PKER_SDRYG( 9, 60) = 0.675690E+00
+ PKER_SDRYG( 9, 61) = 0.679817E+00
+ PKER_SDRYG( 9, 62) = 0.683687E+00
+ PKER_SDRYG( 9, 63) = 0.687317E+00
+ PKER_SDRYG( 9, 64) = 0.690723E+00
+ PKER_SDRYG( 9, 65) = 0.693918E+00
+ PKER_SDRYG( 9, 66) = 0.696917E+00
+ PKER_SDRYG( 9, 67) = 0.699732E+00
+ PKER_SDRYG( 9, 68) = 0.702374E+00
+ PKER_SDRYG( 9, 69) = 0.704853E+00
+ PKER_SDRYG( 9, 70) = 0.707181E+00
+ PKER_SDRYG( 9, 71) = 0.709366E+00
+ PKER_SDRYG( 9, 72) = 0.711417E+00
+ PKER_SDRYG( 9, 73) = 0.713343E+00
+ PKER_SDRYG( 9, 74) = 0.715151E+00
+ PKER_SDRYG( 9, 75) = 0.716848E+00
+ PKER_SDRYG( 9, 76) = 0.718442E+00
+ PKER_SDRYG( 9, 77) = 0.719938E+00
+ PKER_SDRYG( 9, 78) = 0.721343E+00
+ PKER_SDRYG( 9, 79) = 0.722663E+00
+ PKER_SDRYG( 9, 80) = 0.723901E+00
+ PKER_SDRYG( 10, 1) = 0.287649E+01
+ PKER_SDRYG( 10, 2) = 0.267999E+01
+ PKER_SDRYG( 10, 3) = 0.249543E+01
+ PKER_SDRYG( 10, 4) = 0.232209E+01
+ PKER_SDRYG( 10, 5) = 0.215926E+01
+ PKER_SDRYG( 10, 6) = 0.200629E+01
+ PKER_SDRYG( 10, 7) = 0.186256E+01
+ PKER_SDRYG( 10, 8) = 0.172749E+01
+ PKER_SDRYG( 10, 9) = 0.160052E+01
+ PKER_SDRYG( 10, 10) = 0.148113E+01
+ PKER_SDRYG( 10, 11) = 0.136880E+01
+ PKER_SDRYG( 10, 12) = 0.126307E+01
+ PKER_SDRYG( 10, 13) = 0.116348E+01
+ PKER_SDRYG( 10, 14) = 0.106958E+01
+ PKER_SDRYG( 10, 15) = 0.980970E+00
+ PKER_SDRYG( 10, 16) = 0.897241E+00
+ PKER_SDRYG( 10, 17) = 0.818035E+00
+ PKER_SDRYG( 10, 18) = 0.743029E+00
+ PKER_SDRYG( 10, 19) = 0.671957E+00
+ PKER_SDRYG( 10, 20) = 0.604628E+00
+ PKER_SDRYG( 10, 21) = 0.540973E+00
+ PKER_SDRYG( 10, 22) = 0.481134E+00
+ PKER_SDRYG( 10, 23) = 0.425371E+00
+ PKER_SDRYG( 10, 24) = 0.374261E+00
+ PKER_SDRYG( 10, 25) = 0.328628E+00
+ PKER_SDRYG( 10, 26) = 0.289572E+00
+ PKER_SDRYG( 10, 27) = 0.258117E+00
+ PKER_SDRYG( 10, 28) = 0.235368E+00
+ PKER_SDRYG( 10, 29) = 0.221755E+00
+ PKER_SDRYG( 10, 30) = 0.217136E+00
+ PKER_SDRYG( 10, 31) = 0.220856E+00
+ PKER_SDRYG( 10, 32) = 0.231296E+00
+ PKER_SDRYG( 10, 33) = 0.246745E+00
+ PKER_SDRYG( 10, 34) = 0.265573E+00
+ PKER_SDRYG( 10, 35) = 0.286164E+00
+ PKER_SDRYG( 10, 36) = 0.307344E+00
+ PKER_SDRYG( 10, 37) = 0.328309E+00
+ PKER_SDRYG( 10, 38) = 0.348513E+00
+ PKER_SDRYG( 10, 39) = 0.367687E+00
+ PKER_SDRYG( 10, 40) = 0.385687E+00
+ PKER_SDRYG( 10, 41) = 0.402481E+00
+ PKER_SDRYG( 10, 42) = 0.418056E+00
+ PKER_SDRYG( 10, 43) = 0.432452E+00
+ PKER_SDRYG( 10, 44) = 0.445760E+00
+ PKER_SDRYG( 10, 45) = 0.458086E+00
+ PKER_SDRYG( 10, 46) = 0.469537E+00
+ PKER_SDRYG( 10, 47) = 0.480201E+00
+ PKER_SDRYG( 10, 48) = 0.490143E+00
+ PKER_SDRYG( 10, 49) = 0.499411E+00
+ PKER_SDRYG( 10, 50) = 0.508047E+00
+ PKER_SDRYG( 10, 51) = 0.516093E+00
+ PKER_SDRYG( 10, 52) = 0.523596E+00
+ PKER_SDRYG( 10, 53) = 0.530598E+00
+ PKER_SDRYG( 10, 54) = 0.537139E+00
+ PKER_SDRYG( 10, 55) = 0.543253E+00
+ PKER_SDRYG( 10, 56) = 0.548974E+00
+ PKER_SDRYG( 10, 57) = 0.554329E+00
+ PKER_SDRYG( 10, 58) = 0.559345E+00
+ PKER_SDRYG( 10, 59) = 0.564044E+00
+ PKER_SDRYG( 10, 60) = 0.568448E+00
+ PKER_SDRYG( 10, 61) = 0.572577E+00
+ PKER_SDRYG( 10, 62) = 0.576449E+00
+ PKER_SDRYG( 10, 63) = 0.580081E+00
+ PKER_SDRYG( 10, 64) = 0.583488E+00
+ PKER_SDRYG( 10, 65) = 0.586685E+00
+ PKER_SDRYG( 10, 66) = 0.589685E+00
+ PKER_SDRYG( 10, 67) = 0.592500E+00
+ PKER_SDRYG( 10, 68) = 0.595142E+00
+ PKER_SDRYG( 10, 69) = 0.597623E+00
+ PKER_SDRYG( 10, 70) = 0.599950E+00
+ PKER_SDRYG( 10, 71) = 0.602136E+00
+ PKER_SDRYG( 10, 72) = 0.604187E+00
+ PKER_SDRYG( 10, 73) = 0.606113E+00
+ PKER_SDRYG( 10, 74) = 0.607921E+00
+ PKER_SDRYG( 10, 75) = 0.609619E+00
+ PKER_SDRYG( 10, 76) = 0.611213E+00
+ PKER_SDRYG( 10, 77) = 0.612709E+00
+ PKER_SDRYG( 10, 78) = 0.614114E+00
+ PKER_SDRYG( 10, 79) = 0.615433E+00
+ PKER_SDRYG( 10, 80) = 0.616672E+00
+ PKER_SDRYG( 11, 1) = 0.292588E+01
+ PKER_SDRYG( 11, 2) = 0.272942E+01
+ PKER_SDRYG( 11, 3) = 0.254491E+01
+ PKER_SDRYG( 11, 4) = 0.237162E+01
+ PKER_SDRYG( 11, 5) = 0.220887E+01
+ PKER_SDRYG( 11, 6) = 0.205599E+01
+ PKER_SDRYG( 11, 7) = 0.191237E+01
+ PKER_SDRYG( 11, 8) = 0.177743E+01
+ PKER_SDRYG( 11, 9) = 0.165062E+01
+ PKER_SDRYG( 11, 10) = 0.153143E+01
+ PKER_SDRYG( 11, 11) = 0.141936E+01
+ PKER_SDRYG( 11, 12) = 0.131393E+01
+ PKER_SDRYG( 11, 13) = 0.121471E+01
+ PKER_SDRYG( 11, 14) = 0.112125E+01
+ PKER_SDRYG( 11, 15) = 0.103314E+01
+ PKER_SDRYG( 11, 16) = 0.949992E+00
+ PKER_SDRYG( 11, 17) = 0.871403E+00
+ PKER_SDRYG( 11, 18) = 0.797011E+00
+ PKER_SDRYG( 11, 19) = 0.726472E+00
+ PKER_SDRYG( 11, 20) = 0.659472E+00
+ PKER_SDRYG( 11, 21) = 0.595759E+00
+ PKER_SDRYG( 11, 22) = 0.535173E+00
+ PKER_SDRYG( 11, 23) = 0.477686E+00
+ PKER_SDRYG( 11, 24) = 0.423410E+00
+ PKER_SDRYG( 11, 25) = 0.372735E+00
+ PKER_SDRYG( 11, 26) = 0.326343E+00
+ PKER_SDRYG( 11, 27) = 0.285079E+00
+ PKER_SDRYG( 11, 28) = 0.250073E+00
+ PKER_SDRYG( 11, 29) = 0.222370E+00
+ PKER_SDRYG( 11, 30) = 0.202694E+00
+ PKER_SDRYG( 11, 31) = 0.191356E+00
+ PKER_SDRYG( 11, 32) = 0.187944E+00
+ PKER_SDRYG( 11, 33) = 0.191428E+00
+ PKER_SDRYG( 11, 34) = 0.200384E+00
+ PKER_SDRYG( 11, 35) = 0.213284E+00
+ PKER_SDRYG( 11, 36) = 0.228761E+00
+ PKER_SDRYG( 11, 37) = 0.245555E+00
+ PKER_SDRYG( 11, 38) = 0.262820E+00
+ PKER_SDRYG( 11, 39) = 0.279947E+00
+ PKER_SDRYG( 11, 40) = 0.296552E+00
+ PKER_SDRYG( 11, 41) = 0.312363E+00
+ PKER_SDRYG( 11, 42) = 0.327309E+00
+ PKER_SDRYG( 11, 43) = 0.341353E+00
+ PKER_SDRYG( 11, 44) = 0.354467E+00
+ PKER_SDRYG( 11, 45) = 0.366682E+00
+ PKER_SDRYG( 11, 46) = 0.378026E+00
+ PKER_SDRYG( 11, 47) = 0.388571E+00
+ PKER_SDRYG( 11, 48) = 0.398407E+00
+ PKER_SDRYG( 11, 49) = 0.407595E+00
+ PKER_SDRYG( 11, 50) = 0.416190E+00
+ PKER_SDRYG( 11, 51) = 0.424231E+00
+ PKER_SDRYG( 11, 52) = 0.431746E+00
+ PKER_SDRYG( 11, 53) = 0.438766E+00
+ PKER_SDRYG( 11, 54) = 0.445323E+00
+ PKER_SDRYG( 11, 55) = 0.451452E+00
+ PKER_SDRYG( 11, 56) = 0.457183E+00
+ PKER_SDRYG( 11, 57) = 0.462546E+00
+ PKER_SDRYG( 11, 58) = 0.467568E+00
+ PKER_SDRYG( 11, 59) = 0.472272E+00
+ PKER_SDRYG( 11, 60) = 0.476681E+00
+ PKER_SDRYG( 11, 61) = 0.480813E+00
+ PKER_SDRYG( 11, 62) = 0.484687E+00
+ PKER_SDRYG( 11, 63) = 0.488321E+00
+ PKER_SDRYG( 11, 64) = 0.491730E+00
+ PKER_SDRYG( 11, 65) = 0.494928E+00
+ PKER_SDRYG( 11, 66) = 0.497929E+00
+ PKER_SDRYG( 11, 67) = 0.500745E+00
+ PKER_SDRYG( 11, 68) = 0.503387E+00
+ PKER_SDRYG( 11, 69) = 0.505868E+00
+ PKER_SDRYG( 11, 70) = 0.508196E+00
+ PKER_SDRYG( 11, 71) = 0.510382E+00
+ PKER_SDRYG( 11, 72) = 0.512433E+00
+ PKER_SDRYG( 11, 73) = 0.514360E+00
+ PKER_SDRYG( 11, 74) = 0.516168E+00
+ PKER_SDRYG( 11, 75) = 0.517866E+00
+ PKER_SDRYG( 11, 76) = 0.519459E+00
+ PKER_SDRYG( 11, 77) = 0.520956E+00
+ PKER_SDRYG( 11, 78) = 0.522361E+00
+ PKER_SDRYG( 11, 79) = 0.523680E+00
+ PKER_SDRYG( 11, 80) = 0.524919E+00
+ PKER_SDRYG( 12, 1) = 0.296813E+01
+ PKER_SDRYG( 12, 2) = 0.277169E+01
+ PKER_SDRYG( 12, 3) = 0.258722E+01
+ PKER_SDRYG( 12, 4) = 0.241397E+01
+ PKER_SDRYG( 12, 5) = 0.225126E+01
+ PKER_SDRYG( 12, 6) = 0.209845E+01
+ PKER_SDRYG( 12, 7) = 0.195490E+01
+ PKER_SDRYG( 12, 8) = 0.182006E+01
+ PKER_SDRYG( 12, 9) = 0.169337E+01
+ PKER_SDRYG( 12, 10) = 0.157433E+01
+ PKER_SDRYG( 12, 11) = 0.146243E+01
+ PKER_SDRYG( 12, 12) = 0.135723E+01
+ PKER_SDRYG( 12, 13) = 0.125828E+01
+ PKER_SDRYG( 12, 14) = 0.116516E+01
+ PKER_SDRYG( 12, 15) = 0.107747E+01
+ PKER_SDRYG( 12, 16) = 0.994807E+00
+ PKER_SDRYG( 12, 17) = 0.916807E+00
+ PKER_SDRYG( 12, 18) = 0.843095E+00
+ PKER_SDRYG( 12, 19) = 0.773314E+00
+ PKER_SDRYG( 12, 20) = 0.707116E+00
+ PKER_SDRYG( 12, 21) = 0.644174E+00
+ PKER_SDRYG( 12, 22) = 0.584199E+00
+ PKER_SDRYG( 12, 23) = 0.526949E+00
+ PKER_SDRYG( 12, 24) = 0.472291E+00
+ PKER_SDRYG( 12, 25) = 0.420211E+00
+ PKER_SDRYG( 12, 26) = 0.370902E+00
+ PKER_SDRYG( 12, 27) = 0.324892E+00
+ PKER_SDRYG( 12, 28) = 0.282842E+00
+ PKER_SDRYG( 12, 29) = 0.245728E+00
+ PKER_SDRYG( 12, 30) = 0.214626E+00
+ PKER_SDRYG( 12, 31) = 0.190466E+00
+ PKER_SDRYG( 12, 32) = 0.173675E+00
+ PKER_SDRYG( 12, 33) = 0.164353E+00
+ PKER_SDRYG( 12, 34) = 0.161777E+00
+ PKER_SDRYG( 12, 35) = 0.164848E+00
+ PKER_SDRYG( 12, 36) = 0.172447E+00
+ PKER_SDRYG( 12, 37) = 0.183108E+00
+ PKER_SDRYG( 12, 38) = 0.195737E+00
+ PKER_SDRYG( 12, 39) = 0.209501E+00
+ PKER_SDRYG( 12, 40) = 0.223654E+00
+ PKER_SDRYG( 12, 41) = 0.237731E+00
+ PKER_SDRYG( 12, 42) = 0.251446E+00
+ PKER_SDRYG( 12, 43) = 0.264605E+00
+ PKER_SDRYG( 12, 44) = 0.277116E+00
+ PKER_SDRYG( 12, 45) = 0.288946E+00
+ PKER_SDRYG( 12, 46) = 0.300077E+00
+ PKER_SDRYG( 12, 47) = 0.310498E+00
+ PKER_SDRYG( 12, 48) = 0.320228E+00
+ PKER_SDRYG( 12, 49) = 0.329310E+00
+ PKER_SDRYG( 12, 50) = 0.337797E+00
+ PKER_SDRYG( 12, 51) = 0.345746E+00
+ PKER_SDRYG( 12, 52) = 0.353202E+00
+ PKER_SDRYG( 12, 53) = 0.360196E+00
+ PKER_SDRYG( 12, 54) = 0.366751E+00
+ PKER_SDRYG( 12, 55) = 0.372888E+00
+ PKER_SDRYG( 12, 56) = 0.378630E+00
+ PKER_SDRYG( 12, 57) = 0.384002E+00
+ PKER_SDRYG( 12, 58) = 0.389031E+00
+ PKER_SDRYG( 12, 59) = 0.393741E+00
+ PKER_SDRYG( 12, 60) = 0.398154E+00
+ PKER_SDRYG( 12, 61) = 0.402290E+00
+ PKER_SDRYG( 12, 62) = 0.406167E+00
+ PKER_SDRYG( 12, 63) = 0.409803E+00
+ PKER_SDRYG( 12, 64) = 0.413213E+00
+ PKER_SDRYG( 12, 65) = 0.416413E+00
+ PKER_SDRYG( 12, 66) = 0.419414E+00
+ PKER_SDRYG( 12, 67) = 0.422231E+00
+ PKER_SDRYG( 12, 68) = 0.424874E+00
+ PKER_SDRYG( 12, 69) = 0.427355E+00
+ PKER_SDRYG( 12, 70) = 0.429684E+00
+ PKER_SDRYG( 12, 71) = 0.431870E+00
+ PKER_SDRYG( 12, 72) = 0.433922E+00
+ PKER_SDRYG( 12, 73) = 0.435848E+00
+ PKER_SDRYG( 12, 74) = 0.437657E+00
+ PKER_SDRYG( 12, 75) = 0.439355E+00
+ PKER_SDRYG( 12, 76) = 0.440949E+00
+ PKER_SDRYG( 12, 77) = 0.442445E+00
+ PKER_SDRYG( 12, 78) = 0.443850E+00
+ PKER_SDRYG( 12, 79) = 0.445170E+00
+ PKER_SDRYG( 12, 80) = 0.446408E+00
+ PKER_SDRYG( 13, 1) = 0.300426E+01
+ PKER_SDRYG( 13, 2) = 0.280784E+01
+ PKER_SDRYG( 13, 3) = 0.262339E+01
+ PKER_SDRYG( 13, 4) = 0.245018E+01
+ PKER_SDRYG( 13, 5) = 0.228751E+01
+ PKER_SDRYG( 13, 6) = 0.213473E+01
+ PKER_SDRYG( 13, 7) = 0.199125E+01
+ PKER_SDRYG( 13, 8) = 0.185647E+01
+ PKER_SDRYG( 13, 9) = 0.172987E+01
+ PKER_SDRYG( 13, 10) = 0.161093E+01
+ PKER_SDRYG( 13, 11) = 0.149916E+01
+ PKER_SDRYG( 13, 12) = 0.139412E+01
+ PKER_SDRYG( 13, 13) = 0.129536E+01
+ PKER_SDRYG( 13, 14) = 0.120249E+01
+ PKER_SDRYG( 13, 15) = 0.111509E+01
+ PKER_SDRYG( 13, 16) = 0.103280E+01
+ PKER_SDRYG( 13, 17) = 0.955258E+00
+ PKER_SDRYG( 13, 18) = 0.882099E+00
+ PKER_SDRYG( 13, 19) = 0.812980E+00
+ PKER_SDRYG( 13, 20) = 0.747559E+00
+ PKER_SDRYG( 13, 21) = 0.685504E+00
+ PKER_SDRYG( 13, 22) = 0.626487E+00
+ PKER_SDRYG( 13, 23) = 0.570200E+00
+ PKER_SDRYG( 13, 24) = 0.516370E+00
+ PKER_SDRYG( 13, 25) = 0.464781E+00
+ PKER_SDRYG( 13, 26) = 0.415330E+00
+ PKER_SDRYG( 13, 27) = 0.368082E+00
+ PKER_SDRYG( 13, 28) = 0.323329E+00
+ PKER_SDRYG( 13, 29) = 0.281592E+00
+ PKER_SDRYG( 13, 30) = 0.243675E+00
+ PKER_SDRYG( 13, 31) = 0.210623E+00
+ PKER_SDRYG( 13, 32) = 0.183280E+00
+ PKER_SDRYG( 13, 33) = 0.162430E+00
+ PKER_SDRYG( 13, 34) = 0.148317E+00
+ PKER_SDRYG( 13, 35) = 0.140602E+00
+ PKER_SDRYG( 13, 36) = 0.138606E+00
+ PKER_SDRYG( 13, 37) = 0.141294E+00
+ PKER_SDRYG( 13, 38) = 0.147531E+00
+ PKER_SDRYG( 13, 39) = 0.156269E+00
+ PKER_SDRYG( 13, 40) = 0.166597E+00
+ PKER_SDRYG( 13, 41) = 0.177865E+00
+ PKER_SDRYG( 13, 42) = 0.189495E+00
+ PKER_SDRYG( 13, 43) = 0.201132E+00
+ PKER_SDRYG( 13, 44) = 0.212557E+00
+ PKER_SDRYG( 13, 45) = 0.223599E+00
+ PKER_SDRYG( 13, 46) = 0.234145E+00
+ PKER_SDRYG( 13, 47) = 0.244174E+00
+ PKER_SDRYG( 13, 48) = 0.253668E+00
+ PKER_SDRYG( 13, 49) = 0.262605E+00
+ PKER_SDRYG( 13, 50) = 0.270996E+00
+ PKER_SDRYG( 13, 51) = 0.278849E+00
+ PKER_SDRYG( 13, 52) = 0.286203E+00
+ PKER_SDRYG( 13, 53) = 0.293107E+00
+ PKER_SDRYG( 13, 54) = 0.299592E+00
+ PKER_SDRYG( 13, 55) = 0.305689E+00
+ PKER_SDRYG( 13, 56) = 0.311416E+00
+ PKER_SDRYG( 13, 57) = 0.316789E+00
+ PKER_SDRYG( 13, 58) = 0.321824E+00
+ PKER_SDRYG( 13, 59) = 0.326539E+00
+ PKER_SDRYG( 13, 60) = 0.330957E+00
+ PKER_SDRYG( 13, 61) = 0.335096E+00
+ PKER_SDRYG( 13, 62) = 0.338977E+00
+ PKER_SDRYG( 13, 63) = 0.342615E+00
+ PKER_SDRYG( 13, 64) = 0.346027E+00
+ PKER_SDRYG( 13, 65) = 0.349228E+00
+ PKER_SDRYG( 13, 66) = 0.352231E+00
+ PKER_SDRYG( 13, 67) = 0.355048E+00
+ PKER_SDRYG( 13, 68) = 0.357693E+00
+ PKER_SDRYG( 13, 69) = 0.360174E+00
+ PKER_SDRYG( 13, 70) = 0.362503E+00
+ PKER_SDRYG( 13, 71) = 0.364689E+00
+ PKER_SDRYG( 13, 72) = 0.366742E+00
+ PKER_SDRYG( 13, 73) = 0.368668E+00
+ PKER_SDRYG( 13, 74) = 0.370477E+00
+ PKER_SDRYG( 13, 75) = 0.372175E+00
+ PKER_SDRYG( 13, 76) = 0.373769E+00
+ PKER_SDRYG( 13, 77) = 0.375266E+00
+ PKER_SDRYG( 13, 78) = 0.376671E+00
+ PKER_SDRYG( 13, 79) = 0.377990E+00
+ PKER_SDRYG( 13, 80) = 0.379229E+00
+ PKER_SDRYG( 14, 1) = 0.303517E+01
+ PKER_SDRYG( 14, 2) = 0.283877E+01
+ PKER_SDRYG( 14, 3) = 0.265433E+01
+ PKER_SDRYG( 14, 4) = 0.248114E+01
+ PKER_SDRYG( 14, 5) = 0.231850E+01
+ PKER_SDRYG( 14, 6) = 0.216575E+01
+ PKER_SDRYG( 14, 7) = 0.202231E+01
+ PKER_SDRYG( 14, 8) = 0.188758E+01
+ PKER_SDRYG( 14, 9) = 0.176104E+01
+ PKER_SDRYG( 14, 10) = 0.164217E+01
+ PKER_SDRYG( 14, 11) = 0.153050E+01
+ PKER_SDRYG( 14, 12) = 0.142557E+01
+ PKER_SDRYG( 14, 13) = 0.132695E+01
+ PKER_SDRYG( 14, 14) = 0.123425E+01
+ PKER_SDRYG( 14, 15) = 0.114707E+01
+ PKER_SDRYG( 14, 16) = 0.106505E+01
+ PKER_SDRYG( 14, 17) = 0.987829E+00
+ PKER_SDRYG( 14, 18) = 0.915075E+00
+ PKER_SDRYG( 14, 19) = 0.846455E+00
+ PKER_SDRYG( 14, 20) = 0.781644E+00
+ PKER_SDRYG( 14, 21) = 0.720325E+00
+ PKER_SDRYG( 14, 22) = 0.662179E+00
+ PKER_SDRYG( 14, 23) = 0.606894E+00
+ PKER_SDRYG( 14, 24) = 0.554165E+00
+ PKER_SDRYG( 14, 25) = 0.503702E+00
+ PKER_SDRYG( 14, 26) = 0.455255E+00
+ PKER_SDRYG( 14, 27) = 0.408655E+00
+ PKER_SDRYG( 14, 28) = 0.363840E+00
+ PKER_SDRYG( 14, 29) = 0.320957E+00
+ PKER_SDRYG( 14, 30) = 0.280360E+00
+ PKER_SDRYG( 14, 31) = 0.242663E+00
+ PKER_SDRYG( 14, 32) = 0.208805E+00
+ PKER_SDRYG( 14, 33) = 0.179611E+00
+ PKER_SDRYG( 14, 34) = 0.155880E+00
+ PKER_SDRYG( 14, 35) = 0.138098E+00
+ PKER_SDRYG( 14, 36) = 0.126282E+00
+ PKER_SDRYG( 14, 37) = 0.119901E+00
+ PKER_SDRYG( 14, 38) = 0.118300E+00
+ PKER_SDRYG( 14, 39) = 0.120505E+00
+ PKER_SDRYG( 14, 40) = 0.125551E+00
+ PKER_SDRYG( 14, 41) = 0.132700E+00
+ PKER_SDRYG( 14, 42) = 0.141142E+00
+ PKER_SDRYG( 14, 43) = 0.150371E+00
+ PKER_SDRYG( 14, 44) = 0.159990E+00
+ PKER_SDRYG( 14, 45) = 0.169685E+00
+ PKER_SDRYG( 14, 46) = 0.179245E+00
+ PKER_SDRYG( 14, 47) = 0.188540E+00
+ PKER_SDRYG( 14, 48) = 0.197487E+00
+ PKER_SDRYG( 14, 49) = 0.206035E+00
+ PKER_SDRYG( 14, 50) = 0.214165E+00
+ PKER_SDRYG( 14, 51) = 0.221865E+00
+ PKER_SDRYG( 14, 52) = 0.229121E+00
+ PKER_SDRYG( 14, 53) = 0.235935E+00
+ PKER_SDRYG( 14, 54) = 0.242332E+00
+ PKER_SDRYG( 14, 55) = 0.248340E+00
+ PKER_SDRYG( 14, 56) = 0.253994E+00
+ PKER_SDRYG( 14, 57) = 0.259317E+00
+ PKER_SDRYG( 14, 58) = 0.264327E+00
+ PKER_SDRYG( 14, 59) = 0.269036E+00
+ PKER_SDRYG( 14, 60) = 0.273454E+00
+ PKER_SDRYG( 14, 61) = 0.277597E+00
+ PKER_SDRYG( 14, 62) = 0.281481E+00
+ PKER_SDRYG( 14, 63) = 0.285122E+00
+ PKER_SDRYG( 14, 64) = 0.288536E+00
+ PKER_SDRYG( 14, 65) = 0.291738E+00
+ PKER_SDRYG( 14, 66) = 0.294743E+00
+ PKER_SDRYG( 14, 67) = 0.297561E+00
+ PKER_SDRYG( 14, 68) = 0.300206E+00
+ PKER_SDRYG( 14, 69) = 0.302688E+00
+ PKER_SDRYG( 14, 70) = 0.305018E+00
+ PKER_SDRYG( 14, 71) = 0.307205E+00
+ PKER_SDRYG( 14, 72) = 0.309257E+00
+ PKER_SDRYG( 14, 73) = 0.311184E+00
+ PKER_SDRYG( 14, 74) = 0.312993E+00
+ PKER_SDRYG( 14, 75) = 0.314691E+00
+ PKER_SDRYG( 14, 76) = 0.316285E+00
+ PKER_SDRYG( 14, 77) = 0.317782E+00
+ PKER_SDRYG( 14, 78) = 0.319187E+00
+ PKER_SDRYG( 14, 79) = 0.320506E+00
+ PKER_SDRYG( 14, 80) = 0.321745E+00
+ PKER_SDRYG( 15, 1) = 0.306161E+01
+ PKER_SDRYG( 15, 2) = 0.286522E+01
+ PKER_SDRYG( 15, 3) = 0.268080E+01
+ PKER_SDRYG( 15, 4) = 0.250762E+01
+ PKER_SDRYG( 15, 5) = 0.234499E+01
+ PKER_SDRYG( 15, 6) = 0.219228E+01
+ PKER_SDRYG( 15, 7) = 0.204886E+01
+ PKER_SDRYG( 15, 8) = 0.191417E+01
+ PKER_SDRYG( 15, 9) = 0.178767E+01
+ PKER_SDRYG( 15, 10) = 0.166885E+01
+ PKER_SDRYG( 15, 11) = 0.155725E+01
+ PKER_SDRYG( 15, 12) = 0.145240E+01
+ PKER_SDRYG( 15, 13) = 0.135388E+01
+ PKER_SDRYG( 15, 14) = 0.126130E+01
+ PKER_SDRYG( 15, 15) = 0.117427E+01
+ PKER_SDRYG( 15, 16) = 0.109244E+01
+ PKER_SDRYG( 15, 17) = 0.101546E+01
+ PKER_SDRYG( 15, 18) = 0.942994E+00
+ PKER_SDRYG( 15, 19) = 0.874732E+00
+ PKER_SDRYG( 15, 20) = 0.810365E+00
+ PKER_SDRYG( 15, 21) = 0.749592E+00
+ PKER_SDRYG( 15, 22) = 0.692115E+00
+ PKER_SDRYG( 15, 23) = 0.637639E+00
+ PKER_SDRYG( 15, 24) = 0.585869E+00
+ PKER_SDRYG( 15, 25) = 0.536512E+00
+ PKER_SDRYG( 15, 26) = 0.489283E+00
+ PKER_SDRYG( 15, 27) = 0.443919E+00
+ PKER_SDRYG( 15, 28) = 0.400205E+00
+ PKER_SDRYG( 15, 29) = 0.358017E+00
+ PKER_SDRYG( 15, 30) = 0.317369E+00
+ PKER_SDRYG( 15, 31) = 0.278488E+00
+ PKER_SDRYG( 15, 32) = 0.241839E+00
+ PKER_SDRYG( 15, 33) = 0.208131E+00
+ PKER_SDRYG( 15, 34) = 0.178156E+00
+ PKER_SDRYG( 15, 35) = 0.152678E+00
+ PKER_SDRYG( 15, 36) = 0.132382E+00
+ PKER_SDRYG( 15, 37) = 0.117317E+00
+ PKER_SDRYG( 15, 38) = 0.107412E+00
+ PKER_SDRYG( 15, 39) = 0.102138E+00
+ PKER_SDRYG( 15, 40) = 0.100720E+00
+ PKER_SDRYG( 15, 41) = 0.102430E+00
+ PKER_SDRYG( 15, 42) = 0.106496E+00
+ PKER_SDRYG( 15, 43) = 0.112243E+00
+ PKER_SDRYG( 15, 44) = 0.119136E+00
+ PKER_SDRYG( 15, 45) = 0.126711E+00
+ PKER_SDRYG( 15, 46) = 0.134684E+00
+ PKER_SDRYG( 15, 47) = 0.142774E+00
+ PKER_SDRYG( 15, 48) = 0.150805E+00
+ PKER_SDRYG( 15, 49) = 0.158681E+00
+ PKER_SDRYG( 15, 50) = 0.166306E+00
+ PKER_SDRYG( 15, 51) = 0.173620E+00
+ PKER_SDRYG( 15, 52) = 0.180607E+00
+ PKER_SDRYG( 15, 53) = 0.187254E+00
+ PKER_SDRYG( 15, 54) = 0.193543E+00
+ PKER_SDRYG( 15, 55) = 0.199475E+00
+ PKER_SDRYG( 15, 56) = 0.205051E+00
+ PKER_SDRYG( 15, 57) = 0.210294E+00
+ PKER_SDRYG( 15, 58) = 0.215233E+00
+ PKER_SDRYG( 15, 59) = 0.219886E+00
+ PKER_SDRYG( 15, 60) = 0.224272E+00
+ PKER_SDRYG( 15, 61) = 0.228402E+00
+ PKER_SDRYG( 15, 62) = 0.232282E+00
+ PKER_SDRYG( 15, 63) = 0.235924E+00
+ PKER_SDRYG( 15, 64) = 0.239341E+00
+ PKER_SDRYG( 15, 65) = 0.242545E+00
+ PKER_SDRYG( 15, 66) = 0.245550E+00
+ PKER_SDRYG( 15, 67) = 0.248370E+00
+ PKER_SDRYG( 15, 68) = 0.251016E+00
+ PKER_SDRYG( 15, 69) = 0.253499E+00
+ PKER_SDRYG( 15, 70) = 0.255829E+00
+ PKER_SDRYG( 15, 71) = 0.258016E+00
+ PKER_SDRYG( 15, 72) = 0.260069E+00
+ PKER_SDRYG( 15, 73) = 0.261996E+00
+ PKER_SDRYG( 15, 74) = 0.263805E+00
+ PKER_SDRYG( 15, 75) = 0.265503E+00
+ PKER_SDRYG( 15, 76) = 0.267097E+00
+ PKER_SDRYG( 15, 77) = 0.268594E+00
+ PKER_SDRYG( 15, 78) = 0.270000E+00
+ PKER_SDRYG( 15, 79) = 0.271319E+00
+ PKER_SDRYG( 15, 80) = 0.272558E+00
+ PKER_SDRYG( 16, 1) = 0.308423E+01
+ PKER_SDRYG( 16, 2) = 0.288784E+01
+ PKER_SDRYG( 16, 3) = 0.270343E+01
+ PKER_SDRYG( 16, 4) = 0.253026E+01
+ PKER_SDRYG( 16, 5) = 0.236765E+01
+ PKER_SDRYG( 16, 6) = 0.221495E+01
+ PKER_SDRYG( 16, 7) = 0.207156E+01
+ PKER_SDRYG( 16, 8) = 0.193689E+01
+ PKER_SDRYG( 16, 9) = 0.181043E+01
+ PKER_SDRYG( 16, 10) = 0.169165E+01
+ PKER_SDRYG( 16, 11) = 0.158009E+01
+ PKER_SDRYG( 16, 12) = 0.147530E+01
+ PKER_SDRYG( 16, 13) = 0.137686E+01
+ PKER_SDRYG( 16, 14) = 0.128436E+01
+ PKER_SDRYG( 16, 15) = 0.119745E+01
+ PKER_SDRYG( 16, 16) = 0.111575E+01
+ PKER_SDRYG( 16, 17) = 0.103893E+01
+ PKER_SDRYG( 16, 18) = 0.966673E+00
+ PKER_SDRYG( 16, 19) = 0.898666E+00
+ PKER_SDRYG( 16, 20) = 0.834615E+00
+ PKER_SDRYG( 16, 21) = 0.774233E+00
+ PKER_SDRYG( 16, 22) = 0.717240E+00
+ PKER_SDRYG( 16, 23) = 0.663360E+00
+ PKER_SDRYG( 16, 24) = 0.612319E+00
+ PKER_SDRYG( 16, 25) = 0.563842E+00
+ PKER_SDRYG( 16, 26) = 0.517655E+00
+ PKER_SDRYG( 16, 27) = 0.473486E+00
+ PKER_SDRYG( 16, 28) = 0.431073E+00
+ PKER_SDRYG( 16, 29) = 0.390189E+00
+ PKER_SDRYG( 16, 30) = 0.350665E+00
+ PKER_SDRYG( 16, 31) = 0.312442E+00
+ PKER_SDRYG( 16, 32) = 0.275636E+00
+ PKER_SDRYG( 16, 33) = 0.240542E+00
+ PKER_SDRYG( 16, 34) = 0.207718E+00
+ PKER_SDRYG( 16, 35) = 0.177836E+00
+ PKER_SDRYG( 16, 36) = 0.151594E+00
+ PKER_SDRYG( 16, 37) = 0.129702E+00
+ PKER_SDRYG( 16, 38) = 0.112415E+00
+ PKER_SDRYG( 16, 39) = 0.997384E-01
+ PKER_SDRYG( 16, 40) = 0.914126E-01
+ PKER_SDRYG( 16, 41) = 0.869384E-01
+ PKER_SDRYG( 16, 42) = 0.856034E-01
+ PKER_SDRYG( 16, 43) = 0.868406E-01
+ PKER_SDRYG( 16, 44) = 0.900395E-01
+ PKER_SDRYG( 16, 45) = 0.946372E-01
+ PKER_SDRYG( 16, 46) = 0.100254E+00
+ PKER_SDRYG( 16, 47) = 0.106487E+00
+ PKER_SDRYG( 16, 48) = 0.113101E+00
+ PKER_SDRYG( 16, 49) = 0.119871E+00
+ PKER_SDRYG( 16, 50) = 0.126659E+00
+ PKER_SDRYG( 16, 51) = 0.133342E+00
+ PKER_SDRYG( 16, 52) = 0.139846E+00
+ PKER_SDRYG( 16, 53) = 0.146127E+00
+ PKER_SDRYG( 16, 54) = 0.152147E+00
+ PKER_SDRYG( 16, 55) = 0.157896E+00
+ PKER_SDRYG( 16, 56) = 0.163360E+00
+ PKER_SDRYG( 16, 57) = 0.168528E+00
+ PKER_SDRYG( 16, 58) = 0.173397E+00
+ PKER_SDRYG( 16, 59) = 0.177982E+00
+ PKER_SDRYG( 16, 60) = 0.182299E+00
+ PKER_SDRYG( 16, 61) = 0.186373E+00
+ PKER_SDRYG( 16, 62) = 0.190215E+00
+ PKER_SDRYG( 16, 63) = 0.193838E+00
+ PKER_SDRYG( 16, 64) = 0.197247E+00
+ PKER_SDRYG( 16, 65) = 0.200450E+00
+ PKER_SDRYG( 16, 66) = 0.203457E+00
+ PKER_SDRYG( 16, 67) = 0.206278E+00
+ PKER_SDRYG( 16, 68) = 0.208924E+00
+ PKER_SDRYG( 16, 69) = 0.211408E+00
+ PKER_SDRYG( 16, 70) = 0.213739E+00
+ PKER_SDRYG( 16, 71) = 0.215926E+00
+ PKER_SDRYG( 16, 72) = 0.217979E+00
+ PKER_SDRYG( 16, 73) = 0.219907E+00
+ PKER_SDRYG( 16, 74) = 0.221716E+00
+ PKER_SDRYG( 16, 75) = 0.223414E+00
+ PKER_SDRYG( 16, 76) = 0.225009E+00
+ PKER_SDRYG( 16, 77) = 0.226506E+00
+ PKER_SDRYG( 16, 78) = 0.227911E+00
+ PKER_SDRYG( 16, 79) = 0.229231E+00
+ PKER_SDRYG( 16, 80) = 0.230470E+00
+ PKER_SDRYG( 17, 1) = 0.310358E+01
+ PKER_SDRYG( 17, 2) = 0.290720E+01
+ PKER_SDRYG( 17, 3) = 0.272279E+01
+ PKER_SDRYG( 17, 4) = 0.254964E+01
+ PKER_SDRYG( 17, 5) = 0.238704E+01
+ PKER_SDRYG( 17, 6) = 0.223435E+01
+ PKER_SDRYG( 17, 7) = 0.209097E+01
+ PKER_SDRYG( 17, 8) = 0.195632E+01
+ PKER_SDRYG( 17, 9) = 0.182988E+01
+ PKER_SDRYG( 17, 10) = 0.171113E+01
+ PKER_SDRYG( 17, 11) = 0.159960E+01
+ PKER_SDRYG( 17, 12) = 0.149486E+01
+ PKER_SDRYG( 17, 13) = 0.139647E+01
+ PKER_SDRYG( 17, 14) = 0.130404E+01
+ PKER_SDRYG( 17, 15) = 0.121720E+01
+ PKER_SDRYG( 17, 16) = 0.113560E+01
+ PKER_SDRYG( 17, 17) = 0.105890E+01
+ PKER_SDRYG( 17, 18) = 0.986787E+00
+ PKER_SDRYG( 17, 19) = 0.918963E+00
+ PKER_SDRYG( 17, 20) = 0.855137E+00
+ PKER_SDRYG( 17, 21) = 0.795034E+00
+ PKER_SDRYG( 17, 22) = 0.738385E+00
+ PKER_SDRYG( 17, 23) = 0.684932E+00
+ PKER_SDRYG( 17, 24) = 0.634417E+00
+ PKER_SDRYG( 17, 25) = 0.586588E+00
+ PKER_SDRYG( 17, 26) = 0.541190E+00
+ PKER_SDRYG( 17, 27) = 0.497968E+00
+ PKER_SDRYG( 17, 28) = 0.456667E+00
+ PKER_SDRYG( 17, 29) = 0.417040E+00
+ PKER_SDRYG( 17, 30) = 0.378858E+00
+ PKER_SDRYG( 17, 31) = 0.341935E+00
+ PKER_SDRYG( 17, 32) = 0.306167E+00
+ PKER_SDRYG( 17, 33) = 0.271581E+00
+ PKER_SDRYG( 17, 34) = 0.238370E+00
+ PKER_SDRYG( 17, 35) = 0.206924E+00
+ PKER_SDRYG( 17, 36) = 0.177806E+00
+ PKER_SDRYG( 17, 37) = 0.151640E+00
+ PKER_SDRYG( 17, 38) = 0.129035E+00
+ PKER_SDRYG( 17, 39) = 0.110359E+00
+ PKER_SDRYG( 17, 40) = 0.956972E-01
+ PKER_SDRYG( 17, 41) = 0.850722E-01
+ PKER_SDRYG( 17, 42) = 0.779682E-01
+ PKER_SDRYG( 17, 43) = 0.740481E-01
+ PKER_SDRYG( 17, 44) = 0.727646E-01
+ PKER_SDRYG( 17, 45) = 0.735553E-01
+ PKER_SDRYG( 17, 46) = 0.759991E-01
+ PKER_SDRYG( 17, 47) = 0.796568E-01
+ PKER_SDRYG( 17, 48) = 0.841822E-01
+ PKER_SDRYG( 17, 49) = 0.893114E-01
+ PKER_SDRYG( 17, 50) = 0.947876E-01
+ PKER_SDRYG( 17, 51) = 0.100463E+00
+ PKER_SDRYG( 17, 52) = 0.106196E+00
+ PKER_SDRYG( 17, 53) = 0.111874E+00
+ PKER_SDRYG( 17, 54) = 0.117444E+00
+ PKER_SDRYG( 17, 55) = 0.122848E+00
+ PKER_SDRYG( 17, 56) = 0.128044E+00
+ PKER_SDRYG( 17, 57) = 0.133022E+00
+ PKER_SDRYG( 17, 58) = 0.137773E+00
+ PKER_SDRYG( 17, 59) = 0.142278E+00
+ PKER_SDRYG( 17, 60) = 0.146537E+00
+ PKER_SDRYG( 17, 61) = 0.150550E+00
+ PKER_SDRYG( 17, 62) = 0.154332E+00
+ PKER_SDRYG( 17, 63) = 0.157901E+00
+ PKER_SDRYG( 17, 64) = 0.161269E+00
+ PKER_SDRYG( 17, 65) = 0.164447E+00
+ PKER_SDRYG( 17, 66) = 0.167443E+00
+ PKER_SDRYG( 17, 67) = 0.170260E+00
+ PKER_SDRYG( 17, 68) = 0.172907E+00
+ PKER_SDRYG( 17, 69) = 0.175391E+00
+ PKER_SDRYG( 17, 70) = 0.177723E+00
+ PKER_SDRYG( 17, 71) = 0.179911E+00
+ PKER_SDRYG( 17, 72) = 0.181964E+00
+ PKER_SDRYG( 17, 73) = 0.183892E+00
+ PKER_SDRYG( 17, 74) = 0.185701E+00
+ PKER_SDRYG( 17, 75) = 0.187400E+00
+ PKER_SDRYG( 17, 76) = 0.188995E+00
+ PKER_SDRYG( 17, 77) = 0.190492E+00
+ PKER_SDRYG( 17, 78) = 0.191897E+00
+ PKER_SDRYG( 17, 79) = 0.193217E+00
+ PKER_SDRYG( 17, 80) = 0.194456E+00
+ PKER_SDRYG( 18, 1) = 0.312013E+01
+ PKER_SDRYG( 18, 2) = 0.292376E+01
+ PKER_SDRYG( 18, 3) = 0.273936E+01
+ PKER_SDRYG( 18, 4) = 0.256621E+01
+ PKER_SDRYG( 18, 5) = 0.240361E+01
+ PKER_SDRYG( 18, 6) = 0.225094E+01
+ PKER_SDRYG( 18, 7) = 0.210757E+01
+ PKER_SDRYG( 18, 8) = 0.197294E+01
+ PKER_SDRYG( 18, 9) = 0.184651E+01
+ PKER_SDRYG( 18, 10) = 0.172778E+01
+ PKER_SDRYG( 18, 11) = 0.161628E+01
+ PKER_SDRYG( 18, 12) = 0.151156E+01
+ PKER_SDRYG( 18, 13) = 0.141321E+01
+ PKER_SDRYG( 18, 14) = 0.132083E+01
+ PKER_SDRYG( 18, 15) = 0.123405E+01
+ PKER_SDRYG( 18, 16) = 0.115251E+01
+ PKER_SDRYG( 18, 17) = 0.107590E+01
+ PKER_SDRYG( 18, 18) = 0.100390E+01
+ PKER_SDRYG( 18, 19) = 0.936202E+00
+ PKER_SDRYG( 18, 20) = 0.872537E+00
+ PKER_SDRYG( 18, 21) = 0.812633E+00
+ PKER_SDRYG( 18, 22) = 0.756230E+00
+ PKER_SDRYG( 18, 23) = 0.703080E+00
+ PKER_SDRYG( 18, 24) = 0.652942E+00
+ PKER_SDRYG( 18, 25) = 0.605576E+00
+ PKER_SDRYG( 18, 26) = 0.560750E+00
+ PKER_SDRYG( 18, 27) = 0.518227E+00
+ PKER_SDRYG( 18, 28) = 0.477773E+00
+ PKER_SDRYG( 18, 29) = 0.439152E+00
+ PKER_SDRYG( 18, 30) = 0.402131E+00
+ PKER_SDRYG( 18, 31) = 0.366493E+00
+ PKER_SDRYG( 18, 32) = 0.332050E+00
+ PKER_SDRYG( 18, 33) = 0.298676E+00
+ PKER_SDRYG( 18, 34) = 0.266345E+00
+ PKER_SDRYG( 18, 35) = 0.235168E+00
+ PKER_SDRYG( 18, 36) = 0.205422E+00
+ PKER_SDRYG( 18, 37) = 0.177545E+00
+ PKER_SDRYG( 18, 38) = 0.152032E+00
+ PKER_SDRYG( 18, 39) = 0.129423E+00
+ PKER_SDRYG( 18, 40) = 0.110093E+00
+ PKER_SDRYG( 18, 41) = 0.942133E-01
+ PKER_SDRYG( 18, 42) = 0.818749E-01
+ PKER_SDRYG( 18, 43) = 0.728212E-01
+ PKER_SDRYG( 18, 44) = 0.667257E-01
+ PKER_SDRYG( 18, 45) = 0.632100E-01
+ PKER_SDRYG( 18, 46) = 0.618886E-01
+ PKER_SDRYG( 18, 47) = 0.622846E-01
+ PKER_SDRYG( 18, 48) = 0.640674E-01
+ PKER_SDRYG( 18, 49) = 0.669386E-01
+ PKER_SDRYG( 18, 50) = 0.705747E-01
+ PKER_SDRYG( 18, 51) = 0.747677E-01
+ PKER_SDRYG( 18, 52) = 0.793092E-01
+ PKER_SDRYG( 18, 53) = 0.840736E-01
+ PKER_SDRYG( 18, 54) = 0.889086E-01
+ PKER_SDRYG( 18, 55) = 0.937517E-01
+ PKER_SDRYG( 18, 56) = 0.985202E-01
+ PKER_SDRYG( 18, 57) = 0.103163E+00
+ PKER_SDRYG( 18, 58) = 0.107658E+00
+ PKER_SDRYG( 18, 59) = 0.111974E+00
+ PKER_SDRYG( 18, 60) = 0.116103E+00
+ PKER_SDRYG( 18, 61) = 0.120035E+00
+ PKER_SDRYG( 18, 62) = 0.123761E+00
+ PKER_SDRYG( 18, 63) = 0.127277E+00
+ PKER_SDRYG( 18, 64) = 0.130593E+00
+ PKER_SDRYG( 18, 65) = 0.133720E+00
+ PKER_SDRYG( 18, 66) = 0.136675E+00
+ PKER_SDRYG( 18, 67) = 0.139464E+00
+ PKER_SDRYG( 18, 68) = 0.142096E+00
+ PKER_SDRYG( 18, 69) = 0.144574E+00
+ PKER_SDRYG( 18, 70) = 0.146905E+00
+ PKER_SDRYG( 18, 71) = 0.149093E+00
+ PKER_SDRYG( 18, 72) = 0.151147E+00
+ PKER_SDRYG( 18, 73) = 0.153075E+00
+ PKER_SDRYG( 18, 74) = 0.154885E+00
+ PKER_SDRYG( 18, 75) = 0.156583E+00
+ PKER_SDRYG( 18, 76) = 0.158178E+00
+ PKER_SDRYG( 18, 77) = 0.159675E+00
+ PKER_SDRYG( 18, 78) = 0.161081E+00
+ PKER_SDRYG( 18, 79) = 0.162401E+00
+ PKER_SDRYG( 18, 80) = 0.163640E+00
+ PKER_SDRYG( 19, 1) = 0.313430E+01
+ PKER_SDRYG( 19, 2) = 0.293792E+01
+ PKER_SDRYG( 19, 3) = 0.275353E+01
+ PKER_SDRYG( 19, 4) = 0.258038E+01
+ PKER_SDRYG( 19, 5) = 0.241780E+01
+ PKER_SDRYG( 19, 6) = 0.226513E+01
+ PKER_SDRYG( 19, 7) = 0.212176E+01
+ PKER_SDRYG( 19, 8) = 0.198714E+01
+ PKER_SDRYG( 19, 9) = 0.186073E+01
+ PKER_SDRYG( 19, 10) = 0.174202E+01
+ PKER_SDRYG( 19, 11) = 0.163053E+01
+ PKER_SDRYG( 19, 12) = 0.152584E+01
+ PKER_SDRYG( 19, 13) = 0.142751E+01
+ PKER_SDRYG( 19, 14) = 0.133517E+01
+ PKER_SDRYG( 19, 15) = 0.124842E+01
+ PKER_SDRYG( 19, 16) = 0.116694E+01
+ PKER_SDRYG( 19, 17) = 0.109039E+01
+ PKER_SDRYG( 19, 18) = 0.101846E+01
+ PKER_SDRYG( 19, 19) = 0.950864E+00
+ PKER_SDRYG( 19, 20) = 0.887315E+00
+ PKER_SDRYG( 19, 21) = 0.827553E+00
+ PKER_SDRYG( 19, 22) = 0.771326E+00
+ PKER_SDRYG( 19, 23) = 0.718393E+00
+ PKER_SDRYG( 19, 24) = 0.668523E+00
+ PKER_SDRYG( 19, 25) = 0.621489E+00
+ PKER_SDRYG( 19, 26) = 0.577071E+00
+ PKER_SDRYG( 19, 27) = 0.535052E+00
+ PKER_SDRYG( 19, 28) = 0.495215E+00
+ PKER_SDRYG( 19, 29) = 0.457343E+00
+ PKER_SDRYG( 19, 30) = 0.421219E+00
+ PKER_SDRYG( 19, 31) = 0.386628E+00
+ PKER_SDRYG( 19, 32) = 0.353366E+00
+ PKER_SDRYG( 19, 33) = 0.321252E+00
+ PKER_SDRYG( 19, 34) = 0.290155E+00
+ PKER_SDRYG( 19, 35) = 0.260019E+00
+ PKER_SDRYG( 19, 36) = 0.230899E+00
+ PKER_SDRYG( 19, 37) = 0.202987E+00
+ PKER_SDRYG( 19, 38) = 0.176611E+00
+ PKER_SDRYG( 19, 39) = 0.152167E+00
+ PKER_SDRYG( 19, 40) = 0.130090E+00
+ PKER_SDRYG( 19, 41) = 0.110741E+00
+ PKER_SDRYG( 19, 42) = 0.943181E-01
+ PKER_SDRYG( 19, 43) = 0.809330E-01
+ PKER_SDRYG( 19, 44) = 0.704716E-01
+ PKER_SDRYG( 19, 45) = 0.626544E-01
+ PKER_SDRYG( 19, 46) = 0.573699E-01
+ PKER_SDRYG( 19, 47) = 0.541204E-01
+ PKER_SDRYG( 19, 48) = 0.527083E-01
+ PKER_SDRYG( 19, 49) = 0.527892E-01
+ PKER_SDRYG( 19, 50) = 0.540394E-01
+ PKER_SDRYG( 19, 51) = 0.562337E-01
+ PKER_SDRYG( 19, 52) = 0.591260E-01
+ PKER_SDRYG( 19, 53) = 0.625315E-01
+ PKER_SDRYG( 19, 54) = 0.662926E-01
+ PKER_SDRYG( 19, 55) = 0.702636E-01
+ PKER_SDRYG( 19, 56) = 0.743493E-01
+ PKER_SDRYG( 19, 57) = 0.784688E-01
+ PKER_SDRYG( 19, 58) = 0.825487E-01
+ PKER_SDRYG( 19, 59) = 0.865492E-01
+ PKER_SDRYG( 19, 60) = 0.904344E-01
+ PKER_SDRYG( 19, 61) = 0.941778E-01
+ PKER_SDRYG( 19, 62) = 0.977677E-01
+ PKER_SDRYG( 19, 63) = 0.101199E+00
+ PKER_SDRYG( 19, 64) = 0.104457E+00
+ PKER_SDRYG( 19, 65) = 0.107540E+00
+ PKER_SDRYG( 19, 66) = 0.110449E+00
+ PKER_SDRYG( 19, 67) = 0.113194E+00
+ PKER_SDRYG( 19, 68) = 0.115786E+00
+ PKER_SDRYG( 19, 69) = 0.118234E+00
+ PKER_SDRYG( 19, 70) = 0.120546E+00
+ PKER_SDRYG( 19, 71) = 0.122726E+00
+ PKER_SDRYG( 19, 72) = 0.124778E+00
+ PKER_SDRYG( 19, 73) = 0.126705E+00
+ PKER_SDRYG( 19, 74) = 0.128515E+00
+ PKER_SDRYG( 19, 75) = 0.130214E+00
+ PKER_SDRYG( 19, 76) = 0.131809E+00
+ PKER_SDRYG( 19, 77) = 0.133307E+00
+ PKER_SDRYG( 19, 78) = 0.134712E+00
+ PKER_SDRYG( 19, 79) = 0.136032E+00
+ PKER_SDRYG( 19, 80) = 0.137271E+00
+ PKER_SDRYG( 20, 1) = 0.314641E+01
+ PKER_SDRYG( 20, 2) = 0.295004E+01
+ PKER_SDRYG( 20, 3) = 0.276565E+01
+ PKER_SDRYG( 20, 4) = 0.259251E+01
+ PKER_SDRYG( 20, 5) = 0.242993E+01
+ PKER_SDRYG( 20, 6) = 0.227726E+01
+ PKER_SDRYG( 20, 7) = 0.213391E+01
+ PKER_SDRYG( 20, 8) = 0.199929E+01
+ PKER_SDRYG( 20, 9) = 0.187289E+01
+ PKER_SDRYG( 20, 10) = 0.175419E+01
+ PKER_SDRYG( 20, 11) = 0.164272E+01
+ PKER_SDRYG( 20, 12) = 0.153804E+01
+ PKER_SDRYG( 20, 13) = 0.143974E+01
+ PKER_SDRYG( 20, 14) = 0.134741E+01
+ PKER_SDRYG( 20, 15) = 0.126070E+01
+ PKER_SDRYG( 20, 16) = 0.117926E+01
+ PKER_SDRYG( 20, 17) = 0.110275E+01
+ PKER_SDRYG( 20, 18) = 0.103088E+01
+ PKER_SDRYG( 20, 19) = 0.963347E+00
+ PKER_SDRYG( 20, 20) = 0.899882E+00
+ PKER_SDRYG( 20, 21) = 0.840222E+00
+ PKER_SDRYG( 20, 22) = 0.784121E+00
+ PKER_SDRYG( 20, 23) = 0.731345E+00
+ PKER_SDRYG( 20, 24) = 0.681666E+00
+ PKER_SDRYG( 20, 25) = 0.634870E+00
+ PKER_SDRYG( 20, 26) = 0.590745E+00
+ PKER_SDRYG( 20, 27) = 0.549087E+00
+ PKER_SDRYG( 20, 28) = 0.509694E+00
+ PKER_SDRYG( 20, 29) = 0.472366E+00
+ PKER_SDRYG( 20, 30) = 0.436902E+00
+ PKER_SDRYG( 20, 31) = 0.403104E+00
+ PKER_SDRYG( 20, 32) = 0.370773E+00
+ PKER_SDRYG( 20, 33) = 0.339721E+00
+ PKER_SDRYG( 20, 34) = 0.309780E+00
+ PKER_SDRYG( 20, 35) = 0.280817E+00
+ PKER_SDRYG( 20, 36) = 0.252766E+00
+ PKER_SDRYG( 20, 37) = 0.225649E+00
+ PKER_SDRYG( 20, 38) = 0.199598E+00
+ PKER_SDRYG( 20, 39) = 0.174855E+00
+ PKER_SDRYG( 20, 40) = 0.151733E+00
+ PKER_SDRYG( 20, 41) = 0.130576E+00
+ PKER_SDRYG( 20, 42) = 0.111685E+00
+ PKER_SDRYG( 20, 43) = 0.952438E-01
+ PKER_SDRYG( 20, 44) = 0.813642E-01
+ PKER_SDRYG( 20, 45) = 0.700036E-01
+ PKER_SDRYG( 20, 46) = 0.610159E-01
+ PKER_SDRYG( 20, 47) = 0.542824E-01
+ PKER_SDRYG( 20, 48) = 0.495365E-01
+ PKER_SDRYG( 20, 49) = 0.465418E-01
+ PKER_SDRYG( 20, 50) = 0.450362E-01
+ PKER_SDRYG( 20, 51) = 0.448236E-01
+ PKER_SDRYG( 20, 52) = 0.456174E-01
+ PKER_SDRYG( 20, 53) = 0.472243E-01
+ PKER_SDRYG( 20, 54) = 0.495059E-01
+ PKER_SDRYG( 20, 55) = 0.522568E-01
+ PKER_SDRYG( 20, 56) = 0.553442E-01
+ PKER_SDRYG( 20, 57) = 0.586561E-01
+ PKER_SDRYG( 20, 58) = 0.621124E-01
+ PKER_SDRYG( 20, 59) = 0.656027E-01
+ PKER_SDRYG( 20, 60) = 0.690997E-01
+ PKER_SDRYG( 20, 61) = 0.725427E-01
+ PKER_SDRYG( 20, 62) = 0.758958E-01
+ PKER_SDRYG( 20, 63) = 0.791459E-01
+ PKER_SDRYG( 20, 64) = 0.822686E-01
+ PKER_SDRYG( 20, 65) = 0.852588E-01
+ PKER_SDRYG( 20, 66) = 0.881095E-01
+ PKER_SDRYG( 20, 67) = 0.908129E-01
+ PKER_SDRYG( 20, 68) = 0.933663E-01
+ PKER_SDRYG( 20, 69) = 0.957757E-01
+ PKER_SDRYG( 20, 70) = 0.980498E-01
+ PKER_SDRYG( 20, 71) = 0.100200E+00
+ PKER_SDRYG( 20, 72) = 0.102230E+00
+ PKER_SDRYG( 20, 73) = 0.104147E+00
+ PKER_SDRYG( 20, 74) = 0.105953E+00
+ PKER_SDRYG( 20, 75) = 0.107651E+00
+ PKER_SDRYG( 20, 76) = 0.109246E+00
+ PKER_SDRYG( 20, 77) = 0.110743E+00
+ PKER_SDRYG( 20, 78) = 0.112149E+00
+ PKER_SDRYG( 20, 79) = 0.113469E+00
+ PKER_SDRYG( 20, 80) = 0.114708E+00
+ PKER_SDRYG( 21, 1) = 0.315678E+01
+ PKER_SDRYG( 21, 2) = 0.296041E+01
+ PKER_SDRYG( 21, 3) = 0.277602E+01
+ PKER_SDRYG( 21, 4) = 0.260288E+01
+ PKER_SDRYG( 21, 5) = 0.244030E+01
+ PKER_SDRYG( 21, 6) = 0.228764E+01
+ PKER_SDRYG( 21, 7) = 0.214429E+01
+ PKER_SDRYG( 21, 8) = 0.200969E+01
+ PKER_SDRYG( 21, 9) = 0.188329E+01
+ PKER_SDRYG( 21, 10) = 0.176459E+01
+ PKER_SDRYG( 21, 11) = 0.165314E+01
+ PKER_SDRYG( 21, 12) = 0.154847E+01
+ PKER_SDRYG( 21, 13) = 0.145018E+01
+ PKER_SDRYG( 21, 14) = 0.135788E+01
+ PKER_SDRYG( 21, 15) = 0.127119E+01
+ PKER_SDRYG( 21, 16) = 0.118977E+01
+ PKER_SDRYG( 21, 17) = 0.111330E+01
+ PKER_SDRYG( 21, 18) = 0.104147E+01
+ PKER_SDRYG( 21, 19) = 0.973984E+00
+ PKER_SDRYG( 21, 20) = 0.910579E+00
+ PKER_SDRYG( 21, 21) = 0.850994E+00
+ PKER_SDRYG( 21, 22) = 0.794985E+00
+ PKER_SDRYG( 21, 23) = 0.742321E+00
+ PKER_SDRYG( 21, 24) = 0.692781E+00
+ PKER_SDRYG( 21, 25) = 0.646155E+00
+ PKER_SDRYG( 21, 26) = 0.602240E+00
+ PKER_SDRYG( 21, 27) = 0.560841E+00
+ PKER_SDRYG( 21, 28) = 0.521767E+00
+ PKER_SDRYG( 21, 29) = 0.484831E+00
+ PKER_SDRYG( 21, 30) = 0.449847E+00
+ PKER_SDRYG( 21, 31) = 0.416632E+00
+ PKER_SDRYG( 21, 32) = 0.385000E+00
+ PKER_SDRYG( 21, 33) = 0.354772E+00
+ PKER_SDRYG( 21, 34) = 0.325773E+00
+ PKER_SDRYG( 21, 35) = 0.297848E+00
+ PKER_SDRYG( 21, 36) = 0.270871E+00
+ PKER_SDRYG( 21, 37) = 0.244771E+00
+ PKER_SDRYG( 21, 38) = 0.219552E+00
+ PKER_SDRYG( 21, 39) = 0.195307E+00
+ PKER_SDRYG( 21, 40) = 0.172218E+00
+ PKER_SDRYG( 21, 41) = 0.150528E+00
+ PKER_SDRYG( 21, 42) = 0.130506E+00
+ PKER_SDRYG( 21, 43) = 0.112387E+00
+ PKER_SDRYG( 21, 44) = 0.963217E-01
+ PKER_SDRYG( 21, 45) = 0.824142E-01
+ PKER_SDRYG( 21, 46) = 0.706536E-01
+ PKER_SDRYG( 21, 47) = 0.609423E-01
+ PKER_SDRYG( 21, 48) = 0.532273E-01
+ PKER_SDRYG( 21, 49) = 0.473264E-01
+ PKER_SDRYG( 21, 50) = 0.429933E-01
+ PKER_SDRYG( 21, 51) = 0.402064E-01
+ PKER_SDRYG( 21, 52) = 0.386102E-01
+ PKER_SDRYG( 21, 53) = 0.381308E-01
+ PKER_SDRYG( 21, 54) = 0.385657E-01
+ PKER_SDRYG( 21, 55) = 0.397270E-01
+ PKER_SDRYG( 21, 56) = 0.414742E-01
+ PKER_SDRYG( 21, 57) = 0.436663E-01
+ PKER_SDRYG( 21, 58) = 0.461938E-01
+ PKER_SDRYG( 21, 59) = 0.489445E-01
+ PKER_SDRYG( 21, 60) = 0.518374E-01
+ PKER_SDRYG( 21, 61) = 0.548037E-01
+ PKER_SDRYG( 21, 62) = 0.577875E-01
+ PKER_SDRYG( 21, 63) = 0.607451E-01
+ PKER_SDRYG( 21, 64) = 0.636436E-01
+ PKER_SDRYG( 21, 65) = 0.664592E-01
+ PKER_SDRYG( 21, 66) = 0.691751E-01
+ PKER_SDRYG( 21, 67) = 0.717806E-01
+ PKER_SDRYG( 21, 68) = 0.742731E-01
+ PKER_SDRYG( 21, 69) = 0.766406E-01
+ PKER_SDRYG( 21, 70) = 0.788820E-01
+ PKER_SDRYG( 21, 71) = 0.809983E-01
+ PKER_SDRYG( 21, 72) = 0.829967E-01
+ PKER_SDRYG( 21, 73) = 0.848837E-01
+ PKER_SDRYG( 21, 74) = 0.866675E-01
+ PKER_SDRYG( 21, 75) = 0.883526E-01
+ PKER_SDRYG( 21, 76) = 0.899415E-01
+ PKER_SDRYG( 21, 77) = 0.914371E-01
+ PKER_SDRYG( 21, 78) = 0.928426E-01
+ PKER_SDRYG( 21, 79) = 0.941625E-01
+ PKER_SDRYG( 21, 80) = 0.954017E-01
+ PKER_SDRYG( 22, 1) = 0.316565E+01
+ PKER_SDRYG( 22, 2) = 0.296928E+01
+ PKER_SDRYG( 22, 3) = 0.278490E+01
+ PKER_SDRYG( 22, 4) = 0.261176E+01
+ PKER_SDRYG( 22, 5) = 0.244918E+01
+ PKER_SDRYG( 22, 6) = 0.229652E+01
+ PKER_SDRYG( 22, 7) = 0.215318E+01
+ PKER_SDRYG( 22, 8) = 0.201857E+01
+ PKER_SDRYG( 22, 9) = 0.189218E+01
+ PKER_SDRYG( 22, 10) = 0.177349E+01
+ PKER_SDRYG( 22, 11) = 0.166204E+01
+ PKER_SDRYG( 22, 12) = 0.155739E+01
+ PKER_SDRYG( 22, 13) = 0.145911E+01
+ PKER_SDRYG( 22, 14) = 0.136682E+01
+ PKER_SDRYG( 22, 15) = 0.128015E+01
+ PKER_SDRYG( 22, 16) = 0.119875E+01
+ PKER_SDRYG( 22, 17) = 0.112230E+01
+ PKER_SDRYG( 22, 18) = 0.105050E+01
+ PKER_SDRYG( 22, 19) = 0.983055E+00
+ PKER_SDRYG( 22, 20) = 0.919694E+00
+ PKER_SDRYG( 22, 21) = 0.860163E+00
+ PKER_SDRYG( 22, 22) = 0.804221E+00
+ PKER_SDRYG( 22, 23) = 0.751638E+00
+ PKER_SDRYG( 22, 24) = 0.702199E+00
+ PKER_SDRYG( 22, 25) = 0.655696E+00
+ PKER_SDRYG( 22, 26) = 0.611933E+00
+ PKER_SDRYG( 22, 27) = 0.570720E+00
+ PKER_SDRYG( 22, 28) = 0.531876E+00
+ PKER_SDRYG( 22, 29) = 0.495222E+00
+ PKER_SDRYG( 22, 30) = 0.460585E+00
+ PKER_SDRYG( 22, 31) = 0.427793E+00
+ PKER_SDRYG( 22, 32) = 0.396676E+00
+ PKER_SDRYG( 22, 33) = 0.367065E+00
+ PKER_SDRYG( 22, 34) = 0.338793E+00
+ PKER_SDRYG( 22, 35) = 0.311700E+00
+ PKER_SDRYG( 22, 36) = 0.285643E+00
+ PKER_SDRYG( 22, 37) = 0.260506E+00
+ PKER_SDRYG( 22, 38) = 0.236218E+00
+ PKER_SDRYG( 22, 39) = 0.212773E+00
+ PKER_SDRYG( 22, 40) = 0.190240E+00
+ PKER_SDRYG( 22, 41) = 0.168759E+00
+ PKER_SDRYG( 22, 42) = 0.148523E+00
+ PKER_SDRYG( 22, 43) = 0.129738E+00
+ PKER_SDRYG( 22, 44) = 0.112583E+00
+ PKER_SDRYG( 22, 45) = 0.971811E-01
+ PKER_SDRYG( 22, 46) = 0.835936E-01
+ PKER_SDRYG( 22, 47) = 0.718231E-01
+ PKER_SDRYG( 22, 48) = 0.618072E-01
+ PKER_SDRYG( 22, 49) = 0.534898E-01
+ PKER_SDRYG( 22, 50) = 0.467624E-01
+ PKER_SDRYG( 22, 51) = 0.414860E-01
+ PKER_SDRYG( 22, 52) = 0.375763E-01
+ PKER_SDRYG( 22, 53) = 0.348805E-01
+ PKER_SDRYG( 22, 54) = 0.332667E-01
+ PKER_SDRYG( 22, 55) = 0.325688E-01
+ PKER_SDRYG( 22, 56) = 0.326954E-01
+ PKER_SDRYG( 22, 57) = 0.334646E-01
+ PKER_SDRYG( 22, 58) = 0.347486E-01
+ PKER_SDRYG( 22, 59) = 0.364906E-01
+ PKER_SDRYG( 22, 60) = 0.385370E-01
+ PKER_SDRYG( 22, 61) = 0.408038E-01
+ PKER_SDRYG( 22, 62) = 0.432264E-01
+ PKER_SDRYG( 22, 63) = 0.457437E-01
+ PKER_SDRYG( 22, 64) = 0.482800E-01
+ PKER_SDRYG( 22, 65) = 0.508227E-01
+ PKER_SDRYG( 22, 66) = 0.533231E-01
+ PKER_SDRYG( 22, 67) = 0.557593E-01
+ PKER_SDRYG( 22, 68) = 0.581222E-01
+ PKER_SDRYG( 22, 69) = 0.603926E-01
+ PKER_SDRYG( 22, 70) = 0.625678E-01
+ PKER_SDRYG( 22, 71) = 0.646420E-01
+ PKER_SDRYG( 22, 72) = 0.666097E-01
+ PKER_SDRYG( 22, 73) = 0.684688E-01
+ PKER_SDRYG( 22, 74) = 0.702238E-01
+ PKER_SDRYG( 22, 75) = 0.718811E-01
+ PKER_SDRYG( 22, 76) = 0.734478E-01
+ PKER_SDRYG( 22, 77) = 0.749287E-01
+ PKER_SDRYG( 22, 78) = 0.763265E-01
+ PKER_SDRYG( 22, 79) = 0.776433E-01
+ PKER_SDRYG( 22, 80) = 0.788817E-01
+ PKER_SDRYG( 23, 1) = 0.317324E+01
+ PKER_SDRYG( 23, 2) = 0.297688E+01
+ PKER_SDRYG( 23, 3) = 0.279249E+01
+ PKER_SDRYG( 23, 4) = 0.261935E+01
+ PKER_SDRYG( 23, 5) = 0.245678E+01
+ PKER_SDRYG( 23, 6) = 0.230412E+01
+ PKER_SDRYG( 23, 7) = 0.216078E+01
+ PKER_SDRYG( 23, 8) = 0.202618E+01
+ PKER_SDRYG( 23, 9) = 0.189979E+01
+ PKER_SDRYG( 23, 10) = 0.178111E+01
+ PKER_SDRYG( 23, 11) = 0.166966E+01
+ PKER_SDRYG( 23, 12) = 0.156501E+01
+ PKER_SDRYG( 23, 13) = 0.146674E+01
+ PKER_SDRYG( 23, 14) = 0.137446E+01
+ PKER_SDRYG( 23, 15) = 0.128780E+01
+ PKER_SDRYG( 23, 16) = 0.120642E+01
+ PKER_SDRYG( 23, 17) = 0.112999E+01
+ PKER_SDRYG( 23, 18) = 0.105821E+01
+ PKER_SDRYG( 23, 19) = 0.990793E+00
+ PKER_SDRYG( 23, 20) = 0.927466E+00
+ PKER_SDRYG( 23, 21) = 0.867975E+00
+ PKER_SDRYG( 23, 22) = 0.812081E+00
+ PKER_SDRYG( 23, 23) = 0.759559E+00
+ PKER_SDRYG( 23, 24) = 0.710192E+00
+ PKER_SDRYG( 23, 25) = 0.663779E+00
+ PKER_SDRYG( 23, 26) = 0.620126E+00
+ PKER_SDRYG( 23, 27) = 0.579048E+00
+ PKER_SDRYG( 23, 28) = 0.540370E+00
+ PKER_SDRYG( 23, 29) = 0.503920E+00
+ PKER_SDRYG( 23, 30) = 0.469534E+00
+ PKER_SDRYG( 23, 31) = 0.437049E+00
+ PKER_SDRYG( 23, 32) = 0.406307E+00
+ PKER_SDRYG( 23, 33) = 0.377150E+00
+ PKER_SDRYG( 23, 34) = 0.349422E+00
+ PKER_SDRYG( 23, 35) = 0.322971E+00
+ PKER_SDRYG( 23, 36) = 0.297649E+00
+ PKER_SDRYG( 23, 37) = 0.273324E+00
+ PKER_SDRYG( 23, 38) = 0.249890E+00
+ PKER_SDRYG( 23, 39) = 0.227278E+00
+ PKER_SDRYG( 23, 40) = 0.205477E+00
+ PKER_SDRYG( 23, 41) = 0.184540E+00
+ PKER_SDRYG( 23, 42) = 0.164581E+00
+ PKER_SDRYG( 23, 43) = 0.145753E+00
+ PKER_SDRYG( 23, 44) = 0.128220E+00
+ PKER_SDRYG( 23, 45) = 0.112118E+00
+ PKER_SDRYG( 23, 46) = 0.975291E-01
+ PKER_SDRYG( 23, 47) = 0.844965E-01
+ PKER_SDRYG( 23, 48) = 0.730043E-01
+ PKER_SDRYG( 23, 49) = 0.629937E-01
+ PKER_SDRYG( 23, 50) = 0.544338E-01
+ PKER_SDRYG( 23, 51) = 0.472364E-01
+ PKER_SDRYG( 23, 52) = 0.413003E-01
+ PKER_SDRYG( 23, 53) = 0.366010E-01
+ PKER_SDRYG( 23, 54) = 0.330232E-01
+ PKER_SDRYG( 23, 55) = 0.304152E-01
+ PKER_SDRYG( 23, 56) = 0.287909E-01
+ PKER_SDRYG( 23, 57) = 0.279201E-01
+ PKER_SDRYG( 23, 58) = 0.277828E-01
+ PKER_SDRYG( 23, 59) = 0.282422E-01
+ PKER_SDRYG( 23, 60) = 0.291874E-01
+ PKER_SDRYG( 23, 61) = 0.305223E-01
+ PKER_SDRYG( 23, 62) = 0.321561E-01
+ PKER_SDRYG( 23, 63) = 0.340230E-01
+ PKER_SDRYG( 23, 64) = 0.360382E-01
+ PKER_SDRYG( 23, 65) = 0.381505E-01
+ PKER_SDRYG( 23, 66) = 0.403137E-01
+ PKER_SDRYG( 23, 67) = 0.424862E-01
+ PKER_SDRYG( 23, 68) = 0.446395E-01
+ PKER_SDRYG( 23, 69) = 0.467491E-01
+ PKER_SDRYG( 23, 70) = 0.487982E-01
+ PKER_SDRYG( 23, 71) = 0.507757E-01
+ PKER_SDRYG( 23, 72) = 0.526730E-01
+ PKER_SDRYG( 23, 73) = 0.544887E-01
+ PKER_SDRYG( 23, 74) = 0.562135E-01
+ PKER_SDRYG( 23, 75) = 0.578463E-01
+ PKER_SDRYG( 23, 76) = 0.593889E-01
+ PKER_SDRYG( 23, 77) = 0.608458E-01
+ PKER_SDRYG( 23, 78) = 0.622217E-01
+ PKER_SDRYG( 23, 79) = 0.635229E-01
+ PKER_SDRYG( 23, 80) = 0.647520E-01
+ PKER_SDRYG( 24, 1) = 0.317974E+01
+ PKER_SDRYG( 24, 2) = 0.298337E+01
+ PKER_SDRYG( 24, 3) = 0.279898E+01
+ PKER_SDRYG( 24, 4) = 0.262585E+01
+ PKER_SDRYG( 24, 5) = 0.246328E+01
+ PKER_SDRYG( 24, 6) = 0.231062E+01
+ PKER_SDRYG( 24, 7) = 0.216728E+01
+ PKER_SDRYG( 24, 8) = 0.203268E+01
+ PKER_SDRYG( 24, 9) = 0.190630E+01
+ PKER_SDRYG( 24, 10) = 0.178762E+01
+ PKER_SDRYG( 24, 11) = 0.167618E+01
+ PKER_SDRYG( 24, 12) = 0.157153E+01
+ PKER_SDRYG( 24, 13) = 0.147327E+01
+ PKER_SDRYG( 24, 14) = 0.138100E+01
+ PKER_SDRYG( 24, 15) = 0.129435E+01
+ PKER_SDRYG( 24, 16) = 0.121298E+01
+ PKER_SDRYG( 24, 17) = 0.113656E+01
+ PKER_SDRYG( 24, 18) = 0.106480E+01
+ PKER_SDRYG( 24, 19) = 0.997399E+00
+ PKER_SDRYG( 24, 20) = 0.934096E+00
+ PKER_SDRYG( 24, 21) = 0.874634E+00
+ PKER_SDRYG( 24, 22) = 0.818777E+00
+ PKER_SDRYG( 24, 23) = 0.766298E+00
+ PKER_SDRYG( 24, 24) = 0.716985E+00
+ PKER_SDRYG( 24, 25) = 0.670637E+00
+ PKER_SDRYG( 24, 26) = 0.627064E+00
+ PKER_SDRYG( 24, 27) = 0.586085E+00
+ PKER_SDRYG( 24, 28) = 0.547527E+00
+ PKER_SDRYG( 24, 29) = 0.511226E+00
+ PKER_SDRYG( 24, 30) = 0.477021E+00
+ PKER_SDRYG( 24, 31) = 0.444759E+00
+ PKER_SDRYG( 24, 32) = 0.414290E+00
+ PKER_SDRYG( 24, 33) = 0.385466E+00
+ PKER_SDRYG( 24, 34) = 0.358141E+00
+ PKER_SDRYG( 24, 35) = 0.332171E+00
+ PKER_SDRYG( 24, 36) = 0.307415E+00
+ PKER_SDRYG( 24, 37) = 0.283739E+00
+ PKER_SDRYG( 24, 38) = 0.261021E+00
+ PKER_SDRYG( 24, 39) = 0.239161E+00
+ PKER_SDRYG( 24, 40) = 0.218098E+00
+ PKER_SDRYG( 24, 41) = 0.197816E+00
+ PKER_SDRYG( 24, 42) = 0.178358E+00
+ PKER_SDRYG( 24, 43) = 0.159817E+00
+ PKER_SDRYG( 24, 44) = 0.142322E+00
+ PKER_SDRYG( 24, 45) = 0.126004E+00
+ PKER_SDRYG( 24, 46) = 0.110966E+00
+ PKER_SDRYG( 24, 47) = 0.972696E-01
+ PKER_SDRYG( 24, 48) = 0.849240E-01
+ PKER_SDRYG( 24, 49) = 0.739011E-01
+ PKER_SDRYG( 24, 50) = 0.641503E-01
+ PKER_SDRYG( 24, 51) = 0.556168E-01
+ PKER_SDRYG( 24, 52) = 0.482410E-01
+ PKER_SDRYG( 24, 53) = 0.419558E-01
+ PKER_SDRYG( 24, 54) = 0.367232E-01
+ PKER_SDRYG( 24, 55) = 0.324850E-01
+ PKER_SDRYG( 24, 56) = 0.291562E-01
+ PKER_SDRYG( 24, 57) = 0.266947E-01
+ PKER_SDRYG( 24, 58) = 0.250249E-01
+ PKER_SDRYG( 24, 59) = 0.240671E-01
+ PKER_SDRYG( 24, 60) = 0.237119E-01
+ PKER_SDRYG( 24, 61) = 0.239149E-01
+ PKER_SDRYG( 24, 62) = 0.245541E-01
+ PKER_SDRYG( 24, 63) = 0.255388E-01
+ PKER_SDRYG( 24, 64) = 0.268448E-01
+ PKER_SDRYG( 24, 65) = 0.283592E-01
+ PKER_SDRYG( 24, 66) = 0.300237E-01
+ PKER_SDRYG( 24, 67) = 0.317974E-01
+ PKER_SDRYG( 24, 68) = 0.336350E-01
+ PKER_SDRYG( 24, 69) = 0.354861E-01
+ PKER_SDRYG( 24, 70) = 0.373396E-01
+ PKER_SDRYG( 24, 71) = 0.391617E-01
+ PKER_SDRYG( 24, 72) = 0.409381E-01
+ PKER_SDRYG( 24, 73) = 0.426598E-01
+ PKER_SDRYG( 24, 74) = 0.443148E-01
+ PKER_SDRYG( 24, 75) = 0.459007E-01
+ PKER_SDRYG( 24, 76) = 0.474126E-01
+ PKER_SDRYG( 24, 77) = 0.488471E-01
+ PKER_SDRYG( 24, 78) = 0.502027E-01
+ PKER_SDRYG( 24, 79) = 0.514825E-01
+ PKER_SDRYG( 24, 80) = 0.526915E-01
+ PKER_SDRYG( 25, 1) = 0.318529E+01
+ PKER_SDRYG( 25, 2) = 0.298893E+01
+ PKER_SDRYG( 25, 3) = 0.280454E+01
+ PKER_SDRYG( 25, 4) = 0.263141E+01
+ PKER_SDRYG( 25, 5) = 0.246884E+01
+ PKER_SDRYG( 25, 6) = 0.231618E+01
+ PKER_SDRYG( 25, 7) = 0.217284E+01
+ PKER_SDRYG( 25, 8) = 0.203825E+01
+ PKER_SDRYG( 25, 9) = 0.191186E+01
+ PKER_SDRYG( 25, 10) = 0.179319E+01
+ PKER_SDRYG( 25, 11) = 0.168175E+01
+ PKER_SDRYG( 25, 12) = 0.157711E+01
+ PKER_SDRYG( 25, 13) = 0.147885E+01
+ PKER_SDRYG( 25, 14) = 0.138659E+01
+ PKER_SDRYG( 25, 15) = 0.129994E+01
+ PKER_SDRYG( 25, 16) = 0.121858E+01
+ PKER_SDRYG( 25, 17) = 0.114218E+01
+ PKER_SDRYG( 25, 18) = 0.107042E+01
+ PKER_SDRYG( 25, 19) = 0.100304E+01
+ PKER_SDRYG( 25, 20) = 0.939754E+00
+ PKER_SDRYG( 25, 21) = 0.880315E+00
+ PKER_SDRYG( 25, 22) = 0.824484E+00
+ PKER_SDRYG( 25, 23) = 0.772038E+00
+ PKER_SDRYG( 25, 24) = 0.722764E+00
+ PKER_SDRYG( 25, 25) = 0.676465E+00
+ PKER_SDRYG( 25, 26) = 0.632951E+00
+ PKER_SDRYG( 25, 27) = 0.592044E+00
+ PKER_SDRYG( 25, 28) = 0.553574E+00
+ PKER_SDRYG( 25, 29) = 0.517380E+00
+ PKER_SDRYG( 25, 30) = 0.483308E+00
+ PKER_SDRYG( 25, 31) = 0.451208E+00
+ PKER_SDRYG( 25, 32) = 0.420937E+00
+ PKER_SDRYG( 25, 33) = 0.392356E+00
+ PKER_SDRYG( 25, 34) = 0.365326E+00
+ PKER_SDRYG( 25, 35) = 0.339713E+00
+ PKER_SDRYG( 25, 36) = 0.315384E+00
+ PKER_SDRYG( 25, 37) = 0.292209E+00
+ PKER_SDRYG( 25, 38) = 0.270064E+00
+ PKER_SDRYG( 25, 39) = 0.248837E+00
+ PKER_SDRYG( 25, 40) = 0.228437E+00
+ PKER_SDRYG( 25, 41) = 0.208804E+00
+ PKER_SDRYG( 25, 42) = 0.189923E+00
+ PKER_SDRYG( 25, 43) = 0.171829E+00
+ PKER_SDRYG( 25, 44) = 0.154601E+00
+ PKER_SDRYG( 25, 45) = 0.138347E+00
+ PKER_SDRYG( 25, 46) = 0.123178E+00
+ PKER_SDRYG( 25, 47) = 0.109173E+00
+ PKER_SDRYG( 25, 48) = 0.963727E-01
+ PKER_SDRYG( 25, 49) = 0.847717E-01
+ PKER_SDRYG( 25, 50) = 0.743296E-01
+ PKER_SDRYG( 25, 51) = 0.649850E-01
+ PKER_SDRYG( 25, 52) = 0.566822E-01
+ PKER_SDRYG( 25, 53) = 0.493595E-01
+ PKER_SDRYG( 25, 54) = 0.429562E-01
+ PKER_SDRYG( 25, 55) = 0.374539E-01
+ PKER_SDRYG( 25, 56) = 0.328017E-01
+ PKER_SDRYG( 25, 57) = 0.289442E-01
+ PKER_SDRYG( 25, 58) = 0.258795E-01
+ PKER_SDRYG( 25, 59) = 0.235524E-01
+ PKER_SDRYG( 25, 60) = 0.218674E-01
+ PKER_SDRYG( 25, 61) = 0.208371E-01
+ PKER_SDRYG( 25, 62) = 0.203194E-01
+ PKER_SDRYG( 25, 63) = 0.203049E-01
+ PKER_SDRYG( 25, 64) = 0.206977E-01
+ PKER_SDRYG( 25, 65) = 0.214318E-01
+ PKER_SDRYG( 25, 66) = 0.224335E-01
+ PKER_SDRYG( 25, 67) = 0.236433E-01
+ PKER_SDRYG( 25, 68) = 0.250200E-01
+ PKER_SDRYG( 25, 69) = 0.264977E-01
+ PKER_SDRYG( 25, 70) = 0.280428E-01
+ PKER_SDRYG( 25, 71) = 0.296240E-01
+ PKER_SDRYG( 25, 72) = 0.312105E-01
+ PKER_SDRYG( 25, 73) = 0.327816E-01
+ PKER_SDRYG( 25, 74) = 0.343205E-01
+ PKER_SDRYG( 25, 75) = 0.358148E-01
+ PKER_SDRYG( 25, 76) = 0.372575E-01
+ PKER_SDRYG( 25, 77) = 0.386413E-01
+ PKER_SDRYG( 25, 78) = 0.399659E-01
+ PKER_SDRYG( 25, 79) = 0.412241E-01
+ PKER_SDRYG( 25, 80) = 0.424150E-01
+ PKER_SDRYG( 26, 1) = 0.319005E+01
+ PKER_SDRYG( 26, 2) = 0.299368E+01
+ PKER_SDRYG( 26, 3) = 0.280930E+01
+ PKER_SDRYG( 26, 4) = 0.263616E+01
+ PKER_SDRYG( 26, 5) = 0.247359E+01
+ PKER_SDRYG( 26, 6) = 0.232094E+01
+ PKER_SDRYG( 26, 7) = 0.217760E+01
+ PKER_SDRYG( 26, 8) = 0.204301E+01
+ PKER_SDRYG( 26, 9) = 0.191663E+01
+ PKER_SDRYG( 26, 10) = 0.179795E+01
+ PKER_SDRYG( 26, 11) = 0.168652E+01
+ PKER_SDRYG( 26, 12) = 0.158188E+01
+ PKER_SDRYG( 26, 13) = 0.148363E+01
+ PKER_SDRYG( 26, 14) = 0.139136E+01
+ PKER_SDRYG( 26, 15) = 0.130473E+01
+ PKER_SDRYG( 26, 16) = 0.122337E+01
+ PKER_SDRYG( 26, 17) = 0.114697E+01
+ PKER_SDRYG( 26, 18) = 0.107523E+01
+ PKER_SDRYG( 26, 19) = 0.100786E+01
+ PKER_SDRYG( 26, 20) = 0.944586E+00
+ PKER_SDRYG( 26, 21) = 0.885163E+00
+ PKER_SDRYG( 26, 22) = 0.829352E+00
+ PKER_SDRYG( 26, 23) = 0.776930E+00
+ PKER_SDRYG( 26, 24) = 0.727686E+00
+ PKER_SDRYG( 26, 25) = 0.681422E+00
+ PKER_SDRYG( 26, 26) = 0.637952E+00
+ PKER_SDRYG( 26, 27) = 0.597097E+00
+ PKER_SDRYG( 26, 28) = 0.558692E+00
+ PKER_SDRYG( 26, 29) = 0.522578E+00
+ PKER_SDRYG( 26, 30) = 0.488602E+00
+ PKER_SDRYG( 26, 31) = 0.456621E+00
+ PKER_SDRYG( 26, 32) = 0.426495E+00
+ PKER_SDRYG( 26, 33) = 0.398091E+00
+ PKER_SDRYG( 26, 34) = 0.371278E+00
+ PKER_SDRYG( 26, 35) = 0.345928E+00
+ PKER_SDRYG( 26, 36) = 0.321917E+00
+ PKER_SDRYG( 26, 37) = 0.299121E+00
+ PKER_SDRYG( 26, 38) = 0.277419E+00
+ PKER_SDRYG( 26, 39) = 0.256699E+00
+ PKER_SDRYG( 26, 40) = 0.236857E+00
+ PKER_SDRYG( 26, 41) = 0.217808E+00
+ PKER_SDRYG( 26, 42) = 0.199498E+00
+ PKER_SDRYG( 26, 43) = 0.181910E+00
+ PKER_SDRYG( 26, 44) = 0.165073E+00
+ PKER_SDRYG( 26, 45) = 0.149056E+00
+ PKER_SDRYG( 26, 46) = 0.133952E+00
+ PKER_SDRYG( 26, 47) = 0.119852E+00
+ PKER_SDRYG( 26, 48) = 0.106824E+00
+ PKER_SDRYG( 26, 49) = 0.948930E-01
+ PKER_SDRYG( 26, 50) = 0.840437E-01
+ PKER_SDRYG( 26, 51) = 0.742268E-01
+ PKER_SDRYG( 26, 52) = 0.653792E-01
+ PKER_SDRYG( 26, 53) = 0.574320E-01
+ PKER_SDRYG( 26, 54) = 0.503214E-01
+ PKER_SDRYG( 26, 55) = 0.439973E-01
+ PKER_SDRYG( 26, 56) = 0.384248E-01
+ PKER_SDRYG( 26, 57) = 0.335714E-01
+ PKER_SDRYG( 26, 58) = 0.294087E-01
+ PKER_SDRYG( 26, 59) = 0.259221E-01
+ PKER_SDRYG( 26, 60) = 0.230931E-01
+ PKER_SDRYG( 26, 61) = 0.208678E-01
+ PKER_SDRYG( 26, 62) = 0.192226E-01
+ PKER_SDRYG( 26, 63) = 0.181215E-01
+ PKER_SDRYG( 26, 64) = 0.175118E-01
+ PKER_SDRYG( 26, 65) = 0.173173E-01
+ PKER_SDRYG( 26, 66) = 0.175126E-01
+ PKER_SDRYG( 26, 67) = 0.180143E-01
+ PKER_SDRYG( 26, 68) = 0.187588E-01
+ PKER_SDRYG( 26, 69) = 0.197277E-01
+ PKER_SDRYG( 26, 70) = 0.208458E-01
+ PKER_SDRYG( 26, 71) = 0.220691E-01
+ PKER_SDRYG( 26, 72) = 0.233679E-01
+ PKER_SDRYG( 26, 73) = 0.247120E-01
+ PKER_SDRYG( 26, 74) = 0.260656E-01
+ PKER_SDRYG( 26, 75) = 0.274186E-01
+ PKER_SDRYG( 26, 76) = 0.287488E-01
+ PKER_SDRYG( 26, 77) = 0.300462E-01
+ PKER_SDRYG( 26, 78) = 0.313023E-01
+ PKER_SDRYG( 26, 79) = 0.325101E-01
+ PKER_SDRYG( 26, 80) = 0.336677E-01
+ PKER_SDRYG( 27, 1) = 0.319411E+01
+ PKER_SDRYG( 27, 2) = 0.299775E+01
+ PKER_SDRYG( 27, 3) = 0.281337E+01
+ PKER_SDRYG( 27, 4) = 0.264023E+01
+ PKER_SDRYG( 27, 5) = 0.247766E+01
+ PKER_SDRYG( 27, 6) = 0.232501E+01
+ PKER_SDRYG( 27, 7) = 0.218167E+01
+ PKER_SDRYG( 27, 8) = 0.204708E+01
+ PKER_SDRYG( 27, 9) = 0.192070E+01
+ PKER_SDRYG( 27, 10) = 0.180203E+01
+ PKER_SDRYG( 27, 11) = 0.169060E+01
+ PKER_SDRYG( 27, 12) = 0.158596E+01
+ PKER_SDRYG( 27, 13) = 0.148771E+01
+ PKER_SDRYG( 27, 14) = 0.139545E+01
+ PKER_SDRYG( 27, 15) = 0.130882E+01
+ PKER_SDRYG( 27, 16) = 0.122746E+01
+ PKER_SDRYG( 27, 17) = 0.115107E+01
+ PKER_SDRYG( 27, 18) = 0.107934E+01
+ PKER_SDRYG( 27, 19) = 0.101197E+01
+ PKER_SDRYG( 27, 20) = 0.948712E+00
+ PKER_SDRYG( 27, 21) = 0.889302E+00
+ PKER_SDRYG( 27, 22) = 0.833506E+00
+ PKER_SDRYG( 27, 23) = 0.781102E+00
+ PKER_SDRYG( 27, 24) = 0.731880E+00
+ PKER_SDRYG( 27, 25) = 0.685643E+00
+ PKER_SDRYG( 27, 26) = 0.642205E+00
+ PKER_SDRYG( 27, 27) = 0.601390E+00
+ PKER_SDRYG( 27, 28) = 0.563032E+00
+ PKER_SDRYG( 27, 29) = 0.526976E+00
+ PKER_SDRYG( 27, 30) = 0.493071E+00
+ PKER_SDRYG( 27, 31) = 0.461177E+00
+ PKER_SDRYG( 27, 32) = 0.431158E+00
+ PKER_SDRYG( 27, 33) = 0.402883E+00
+ PKER_SDRYG( 27, 34) = 0.376229E+00
+ PKER_SDRYG( 27, 35) = 0.351073E+00
+ PKER_SDRYG( 27, 36) = 0.327297E+00
+ PKER_SDRYG( 27, 37) = 0.304783E+00
+ PKER_SDRYG( 27, 38) = 0.283419E+00
+ PKER_SDRYG( 27, 39) = 0.263094E+00
+ PKER_SDRYG( 27, 40) = 0.243701E+00
+ PKER_SDRYG( 27, 41) = 0.225146E+00
+ PKER_SDRYG( 27, 42) = 0.207352E+00
+ PKER_SDRYG( 27, 43) = 0.190265E+00
+ PKER_SDRYG( 27, 44) = 0.173872E+00
+ PKER_SDRYG( 27, 45) = 0.158194E+00
+ PKER_SDRYG( 27, 46) = 0.143292E+00
+ PKER_SDRYG( 27, 47) = 0.129246E+00
+ PKER_SDRYG( 27, 48) = 0.116137E+00
+ PKER_SDRYG( 27, 49) = 0.104019E+00
+ PKER_SDRYG( 27, 50) = 0.929097E-01
+ PKER_SDRYG( 27, 51) = 0.827874E-01
+ PKER_SDRYG( 27, 52) = 0.735998E-01
+ PKER_SDRYG( 27, 53) = 0.652790E-01
+ PKER_SDRYG( 27, 54) = 0.577537E-01
+ PKER_SDRYG( 27, 55) = 0.509584E-01
+ PKER_SDRYG( 27, 56) = 0.448376E-01
+ PKER_SDRYG( 27, 57) = 0.393546E-01
+ PKER_SDRYG( 27, 58) = 0.344768E-01
+ PKER_SDRYG( 27, 59) = 0.301795E-01
+ PKER_SDRYG( 27, 60) = 0.264605E-01
+ PKER_SDRYG( 27, 61) = 0.233008E-01
+ PKER_SDRYG( 27, 62) = 0.206714E-01
+ PKER_SDRYG( 27, 63) = 0.185744E-01
+ PKER_SDRYG( 27, 64) = 0.169884E-01
+ PKER_SDRYG( 27, 65) = 0.158478E-01
+ PKER_SDRYG( 27, 66) = 0.151582E-01
+ PKER_SDRYG( 27, 67) = 0.148323E-01
+ PKER_SDRYG( 27, 68) = 0.148592E-01
+ PKER_SDRYG( 27, 69) = 0.151721E-01
+ PKER_SDRYG( 27, 70) = 0.157308E-01
+ PKER_SDRYG( 27, 71) = 0.164769E-01
+ PKER_SDRYG( 27, 72) = 0.173707E-01
+ PKER_SDRYG( 27, 73) = 0.183846E-01
+ PKER_SDRYG( 27, 74) = 0.194688E-01
+ PKER_SDRYG( 27, 75) = 0.206001E-01
+ PKER_SDRYG( 27, 76) = 0.217573E-01
+ PKER_SDRYG( 27, 77) = 0.229174E-01
+ PKER_SDRYG( 27, 78) = 0.240651E-01
+ PKER_SDRYG( 27, 79) = 0.251891E-01
+ PKER_SDRYG( 27, 80) = 0.262800E-01
+ PKER_SDRYG( 28, 1) = 0.319759E+01
+ PKER_SDRYG( 28, 2) = 0.300123E+01
+ PKER_SDRYG( 28, 3) = 0.281685E+01
+ PKER_SDRYG( 28, 4) = 0.264371E+01
+ PKER_SDRYG( 28, 5) = 0.248114E+01
+ PKER_SDRYG( 28, 6) = 0.232849E+01
+ PKER_SDRYG( 28, 7) = 0.218516E+01
+ PKER_SDRYG( 28, 8) = 0.205056E+01
+ PKER_SDRYG( 28, 9) = 0.192418E+01
+ PKER_SDRYG( 28, 10) = 0.180551E+01
+ PKER_SDRYG( 28, 11) = 0.169408E+01
+ PKER_SDRYG( 28, 12) = 0.158945E+01
+ PKER_SDRYG( 28, 13) = 0.149120E+01
+ PKER_SDRYG( 28, 14) = 0.139894E+01
+ PKER_SDRYG( 28, 15) = 0.131231E+01
+ PKER_SDRYG( 28, 16) = 0.123097E+01
+ PKER_SDRYG( 28, 17) = 0.115458E+01
+ PKER_SDRYG( 28, 18) = 0.108285E+01
+ PKER_SDRYG( 28, 19) = 0.101549E+01
+ PKER_SDRYG( 28, 20) = 0.952238E+00
+ PKER_SDRYG( 28, 21) = 0.892837E+00
+ PKER_SDRYG( 28, 22) = 0.837052E+00
+ PKER_SDRYG( 28, 23) = 0.784662E+00
+ PKER_SDRYG( 28, 24) = 0.735456E+00
+ PKER_SDRYG( 28, 25) = 0.689239E+00
+ PKER_SDRYG( 28, 26) = 0.645825E+00
+ PKER_SDRYG( 28, 27) = 0.605039E+00
+ PKER_SDRYG( 28, 28) = 0.566718E+00
+ PKER_SDRYG( 28, 29) = 0.530704E+00
+ PKER_SDRYG( 28, 30) = 0.496852E+00
+ PKER_SDRYG( 28, 31) = 0.465022E+00
+ PKER_SDRYG( 28, 32) = 0.435081E+00
+ PKER_SDRYG( 28, 33) = 0.406902E+00
+ PKER_SDRYG( 28, 34) = 0.380365E+00
+ PKER_SDRYG( 28, 35) = 0.355351E+00
+ PKER_SDRYG( 28, 36) = 0.331748E+00
+ PKER_SDRYG( 28, 37) = 0.309445E+00
+ PKER_SDRYG( 28, 38) = 0.288334E+00
+ PKER_SDRYG( 28, 39) = 0.268309E+00
+ PKER_SDRYG( 28, 40) = 0.249267E+00
+ PKER_SDRYG( 28, 41) = 0.231112E+00
+ PKER_SDRYG( 28, 42) = 0.213755E+00
+ PKER_SDRYG( 28, 43) = 0.197125E+00
+ PKER_SDRYG( 28, 44) = 0.181172E+00
+ PKER_SDRYG( 28, 45) = 0.165882E+00
+ PKER_SDRYG( 28, 46) = 0.151274E+00
+ PKER_SDRYG( 28, 47) = 0.137400E+00
+ PKER_SDRYG( 28, 48) = 0.124331E+00
+ PKER_SDRYG( 28, 49) = 0.112135E+00
+ PKER_SDRYG( 28, 50) = 0.100860E+00
+ PKER_SDRYG( 28, 51) = 0.905169E-01
+ PKER_SDRYG( 28, 52) = 0.810815E-01
+ PKER_SDRYG( 28, 53) = 0.725012E-01
+ PKER_SDRYG( 28, 54) = 0.647084E-01
+ PKER_SDRYG( 28, 55) = 0.576308E-01
+ PKER_SDRYG( 28, 56) = 0.512005E-01
+ PKER_SDRYG( 28, 57) = 0.453625E-01
+ PKER_SDRYG( 28, 58) = 0.400717E-01
+ PKER_SDRYG( 28, 59) = 0.352935E-01
+ PKER_SDRYG( 28, 60) = 0.310071E-01
+ PKER_SDRYG( 28, 61) = 0.272018E-01
+ PKER_SDRYG( 28, 62) = 0.238669E-01
+ PKER_SDRYG( 28, 63) = 0.209938E-01
+ PKER_SDRYG( 28, 64) = 0.185775E-01
+ PKER_SDRYG( 28, 65) = 0.166174E-01
+ PKER_SDRYG( 28, 66) = 0.150755E-01
+ PKER_SDRYG( 28, 67) = 0.139364E-01
+ PKER_SDRYG( 28, 68) = 0.131851E-01
+ PKER_SDRYG( 28, 69) = 0.127769E-01
+ PKER_SDRYG( 28, 70) = 0.126668E-01
+ PKER_SDRYG( 28, 71) = 0.128310E-01
+ PKER_SDRYG( 28, 72) = 0.132148E-01
+ PKER_SDRYG( 28, 73) = 0.137746E-01
+ PKER_SDRYG( 28, 74) = 0.144895E-01
+ PKER_SDRYG( 28, 75) = 0.153140E-01
+ PKER_SDRYG( 28, 76) = 0.162131E-01
+ PKER_SDRYG( 28, 77) = 0.171648E-01
+ PKER_SDRYG( 28, 78) = 0.181488E-01
+ PKER_SDRYG( 28, 79) = 0.191394E-01
+ PKER_SDRYG( 28, 80) = 0.201280E-01
+ PKER_SDRYG( 29, 1) = 0.320057E+01
+ PKER_SDRYG( 29, 2) = 0.300421E+01
+ PKER_SDRYG( 29, 3) = 0.281983E+01
+ PKER_SDRYG( 29, 4) = 0.264669E+01
+ PKER_SDRYG( 29, 5) = 0.248412E+01
+ PKER_SDRYG( 29, 6) = 0.233147E+01
+ PKER_SDRYG( 29, 7) = 0.218814E+01
+ PKER_SDRYG( 29, 8) = 0.205355E+01
+ PKER_SDRYG( 29, 9) = 0.192717E+01
+ PKER_SDRYG( 29, 10) = 0.180850E+01
+ PKER_SDRYG( 29, 11) = 0.169707E+01
+ PKER_SDRYG( 29, 12) = 0.159244E+01
+ PKER_SDRYG( 29, 13) = 0.149419E+01
+ PKER_SDRYG( 29, 14) = 0.140193E+01
+ PKER_SDRYG( 29, 15) = 0.131530E+01
+ PKER_SDRYG( 29, 16) = 0.123396E+01
+ PKER_SDRYG( 29, 17) = 0.115758E+01
+ PKER_SDRYG( 29, 18) = 0.108585E+01
+ PKER_SDRYG( 29, 19) = 0.101850E+01
+ PKER_SDRYG( 29, 20) = 0.955250E+00
+ PKER_SDRYG( 29, 21) = 0.895856E+00
+ PKER_SDRYG( 29, 22) = 0.840080E+00
+ PKER_SDRYG( 29, 23) = 0.787700E+00
+ PKER_SDRYG( 29, 24) = 0.738507E+00
+ PKER_SDRYG( 29, 25) = 0.692305E+00
+ PKER_SDRYG( 29, 26) = 0.648909E+00
+ PKER_SDRYG( 29, 27) = 0.608145E+00
+ PKER_SDRYG( 29, 28) = 0.569850E+00
+ PKER_SDRYG( 29, 29) = 0.533869E+00
+ PKER_SDRYG( 29, 30) = 0.500057E+00
+ PKER_SDRYG( 29, 31) = 0.468274E+00
+ PKER_SDRYG( 29, 32) = 0.438391E+00
+ PKER_SDRYG( 29, 33) = 0.410283E+00
+ PKER_SDRYG( 29, 34) = 0.383831E+00
+ PKER_SDRYG( 29, 35) = 0.358922E+00
+ PKER_SDRYG( 29, 36) = 0.335447E+00
+ PKER_SDRYG( 29, 37) = 0.313300E+00
+ PKER_SDRYG( 29, 38) = 0.292377E+00
+ PKER_SDRYG( 29, 39) = 0.272578E+00
+ PKER_SDRYG( 29, 40) = 0.253805E+00
+ PKER_SDRYG( 29, 41) = 0.235964E+00
+ PKER_SDRYG( 29, 42) = 0.218962E+00
+ PKER_SDRYG( 29, 43) = 0.202721E+00
+ PKER_SDRYG( 29, 44) = 0.187172E+00
+ PKER_SDRYG( 29, 45) = 0.172272E+00
+ PKER_SDRYG( 29, 46) = 0.158003E+00
+ PKER_SDRYG( 29, 47) = 0.144383E+00
+ PKER_SDRYG( 29, 48) = 0.131457E+00
+ PKER_SDRYG( 29, 49) = 0.119287E+00
+ PKER_SDRYG( 29, 50) = 0.107934E+00
+ PKER_SDRYG( 29, 51) = 0.974376E-01
+ PKER_SDRYG( 29, 52) = 0.878049E-01
+ PKER_SDRYG( 29, 53) = 0.790110E-01
+ PKER_SDRYG( 29, 54) = 0.710047E-01
+ PKER_SDRYG( 29, 55) = 0.637201E-01
+ PKER_SDRYG( 29, 56) = 0.570871E-01
+ PKER_SDRYG( 29, 57) = 0.510391E-01
+ PKER_SDRYG( 29, 58) = 0.455190E-01
+ PKER_SDRYG( 29, 59) = 0.404790E-01
+ PKER_SDRYG( 29, 60) = 0.358835E-01
+ PKER_SDRYG( 29, 61) = 0.317075E-01
+ PKER_SDRYG( 29, 62) = 0.279360E-01
+ PKER_SDRYG( 29, 63) = 0.245579E-01
+ PKER_SDRYG( 29, 64) = 0.215683E-01
+ PKER_SDRYG( 29, 65) = 0.189675E-01
+ PKER_SDRYG( 29, 66) = 0.167538E-01
+ PKER_SDRYG( 29, 67) = 0.149086E-01
+ PKER_SDRYG( 29, 68) = 0.134333E-01
+ PKER_SDRYG( 29, 69) = 0.123230E-01
+ PKER_SDRYG( 29, 70) = 0.115303E-01
+ PKER_SDRYG( 29, 71) = 0.110545E-01
+ PKER_SDRYG( 29, 72) = 0.108420E-01
+ PKER_SDRYG( 29, 73) = 0.108817E-01
+ PKER_SDRYG( 29, 74) = 0.111244E-01
+ PKER_SDRYG( 29, 75) = 0.115437E-01
+ PKER_SDRYG( 29, 76) = 0.120983E-01
+ PKER_SDRYG( 29, 77) = 0.127573E-01
+ PKER_SDRYG( 29, 78) = 0.135034E-01
+ PKER_SDRYG( 29, 79) = 0.142993E-01
+ PKER_SDRYG( 29, 80) = 0.151279E-01
+ PKER_SDRYG( 30, 1) = 0.320312E+01
+ PKER_SDRYG( 30, 2) = 0.300676E+01
+ PKER_SDRYG( 30, 3) = 0.282237E+01
+ PKER_SDRYG( 30, 4) = 0.264924E+01
+ PKER_SDRYG( 30, 5) = 0.248667E+01
+ PKER_SDRYG( 30, 6) = 0.233402E+01
+ PKER_SDRYG( 30, 7) = 0.219069E+01
+ PKER_SDRYG( 30, 8) = 0.205610E+01
+ PKER_SDRYG( 30, 9) = 0.192972E+01
+ PKER_SDRYG( 30, 10) = 0.181105E+01
+ PKER_SDRYG( 30, 11) = 0.169962E+01
+ PKER_SDRYG( 30, 12) = 0.159499E+01
+ PKER_SDRYG( 30, 13) = 0.149674E+01
+ PKER_SDRYG( 30, 14) = 0.140449E+01
+ PKER_SDRYG( 30, 15) = 0.131786E+01
+ PKER_SDRYG( 30, 16) = 0.123652E+01
+ PKER_SDRYG( 30, 17) = 0.116014E+01
+ PKER_SDRYG( 30, 18) = 0.108842E+01
+ PKER_SDRYG( 30, 19) = 0.102107E+01
+ PKER_SDRYG( 30, 20) = 0.957825E+00
+ PKER_SDRYG( 30, 21) = 0.898436E+00
+ PKER_SDRYG( 30, 22) = 0.842667E+00
+ PKER_SDRYG( 30, 23) = 0.790295E+00
+ PKER_SDRYG( 30, 24) = 0.741111E+00
+ PKER_SDRYG( 30, 25) = 0.694920E+00
+ PKER_SDRYG( 30, 26) = 0.651538E+00
+ PKER_SDRYG( 30, 27) = 0.610791E+00
+ PKER_SDRYG( 30, 28) = 0.572516E+00
+ PKER_SDRYG( 30, 29) = 0.536559E+00
+ PKER_SDRYG( 30, 30) = 0.502776E+00
+ PKER_SDRYG( 30, 31) = 0.471029E+00
+ PKER_SDRYG( 30, 32) = 0.441189E+00
+ PKER_SDRYG( 30, 33) = 0.413133E+00
+ PKER_SDRYG( 30, 34) = 0.386745E+00
+ PKER_SDRYG( 30, 35) = 0.361914E+00
+ PKER_SDRYG( 30, 36) = 0.338534E+00
+ PKER_SDRYG( 30, 37) = 0.316502E+00
+ PKER_SDRYG( 30, 38) = 0.295719E+00
+ PKER_SDRYG( 30, 39) = 0.276089E+00
+ PKER_SDRYG( 30, 40) = 0.257519E+00
+ PKER_SDRYG( 30, 41) = 0.239918E+00
+ PKER_SDRYG( 30, 42) = 0.223197E+00
+ PKER_SDRYG( 30, 43) = 0.207273E+00
+ PKER_SDRYG( 30, 44) = 0.192071E+00
+ PKER_SDRYG( 30, 45) = 0.177528E+00
+ PKER_SDRYG( 30, 46) = 0.163604E+00
+ PKER_SDRYG( 30, 47) = 0.150282E+00
+ PKER_SDRYG( 30, 48) = 0.137575E+00
+ PKER_SDRYG( 30, 49) = 0.125525E+00
+ PKER_SDRYG( 30, 50) = 0.114185E+00
+ PKER_SDRYG( 30, 51) = 0.103610E+00
+ PKER_SDRYG( 30, 52) = 0.938314E-01
+ PKER_SDRYG( 30, 53) = 0.848558E-01
+ PKER_SDRYG( 30, 54) = 0.766574E-01
+ PKER_SDRYG( 30, 55) = 0.691873E-01
+ PKER_SDRYG( 30, 56) = 0.623830E-01
+ PKER_SDRYG( 30, 57) = 0.561775E-01
+ PKER_SDRYG( 30, 58) = 0.505069E-01
+ PKER_SDRYG( 30, 59) = 0.453150E-01
+ PKER_SDRYG( 30, 60) = 0.405539E-01
+ PKER_SDRYG( 30, 61) = 0.361851E-01
+ PKER_SDRYG( 30, 62) = 0.321814E-01
+ PKER_SDRYG( 30, 63) = 0.285232E-01
+ PKER_SDRYG( 30, 64) = 0.251963E-01
+ PKER_SDRYG( 30, 65) = 0.221941E-01
+ PKER_SDRYG( 30, 66) = 0.195174E-01
+ PKER_SDRYG( 30, 67) = 0.171634E-01
+ PKER_SDRYG( 30, 68) = 0.151306E-01
+ PKER_SDRYG( 30, 69) = 0.134200E-01
+ PKER_SDRYG( 30, 70) = 0.120326E-01
+ PKER_SDRYG( 30, 71) = 0.109418E-01
+ PKER_SDRYG( 30, 72) = 0.101394E-01
+ PKER_SDRYG( 30, 73) = 0.961608E-02
+ PKER_SDRYG( 30, 74) = 0.933453E-02
+ PKER_SDRYG( 30, 75) = 0.927173E-02
+ PKER_SDRYG( 30, 76) = 0.940407E-02
+ PKER_SDRYG( 30, 77) = 0.969318E-02
+ PKER_SDRYG( 30, 78) = 0.101124E-01
+ PKER_SDRYG( 30, 79) = 0.106403E-01
+ PKER_SDRYG( 30, 80) = 0.112467E-01
+ PKER_SDRYG( 31, 1) = 0.320530E+01
+ PKER_SDRYG( 31, 2) = 0.300894E+01
+ PKER_SDRYG( 31, 3) = 0.282455E+01
+ PKER_SDRYG( 31, 4) = 0.265142E+01
+ PKER_SDRYG( 31, 5) = 0.248885E+01
+ PKER_SDRYG( 31, 6) = 0.233620E+01
+ PKER_SDRYG( 31, 7) = 0.219287E+01
+ PKER_SDRYG( 31, 8) = 0.205828E+01
+ PKER_SDRYG( 31, 9) = 0.193190E+01
+ PKER_SDRYG( 31, 10) = 0.181323E+01
+ PKER_SDRYG( 31, 11) = 0.170180E+01
+ PKER_SDRYG( 31, 12) = 0.159717E+01
+ PKER_SDRYG( 31, 13) = 0.149893E+01
+ PKER_SDRYG( 31, 14) = 0.140668E+01
+ PKER_SDRYG( 31, 15) = 0.132005E+01
+ PKER_SDRYG( 31, 16) = 0.123871E+01
+ PKER_SDRYG( 31, 17) = 0.116233E+01
+ PKER_SDRYG( 31, 18) = 0.109061E+01
+ PKER_SDRYG( 31, 19) = 0.102327E+01
+ PKER_SDRYG( 31, 20) = 0.960026E+00
+ PKER_SDRYG( 31, 21) = 0.900641E+00
+ PKER_SDRYG( 31, 22) = 0.844877E+00
+ PKER_SDRYG( 31, 23) = 0.792511E+00
+ PKER_SDRYG( 31, 24) = 0.743334E+00
+ PKER_SDRYG( 31, 25) = 0.697152E+00
+ PKER_SDRYG( 31, 26) = 0.653780E+00
+ PKER_SDRYG( 31, 27) = 0.613046E+00
+ PKER_SDRYG( 31, 28) = 0.574786E+00
+ PKER_SDRYG( 31, 29) = 0.538847E+00
+ PKER_SDRYG( 31, 30) = 0.505086E+00
+ PKER_SDRYG( 31, 31) = 0.473366E+00
+ PKER_SDRYG( 31, 32) = 0.443558E+00
+ PKER_SDRYG( 31, 33) = 0.415542E+00
+ PKER_SDRYG( 31, 34) = 0.389201E+00
+ PKER_SDRYG( 31, 35) = 0.364428E+00
+ PKER_SDRYG( 31, 36) = 0.341118E+00
+ PKER_SDRYG( 31, 37) = 0.319171E+00
+ PKER_SDRYG( 31, 38) = 0.298492E+00
+ PKER_SDRYG( 31, 39) = 0.278989E+00
+ PKER_SDRYG( 31, 40) = 0.260571E+00
+ PKER_SDRYG( 31, 41) = 0.243153E+00
+ PKER_SDRYG( 31, 42) = 0.226648E+00
+ PKER_SDRYG( 31, 43) = 0.210975E+00
+ PKER_SDRYG( 31, 44) = 0.196056E+00
+ PKER_SDRYG( 31, 45) = 0.181823E+00
+ PKER_SDRYG( 31, 46) = 0.168217E+00
+ PKER_SDRYG( 31, 47) = 0.155200E+00
+ PKER_SDRYG( 31, 48) = 0.142755E+00
+ PKER_SDRYG( 31, 49) = 0.130895E+00
+ PKER_SDRYG( 31, 50) = 0.119654E+00
+ PKER_SDRYG( 31, 51) = 0.109081E+00
+ PKER_SDRYG( 31, 52) = 0.992231E-01
+ PKER_SDRYG( 31, 53) = 0.901085E-01
+ PKER_SDRYG( 31, 54) = 0.817403E-01
+ PKER_SDRYG( 31, 55) = 0.740936E-01
+ PKER_SDRYG( 31, 56) = 0.671220E-01
+ PKER_SDRYG( 31, 57) = 0.607667E-01
+ PKER_SDRYG( 31, 58) = 0.549649E-01
+ PKER_SDRYG( 31, 59) = 0.496562E-01
+ PKER_SDRYG( 31, 60) = 0.447864E-01
+ PKER_SDRYG( 31, 61) = 0.403087E-01
+ PKER_SDRYG( 31, 62) = 0.361850E-01
+ PKER_SDRYG( 31, 63) = 0.323859E-01
+ PKER_SDRYG( 31, 64) = 0.288877E-01
+ PKER_SDRYG( 31, 65) = 0.256749E-01
+ PKER_SDRYG( 31, 66) = 0.227386E-01
+ PKER_SDRYG( 31, 67) = 0.200734E-01
+ PKER_SDRYG( 31, 68) = 0.176775E-01
+ PKER_SDRYG( 31, 69) = 0.155527E-01
+ PKER_SDRYG( 31, 70) = 0.136989E-01
+ PKER_SDRYG( 31, 71) = 0.121210E-01
+ PKER_SDRYG( 31, 72) = 0.108058E-01
+ PKER_SDRYG( 31, 73) = 0.975234E-02
+ PKER_SDRYG( 31, 74) = 0.896449E-02
+ PKER_SDRYG( 31, 75) = 0.840572E-02
+ PKER_SDRYG( 31, 76) = 0.807166E-02
+ PKER_SDRYG( 31, 77) = 0.793136E-02
+ PKER_SDRYG( 31, 78) = 0.797231E-02
+ PKER_SDRYG( 31, 79) = 0.815684E-02
+ PKER_SDRYG( 31, 80) = 0.847058E-02
+ PKER_SDRYG( 32, 1) = 0.320717E+01
+ PKER_SDRYG( 32, 2) = 0.301080E+01
+ PKER_SDRYG( 32, 3) = 0.282642E+01
+ PKER_SDRYG( 32, 4) = 0.265329E+01
+ PKER_SDRYG( 32, 5) = 0.249072E+01
+ PKER_SDRYG( 32, 6) = 0.233807E+01
+ PKER_SDRYG( 32, 7) = 0.219474E+01
+ PKER_SDRYG( 32, 8) = 0.206015E+01
+ PKER_SDRYG( 32, 9) = 0.193377E+01
+ PKER_SDRYG( 32, 10) = 0.181510E+01
+ PKER_SDRYG( 32, 11) = 0.170367E+01
+ PKER_SDRYG( 32, 12) = 0.159904E+01
+ PKER_SDRYG( 32, 13) = 0.150080E+01
+ PKER_SDRYG( 32, 14) = 0.140855E+01
+ PKER_SDRYG( 32, 15) = 0.132192E+01
+ PKER_SDRYG( 32, 16) = 0.124058E+01
+ PKER_SDRYG( 32, 17) = 0.116421E+01
+ PKER_SDRYG( 32, 18) = 0.109249E+01
+ PKER_SDRYG( 32, 19) = 0.102514E+01
+ PKER_SDRYG( 32, 20) = 0.961907E+00
+ PKER_SDRYG( 32, 21) = 0.902526E+00
+ PKER_SDRYG( 32, 22) = 0.846765E+00
+ PKER_SDRYG( 32, 23) = 0.794404E+00
+ PKER_SDRYG( 32, 24) = 0.745233E+00
+ PKER_SDRYG( 32, 25) = 0.699057E+00
+ PKER_SDRYG( 32, 26) = 0.655693E+00
+ PKER_SDRYG( 32, 27) = 0.614968E+00
+ PKER_SDRYG( 32, 28) = 0.576720E+00
+ PKER_SDRYG( 32, 29) = 0.540795E+00
+ PKER_SDRYG( 32, 30) = 0.507051E+00
+ PKER_SDRYG( 32, 31) = 0.475350E+00
+ PKER_SDRYG( 32, 32) = 0.445567E+00
+ PKER_SDRYG( 32, 33) = 0.417580E+00
+ PKER_SDRYG( 32, 34) = 0.391276E+00
+ PKER_SDRYG( 32, 35) = 0.366546E+00
+ PKER_SDRYG( 32, 36) = 0.343288E+00
+ PKER_SDRYG( 32, 37) = 0.321405E+00
+ PKER_SDRYG( 32, 38) = 0.300804E+00
+ PKER_SDRYG( 32, 39) = 0.281394E+00
+ PKER_SDRYG( 32, 40) = 0.263091E+00
+ PKER_SDRYG( 32, 41) = 0.245809E+00
+ PKER_SDRYG( 32, 42) = 0.229469E+00
+ PKER_SDRYG( 32, 43) = 0.213990E+00
+ PKER_SDRYG( 32, 44) = 0.199297E+00
+ PKER_SDRYG( 32, 45) = 0.185318E+00
+ PKER_SDRYG( 32, 46) = 0.171989E+00
+ PKER_SDRYG( 32, 47) = 0.159255E+00
+ PKER_SDRYG( 32, 48) = 0.147081E+00
+ PKER_SDRYG( 32, 49) = 0.135452E+00
+ PKER_SDRYG( 32, 50) = 0.124376E+00
+ PKER_SDRYG( 32, 51) = 0.113884E+00
+ PKER_SDRYG( 32, 52) = 0.104021E+00
+ PKER_SDRYG( 32, 53) = 0.948256E-01
+ PKER_SDRYG( 32, 54) = 0.863244E-01
+ PKER_SDRYG( 32, 55) = 0.785179E-01
+ PKER_SDRYG( 32, 56) = 0.713821E-01
+ PKER_SDRYG( 32, 57) = 0.648731E-01
+ PKER_SDRYG( 32, 58) = 0.589359E-01
+ PKER_SDRYG( 32, 59) = 0.535119E-01
+ PKER_SDRYG( 32, 60) = 0.485445E-01
+ PKER_SDRYG( 32, 61) = 0.439825E-01
+ PKER_SDRYG( 32, 62) = 0.397817E-01
+ PKER_SDRYG( 32, 63) = 0.359045E-01
+ PKER_SDRYG( 32, 64) = 0.323209E-01
+ PKER_SDRYG( 32, 65) = 0.290070E-01
+ PKER_SDRYG( 32, 66) = 0.259441E-01
+ PKER_SDRYG( 32, 67) = 0.231196E-01
+ PKER_SDRYG( 32, 68) = 0.205267E-01
+ PKER_SDRYG( 32, 69) = 0.181592E-01
+ PKER_SDRYG( 32, 70) = 0.160162E-01
+ PKER_SDRYG( 32, 71) = 0.141022E-01
+ PKER_SDRYG( 32, 72) = 0.124158E-01
+ PKER_SDRYG( 32, 73) = 0.109584E-01
+ PKER_SDRYG( 32, 74) = 0.973316E-02
+ PKER_SDRYG( 32, 75) = 0.873966E-02
+ PKER_SDRYG( 32, 76) = 0.796029E-02
+ PKER_SDRYG( 32, 77) = 0.738911E-02
+ PKER_SDRYG( 32, 78) = 0.702077E-02
+ PKER_SDRYG( 32, 79) = 0.682454E-02
+ PKER_SDRYG( 32, 80) = 0.678880E-02
+ PKER_SDRYG( 33, 1) = 0.320876E+01
+ PKER_SDRYG( 33, 2) = 0.301240E+01
+ PKER_SDRYG( 33, 3) = 0.282802E+01
+ PKER_SDRYG( 33, 4) = 0.265489E+01
+ PKER_SDRYG( 33, 5) = 0.249232E+01
+ PKER_SDRYG( 33, 6) = 0.233967E+01
+ PKER_SDRYG( 33, 7) = 0.219633E+01
+ PKER_SDRYG( 33, 8) = 0.206174E+01
+ PKER_SDRYG( 33, 9) = 0.193536E+01
+ PKER_SDRYG( 33, 10) = 0.181670E+01
+ PKER_SDRYG( 33, 11) = 0.170527E+01
+ PKER_SDRYG( 33, 12) = 0.160064E+01
+ PKER_SDRYG( 33, 13) = 0.150240E+01
+ PKER_SDRYG( 33, 14) = 0.141015E+01
+ PKER_SDRYG( 33, 15) = 0.132352E+01
+ PKER_SDRYG( 33, 16) = 0.124219E+01
+ PKER_SDRYG( 33, 17) = 0.116581E+01
+ PKER_SDRYG( 33, 18) = 0.109409E+01
+ PKER_SDRYG( 33, 19) = 0.102675E+01
+ PKER_SDRYG( 33, 20) = 0.963516E+00
+ PKER_SDRYG( 33, 21) = 0.904137E+00
+ PKER_SDRYG( 33, 22) = 0.848379E+00
+ PKER_SDRYG( 33, 23) = 0.796021E+00
+ PKER_SDRYG( 33, 24) = 0.746854E+00
+ PKER_SDRYG( 33, 25) = 0.700684E+00
+ PKER_SDRYG( 33, 26) = 0.657326E+00
+ PKER_SDRYG( 33, 27) = 0.616608E+00
+ PKER_SDRYG( 33, 28) = 0.578369E+00
+ PKER_SDRYG( 33, 29) = 0.542455E+00
+ PKER_SDRYG( 33, 30) = 0.508723E+00
+ PKER_SDRYG( 33, 31) = 0.477038E+00
+ PKER_SDRYG( 33, 32) = 0.447273E+00
+ PKER_SDRYG( 33, 33) = 0.419308E+00
+ PKER_SDRYG( 33, 34) = 0.393031E+00
+ PKER_SDRYG( 33, 35) = 0.368334E+00
+ PKER_SDRYG( 33, 36) = 0.345115E+00
+ PKER_SDRYG( 33, 37) = 0.323280E+00
+ PKER_SDRYG( 33, 38) = 0.302737E+00
+ PKER_SDRYG( 33, 39) = 0.283398E+00
+ PKER_SDRYG( 33, 40) = 0.265179E+00
+ PKER_SDRYG( 33, 41) = 0.248001E+00
+ PKER_SDRYG( 33, 42) = 0.231784E+00
+ PKER_SDRYG( 33, 43) = 0.216454E+00
+ PKER_SDRYG( 33, 44) = 0.201936E+00
+ PKER_SDRYG( 33, 45) = 0.188160E+00
+ PKER_SDRYG( 33, 46) = 0.175059E+00
+ PKER_SDRYG( 33, 47) = 0.162573E+00
+ PKER_SDRYG( 33, 48) = 0.150653E+00
+ PKER_SDRYG( 33, 49) = 0.139264E+00
+ PKER_SDRYG( 33, 50) = 0.128391E+00
+ PKER_SDRYG( 33, 51) = 0.118043E+00
+ PKER_SDRYG( 33, 52) = 0.108246E+00
+ PKER_SDRYG( 33, 53) = 0.990391E-01
+ PKER_SDRYG( 33, 54) = 0.904578E-01
+ PKER_SDRYG( 33, 55) = 0.825243E-01
+ PKER_SDRYG( 33, 56) = 0.752379E-01
+ PKER_SDRYG( 33, 57) = 0.685753E-01
+ PKER_SDRYG( 33, 58) = 0.624955E-01
+ PKER_SDRYG( 33, 59) = 0.569470E-01
+ PKER_SDRYG( 33, 60) = 0.518753E-01
+ PKER_SDRYG( 33, 61) = 0.472275E-01
+ PKER_SDRYG( 33, 62) = 0.429558E-01
+ PKER_SDRYG( 33, 63) = 0.390186E-01
+ PKER_SDRYG( 33, 64) = 0.353804E-01
+ PKER_SDRYG( 33, 65) = 0.320117E-01
+ PKER_SDRYG( 33, 66) = 0.288882E-01
+ PKER_SDRYG( 33, 67) = 0.259908E-01
+ PKER_SDRYG( 33, 68) = 0.233051E-01
+ PKER_SDRYG( 33, 69) = 0.208197E-01
+ PKER_SDRYG( 33, 70) = 0.185279E-01
+ PKER_SDRYG( 33, 71) = 0.164268E-01
+ PKER_SDRYG( 33, 72) = 0.145150E-01
+ PKER_SDRYG( 33, 73) = 0.127936E-01
+ PKER_SDRYG( 33, 74) = 0.112662E-01
+ PKER_SDRYG( 33, 75) = 0.993136E-02
+ PKER_SDRYG( 33, 76) = 0.879659E-02
+ PKER_SDRYG( 33, 77) = 0.785167E-02
+ PKER_SDRYG( 33, 78) = 0.709416E-02
+ PKER_SDRYG( 33, 79) = 0.653114E-02
+ PKER_SDRYG( 33, 80) = 0.613422E-02
+ PKER_SDRYG( 34, 1) = 0.321013E+01
+ PKER_SDRYG( 34, 2) = 0.301377E+01
+ PKER_SDRYG( 34, 3) = 0.282938E+01
+ PKER_SDRYG( 34, 4) = 0.265625E+01
+ PKER_SDRYG( 34, 5) = 0.249368E+01
+ PKER_SDRYG( 34, 6) = 0.234103E+01
+ PKER_SDRYG( 34, 7) = 0.219770E+01
+ PKER_SDRYG( 34, 8) = 0.206311E+01
+ PKER_SDRYG( 34, 9) = 0.193673E+01
+ PKER_SDRYG( 34, 10) = 0.181807E+01
+ PKER_SDRYG( 34, 11) = 0.170664E+01
+ PKER_SDRYG( 34, 12) = 0.160201E+01
+ PKER_SDRYG( 34, 13) = 0.150377E+01
+ PKER_SDRYG( 34, 14) = 0.141152E+01
+ PKER_SDRYG( 34, 15) = 0.132489E+01
+ PKER_SDRYG( 34, 16) = 0.124356E+01
+ PKER_SDRYG( 34, 17) = 0.116718E+01
+ PKER_SDRYG( 34, 18) = 0.109547E+01
+ PKER_SDRYG( 34, 19) = 0.102812E+01
+ PKER_SDRYG( 34, 20) = 0.964891E+00
+ PKER_SDRYG( 34, 21) = 0.905514E+00
+ PKER_SDRYG( 34, 22) = 0.849759E+00
+ PKER_SDRYG( 34, 23) = 0.797403E+00
+ PKER_SDRYG( 34, 24) = 0.748240E+00
+ PKER_SDRYG( 34, 25) = 0.702073E+00
+ PKER_SDRYG( 34, 26) = 0.658720E+00
+ PKER_SDRYG( 34, 27) = 0.618008E+00
+ PKER_SDRYG( 34, 28) = 0.579775E+00
+ PKER_SDRYG( 34, 29) = 0.543869E+00
+ PKER_SDRYG( 34, 30) = 0.510147E+00
+ PKER_SDRYG( 34, 31) = 0.478474E+00
+ PKER_SDRYG( 34, 32) = 0.448723E+00
+ PKER_SDRYG( 34, 33) = 0.420775E+00
+ PKER_SDRYG( 34, 34) = 0.394518E+00
+ PKER_SDRYG( 34, 35) = 0.369845E+00
+ PKER_SDRYG( 34, 36) = 0.346657E+00
+ PKER_SDRYG( 34, 37) = 0.324858E+00
+ PKER_SDRYG( 34, 38) = 0.304358E+00
+ PKER_SDRYG( 34, 39) = 0.285071E+00
+ PKER_SDRYG( 34, 40) = 0.266917E+00
+ PKER_SDRYG( 34, 41) = 0.249816E+00
+ PKER_SDRYG( 34, 42) = 0.233693E+00
+ PKER_SDRYG( 34, 43) = 0.218475E+00
+ PKER_SDRYG( 34, 44) = 0.204091E+00
+ PKER_SDRYG( 34, 45) = 0.190473E+00
+ PKER_SDRYG( 34, 46) = 0.177555E+00
+ PKER_SDRYG( 34, 47) = 0.165275E+00
+ PKER_SDRYG( 34, 48) = 0.153578E+00
+ PKER_SDRYG( 34, 49) = 0.142416E+00
+ PKER_SDRYG( 34, 50) = 0.131757E+00
+ PKER_SDRYG( 34, 51) = 0.121589E+00
+ PKER_SDRYG( 34, 52) = 0.111916E+00
+ PKER_SDRYG( 34, 53) = 0.102764E+00
+ PKER_SDRYG( 34, 54) = 0.941652E-01
+ PKER_SDRYG( 34, 55) = 0.861526E-01
+ PKER_SDRYG( 34, 56) = 0.787448E-01
+ PKER_SDRYG( 34, 57) = 0.719403E-01
+ PKER_SDRYG( 34, 58) = 0.657167E-01
+ PKER_SDRYG( 34, 59) = 0.600352E-01
+ PKER_SDRYG( 34, 60) = 0.548480E-01
+ PKER_SDRYG( 34, 61) = 0.501041E-01
+ PKER_SDRYG( 34, 62) = 0.457547E-01
+ PKER_SDRYG( 34, 63) = 0.417550E-01
+ PKER_SDRYG( 34, 64) = 0.380663E-01
+ PKER_SDRYG( 34, 65) = 0.346552E-01
+ PKER_SDRYG( 34, 66) = 0.314935E-01
+ PKER_SDRYG( 34, 67) = 0.285580E-01
+ PKER_SDRYG( 34, 68) = 0.258292E-01
+ PKER_SDRYG( 34, 69) = 0.232916E-01
+ PKER_SDRYG( 34, 70) = 0.209331E-01
+ PKER_SDRYG( 34, 71) = 0.187445E-01
+ PKER_SDRYG( 34, 72) = 0.167197E-01
+ PKER_SDRYG( 34, 73) = 0.148560E-01
+ PKER_SDRYG( 34, 74) = 0.131512E-01
+ PKER_SDRYG( 34, 75) = 0.116067E-01
+ PKER_SDRYG( 34, 76) = 0.102254E-01
+ PKER_SDRYG( 34, 77) = 0.900807E-02
+ PKER_SDRYG( 34, 78) = 0.795670E-02
+ PKER_SDRYG( 34, 79) = 0.707317E-02
+ PKER_SDRYG( 34, 80) = 0.635774E-02
+ PKER_SDRYG( 35, 1) = 0.321130E+01
+ PKER_SDRYG( 35, 2) = 0.301493E+01
+ PKER_SDRYG( 35, 3) = 0.283055E+01
+ PKER_SDRYG( 35, 4) = 0.265742E+01
+ PKER_SDRYG( 35, 5) = 0.249485E+01
+ PKER_SDRYG( 35, 6) = 0.234220E+01
+ PKER_SDRYG( 35, 7) = 0.219887E+01
+ PKER_SDRYG( 35, 8) = 0.206428E+01
+ PKER_SDRYG( 35, 9) = 0.193790E+01
+ PKER_SDRYG( 35, 10) = 0.181923E+01
+ PKER_SDRYG( 35, 11) = 0.170781E+01
+ PKER_SDRYG( 35, 12) = 0.160318E+01
+ PKER_SDRYG( 35, 13) = 0.150494E+01
+ PKER_SDRYG( 35, 14) = 0.141269E+01
+ PKER_SDRYG( 35, 15) = 0.132607E+01
+ PKER_SDRYG( 35, 16) = 0.124473E+01
+ PKER_SDRYG( 35, 17) = 0.116835E+01
+ PKER_SDRYG( 35, 18) = 0.109664E+01
+ PKER_SDRYG( 35, 19) = 0.102930E+01
+ PKER_SDRYG( 35, 20) = 0.966067E+00
+ PKER_SDRYG( 35, 21) = 0.906692E+00
+ PKER_SDRYG( 35, 22) = 0.850938E+00
+ PKER_SDRYG( 35, 23) = 0.798585E+00
+ PKER_SDRYG( 35, 24) = 0.749424E+00
+ PKER_SDRYG( 35, 25) = 0.703260E+00
+ PKER_SDRYG( 35, 26) = 0.659911E+00
+ PKER_SDRYG( 35, 27) = 0.619203E+00
+ PKER_SDRYG( 35, 28) = 0.580975E+00
+ PKER_SDRYG( 35, 29) = 0.545076E+00
+ PKER_SDRYG( 35, 30) = 0.511361E+00
+ PKER_SDRYG( 35, 31) = 0.479697E+00
+ PKER_SDRYG( 35, 32) = 0.449956E+00
+ PKER_SDRYG( 35, 33) = 0.422022E+00
+ PKER_SDRYG( 35, 34) = 0.395780E+00
+ PKER_SDRYG( 35, 35) = 0.371126E+00
+ PKER_SDRYG( 35, 36) = 0.347960E+00
+ PKER_SDRYG( 35, 37) = 0.326188E+00
+ PKER_SDRYG( 35, 38) = 0.305721E+00
+ PKER_SDRYG( 35, 39) = 0.286474E+00
+ PKER_SDRYG( 35, 40) = 0.268367E+00
+ PKER_SDRYG( 35, 41) = 0.251325E+00
+ PKER_SDRYG( 35, 42) = 0.235272E+00
+ PKER_SDRYG( 35, 43) = 0.220139E+00
+ PKER_SDRYG( 35, 44) = 0.205857E+00
+ PKER_SDRYG( 35, 45) = 0.192361E+00
+ PKER_SDRYG( 35, 46) = 0.179586E+00
+ PKER_SDRYG( 35, 47) = 0.167472E+00
+ PKER_SDRYG( 35, 48) = 0.155960E+00
+ PKER_SDRYG( 35, 49) = 0.144998E+00
+ PKER_SDRYG( 35, 50) = 0.134544E+00
+ PKER_SDRYG( 35, 51) = 0.124567E+00
+ PKER_SDRYG( 35, 52) = 0.115053E+00
+ PKER_SDRYG( 35, 53) = 0.106009E+00
+ PKER_SDRYG( 35, 54) = 0.974547E-01
+ PKER_SDRYG( 35, 55) = 0.894206E-01
+ PKER_SDRYG( 35, 56) = 0.819354E-01
+ PKER_SDRYG( 35, 57) = 0.750153E-01
+ PKER_SDRYG( 35, 58) = 0.686578E-01
+ PKER_SDRYG( 35, 59) = 0.628415E-01
+ PKER_SDRYG( 35, 60) = 0.575301E-01
+ PKER_SDRYG( 35, 61) = 0.526787E-01
+ PKER_SDRYG( 35, 62) = 0.482402E-01
+ PKER_SDRYG( 35, 63) = 0.441689E-01
+ PKER_SDRYG( 35, 64) = 0.404234E-01
+ PKER_SDRYG( 35, 65) = 0.369676E-01
+ PKER_SDRYG( 35, 66) = 0.337703E-01
+ PKER_SDRYG( 35, 67) = 0.308051E-01
+ PKER_SDRYG( 35, 68) = 0.280497E-01
+ PKER_SDRYG( 35, 69) = 0.254855E-01
+ PKER_SDRYG( 35, 70) = 0.230970E-01
+ PKER_SDRYG( 35, 71) = 0.208713E-01
+ PKER_SDRYG( 35, 72) = 0.187982E-01
+ PKER_SDRYG( 35, 73) = 0.168703E-01
+ PKER_SDRYG( 35, 74) = 0.150815E-01
+ PKER_SDRYG( 35, 75) = 0.134288E-01
+ PKER_SDRYG( 35, 76) = 0.119116E-01
+ PKER_SDRYG( 35, 77) = 0.105294E-01
+ PKER_SDRYG( 35, 78) = 0.928417E-02
+ PKER_SDRYG( 35, 79) = 0.817987E-02
+ PKER_SDRYG( 35, 80) = 0.721421E-02
+ PKER_SDRYG( 36, 1) = 0.321230E+01
+ PKER_SDRYG( 36, 2) = 0.301593E+01
+ PKER_SDRYG( 36, 3) = 0.283155E+01
+ PKER_SDRYG( 36, 4) = 0.265842E+01
+ PKER_SDRYG( 36, 5) = 0.249585E+01
+ PKER_SDRYG( 36, 6) = 0.234320E+01
+ PKER_SDRYG( 36, 7) = 0.219987E+01
+ PKER_SDRYG( 36, 8) = 0.206528E+01
+ PKER_SDRYG( 36, 9) = 0.193890E+01
+ PKER_SDRYG( 36, 10) = 0.182024E+01
+ PKER_SDRYG( 36, 11) = 0.170881E+01
+ PKER_SDRYG( 36, 12) = 0.160418E+01
+ PKER_SDRYG( 36, 13) = 0.150594E+01
+ PKER_SDRYG( 36, 14) = 0.141369E+01
+ PKER_SDRYG( 36, 15) = 0.132707E+01
+ PKER_SDRYG( 36, 16) = 0.124573E+01
+ PKER_SDRYG( 36, 17) = 0.116936E+01
+ PKER_SDRYG( 36, 18) = 0.109764E+01
+ PKER_SDRYG( 36, 19) = 0.103030E+01
+ PKER_SDRYG( 36, 20) = 0.967073E+00
+ PKER_SDRYG( 36, 21) = 0.907699E+00
+ PKER_SDRYG( 36, 22) = 0.851947E+00
+ PKER_SDRYG( 36, 23) = 0.799595E+00
+ PKER_SDRYG( 36, 24) = 0.750436E+00
+ PKER_SDRYG( 36, 25) = 0.704275E+00
+ PKER_SDRYG( 36, 26) = 0.660928E+00
+ PKER_SDRYG( 36, 27) = 0.620224E+00
+ PKER_SDRYG( 36, 28) = 0.582000E+00
+ PKER_SDRYG( 36, 29) = 0.546105E+00
+ PKER_SDRYG( 36, 30) = 0.512396E+00
+ PKER_SDRYG( 36, 31) = 0.480738E+00
+ PKER_SDRYG( 36, 32) = 0.451006E+00
+ PKER_SDRYG( 36, 33) = 0.423081E+00
+ PKER_SDRYG( 36, 34) = 0.396851E+00
+ PKER_SDRYG( 36, 35) = 0.372212E+00
+ PKER_SDRYG( 36, 36) = 0.349063E+00
+ PKER_SDRYG( 36, 37) = 0.327311E+00
+ PKER_SDRYG( 36, 38) = 0.306869E+00
+ PKER_SDRYG( 36, 39) = 0.287653E+00
+ PKER_SDRYG( 36, 40) = 0.269582E+00
+ PKER_SDRYG( 36, 41) = 0.252583E+00
+ PKER_SDRYG( 36, 42) = 0.236584E+00
+ PKER_SDRYG( 36, 43) = 0.221515E+00
+ PKER_SDRYG( 36, 44) = 0.207311E+00
+ PKER_SDRYG( 36, 45) = 0.193907E+00
+ PKER_SDRYG( 36, 46) = 0.181243E+00
+ PKER_SDRYG( 36, 47) = 0.169258E+00
+ PKER_SDRYG( 36, 48) = 0.157896E+00
+ PKER_SDRYG( 36, 49) = 0.147102E+00
+ PKER_SDRYG( 36, 50) = 0.136828E+00
+ PKER_SDRYG( 36, 51) = 0.127035E+00
+ PKER_SDRYG( 36, 52) = 0.117693E+00
+ PKER_SDRYG( 36, 53) = 0.108790E+00
+ PKER_SDRYG( 36, 54) = 0.100330E+00
+ PKER_SDRYG( 36, 55) = 0.923315E-01
+ PKER_SDRYG( 36, 56) = 0.848218E-01
+ PKER_SDRYG( 36, 57) = 0.778261E-01
+ PKER_SDRYG( 36, 58) = 0.713586E-01
+ PKER_SDRYG( 36, 59) = 0.654162E-01
+ PKER_SDRYG( 36, 60) = 0.599783E-01
+ PKER_SDRYG( 36, 61) = 0.550109E-01
+ PKER_SDRYG( 36, 62) = 0.504721E-01
+ PKER_SDRYG( 36, 63) = 0.463179E-01
+ PKER_SDRYG( 36, 64) = 0.425060E-01
+ PKER_SDRYG( 36, 65) = 0.389979E-01
+ PKER_SDRYG( 36, 66) = 0.357599E-01
+ PKER_SDRYG( 36, 67) = 0.327630E-01
+ PKER_SDRYG( 36, 68) = 0.299825E-01
+ PKER_SDRYG( 36, 69) = 0.273977E-01
+ PKER_SDRYG( 36, 70) = 0.249908E-01
+ PKER_SDRYG( 36, 71) = 0.227467E-01
+ PKER_SDRYG( 36, 72) = 0.206528E-01
+ PKER_SDRYG( 36, 73) = 0.186985E-01
+ PKER_SDRYG( 36, 74) = 0.168752E-01
+ PKER_SDRYG( 36, 75) = 0.151760E-01
+ PKER_SDRYG( 36, 76) = 0.135960E-01
+ PKER_SDRYG( 36, 77) = 0.121320E-01
+ PKER_SDRYG( 36, 78) = 0.107828E-01
+ PKER_SDRYG( 36, 79) = 0.954776E-02
+ PKER_SDRYG( 36, 80) = 0.842894E-02
+ PKER_SDRYG( 37, 1) = 0.321315E+01
+ PKER_SDRYG( 37, 2) = 0.301679E+01
+ PKER_SDRYG( 37, 3) = 0.283241E+01
+ PKER_SDRYG( 37, 4) = 0.265928E+01
+ PKER_SDRYG( 37, 5) = 0.249671E+01
+ PKER_SDRYG( 37, 6) = 0.234406E+01
+ PKER_SDRYG( 37, 7) = 0.220072E+01
+ PKER_SDRYG( 37, 8) = 0.206614E+01
+ PKER_SDRYG( 37, 9) = 0.193976E+01
+ PKER_SDRYG( 37, 10) = 0.182109E+01
+ PKER_SDRYG( 37, 11) = 0.170967E+01
+ PKER_SDRYG( 37, 12) = 0.160504E+01
+ PKER_SDRYG( 37, 13) = 0.150680E+01
+ PKER_SDRYG( 37, 14) = 0.141455E+01
+ PKER_SDRYG( 37, 15) = 0.132793E+01
+ PKER_SDRYG( 37, 16) = 0.124659E+01
+ PKER_SDRYG( 37, 17) = 0.117022E+01
+ PKER_SDRYG( 37, 18) = 0.109850E+01
+ PKER_SDRYG( 37, 19) = 0.103116E+01
+ PKER_SDRYG( 37, 20) = 0.967933E+00
+ PKER_SDRYG( 37, 21) = 0.908560E+00
+ PKER_SDRYG( 37, 22) = 0.852809E+00
+ PKER_SDRYG( 37, 23) = 0.800458E+00
+ PKER_SDRYG( 37, 24) = 0.751301E+00
+ PKER_SDRYG( 37, 25) = 0.705142E+00
+ PKER_SDRYG( 37, 26) = 0.661797E+00
+ PKER_SDRYG( 37, 27) = 0.621095E+00
+ PKER_SDRYG( 37, 28) = 0.582874E+00
+ PKER_SDRYG( 37, 29) = 0.546983E+00
+ PKER_SDRYG( 37, 30) = 0.513278E+00
+ PKER_SDRYG( 37, 31) = 0.481626E+00
+ PKER_SDRYG( 37, 32) = 0.451901E+00
+ PKER_SDRYG( 37, 33) = 0.423983E+00
+ PKER_SDRYG( 37, 34) = 0.397762E+00
+ PKER_SDRYG( 37, 35) = 0.373134E+00
+ PKER_SDRYG( 37, 36) = 0.349998E+00
+ PKER_SDRYG( 37, 37) = 0.328262E+00
+ PKER_SDRYG( 37, 38) = 0.307839E+00
+ PKER_SDRYG( 37, 39) = 0.288645E+00
+ PKER_SDRYG( 37, 40) = 0.270603E+00
+ PKER_SDRYG( 37, 41) = 0.253637E+00
+ PKER_SDRYG( 37, 42) = 0.237677E+00
+ PKER_SDRYG( 37, 43) = 0.222657E+00
+ PKER_SDRYG( 37, 44) = 0.208511E+00
+ PKER_SDRYG( 37, 45) = 0.195178E+00
+ PKER_SDRYG( 37, 46) = 0.182599E+00
+ PKER_SDRYG( 37, 47) = 0.170714E+00
+ PKER_SDRYG( 37, 48) = 0.159470E+00
+ PKER_SDRYG( 37, 49) = 0.148812E+00
+ PKER_SDRYG( 37, 50) = 0.138690E+00
+ PKER_SDRYG( 37, 51) = 0.129060E+00
+ PKER_SDRYG( 37, 52) = 0.119883E+00
+ PKER_SDRYG( 37, 53) = 0.111134E+00
+ PKER_SDRYG( 37, 54) = 0.102800E+00
+ PKER_SDRYG( 37, 55) = 0.948842E-01
+ PKER_SDRYG( 37, 56) = 0.874029E-01
+ PKER_SDRYG( 37, 57) = 0.803806E-01
+ PKER_SDRYG( 37, 58) = 0.738398E-01
+ PKER_SDRYG( 37, 59) = 0.677928E-01
+ PKER_SDRYG( 37, 60) = 0.622361E-01
+ PKER_SDRYG( 37, 61) = 0.571501E-01
+ PKER_SDRYG( 37, 62) = 0.525027E-01
+ PKER_SDRYG( 37, 63) = 0.482549E-01
+ PKER_SDRYG( 37, 64) = 0.443658E-01
+ PKER_SDRYG( 37, 65) = 0.407958E-01
+ PKER_SDRYG( 37, 66) = 0.375092E-01
+ PKER_SDRYG( 37, 67) = 0.344748E-01
+ PKER_SDRYG( 37, 68) = 0.316655E-01
+ PKER_SDRYG( 37, 69) = 0.290583E-01
+ PKER_SDRYG( 37, 70) = 0.266339E-01
+ PKER_SDRYG( 37, 71) = 0.243755E-01
+ PKER_SDRYG( 37, 72) = 0.222689E-01
+ PKER_SDRYG( 37, 73) = 0.203019E-01
+ PKER_SDRYG( 37, 74) = 0.184641E-01
+ PKER_SDRYG( 37, 75) = 0.167467E-01
+ PKER_SDRYG( 37, 76) = 0.151420E-01
+ PKER_SDRYG( 37, 77) = 0.136442E-01
+ PKER_SDRYG( 37, 78) = 0.122492E-01
+ PKER_SDRYG( 37, 79) = 0.109531E-01
+ PKER_SDRYG( 37, 80) = 0.975456E-02
+ PKER_SDRYG( 38, 1) = 0.321388E+01
+ PKER_SDRYG( 38, 2) = 0.301752E+01
+ PKER_SDRYG( 38, 3) = 0.283314E+01
+ PKER_SDRYG( 38, 4) = 0.266001E+01
+ PKER_SDRYG( 38, 5) = 0.249744E+01
+ PKER_SDRYG( 38, 6) = 0.234479E+01
+ PKER_SDRYG( 38, 7) = 0.220146E+01
+ PKER_SDRYG( 38, 8) = 0.206687E+01
+ PKER_SDRYG( 38, 9) = 0.194049E+01
+ PKER_SDRYG( 38, 10) = 0.182182E+01
+ PKER_SDRYG( 38, 11) = 0.171040E+01
+ PKER_SDRYG( 38, 12) = 0.160577E+01
+ PKER_SDRYG( 38, 13) = 0.150753E+01
+ PKER_SDRYG( 38, 14) = 0.141528E+01
+ PKER_SDRYG( 38, 15) = 0.132866E+01
+ PKER_SDRYG( 38, 16) = 0.124732E+01
+ PKER_SDRYG( 38, 17) = 0.117095E+01
+ PKER_SDRYG( 38, 18) = 0.109924E+01
+ PKER_SDRYG( 38, 19) = 0.103190E+01
+ PKER_SDRYG( 38, 20) = 0.968669E+00
+ PKER_SDRYG( 38, 21) = 0.909296E+00
+ PKER_SDRYG( 38, 22) = 0.853546E+00
+ PKER_SDRYG( 38, 23) = 0.801197E+00
+ PKER_SDRYG( 38, 24) = 0.752040E+00
+ PKER_SDRYG( 38, 25) = 0.705882E+00
+ PKER_SDRYG( 38, 26) = 0.662539E+00
+ PKER_SDRYG( 38, 27) = 0.621840E+00
+ PKER_SDRYG( 38, 28) = 0.583621E+00
+ PKER_SDRYG( 38, 29) = 0.547733E+00
+ PKER_SDRYG( 38, 30) = 0.514032E+00
+ PKER_SDRYG( 38, 31) = 0.482384E+00
+ PKER_SDRYG( 38, 32) = 0.452663E+00
+ PKER_SDRYG( 38, 33) = 0.424751E+00
+ PKER_SDRYG( 38, 34) = 0.398537E+00
+ PKER_SDRYG( 38, 35) = 0.373917E+00
+ PKER_SDRYG( 38, 36) = 0.350791E+00
+ PKER_SDRYG( 38, 37) = 0.329068E+00
+ PKER_SDRYG( 38, 38) = 0.308659E+00
+ PKER_SDRYG( 38, 39) = 0.289483E+00
+ PKER_SDRYG( 38, 40) = 0.271461E+00
+ PKER_SDRYG( 38, 41) = 0.254521E+00
+ PKER_SDRYG( 38, 42) = 0.238592E+00
+ PKER_SDRYG( 38, 43) = 0.223608E+00
+ PKER_SDRYG( 38, 44) = 0.209507E+00
+ PKER_SDRYG( 38, 45) = 0.196227E+00
+ PKER_SDRYG( 38, 46) = 0.183712E+00
+ PKER_SDRYG( 38, 47) = 0.171905E+00
+ PKER_SDRYG( 38, 48) = 0.160752E+00
+ PKER_SDRYG( 38, 49) = 0.150201E+00
+ PKER_SDRYG( 38, 50) = 0.140203E+00
+ PKER_SDRYG( 38, 51) = 0.130711E+00
+ PKER_SDRYG( 38, 52) = 0.121682E+00
+ PKER_SDRYG( 38, 53) = 0.113083E+00
+ PKER_SDRYG( 38, 54) = 0.104887E+00
+ PKER_SDRYG( 38, 55) = 0.970832E-01
+ PKER_SDRYG( 38, 56) = 0.896740E-01
+ PKER_SDRYG( 38, 57) = 0.826740E-01
+ PKER_SDRYG( 38, 58) = 0.761051E-01
+ PKER_SDRYG( 38, 59) = 0.699873E-01
+ PKER_SDRYG( 38, 60) = 0.643313E-01
+ PKER_SDRYG( 38, 61) = 0.591334E-01
+ PKER_SDRYG( 38, 62) = 0.543747E-01
+ PKER_SDRYG( 38, 63) = 0.500254E-01
+ PKER_SDRYG( 38, 64) = 0.460488E-01
+ PKER_SDRYG( 38, 65) = 0.424067E-01
+ PKER_SDRYG( 38, 66) = 0.390625E-01
+ PKER_SDRYG( 38, 67) = 0.359829E-01
+ PKER_SDRYG( 38, 68) = 0.331387E-01
+ PKER_SDRYG( 38, 69) = 0.305049E-01
+ PKER_SDRYG( 38, 70) = 0.280601E-01
+ PKER_SDRYG( 38, 71) = 0.257861E-01
+ PKER_SDRYG( 38, 72) = 0.236673E-01
+ PKER_SDRYG( 38, 73) = 0.216904E-01
+ PKER_SDRYG( 38, 74) = 0.198439E-01
+ PKER_SDRYG( 38, 75) = 0.181177E-01
+ PKER_SDRYG( 38, 76) = 0.165031E-01
+ PKER_SDRYG( 38, 77) = 0.149927E-01
+ PKER_SDRYG( 38, 78) = 0.135800E-01
+ PKER_SDRYG( 38, 79) = 0.122598E-01
+ PKER_SDRYG( 38, 80) = 0.110278E-01
+ PKER_SDRYG( 39, 1) = 0.321451E+01
+ PKER_SDRYG( 39, 2) = 0.301815E+01
+ PKER_SDRYG( 39, 3) = 0.283377E+01
+ PKER_SDRYG( 39, 4) = 0.266063E+01
+ PKER_SDRYG( 39, 5) = 0.249807E+01
+ PKER_SDRYG( 39, 6) = 0.234542E+01
+ PKER_SDRYG( 39, 7) = 0.220208E+01
+ PKER_SDRYG( 39, 8) = 0.206749E+01
+ PKER_SDRYG( 39, 9) = 0.194112E+01
+ PKER_SDRYG( 39, 10) = 0.182245E+01
+ PKER_SDRYG( 39, 11) = 0.171103E+01
+ PKER_SDRYG( 39, 12) = 0.160640E+01
+ PKER_SDRYG( 39, 13) = 0.150816E+01
+ PKER_SDRYG( 39, 14) = 0.141591E+01
+ PKER_SDRYG( 39, 15) = 0.132929E+01
+ PKER_SDRYG( 39, 16) = 0.124795E+01
+ PKER_SDRYG( 39, 17) = 0.117158E+01
+ PKER_SDRYG( 39, 18) = 0.109987E+01
+ PKER_SDRYG( 39, 19) = 0.103253E+01
+ PKER_SDRYG( 39, 20) = 0.969298E+00
+ PKER_SDRYG( 39, 21) = 0.909926E+00
+ PKER_SDRYG( 39, 22) = 0.854176E+00
+ PKER_SDRYG( 39, 23) = 0.801828E+00
+ PKER_SDRYG( 39, 24) = 0.752672E+00
+ PKER_SDRYG( 39, 25) = 0.706516E+00
+ PKER_SDRYG( 39, 26) = 0.663174E+00
+ PKER_SDRYG( 39, 27) = 0.622476E+00
+ PKER_SDRYG( 39, 28) = 0.584259E+00
+ PKER_SDRYG( 39, 29) = 0.548373E+00
+ PKER_SDRYG( 39, 30) = 0.514674E+00
+ PKER_SDRYG( 39, 31) = 0.483030E+00
+ PKER_SDRYG( 39, 32) = 0.453313E+00
+ PKER_SDRYG( 39, 33) = 0.425406E+00
+ PKER_SDRYG( 39, 34) = 0.399197E+00
+ PKER_SDRYG( 39, 35) = 0.374583E+00
+ PKER_SDRYG( 39, 36) = 0.351465E+00
+ PKER_SDRYG( 39, 37) = 0.329751E+00
+ PKER_SDRYG( 39, 38) = 0.309353E+00
+ PKER_SDRYG( 39, 39) = 0.290190E+00
+ PKER_SDRYG( 39, 40) = 0.272185E+00
+ PKER_SDRYG( 39, 41) = 0.255264E+00
+ PKER_SDRYG( 39, 42) = 0.239358E+00
+ PKER_SDRYG( 39, 43) = 0.224402E+00
+ PKER_SDRYG( 39, 44) = 0.210335E+00
+ PKER_SDRYG( 39, 45) = 0.197096E+00
+ PKER_SDRYG( 39, 46) = 0.184630E+00
+ PKER_SDRYG( 39, 47) = 0.172881E+00
+ PKER_SDRYG( 39, 48) = 0.161799E+00
+ PKER_SDRYG( 39, 49) = 0.151332E+00
+ PKER_SDRYG( 39, 50) = 0.141432E+00
+ PKER_SDRYG( 39, 51) = 0.132052E+00
+ PKER_SDRYG( 39, 52) = 0.123149E+00
+ PKER_SDRYG( 39, 53) = 0.114684E+00
+ PKER_SDRYG( 39, 54) = 0.106623E+00
+ PKER_SDRYG( 39, 55) = 0.989442E-01
+ PKER_SDRYG( 39, 56) = 0.916356E-01
+ PKER_SDRYG( 39, 57) = 0.846988E-01
+ PKER_SDRYG( 39, 58) = 0.781472E-01
+ PKER_SDRYG( 39, 59) = 0.720003E-01
+ PKER_SDRYG( 39, 60) = 0.662762E-01
+ PKER_SDRYG( 39, 61) = 0.609842E-01
+ PKER_SDRYG( 39, 62) = 0.561201E-01
+ PKER_SDRYG( 39, 63) = 0.516663E-01
+ PKER_SDRYG( 39, 64) = 0.475946E-01
+ PKER_SDRYG( 39, 65) = 0.438709E-01
+ PKER_SDRYG( 39, 66) = 0.404594E-01
+ PKER_SDRYG( 39, 67) = 0.373260E-01
+ PKER_SDRYG( 39, 68) = 0.344398E-01
+ PKER_SDRYG( 39, 69) = 0.317735E-01
+ PKER_SDRYG( 39, 70) = 0.293039E-01
+ PKER_SDRYG( 39, 71) = 0.270111E-01
+ PKER_SDRYG( 39, 72) = 0.248780E-01
+ PKER_SDRYG( 39, 73) = 0.228902E-01
+ PKER_SDRYG( 39, 74) = 0.210352E-01
+ PKER_SDRYG( 39, 75) = 0.193021E-01
+ PKER_SDRYG( 39, 76) = 0.176816E-01
+ PKER_SDRYG( 39, 77) = 0.161652E-01
+ PKER_SDRYG( 39, 78) = 0.147457E-01
+ PKER_SDRYG( 39, 79) = 0.134166E-01
+ PKER_SDRYG( 39, 80) = 0.121725E-01
+ PKER_SDRYG( 40, 1) = 0.321505E+01
+ PKER_SDRYG( 40, 2) = 0.301868E+01
+ PKER_SDRYG( 40, 3) = 0.283430E+01
+ PKER_SDRYG( 40, 4) = 0.266117E+01
+ PKER_SDRYG( 40, 5) = 0.249860E+01
+ PKER_SDRYG( 40, 6) = 0.234595E+01
+ PKER_SDRYG( 40, 7) = 0.220262E+01
+ PKER_SDRYG( 40, 8) = 0.206803E+01
+ PKER_SDRYG( 40, 9) = 0.194165E+01
+ PKER_SDRYG( 40, 10) = 0.182299E+01
+ PKER_SDRYG( 40, 11) = 0.171156E+01
+ PKER_SDRYG( 40, 12) = 0.160694E+01
+ PKER_SDRYG( 40, 13) = 0.150869E+01
+ PKER_SDRYG( 40, 14) = 0.141644E+01
+ PKER_SDRYG( 40, 15) = 0.132982E+01
+ PKER_SDRYG( 40, 16) = 0.124849E+01
+ PKER_SDRYG( 40, 17) = 0.117212E+01
+ PKER_SDRYG( 40, 18) = 0.110040E+01
+ PKER_SDRYG( 40, 19) = 0.103307E+01
+ PKER_SDRYG( 40, 20) = 0.969836E+00
+ PKER_SDRYG( 40, 21) = 0.910465E+00
+ PKER_SDRYG( 40, 22) = 0.854716E+00
+ PKER_SDRYG( 40, 23) = 0.802368E+00
+ PKER_SDRYG( 40, 24) = 0.753213E+00
+ PKER_SDRYG( 40, 25) = 0.707057E+00
+ PKER_SDRYG( 40, 26) = 0.663716E+00
+ PKER_SDRYG( 40, 27) = 0.623019E+00
+ PKER_SDRYG( 40, 28) = 0.584804E+00
+ PKER_SDRYG( 40, 29) = 0.548920E+00
+ PKER_SDRYG( 40, 30) = 0.515223E+00
+ PKER_SDRYG( 40, 31) = 0.483581E+00
+ PKER_SDRYG( 40, 32) = 0.453867E+00
+ PKER_SDRYG( 40, 33) = 0.425963E+00
+ PKER_SDRYG( 40, 34) = 0.399759E+00
+ PKER_SDRYG( 40, 35) = 0.375150E+00
+ PKER_SDRYG( 40, 36) = 0.352038E+00
+ PKER_SDRYG( 40, 37) = 0.330331E+00
+ PKER_SDRYG( 40, 38) = 0.309942E+00
+ PKER_SDRYG( 40, 39) = 0.290789E+00
+ PKER_SDRYG( 40, 40) = 0.272796E+00
+ PKER_SDRYG( 40, 41) = 0.255890E+00
+ PKER_SDRYG( 40, 42) = 0.240002E+00
+ PKER_SDRYG( 40, 43) = 0.225068E+00
+ PKER_SDRYG( 40, 44) = 0.211026E+00
+ PKER_SDRYG( 40, 45) = 0.197818E+00
+ PKER_SDRYG( 40, 46) = 0.185389E+00
+ PKER_SDRYG( 40, 47) = 0.173686E+00
+ PKER_SDRYG( 40, 48) = 0.162657E+00
+ PKER_SDRYG( 40, 49) = 0.152255E+00
+ PKER_SDRYG( 40, 50) = 0.142431E+00
+ PKER_SDRYG( 40, 51) = 0.133141E+00
+ PKER_SDRYG( 40, 52) = 0.124340E+00
+ PKER_SDRYG( 40, 53) = 0.115989E+00
+ PKER_SDRYG( 40, 54) = 0.108051E+00
+ PKER_SDRYG( 40, 55) = 0.100495E+00
+ PKER_SDRYG( 40, 56) = 0.932989E-01
+ PKER_SDRYG( 40, 57) = 0.864523E-01
+ PKER_SDRYG( 40, 58) = 0.799563E-01
+ PKER_SDRYG( 40, 59) = 0.738226E-01
+ PKER_SDRYG( 40, 60) = 0.680689E-01
+ PKER_SDRYG( 40, 61) = 0.627114E-01
+ PKER_SDRYG( 40, 62) = 0.577583E-01
+ PKER_SDRYG( 40, 63) = 0.532053E-01
+ PKER_SDRYG( 40, 64) = 0.490356E-01
+ PKER_SDRYG( 40, 65) = 0.452228E-01
+ PKER_SDRYG( 40, 66) = 0.417349E-01
+ PKER_SDRYG( 40, 67) = 0.385386E-01
+ PKER_SDRYG( 40, 68) = 0.356022E-01
+ PKER_SDRYG( 40, 69) = 0.328967E-01
+ PKER_SDRYG( 40, 70) = 0.303969E-01
+ PKER_SDRYG( 40, 71) = 0.280809E-01
+ PKER_SDRYG( 40, 72) = 0.259303E-01
+ PKER_SDRYG( 40, 73) = 0.239293E-01
+ PKER_SDRYG( 40, 74) = 0.220643E-01
+ PKER_SDRYG( 40, 75) = 0.203236E-01
+ PKER_SDRYG( 40, 76) = 0.186972E-01
+ PKER_SDRYG( 40, 77) = 0.171761E-01
+ PKER_SDRYG( 40, 78) = 0.157525E-01
+ PKER_SDRYG( 40, 79) = 0.144193E-01
+ PKER_SDRYG( 40, 80) = 0.131706E-01
END IF
!
+IF (LHOOK) CALL DR_HOOK('READ_XKER_SDRYG',1,ZHOOK_HANDLE)
END SUBROUTINE READ_XKER_SDRYG
+END MODULE MODE_READ_XKER_SDRYG
diff --git a/src/PHYEX/micro/mode_read_xker_sweth.f90 b/src/PHYEX/micro/mode_read_xker_sweth.f90
index 2ef9b959cc8b82993889381645040f63b678baa9..48d4b1aa4fdaaff9a24e2096f9ddd1e1137624c7 100644
--- a/src/PHYEX/micro/mode_read_xker_sweth.f90
+++ b/src/PHYEX/micro/mode_read_xker_sweth.f90
@@ -2,51 +2,18 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 microph 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###########################
- MODULE MODI_READ_XKER_SWETH
+ MODULE MODE_READ_XKER_SWETH
! ###########################
-!
-INTERFACE
- SUBROUTINE READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
- PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
- PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
- PFDINFTY,PKER_SWETH )
-!
-INTEGER, INTENT(OUT) :: KND,KWETLBDAH,KWETLBDAS
-REAL, INTENT(OUT) :: PALPHAH
-REAL, INTENT(OUT) :: PNUH
-REAL, INTENT(OUT) :: PALPHAS
-REAL, INTENT(OUT) :: PNUS
-REAL, INTENT(OUT) :: PEHS
-REAL, INTENT(OUT) :: PBS
-REAL, INTENT(OUT) :: PCH
-REAL, INTENT(OUT) :: PDH
-REAL, INTENT(OUT) :: PCS
-REAL, INTENT(OUT) :: PDS
-REAL, INTENT(OUT) :: PFVELOS
-REAL, INTENT(OUT) :: PWETLBDAH_MAX
-REAL, INTENT(OUT) :: PWETLBDAS_MAX
-REAL, INTENT(OUT) :: PWETLBDAH_MIN
-REAL, INTENT(OUT) :: PWETLBDAS_MIN
-REAL, INTENT(OUT) :: PFDINFTY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SWETH
-!
-END SUBROUTINE
-!
-END INTERFACE
-!
-END MODULE MODI_READ_XKER_SWETH
-! ########################################################################
+IMPLICIT NONE
+CONTAINS
SUBROUTINE READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
PFDINFTY,PKER_SWETH )
+!DEC$ OPTIMIZE:0
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-hail wet growth process
@@ -82,6 +49,7 @@ END MODULE MODI_READ_XKER_SWETH
!! MODIFICATIONS
!! -------------
!! Original 19/04/97
+!! 14-Feb-2014 R. El Khatib optimise for compile time on Intel
!!
!-------------------------------------------------------------------------------
!
@@ -114,6 +82,8 @@ REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PKER_SWETH
! #INSERT HERE THE OUTPUT OF INI_RAIN_ICE_HAIL IF THE KERNELS ARE UPDATED#
! ########################################################################
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('READ_XKER_SWETH',0,ZHOOK_HANDLE)
KND= 50
KWETLBDAH= 40
KWETLBDAS= 80
@@ -125,7 +95,7 @@ PEHS= 0.100000E+01
PBS= 0.190000E+01
PCH= 0.207000E+03
PDH= 0.640000E+00
-PCS= 0.500000E+01
+PCS= 0.510000E+01
PDS= 0.270000E+00
PFVELOS= 0.000000E+00
PWETLBDAH_MAX= 0.100000E+08
@@ -135,3206 +105,3208 @@ PWETLBDAS_MIN= 0.250000E+02
PFDINFTY= 0.200000E+02
!
IF( PRESENT(PKER_SWETH) ) THEN
-PKER_SWETH( 1, 1) = 0.621503E+01
-PKER_SWETH( 1, 2) = 0.642955E+01
-PKER_SWETH( 1, 3) = 0.663737E+01
-PKER_SWETH( 1, 4) = 0.684015E+01
-PKER_SWETH( 1, 5) = 0.703956E+01
-PKER_SWETH( 1, 6) = 0.723727E+01
-PKER_SWETH( 1, 7) = 0.743478E+01
-PKER_SWETH( 1, 8) = 0.763325E+01
-PKER_SWETH( 1, 9) = 0.783330E+01
-PKER_SWETH( 1, 10) = 0.803476E+01
-PKER_SWETH( 1, 11) = 0.823653E+01
-PKER_SWETH( 1, 12) = 0.843651E+01
-PKER_SWETH( 1, 13) = 0.863186E+01
-PKER_SWETH( 1, 14) = 0.881940E+01
-PKER_SWETH( 1, 15) = 0.899609E+01
-PKER_SWETH( 1, 16) = 0.915958E+01
-PKER_SWETH( 1, 17) = 0.930842E+01
-PKER_SWETH( 1, 18) = 0.944217E+01
-PKER_SWETH( 1, 19) = 0.956119E+01
-PKER_SWETH( 1, 20) = 0.966648E+01
-PKER_SWETH( 1, 21) = 0.975933E+01
-PKER_SWETH( 1, 22) = 0.984120E+01
-PKER_SWETH( 1, 23) = 0.991349E+01
-PKER_SWETH( 1, 24) = 0.997753E+01
-PKER_SWETH( 1, 25) = 0.100345E+02
-PKER_SWETH( 1, 26) = 0.100854E+02
-PKER_SWETH( 1, 27) = 0.101311E+02
-PKER_SWETH( 1, 28) = 0.101723E+02
-PKER_SWETH( 1, 29) = 0.102097E+02
-PKER_SWETH( 1, 30) = 0.102438E+02
-PKER_SWETH( 1, 31) = 0.102749E+02
-PKER_SWETH( 1, 32) = 0.103034E+02
-PKER_SWETH( 1, 33) = 0.103296E+02
-PKER_SWETH( 1, 34) = 0.103539E+02
-PKER_SWETH( 1, 35) = 0.103763E+02
-PKER_SWETH( 1, 36) = 0.103971E+02
-PKER_SWETH( 1, 37) = 0.104164E+02
-PKER_SWETH( 1, 38) = 0.104343E+02
-PKER_SWETH( 1, 39) = 0.104511E+02
-PKER_SWETH( 1, 40) = 0.104667E+02
-PKER_SWETH( 1, 41) = 0.104812E+02
-PKER_SWETH( 1, 42) = 0.104949E+02
-PKER_SWETH( 1, 43) = 0.105076E+02
-PKER_SWETH( 1, 44) = 0.105195E+02
-PKER_SWETH( 1, 45) = 0.105307E+02
-PKER_SWETH( 1, 46) = 0.105412E+02
-PKER_SWETH( 1, 47) = 0.105510E+02
-PKER_SWETH( 1, 48) = 0.105601E+02
-PKER_SWETH( 1, 49) = 0.105688E+02
-PKER_SWETH( 1, 50) = 0.105768E+02
-PKER_SWETH( 1, 51) = 0.105844E+02
-PKER_SWETH( 1, 52) = 0.105915E+02
-PKER_SWETH( 1, 53) = 0.105982E+02
-PKER_SWETH( 1, 54) = 0.106044E+02
-PKER_SWETH( 1, 55) = 0.106103E+02
-PKER_SWETH( 1, 56) = 0.106158E+02
-PKER_SWETH( 1, 57) = 0.106210E+02
-PKER_SWETH( 1, 58) = 0.106259E+02
-PKER_SWETH( 1, 59) = 0.106304E+02
-PKER_SWETH( 1, 60) = 0.106347E+02
-PKER_SWETH( 1, 61) = 0.106387E+02
-PKER_SWETH( 1, 62) = 0.106425E+02
-PKER_SWETH( 1, 63) = 0.106460E+02
-PKER_SWETH( 1, 64) = 0.106494E+02
-PKER_SWETH( 1, 65) = 0.106525E+02
-PKER_SWETH( 1, 66) = 0.106554E+02
-PKER_SWETH( 1, 67) = 0.106582E+02
-PKER_SWETH( 1, 68) = 0.106608E+02
-PKER_SWETH( 1, 69) = 0.106632E+02
-PKER_SWETH( 1, 70) = 0.106655E+02
-PKER_SWETH( 1, 71) = 0.106676E+02
-PKER_SWETH( 1, 72) = 0.106696E+02
-PKER_SWETH( 1, 73) = 0.106715E+02
-PKER_SWETH( 1, 74) = 0.106733E+02
-PKER_SWETH( 1, 75) = 0.106749E+02
-PKER_SWETH( 1, 76) = 0.106765E+02
-PKER_SWETH( 1, 77) = 0.106780E+02
-PKER_SWETH( 1, 78) = 0.106793E+02
-PKER_SWETH( 1, 79) = 0.106806E+02
-PKER_SWETH( 1, 80) = 0.106818E+02
-PKER_SWETH( 2, 1) = 0.488694E+01
-PKER_SWETH( 2, 2) = 0.509473E+01
-PKER_SWETH( 2, 3) = 0.529455E+01
-PKER_SWETH( 2, 4) = 0.548777E+01
-PKER_SWETH( 2, 5) = 0.567585E+01
-PKER_SWETH( 2, 6) = 0.586027E+01
-PKER_SWETH( 2, 7) = 0.604252E+01
-PKER_SWETH( 2, 8) = 0.622393E+01
-PKER_SWETH( 2, 9) = 0.640554E+01
-PKER_SWETH( 2, 10) = 0.658791E+01
-PKER_SWETH( 2, 11) = 0.677095E+01
-PKER_SWETH( 2, 12) = 0.695370E+01
-PKER_SWETH( 2, 13) = 0.713440E+01
-PKER_SWETH( 2, 14) = 0.731059E+01
-PKER_SWETH( 2, 15) = 0.747955E+01
-PKER_SWETH( 2, 16) = 0.763866E+01
-PKER_SWETH( 2, 17) = 0.778589E+01
-PKER_SWETH( 2, 18) = 0.792003E+01
-PKER_SWETH( 2, 19) = 0.804070E+01
-PKER_SWETH( 2, 20) = 0.814827E+01
-PKER_SWETH( 2, 21) = 0.824361E+01
-PKER_SWETH( 2, 22) = 0.832788E+01
-PKER_SWETH( 2, 23) = 0.840235E+01
-PKER_SWETH( 2, 24) = 0.846829E+01
-PKER_SWETH( 2, 25) = 0.852685E+01
-PKER_SWETH( 2, 26) = 0.857908E+01
-PKER_SWETH( 2, 27) = 0.862586E+01
-PKER_SWETH( 2, 28) = 0.866797E+01
-PKER_SWETH( 2, 29) = 0.870604E+01
-PKER_SWETH( 2, 30) = 0.874063E+01
-PKER_SWETH( 2, 31) = 0.877217E+01
-PKER_SWETH( 2, 32) = 0.880105E+01
-PKER_SWETH( 2, 33) = 0.882758E+01
-PKER_SWETH( 2, 34) = 0.885202E+01
-PKER_SWETH( 2, 35) = 0.887461E+01
-PKER_SWETH( 2, 36) = 0.889553E+01
-PKER_SWETH( 2, 37) = 0.891494E+01
-PKER_SWETH( 2, 38) = 0.893298E+01
-PKER_SWETH( 2, 39) = 0.894979E+01
-PKER_SWETH( 2, 40) = 0.896545E+01
-PKER_SWETH( 2, 41) = 0.898007E+01
-PKER_SWETH( 2, 42) = 0.899372E+01
-PKER_SWETH( 2, 43) = 0.900649E+01
-PKER_SWETH( 2, 44) = 0.901843E+01
-PKER_SWETH( 2, 45) = 0.902961E+01
-PKER_SWETH( 2, 46) = 0.904008E+01
-PKER_SWETH( 2, 47) = 0.904989E+01
-PKER_SWETH( 2, 48) = 0.905908E+01
-PKER_SWETH( 2, 49) = 0.906770E+01
-PKER_SWETH( 2, 50) = 0.907578E+01
-PKER_SWETH( 2, 51) = 0.908336E+01
-PKER_SWETH( 2, 52) = 0.909048E+01
-PKER_SWETH( 2, 53) = 0.909715E+01
-PKER_SWETH( 2, 54) = 0.910341E+01
-PKER_SWETH( 2, 55) = 0.910928E+01
-PKER_SWETH( 2, 56) = 0.911480E+01
-PKER_SWETH( 2, 57) = 0.911997E+01
-PKER_SWETH( 2, 58) = 0.912483E+01
-PKER_SWETH( 2, 59) = 0.912939E+01
-PKER_SWETH( 2, 60) = 0.913368E+01
-PKER_SWETH( 2, 61) = 0.913770E+01
-PKER_SWETH( 2, 62) = 0.914147E+01
-PKER_SWETH( 2, 63) = 0.914501E+01
-PKER_SWETH( 2, 64) = 0.914834E+01
-PKER_SWETH( 2, 65) = 0.915146E+01
-PKER_SWETH( 2, 66) = 0.915439E+01
-PKER_SWETH( 2, 67) = 0.915715E+01
-PKER_SWETH( 2, 68) = 0.915973E+01
-PKER_SWETH( 2, 69) = 0.916216E+01
-PKER_SWETH( 2, 70) = 0.916444E+01
-PKER_SWETH( 2, 71) = 0.916658E+01
-PKER_SWETH( 2, 72) = 0.916859E+01
-PKER_SWETH( 2, 73) = 0.917047E+01
-PKER_SWETH( 2, 74) = 0.917224E+01
-PKER_SWETH( 2, 75) = 0.917391E+01
-PKER_SWETH( 2, 76) = 0.917547E+01
-PKER_SWETH( 2, 77) = 0.917693E+01
-PKER_SWETH( 2, 78) = 0.917831E+01
-PKER_SWETH( 2, 79) = 0.917960E+01
-PKER_SWETH( 2, 80) = 0.918082E+01
-PKER_SWETH( 3, 1) = 0.375124E+01
-PKER_SWETH( 3, 2) = 0.395338E+01
-PKER_SWETH( 3, 3) = 0.414703E+01
-PKER_SWETH( 3, 4) = 0.433314E+01
-PKER_SWETH( 3, 5) = 0.451285E+01
-PKER_SWETH( 3, 6) = 0.468742E+01
-PKER_SWETH( 3, 7) = 0.485815E+01
-PKER_SWETH( 3, 8) = 0.502636E+01
-PKER_SWETH( 3, 9) = 0.519322E+01
-PKER_SWETH( 3, 10) = 0.535966E+01
-PKER_SWETH( 3, 11) = 0.552622E+01
-PKER_SWETH( 3, 12) = 0.569281E+01
-PKER_SWETH( 3, 13) = 0.585866E+01
-PKER_SWETH( 3, 14) = 0.602225E+01
-PKER_SWETH( 3, 15) = 0.618147E+01
-PKER_SWETH( 3, 16) = 0.633398E+01
-PKER_SWETH( 3, 17) = 0.647752E+01
-PKER_SWETH( 3, 18) = 0.661037E+01
-PKER_SWETH( 3, 19) = 0.673149E+01
-PKER_SWETH( 3, 20) = 0.684057E+01
-PKER_SWETH( 3, 21) = 0.693797E+01
-PKER_SWETH( 3, 22) = 0.702445E+01
-PKER_SWETH( 3, 23) = 0.710106E+01
-PKER_SWETH( 3, 24) = 0.716893E+01
-PKER_SWETH( 3, 25) = 0.722916E+01
-PKER_SWETH( 3, 26) = 0.728280E+01
-PKER_SWETH( 3, 27) = 0.733075E+01
-PKER_SWETH( 3, 28) = 0.737380E+01
-PKER_SWETH( 3, 29) = 0.741264E+01
-PKER_SWETH( 3, 30) = 0.744784E+01
-PKER_SWETH( 3, 31) = 0.747987E+01
-PKER_SWETH( 3, 32) = 0.750913E+01
-PKER_SWETH( 3, 33) = 0.753597E+01
-PKER_SWETH( 3, 34) = 0.756065E+01
-PKER_SWETH( 3, 35) = 0.758343E+01
-PKER_SWETH( 3, 36) = 0.760450E+01
-PKER_SWETH( 3, 37) = 0.762403E+01
-PKER_SWETH( 3, 38) = 0.764217E+01
-PKER_SWETH( 3, 39) = 0.765904E+01
-PKER_SWETH( 3, 40) = 0.767476E+01
-PKER_SWETH( 3, 41) = 0.768943E+01
-PKER_SWETH( 3, 42) = 0.770312E+01
-PKER_SWETH( 3, 43) = 0.771591E+01
-PKER_SWETH( 3, 44) = 0.772788E+01
-PKER_SWETH( 3, 45) = 0.773907E+01
-PKER_SWETH( 3, 46) = 0.774956E+01
-PKER_SWETH( 3, 47) = 0.775938E+01
-PKER_SWETH( 3, 48) = 0.776858E+01
-PKER_SWETH( 3, 49) = 0.777721E+01
-PKER_SWETH( 3, 50) = 0.778529E+01
-PKER_SWETH( 3, 51) = 0.779288E+01
-PKER_SWETH( 3, 52) = 0.779999E+01
-PKER_SWETH( 3, 53) = 0.780667E+01
-PKER_SWETH( 3, 54) = 0.781293E+01
-PKER_SWETH( 3, 55) = 0.781881E+01
-PKER_SWETH( 3, 56) = 0.782432E+01
-PKER_SWETH( 3, 57) = 0.782950E+01
-PKER_SWETH( 3, 58) = 0.783436E+01
-PKER_SWETH( 3, 59) = 0.783892E+01
-PKER_SWETH( 3, 60) = 0.784320E+01
-PKER_SWETH( 3, 61) = 0.784722E+01
-PKER_SWETH( 3, 62) = 0.785100E+01
-PKER_SWETH( 3, 63) = 0.785454E+01
-PKER_SWETH( 3, 64) = 0.785787E+01
-PKER_SWETH( 3, 65) = 0.786099E+01
-PKER_SWETH( 3, 66) = 0.786392E+01
-PKER_SWETH( 3, 67) = 0.786667E+01
-PKER_SWETH( 3, 68) = 0.786926E+01
-PKER_SWETH( 3, 69) = 0.787169E+01
-PKER_SWETH( 3, 70) = 0.787397E+01
-PKER_SWETH( 3, 71) = 0.787611E+01
-PKER_SWETH( 3, 72) = 0.787811E+01
-PKER_SWETH( 3, 73) = 0.788000E+01
-PKER_SWETH( 3, 74) = 0.788177E+01
-PKER_SWETH( 3, 75) = 0.788344E+01
-PKER_SWETH( 3, 76) = 0.788500E+01
-PKER_SWETH( 3, 77) = 0.788646E+01
-PKER_SWETH( 3, 78) = 0.788784E+01
-PKER_SWETH( 3, 79) = 0.788913E+01
-PKER_SWETH( 3, 80) = 0.789035E+01
-PKER_SWETH( 4, 1) = 0.278424E+01
-PKER_SWETH( 4, 2) = 0.297942E+01
-PKER_SWETH( 4, 3) = 0.316697E+01
-PKER_SWETH( 4, 4) = 0.334706E+01
-PKER_SWETH( 4, 5) = 0.352024E+01
-PKER_SWETH( 4, 6) = 0.368737E+01
-PKER_SWETH( 4, 7) = 0.384947E+01
-PKER_SWETH( 4, 8) = 0.400765E+01
-PKER_SWETH( 4, 9) = 0.416307E+01
-PKER_SWETH( 4, 10) = 0.431675E+01
-PKER_SWETH( 4, 11) = 0.446953E+01
-PKER_SWETH( 4, 12) = 0.462189E+01
-PKER_SWETH( 4, 13) = 0.477380E+01
-PKER_SWETH( 4, 14) = 0.492458E+01
-PKER_SWETH( 4, 15) = 0.507296E+01
-PKER_SWETH( 4, 16) = 0.521712E+01
-PKER_SWETH( 4, 17) = 0.535504E+01
-PKER_SWETH( 4, 18) = 0.548479E+01
-PKER_SWETH( 4, 19) = 0.560488E+01
-PKER_SWETH( 4, 20) = 0.571444E+01
-PKER_SWETH( 4, 21) = 0.581323E+01
-PKER_SWETH( 4, 22) = 0.590157E+01
-PKER_SWETH( 4, 23) = 0.598017E+01
-PKER_SWETH( 4, 24) = 0.604994E+01
-PKER_SWETH( 4, 25) = 0.611189E+01
-PKER_SWETH( 4, 26) = 0.616700E+01
-PKER_SWETH( 4, 27) = 0.621619E+01
-PKER_SWETH( 4, 28) = 0.626027E+01
-PKER_SWETH( 4, 29) = 0.629995E+01
-PKER_SWETH( 4, 30) = 0.633582E+01
-PKER_SWETH( 4, 31) = 0.636838E+01
-PKER_SWETH( 4, 32) = 0.639808E+01
-PKER_SWETH( 4, 33) = 0.642525E+01
-PKER_SWETH( 4, 34) = 0.645021E+01
-PKER_SWETH( 4, 35) = 0.647320E+01
-PKER_SWETH( 4, 36) = 0.649443E+01
-PKER_SWETH( 4, 37) = 0.651409E+01
-PKER_SWETH( 4, 38) = 0.653234E+01
-PKER_SWETH( 4, 39) = 0.654929E+01
-PKER_SWETH( 4, 40) = 0.656508E+01
-PKER_SWETH( 4, 41) = 0.657979E+01
-PKER_SWETH( 4, 42) = 0.659352E+01
-PKER_SWETH( 4, 43) = 0.660635E+01
-PKER_SWETH( 4, 44) = 0.661834E+01
-PKER_SWETH( 4, 45) = 0.662955E+01
-PKER_SWETH( 4, 46) = 0.664005E+01
-PKER_SWETH( 4, 47) = 0.664988E+01
-PKER_SWETH( 4, 48) = 0.665910E+01
-PKER_SWETH( 4, 49) = 0.666773E+01
-PKER_SWETH( 4, 50) = 0.667582E+01
-PKER_SWETH( 4, 51) = 0.668341E+01
-PKER_SWETH( 4, 52) = 0.669053E+01
-PKER_SWETH( 4, 53) = 0.669721E+01
-PKER_SWETH( 4, 54) = 0.670347E+01
-PKER_SWETH( 4, 55) = 0.670935E+01
-PKER_SWETH( 4, 56) = 0.671487E+01
-PKER_SWETH( 4, 57) = 0.672005E+01
-PKER_SWETH( 4, 58) = 0.672491E+01
-PKER_SWETH( 4, 59) = 0.672947E+01
-PKER_SWETH( 4, 60) = 0.673375E+01
-PKER_SWETH( 4, 61) = 0.673777E+01
-PKER_SWETH( 4, 62) = 0.674155E+01
-PKER_SWETH( 4, 63) = 0.674509E+01
-PKER_SWETH( 4, 64) = 0.674842E+01
-PKER_SWETH( 4, 65) = 0.675154E+01
-PKER_SWETH( 4, 66) = 0.675447E+01
-PKER_SWETH( 4, 67) = 0.675723E+01
-PKER_SWETH( 4, 68) = 0.675981E+01
-PKER_SWETH( 4, 69) = 0.676224E+01
-PKER_SWETH( 4, 70) = 0.676452E+01
-PKER_SWETH( 4, 71) = 0.676666E+01
-PKER_SWETH( 4, 72) = 0.676867E+01
-PKER_SWETH( 4, 73) = 0.677055E+01
-PKER_SWETH( 4, 74) = 0.677232E+01
-PKER_SWETH( 4, 75) = 0.677399E+01
-PKER_SWETH( 4, 76) = 0.677555E+01
-PKER_SWETH( 4, 77) = 0.677702E+01
-PKER_SWETH( 4, 78) = 0.677839E+01
-PKER_SWETH( 4, 79) = 0.677969E+01
-PKER_SWETH( 4, 80) = 0.678090E+01
-PKER_SWETH( 5, 1) = 0.197467E+01
-PKER_SWETH( 5, 2) = 0.215641E+01
-PKER_SWETH( 5, 3) = 0.233442E+01
-PKER_SWETH( 5, 4) = 0.250706E+01
-PKER_SWETH( 5, 5) = 0.267376E+01
-PKER_SWETH( 5, 6) = 0.283450E+01
-PKER_SWETH( 5, 7) = 0.298975E+01
-PKER_SWETH( 5, 8) = 0.314024E+01
-PKER_SWETH( 5, 9) = 0.328687E+01
-PKER_SWETH( 5, 10) = 0.343059E+01
-PKER_SWETH( 5, 11) = 0.357230E+01
-PKER_SWETH( 5, 12) = 0.371274E+01
-PKER_SWETH( 5, 13) = 0.385234E+01
-PKER_SWETH( 5, 14) = 0.399109E+01
-PKER_SWETH( 5, 15) = 0.412843E+01
-PKER_SWETH( 5, 16) = 0.426326E+01
-PKER_SWETH( 5, 17) = 0.439402E+01
-PKER_SWETH( 5, 18) = 0.451898E+01
-PKER_SWETH( 5, 19) = 0.463649E+01
-PKER_SWETH( 5, 20) = 0.474526E+01
-PKER_SWETH( 5, 21) = 0.484454E+01
-PKER_SWETH( 5, 22) = 0.493417E+01
-PKER_SWETH( 5, 23) = 0.501444E+01
-PKER_SWETH( 5, 24) = 0.508599E+01
-PKER_SWETH( 5, 25) = 0.514963E+01
-PKER_SWETH( 5, 26) = 0.520627E+01
-PKER_SWETH( 5, 27) = 0.525678E+01
-PKER_SWETH( 5, 28) = 0.530196E+01
-PKER_SWETH( 5, 29) = 0.534254E+01
-PKER_SWETH( 5, 30) = 0.537915E+01
-PKER_SWETH( 5, 31) = 0.541231E+01
-PKER_SWETH( 5, 32) = 0.544248E+01
-PKER_SWETH( 5, 33) = 0.547003E+01
-PKER_SWETH( 5, 34) = 0.549528E+01
-PKER_SWETH( 5, 35) = 0.551851E+01
-PKER_SWETH( 5, 36) = 0.553993E+01
-PKER_SWETH( 5, 37) = 0.555974E+01
-PKER_SWETH( 5, 38) = 0.557809E+01
-PKER_SWETH( 5, 39) = 0.559514E+01
-PKER_SWETH( 5, 40) = 0.561100E+01
-PKER_SWETH( 5, 41) = 0.562577E+01
-PKER_SWETH( 5, 42) = 0.563954E+01
-PKER_SWETH( 5, 43) = 0.565240E+01
-PKER_SWETH( 5, 44) = 0.566442E+01
-PKER_SWETH( 5, 45) = 0.567565E+01
-PKER_SWETH( 5, 46) = 0.568617E+01
-PKER_SWETH( 5, 47) = 0.569602E+01
-PKER_SWETH( 5, 48) = 0.570524E+01
-PKER_SWETH( 5, 49) = 0.571388E+01
-PKER_SWETH( 5, 50) = 0.572198E+01
-PKER_SWETH( 5, 51) = 0.572957E+01
-PKER_SWETH( 5, 52) = 0.573670E+01
-PKER_SWETH( 5, 53) = 0.574338E+01
-PKER_SWETH( 5, 54) = 0.574965E+01
-PKER_SWETH( 5, 55) = 0.575553E+01
-PKER_SWETH( 5, 56) = 0.576105E+01
-PKER_SWETH( 5, 57) = 0.576622E+01
-PKER_SWETH( 5, 58) = 0.577109E+01
-PKER_SWETH( 5, 59) = 0.577565E+01
-PKER_SWETH( 5, 60) = 0.577993E+01
-PKER_SWETH( 5, 61) = 0.578395E+01
-PKER_SWETH( 5, 62) = 0.578773E+01
-PKER_SWETH( 5, 63) = 0.579127E+01
-PKER_SWETH( 5, 64) = 0.579460E+01
-PKER_SWETH( 5, 65) = 0.579772E+01
-PKER_SWETH( 5, 66) = 0.580065E+01
-PKER_SWETH( 5, 67) = 0.580341E+01
-PKER_SWETH( 5, 68) = 0.580599E+01
-PKER_SWETH( 5, 69) = 0.580842E+01
-PKER_SWETH( 5, 70) = 0.581070E+01
-PKER_SWETH( 5, 71) = 0.581284E+01
-PKER_SWETH( 5, 72) = 0.581485E+01
-PKER_SWETH( 5, 73) = 0.581673E+01
-PKER_SWETH( 5, 74) = 0.581851E+01
-PKER_SWETH( 5, 75) = 0.582017E+01
-PKER_SWETH( 5, 76) = 0.582173E+01
-PKER_SWETH( 5, 77) = 0.582320E+01
-PKER_SWETH( 5, 78) = 0.582457E+01
-PKER_SWETH( 5, 79) = 0.582587E+01
-PKER_SWETH( 5, 80) = 0.582708E+01
-PKER_SWETH( 6, 1) = 0.133054E+01
-PKER_SWETH( 6, 2) = 0.148339E+01
-PKER_SWETH( 6, 3) = 0.164133E+01
-PKER_SWETH( 6, 4) = 0.180001E+01
-PKER_SWETH( 6, 5) = 0.195663E+01
-PKER_SWETH( 6, 6) = 0.210950E+01
-PKER_SWETH( 6, 7) = 0.225787E+01
-PKER_SWETH( 6, 8) = 0.240166E+01
-PKER_SWETH( 6, 9) = 0.254118E+01
-PKER_SWETH( 6, 10) = 0.267706E+01
-PKER_SWETH( 6, 11) = 0.281002E+01
-PKER_SWETH( 6, 12) = 0.294082E+01
-PKER_SWETH( 6, 13) = 0.307007E+01
-PKER_SWETH( 6, 14) = 0.319817E+01
-PKER_SWETH( 6, 15) = 0.332511E+01
-PKER_SWETH( 6, 16) = 0.345042E+01
-PKER_SWETH( 6, 17) = 0.357316E+01
-PKER_SWETH( 6, 18) = 0.369200E+01
-PKER_SWETH( 6, 19) = 0.380543E+01
-PKER_SWETH( 6, 20) = 0.391203E+01
-PKER_SWETH( 6, 21) = 0.401072E+01
-PKER_SWETH( 6, 22) = 0.410087E+01
-PKER_SWETH( 6, 23) = 0.418233E+01
-PKER_SWETH( 6, 24) = 0.425540E+01
-PKER_SWETH( 6, 25) = 0.432064E+01
-PKER_SWETH( 6, 26) = 0.437879E+01
-PKER_SWETH( 6, 27) = 0.443065E+01
-PKER_SWETH( 6, 28) = 0.447700E+01
-PKER_SWETH( 6, 29) = 0.451856E+01
-PKER_SWETH( 6, 30) = 0.455597E+01
-PKER_SWETH( 6, 31) = 0.458978E+01
-PKER_SWETH( 6, 32) = 0.462047E+01
-PKER_SWETH( 6, 33) = 0.464844E+01
-PKER_SWETH( 6, 34) = 0.467403E+01
-PKER_SWETH( 6, 35) = 0.469752E+01
-PKER_SWETH( 6, 36) = 0.471914E+01
-PKER_SWETH( 6, 37) = 0.473911E+01
-PKER_SWETH( 6, 38) = 0.475760E+01
-PKER_SWETH( 6, 39) = 0.477475E+01
-PKER_SWETH( 6, 40) = 0.479068E+01
-PKER_SWETH( 6, 41) = 0.480552E+01
-PKER_SWETH( 6, 42) = 0.481934E+01
-PKER_SWETH( 6, 43) = 0.483224E+01
-PKER_SWETH( 6, 44) = 0.484428E+01
-PKER_SWETH( 6, 45) = 0.485555E+01
-PKER_SWETH( 6, 46) = 0.486608E+01
-PKER_SWETH( 6, 47) = 0.487594E+01
-PKER_SWETH( 6, 48) = 0.488517E+01
-PKER_SWETH( 6, 49) = 0.489382E+01
-PKER_SWETH( 6, 50) = 0.490193E+01
-PKER_SWETH( 6, 51) = 0.490953E+01
-PKER_SWETH( 6, 52) = 0.491666E+01
-PKER_SWETH( 6, 53) = 0.492334E+01
-PKER_SWETH( 6, 54) = 0.492961E+01
-PKER_SWETH( 6, 55) = 0.493550E+01
-PKER_SWETH( 6, 56) = 0.494102E+01
-PKER_SWETH( 6, 57) = 0.494620E+01
-PKER_SWETH( 6, 58) = 0.495106E+01
-PKER_SWETH( 6, 59) = 0.495562E+01
-PKER_SWETH( 6, 60) = 0.495991E+01
-PKER_SWETH( 6, 61) = 0.496393E+01
-PKER_SWETH( 6, 62) = 0.496770E+01
-PKER_SWETH( 6, 63) = 0.497125E+01
-PKER_SWETH( 6, 64) = 0.497458E+01
-PKER_SWETH( 6, 65) = 0.497770E+01
-PKER_SWETH( 6, 66) = 0.498063E+01
-PKER_SWETH( 6, 67) = 0.498339E+01
-PKER_SWETH( 6, 68) = 0.498597E+01
-PKER_SWETH( 6, 69) = 0.498840E+01
-PKER_SWETH( 6, 70) = 0.499068E+01
-PKER_SWETH( 6, 71) = 0.499282E+01
-PKER_SWETH( 6, 72) = 0.499483E+01
-PKER_SWETH( 6, 73) = 0.499671E+01
-PKER_SWETH( 6, 74) = 0.499848E+01
-PKER_SWETH( 6, 75) = 0.500015E+01
-PKER_SWETH( 6, 76) = 0.500171E+01
-PKER_SWETH( 6, 77) = 0.500318E+01
-PKER_SWETH( 6, 78) = 0.500455E+01
-PKER_SWETH( 6, 79) = 0.500585E+01
-PKER_SWETH( 6, 80) = 0.500706E+01
-PKER_SWETH( 7, 1) = 0.882034E+00
-PKER_SWETH( 7, 2) = 0.980376E+00
-PKER_SWETH( 7, 3) = 0.109779E+01
-PKER_SWETH( 7, 4) = 0.122745E+01
-PKER_SWETH( 7, 5) = 0.136358E+01
-PKER_SWETH( 7, 6) = 0.150199E+01
-PKER_SWETH( 7, 7) = 0.163983E+01
-PKER_SWETH( 7, 8) = 0.177532E+01
-PKER_SWETH( 7, 9) = 0.190762E+01
-PKER_SWETH( 7, 10) = 0.203653E+01
-PKER_SWETH( 7, 11) = 0.216224E+01
-PKER_SWETH( 7, 12) = 0.228520E+01
-PKER_SWETH( 7, 13) = 0.240598E+01
-PKER_SWETH( 7, 14) = 0.252506E+01
-PKER_SWETH( 7, 15) = 0.264275E+01
-PKER_SWETH( 7, 16) = 0.275907E+01
-PKER_SWETH( 7, 17) = 0.287359E+01
-PKER_SWETH( 7, 18) = 0.298552E+01
-PKER_SWETH( 7, 19) = 0.309371E+01
-PKER_SWETH( 7, 20) = 0.319686E+01
-PKER_SWETH( 7, 21) = 0.329376E+01
-PKER_SWETH( 7, 22) = 0.338346E+01
-PKER_SWETH( 7, 23) = 0.346545E+01
-PKER_SWETH( 7, 24) = 0.353962E+01
-PKER_SWETH( 7, 25) = 0.360624E+01
-PKER_SWETH( 7, 26) = 0.366583E+01
-PKER_SWETH( 7, 27) = 0.371905E+01
-PKER_SWETH( 7, 28) = 0.376661E+01
-PKER_SWETH( 7, 29) = 0.380921E+01
-PKER_SWETH( 7, 30) = 0.384748E+01
-PKER_SWETH( 7, 31) = 0.388201E+01
-PKER_SWETH( 7, 32) = 0.391327E+01
-PKER_SWETH( 7, 33) = 0.394171E+01
-PKER_SWETH( 7, 34) = 0.396766E+01
-PKER_SWETH( 7, 35) = 0.399144E+01
-PKER_SWETH( 7, 36) = 0.401330E+01
-PKER_SWETH( 7, 37) = 0.403345E+01
-PKER_SWETH( 7, 38) = 0.405208E+01
-PKER_SWETH( 7, 39) = 0.406934E+01
-PKER_SWETH( 7, 40) = 0.408537E+01
-PKER_SWETH( 7, 41) = 0.410027E+01
-PKER_SWETH( 7, 42) = 0.411415E+01
-PKER_SWETH( 7, 43) = 0.412709E+01
-PKER_SWETH( 7, 44) = 0.413917E+01
-PKER_SWETH( 7, 45) = 0.415046E+01
-PKER_SWETH( 7, 46) = 0.416101E+01
-PKER_SWETH( 7, 47) = 0.417089E+01
-PKER_SWETH( 7, 48) = 0.418014E+01
-PKER_SWETH( 7, 49) = 0.418880E+01
-PKER_SWETH( 7, 50) = 0.419691E+01
-PKER_SWETH( 7, 51) = 0.420452E+01
-PKER_SWETH( 7, 52) = 0.421165E+01
-PKER_SWETH( 7, 53) = 0.421834E+01
-PKER_SWETH( 7, 54) = 0.422461E+01
-PKER_SWETH( 7, 55) = 0.423050E+01
-PKER_SWETH( 7, 56) = 0.423602E+01
-PKER_SWETH( 7, 57) = 0.424120E+01
-PKER_SWETH( 7, 58) = 0.424606E+01
-PKER_SWETH( 7, 59) = 0.425063E+01
-PKER_SWETH( 7, 60) = 0.425491E+01
-PKER_SWETH( 7, 61) = 0.425894E+01
-PKER_SWETH( 7, 62) = 0.426271E+01
-PKER_SWETH( 7, 63) = 0.426626E+01
-PKER_SWETH( 7, 64) = 0.426958E+01
-PKER_SWETH( 7, 65) = 0.427271E+01
-PKER_SWETH( 7, 66) = 0.427564E+01
-PKER_SWETH( 7, 67) = 0.427839E+01
-PKER_SWETH( 7, 68) = 0.428098E+01
-PKER_SWETH( 7, 69) = 0.428341E+01
-PKER_SWETH( 7, 70) = 0.428568E+01
-PKER_SWETH( 7, 71) = 0.428782E+01
-PKER_SWETH( 7, 72) = 0.428983E+01
-PKER_SWETH( 7, 73) = 0.429172E+01
-PKER_SWETH( 7, 74) = 0.429349E+01
-PKER_SWETH( 7, 75) = 0.429516E+01
-PKER_SWETH( 7, 76) = 0.429672E+01
-PKER_SWETH( 7, 77) = 0.429818E+01
-PKER_SWETH( 7, 78) = 0.429956E+01
-PKER_SWETH( 7, 79) = 0.430085E+01
-PKER_SWETH( 7, 80) = 0.430207E+01
-PKER_SWETH( 8, 1) = 0.663981E+00
-PKER_SWETH( 8, 2) = 0.681720E+00
-PKER_SWETH( 8, 3) = 0.732609E+00
-PKER_SWETH( 8, 4) = 0.809815E+00
-PKER_SWETH( 8, 5) = 0.906209E+00
-PKER_SWETH( 8, 6) = 0.101559E+01
-PKER_SWETH( 8, 7) = 0.113265E+01
-PKER_SWETH( 8, 8) = 0.125326E+01
-PKER_SWETH( 8, 9) = 0.137459E+01
-PKER_SWETH( 8, 10) = 0.149483E+01
-PKER_SWETH( 8, 11) = 0.161303E+01
-PKER_SWETH( 8, 12) = 0.172886E+01
-PKER_SWETH( 8, 13) = 0.184237E+01
-PKER_SWETH( 8, 14) = 0.195383E+01
-PKER_SWETH( 8, 15) = 0.206359E+01
-PKER_SWETH( 8, 16) = 0.217183E+01
-PKER_SWETH( 8, 17) = 0.227854E+01
-PKER_SWETH( 8, 18) = 0.238337E+01
-PKER_SWETH( 8, 19) = 0.248561E+01
-PKER_SWETH( 8, 20) = 0.258428E+01
-PKER_SWETH( 8, 21) = 0.267825E+01
-PKER_SWETH( 8, 22) = 0.276647E+01
-PKER_SWETH( 8, 23) = 0.284816E+01
-PKER_SWETH( 8, 24) = 0.292286E+01
-PKER_SWETH( 8, 25) = 0.299050E+01
-PKER_SWETH( 8, 26) = 0.305135E+01
-PKER_SWETH( 8, 27) = 0.310586E+01
-PKER_SWETH( 8, 28) = 0.315464E+01
-PKER_SWETH( 8, 29) = 0.319832E+01
-PKER_SWETH( 8, 30) = 0.323752E+01
-PKER_SWETH( 8, 31) = 0.327282E+01
-PKER_SWETH( 8, 32) = 0.330472E+01
-PKER_SWETH( 8, 33) = 0.333366E+01
-PKER_SWETH( 8, 34) = 0.336003E+01
-PKER_SWETH( 8, 35) = 0.338413E+01
-PKER_SWETH( 8, 36) = 0.340625E+01
-PKER_SWETH( 8, 37) = 0.342661E+01
-PKER_SWETH( 8, 38) = 0.344540E+01
-PKER_SWETH( 8, 39) = 0.346278E+01
-PKER_SWETH( 8, 40) = 0.347891E+01
-PKER_SWETH( 8, 41) = 0.349389E+01
-PKER_SWETH( 8, 42) = 0.350783E+01
-PKER_SWETH( 8, 43) = 0.352082E+01
-PKER_SWETH( 8, 44) = 0.353293E+01
-PKER_SWETH( 8, 45) = 0.354425E+01
-PKER_SWETH( 8, 46) = 0.355483E+01
-PKER_SWETH( 8, 47) = 0.356472E+01
-PKER_SWETH( 8, 48) = 0.357398E+01
-PKER_SWETH( 8, 49) = 0.358266E+01
-PKER_SWETH( 8, 50) = 0.359078E+01
-PKER_SWETH( 8, 51) = 0.359839E+01
-PKER_SWETH( 8, 52) = 0.360553E+01
-PKER_SWETH( 8, 53) = 0.361222E+01
-PKER_SWETH( 8, 54) = 0.361850E+01
-PKER_SWETH( 8, 55) = 0.362439E+01
-PKER_SWETH( 8, 56) = 0.362991E+01
-PKER_SWETH( 8, 57) = 0.363510E+01
-PKER_SWETH( 8, 58) = 0.363996E+01
-PKER_SWETH( 8, 59) = 0.364453E+01
-PKER_SWETH( 8, 60) = 0.364881E+01
-PKER_SWETH( 8, 61) = 0.365284E+01
-PKER_SWETH( 8, 62) = 0.365661E+01
-PKER_SWETH( 8, 63) = 0.366016E+01
-PKER_SWETH( 8, 64) = 0.366348E+01
-PKER_SWETH( 8, 65) = 0.366661E+01
-PKER_SWETH( 8, 66) = 0.366954E+01
-PKER_SWETH( 8, 67) = 0.367229E+01
-PKER_SWETH( 8, 68) = 0.367488E+01
-PKER_SWETH( 8, 69) = 0.367731E+01
-PKER_SWETH( 8, 70) = 0.367959E+01
-PKER_SWETH( 8, 71) = 0.368173E+01
-PKER_SWETH( 8, 72) = 0.368374E+01
-PKER_SWETH( 8, 73) = 0.368562E+01
-PKER_SWETH( 8, 74) = 0.368739E+01
-PKER_SWETH( 8, 75) = 0.368906E+01
-PKER_SWETH( 8, 76) = 0.369062E+01
-PKER_SWETH( 8, 77) = 0.369209E+01
-PKER_SWETH( 8, 78) = 0.369346E+01
-PKER_SWETH( 8, 79) = 0.369476E+01
-PKER_SWETH( 8, 80) = 0.369597E+01
-PKER_SWETH( 9, 1) = 0.677324E+00
-PKER_SWETH( 9, 2) = 0.606793E+00
-PKER_SWETH( 9, 3) = 0.574292E+00
-PKER_SWETH( 9, 4) = 0.577620E+00
-PKER_SWETH( 9, 5) = 0.611503E+00
-PKER_SWETH( 9, 6) = 0.670570E+00
-PKER_SWETH( 9, 7) = 0.748918E+00
-PKER_SWETH( 9, 8) = 0.840739E+00
-PKER_SWETH( 9, 9) = 0.941077E+00
-PKER_SWETH( 9, 10) = 0.104607E+01
-PKER_SWETH( 9, 11) = 0.115294E+01
-PKER_SWETH( 9, 12) = 0.125978E+01
-PKER_SWETH( 9, 13) = 0.136558E+01
-PKER_SWETH( 9, 14) = 0.146986E+01
-PKER_SWETH( 9, 15) = 0.157251E+01
-PKER_SWETH( 9, 16) = 0.167360E+01
-PKER_SWETH( 9, 17) = 0.177319E+01
-PKER_SWETH( 9, 18) = 0.187120E+01
-PKER_SWETH( 9, 19) = 0.196728E+01
-PKER_SWETH( 9, 20) = 0.206081E+01
-PKER_SWETH( 9, 21) = 0.215094E+01
-PKER_SWETH( 9, 22) = 0.223669E+01
-PKER_SWETH( 9, 23) = 0.231716E+01
-PKER_SWETH( 9, 24) = 0.239167E+01
-PKER_SWETH( 9, 25) = 0.245984E+01
-PKER_SWETH( 9, 26) = 0.252164E+01
-PKER_SWETH( 9, 27) = 0.257730E+01
-PKER_SWETH( 9, 28) = 0.262725E+01
-PKER_SWETH( 9, 29) = 0.267202E+01
-PKER_SWETH( 9, 30) = 0.271219E+01
-PKER_SWETH( 9, 31) = 0.274832E+01
-PKER_SWETH( 9, 32) = 0.278090E+01
-PKER_SWETH( 9, 33) = 0.281041E+01
-PKER_SWETH( 9, 34) = 0.283723E+01
-PKER_SWETH( 9, 35) = 0.286170E+01
-PKER_SWETH( 9, 36) = 0.288411E+01
-PKER_SWETH( 9, 37) = 0.290469E+01
-PKER_SWETH( 9, 38) = 0.292366E+01
-PKER_SWETH( 9, 39) = 0.294119E+01
-PKER_SWETH( 9, 40) = 0.295743E+01
-PKER_SWETH( 9, 41) = 0.297249E+01
-PKER_SWETH( 9, 42) = 0.298650E+01
-PKER_SWETH( 9, 43) = 0.299954E+01
-PKER_SWETH( 9, 44) = 0.301170E+01
-PKER_SWETH( 9, 45) = 0.302305E+01
-PKER_SWETH( 9, 46) = 0.303366E+01
-PKER_SWETH( 9, 47) = 0.304357E+01
-PKER_SWETH( 9, 48) = 0.305285E+01
-PKER_SWETH( 9, 49) = 0.306153E+01
-PKER_SWETH( 9, 50) = 0.306967E+01
-PKER_SWETH( 9, 51) = 0.307729E+01
-PKER_SWETH( 9, 52) = 0.308443E+01
-PKER_SWETH( 9, 53) = 0.309113E+01
-PKER_SWETH( 9, 54) = 0.309741E+01
-PKER_SWETH( 9, 55) = 0.310330E+01
-PKER_SWETH( 9, 56) = 0.310883E+01
-PKER_SWETH( 9, 57) = 0.311401E+01
-PKER_SWETH( 9, 58) = 0.311888E+01
-PKER_SWETH( 9, 59) = 0.312345E+01
-PKER_SWETH( 9, 60) = 0.312773E+01
-PKER_SWETH( 9, 61) = 0.313176E+01
-PKER_SWETH( 9, 62) = 0.313553E+01
-PKER_SWETH( 9, 63) = 0.313908E+01
-PKER_SWETH( 9, 64) = 0.314241E+01
-PKER_SWETH( 9, 65) = 0.314553E+01
-PKER_SWETH( 9, 66) = 0.314846E+01
-PKER_SWETH( 9, 67) = 0.315122E+01
-PKER_SWETH( 9, 68) = 0.315380E+01
-PKER_SWETH( 9, 69) = 0.315623E+01
-PKER_SWETH( 9, 70) = 0.315851E+01
-PKER_SWETH( 9, 71) = 0.316065E+01
-PKER_SWETH( 9, 72) = 0.316266E+01
-PKER_SWETH( 9, 73) = 0.316455E+01
-PKER_SWETH( 9, 74) = 0.316632E+01
-PKER_SWETH( 9, 75) = 0.316798E+01
-PKER_SWETH( 9, 76) = 0.316954E+01
-PKER_SWETH( 9, 77) = 0.317101E+01
-PKER_SWETH( 9, 78) = 0.317239E+01
-PKER_SWETH( 9, 79) = 0.317368E+01
-PKER_SWETH( 9, 80) = 0.317489E+01
-PKER_SWETH( 10, 1) = 0.862136E+00
-PKER_SWETH( 10, 2) = 0.722748E+00
-PKER_SWETH( 10, 3) = 0.615556E+00
-PKER_SWETH( 10, 4) = 0.541805E+00
-PKER_SWETH( 10, 5) = 0.501642E+00
-PKER_SWETH( 10, 6) = 0.493082E+00
-PKER_SWETH( 10, 7) = 0.513290E+00
-PKER_SWETH( 10, 8) = 0.557280E+00
-PKER_SWETH( 10, 9) = 0.620074E+00
-PKER_SWETH( 10, 10) = 0.696671E+00
-PKER_SWETH( 10, 11) = 0.782464E+00
-PKER_SWETH( 10, 12) = 0.873848E+00
-PKER_SWETH( 10, 13) = 0.968012E+00
-PKER_SWETH( 10, 14) = 0.106310E+01
-PKER_SWETH( 10, 15) = 0.115798E+01
-PKER_SWETH( 10, 16) = 0.125199E+01
-PKER_SWETH( 10, 17) = 0.134486E+01
-PKER_SWETH( 10, 18) = 0.143642E+01
-PKER_SWETH( 10, 19) = 0.152645E+01
-PKER_SWETH( 10, 20) = 0.161460E+01
-PKER_SWETH( 10, 21) = 0.170028E+01
-PKER_SWETH( 10, 22) = 0.178274E+01
-PKER_SWETH( 10, 23) = 0.186111E+01
-PKER_SWETH( 10, 24) = 0.193463E+01
-PKER_SWETH( 10, 25) = 0.200271E+01
-PKER_SWETH( 10, 26) = 0.206503E+01
-PKER_SWETH( 10, 27) = 0.212157E+01
-PKER_SWETH( 10, 28) = 0.217256E+01
-PKER_SWETH( 10, 29) = 0.221840E+01
-PKER_SWETH( 10, 30) = 0.225956E+01
-PKER_SWETH( 10, 31) = 0.229655E+01
-PKER_SWETH( 10, 32) = 0.232988E+01
-PKER_SWETH( 10, 33) = 0.236000E+01
-PKER_SWETH( 10, 34) = 0.238732E+01
-PKER_SWETH( 10, 35) = 0.241219E+01
-PKER_SWETH( 10, 36) = 0.243492E+01
-PKER_SWETH( 10, 37) = 0.245577E+01
-PKER_SWETH( 10, 38) = 0.247494E+01
-PKER_SWETH( 10, 39) = 0.249263E+01
-PKER_SWETH( 10, 40) = 0.250899E+01
-PKER_SWETH( 10, 41) = 0.252415E+01
-PKER_SWETH( 10, 42) = 0.253824E+01
-PKER_SWETH( 10, 43) = 0.255134E+01
-PKER_SWETH( 10, 44) = 0.256355E+01
-PKER_SWETH( 10, 45) = 0.257494E+01
-PKER_SWETH( 10, 46) = 0.258557E+01
-PKER_SWETH( 10, 47) = 0.259551E+01
-PKER_SWETH( 10, 48) = 0.260480E+01
-PKER_SWETH( 10, 49) = 0.261350E+01
-PKER_SWETH( 10, 50) = 0.262165E+01
-PKER_SWETH( 10, 51) = 0.262927E+01
-PKER_SWETH( 10, 52) = 0.263642E+01
-PKER_SWETH( 10, 53) = 0.264313E+01
-PKER_SWETH( 10, 54) = 0.264941E+01
-PKER_SWETH( 10, 55) = 0.265531E+01
-PKER_SWETH( 10, 56) = 0.266084E+01
-PKER_SWETH( 10, 57) = 0.266602E+01
-PKER_SWETH( 10, 58) = 0.267089E+01
-PKER_SWETH( 10, 59) = 0.267546E+01
-PKER_SWETH( 10, 60) = 0.267975E+01
-PKER_SWETH( 10, 61) = 0.268377E+01
-PKER_SWETH( 10, 62) = 0.268755E+01
-PKER_SWETH( 10, 63) = 0.269109E+01
-PKER_SWETH( 10, 64) = 0.269442E+01
-PKER_SWETH( 10, 65) = 0.269755E+01
-PKER_SWETH( 10, 66) = 0.270048E+01
-PKER_SWETH( 10, 67) = 0.270323E+01
-PKER_SWETH( 10, 68) = 0.270582E+01
-PKER_SWETH( 10, 69) = 0.270825E+01
-PKER_SWETH( 10, 70) = 0.271053E+01
-PKER_SWETH( 10, 71) = 0.271267E+01
-PKER_SWETH( 10, 72) = 0.271468E+01
-PKER_SWETH( 10, 73) = 0.271656E+01
-PKER_SWETH( 10, 74) = 0.271833E+01
-PKER_SWETH( 10, 75) = 0.272000E+01
-PKER_SWETH( 10, 76) = 0.272156E+01
-PKER_SWETH( 10, 77) = 0.272303E+01
-PKER_SWETH( 10, 78) = 0.272440E+01
-PKER_SWETH( 10, 79) = 0.272570E+01
-PKER_SWETH( 10, 80) = 0.272691E+01
-PKER_SWETH( 11, 1) = 0.112616E+01
-PKER_SWETH( 11, 2) = 0.949999E+00
-PKER_SWETH( 11, 3) = 0.795521E+00
-PKER_SWETH( 11, 4) = 0.665367E+00
-PKER_SWETH( 11, 5) = 0.562111E+00
-PKER_SWETH( 11, 6) = 0.487299E+00
-PKER_SWETH( 11, 7) = 0.441862E+00
-PKER_SWETH( 11, 8) = 0.424814E+00
-PKER_SWETH( 11, 9) = 0.433720E+00
-PKER_SWETH( 11, 10) = 0.465112E+00
-PKER_SWETH( 11, 11) = 0.514757E+00
-PKER_SWETH( 11, 12) = 0.578272E+00
-PKER_SWETH( 11, 13) = 0.651459E+00
-PKER_SWETH( 11, 14) = 0.730946E+00
-PKER_SWETH( 11, 15) = 0.814029E+00
-PKER_SWETH( 11, 16) = 0.898773E+00
-PKER_SWETH( 11, 17) = 0.983944E+00
-PKER_SWETH( 11, 18) = 0.106874E+01
-PKER_SWETH( 11, 19) = 0.115266E+01
-PKER_SWETH( 11, 20) = 0.123529E+01
-PKER_SWETH( 11, 21) = 0.131618E+01
-PKER_SWETH( 11, 22) = 0.139474E+01
-PKER_SWETH( 11, 23) = 0.147027E+01
-PKER_SWETH( 11, 24) = 0.154202E+01
-PKER_SWETH( 11, 25) = 0.160929E+01
-PKER_SWETH( 11, 26) = 0.167158E+01
-PKER_SWETH( 11, 27) = 0.172864E+01
-PKER_SWETH( 11, 28) = 0.178046E+01
-PKER_SWETH( 11, 29) = 0.182725E+01
-PKER_SWETH( 11, 30) = 0.186937E+01
-PKER_SWETH( 11, 31) = 0.190725E+01
-PKER_SWETH( 11, 32) = 0.194136E+01
-PKER_SWETH( 11, 33) = 0.197215E+01
-PKER_SWETH( 11, 34) = 0.200002E+01
-PKER_SWETH( 11, 35) = 0.202534E+01
-PKER_SWETH( 11, 36) = 0.204844E+01
-PKER_SWETH( 11, 37) = 0.206957E+01
-PKER_SWETH( 11, 38) = 0.208897E+01
-PKER_SWETH( 11, 39) = 0.210683E+01
-PKER_SWETH( 11, 40) = 0.212334E+01
-PKER_SWETH( 11, 41) = 0.213861E+01
-PKER_SWETH( 11, 42) = 0.215278E+01
-PKER_SWETH( 11, 43) = 0.216596E+01
-PKER_SWETH( 11, 44) = 0.217822E+01
-PKER_SWETH( 11, 45) = 0.218965E+01
-PKER_SWETH( 11, 46) = 0.220031E+01
-PKER_SWETH( 11, 47) = 0.221028E+01
-PKER_SWETH( 11, 48) = 0.221959E+01
-PKER_SWETH( 11, 49) = 0.222830E+01
-PKER_SWETH( 11, 50) = 0.223646E+01
-PKER_SWETH( 11, 51) = 0.224410E+01
-PKER_SWETH( 11, 52) = 0.225126E+01
-PKER_SWETH( 11, 53) = 0.225796E+01
-PKER_SWETH( 11, 54) = 0.226425E+01
-PKER_SWETH( 11, 55) = 0.227015E+01
-PKER_SWETH( 11, 56) = 0.227568E+01
-PKER_SWETH( 11, 57) = 0.228087E+01
-PKER_SWETH( 11, 58) = 0.228574E+01
-PKER_SWETH( 11, 59) = 0.229031E+01
-PKER_SWETH( 11, 60) = 0.229460E+01
-PKER_SWETH( 11, 61) = 0.229863E+01
-PKER_SWETH( 11, 62) = 0.230240E+01
-PKER_SWETH( 11, 63) = 0.230595E+01
-PKER_SWETH( 11, 64) = 0.230928E+01
-PKER_SWETH( 11, 65) = 0.231240E+01
-PKER_SWETH( 11, 66) = 0.231534E+01
-PKER_SWETH( 11, 67) = 0.231809E+01
-PKER_SWETH( 11, 68) = 0.232068E+01
-PKER_SWETH( 11, 69) = 0.232311E+01
-PKER_SWETH( 11, 70) = 0.232539E+01
-PKER_SWETH( 11, 71) = 0.232753E+01
-PKER_SWETH( 11, 72) = 0.232953E+01
-PKER_SWETH( 11, 73) = 0.233142E+01
-PKER_SWETH( 11, 74) = 0.233319E+01
-PKER_SWETH( 11, 75) = 0.233486E+01
-PKER_SWETH( 11, 76) = 0.233642E+01
-PKER_SWETH( 11, 77) = 0.233788E+01
-PKER_SWETH( 11, 78) = 0.233926E+01
-PKER_SWETH( 11, 79) = 0.234055E+01
-PKER_SWETH( 11, 80) = 0.234177E+01
-PKER_SWETH( 12, 1) = 0.139660E+01
-PKER_SWETH( 12, 2) = 0.120724E+01
-PKER_SWETH( 12, 3) = 0.103274E+01
-PKER_SWETH( 12, 4) = 0.874299E+00
-PKER_SWETH( 12, 5) = 0.733680E+00
-PKER_SWETH( 12, 6) = 0.613159E+00
-PKER_SWETH( 12, 7) = 0.515044E+00
-PKER_SWETH( 12, 8) = 0.441045E+00
-PKER_SWETH( 12, 9) = 0.392420E+00
-PKER_SWETH( 12, 10) = 0.369044E+00
-PKER_SWETH( 12, 11) = 0.369169E+00
-PKER_SWETH( 12, 12) = 0.390273E+00
-PKER_SWETH( 12, 13) = 0.428905E+00
-PKER_SWETH( 12, 14) = 0.481190E+00
-PKER_SWETH( 12, 15) = 0.543494E+00
-PKER_SWETH( 12, 16) = 0.612648E+00
-PKER_SWETH( 12, 17) = 0.685999E+00
-PKER_SWETH( 12, 18) = 0.761603E+00
-PKER_SWETH( 12, 19) = 0.838094E+00
-PKER_SWETH( 12, 20) = 0.914490E+00
-PKER_SWETH( 12, 21) = 0.990075E+00
-PKER_SWETH( 12, 22) = 0.106422E+01
-PKER_SWETH( 12, 23) = 0.113626E+01
-PKER_SWETH( 12, 24) = 0.120550E+01
-PKER_SWETH( 12, 25) = 0.127125E+01
-PKER_SWETH( 12, 26) = 0.133290E+01
-PKER_SWETH( 12, 27) = 0.138999E+01
-PKER_SWETH( 12, 28) = 0.144231E+01
-PKER_SWETH( 12, 29) = 0.148987E+01
-PKER_SWETH( 12, 30) = 0.153286E+01
-PKER_SWETH( 12, 31) = 0.157162E+01
-PKER_SWETH( 12, 32) = 0.160653E+01
-PKER_SWETH( 12, 33) = 0.163802E+01
-PKER_SWETH( 12, 34) = 0.166649E+01
-PKER_SWETH( 12, 35) = 0.169231E+01
-PKER_SWETH( 12, 36) = 0.171580E+01
-PKER_SWETH( 12, 37) = 0.173725E+01
-PKER_SWETH( 12, 38) = 0.175691E+01
-PKER_SWETH( 12, 39) = 0.177498E+01
-PKER_SWETH( 12, 40) = 0.179164E+01
-PKER_SWETH( 12, 41) = 0.180705E+01
-PKER_SWETH( 12, 42) = 0.182132E+01
-PKER_SWETH( 12, 43) = 0.183457E+01
-PKER_SWETH( 12, 44) = 0.184689E+01
-PKER_SWETH( 12, 45) = 0.185836E+01
-PKER_SWETH( 12, 46) = 0.186907E+01
-PKER_SWETH( 12, 47) = 0.187906E+01
-PKER_SWETH( 12, 48) = 0.188839E+01
-PKER_SWETH( 12, 49) = 0.189712E+01
-PKER_SWETH( 12, 50) = 0.190530E+01
-PKER_SWETH( 12, 51) = 0.191295E+01
-PKER_SWETH( 12, 52) = 0.192011E+01
-PKER_SWETH( 12, 53) = 0.192683E+01
-PKER_SWETH( 12, 54) = 0.193312E+01
-PKER_SWETH( 12, 55) = 0.193902E+01
-PKER_SWETH( 12, 56) = 0.194456E+01
-PKER_SWETH( 12, 57) = 0.194975E+01
-PKER_SWETH( 12, 58) = 0.195462E+01
-PKER_SWETH( 12, 59) = 0.195919E+01
-PKER_SWETH( 12, 60) = 0.196348E+01
-PKER_SWETH( 12, 61) = 0.196751E+01
-PKER_SWETH( 12, 62) = 0.197129E+01
-PKER_SWETH( 12, 63) = 0.197483E+01
-PKER_SWETH( 12, 64) = 0.197816E+01
-PKER_SWETH( 12, 65) = 0.198129E+01
-PKER_SWETH( 12, 66) = 0.198422E+01
-PKER_SWETH( 12, 67) = 0.198698E+01
-PKER_SWETH( 12, 68) = 0.198956E+01
-PKER_SWETH( 12, 69) = 0.199199E+01
-PKER_SWETH( 12, 70) = 0.199427E+01
-PKER_SWETH( 12, 71) = 0.199641E+01
-PKER_SWETH( 12, 72) = 0.199842E+01
-PKER_SWETH( 12, 73) = 0.200031E+01
-PKER_SWETH( 12, 74) = 0.200208E+01
-PKER_SWETH( 12, 75) = 0.200374E+01
-PKER_SWETH( 12, 76) = 0.200530E+01
-PKER_SWETH( 12, 77) = 0.200677E+01
-PKER_SWETH( 12, 78) = 0.200815E+01
-PKER_SWETH( 12, 79) = 0.200944E+01
-PKER_SWETH( 12, 80) = 0.201065E+01
-PKER_SWETH( 13, 1) = 0.164107E+01
-PKER_SWETH( 13, 2) = 0.144869E+01
-PKER_SWETH( 13, 3) = 0.126862E+01
-PKER_SWETH( 13, 4) = 0.110074E+01
-PKER_SWETH( 13, 5) = 0.945359E+00
-PKER_SWETH( 13, 6) = 0.803325E+00
-PKER_SWETH( 13, 7) = 0.675971E+00
-PKER_SWETH( 13, 8) = 0.565209E+00
-PKER_SWETH( 13, 9) = 0.473028E+00
-PKER_SWETH( 13, 10) = 0.401201E+00
-PKER_SWETH( 13, 11) = 0.351280E+00
-PKER_SWETH( 13, 12) = 0.323281E+00
-PKER_SWETH( 13, 13) = 0.316755E+00
-PKER_SWETH( 13, 14) = 0.329470E+00
-PKER_SWETH( 13, 15) = 0.358858E+00
-PKER_SWETH( 13, 16) = 0.401716E+00
-PKER_SWETH( 13, 17) = 0.454695E+00
-PKER_SWETH( 13, 18) = 0.514860E+00
-PKER_SWETH( 13, 19) = 0.579683E+00
-PKER_SWETH( 13, 20) = 0.647150E+00
-PKER_SWETH( 13, 21) = 0.715769E+00
-PKER_SWETH( 13, 22) = 0.784383E+00
-PKER_SWETH( 13, 23) = 0.852082E+00
-PKER_SWETH( 13, 24) = 0.918051E+00
-PKER_SWETH( 13, 25) = 0.981534E+00
-PKER_SWETH( 13, 26) = 0.104184E+01
-PKER_SWETH( 13, 27) = 0.109839E+01
-PKER_SWETH( 13, 28) = 0.115078E+01
-PKER_SWETH( 13, 29) = 0.119883E+01
-PKER_SWETH( 13, 30) = 0.124254E+01
-PKER_SWETH( 13, 31) = 0.128210E+01
-PKER_SWETH( 13, 32) = 0.131781E+01
-PKER_SWETH( 13, 33) = 0.135003E+01
-PKER_SWETH( 13, 34) = 0.137913E+01
-PKER_SWETH( 13, 35) = 0.140548E+01
-PKER_SWETH( 13, 36) = 0.142942E+01
-PKER_SWETH( 13, 37) = 0.145123E+01
-PKER_SWETH( 13, 38) = 0.147118E+01
-PKER_SWETH( 13, 39) = 0.148948E+01
-PKER_SWETH( 13, 40) = 0.150632E+01
-PKER_SWETH( 13, 41) = 0.152187E+01
-PKER_SWETH( 13, 42) = 0.153625E+01
-PKER_SWETH( 13, 43) = 0.154959E+01
-PKER_SWETH( 13, 44) = 0.156198E+01
-PKER_SWETH( 13, 45) = 0.157350E+01
-PKER_SWETH( 13, 46) = 0.158425E+01
-PKER_SWETH( 13, 47) = 0.159427E+01
-PKER_SWETH( 13, 48) = 0.160364E+01
-PKER_SWETH( 13, 49) = 0.161239E+01
-PKER_SWETH( 13, 50) = 0.162057E+01
-PKER_SWETH( 13, 51) = 0.162823E+01
-PKER_SWETH( 13, 52) = 0.163541E+01
-PKER_SWETH( 13, 53) = 0.164213E+01
-PKER_SWETH( 13, 54) = 0.164843E+01
-PKER_SWETH( 13, 55) = 0.165434E+01
-PKER_SWETH( 13, 56) = 0.165988E+01
-PKER_SWETH( 13, 57) = 0.166507E+01
-PKER_SWETH( 13, 58) = 0.166995E+01
-PKER_SWETH( 13, 59) = 0.167452E+01
-PKER_SWETH( 13, 60) = 0.167881E+01
-PKER_SWETH( 13, 61) = 0.168284E+01
-PKER_SWETH( 13, 62) = 0.168662E+01
-PKER_SWETH( 13, 63) = 0.169016E+01
-PKER_SWETH( 13, 64) = 0.169349E+01
-PKER_SWETH( 13, 65) = 0.169662E+01
-PKER_SWETH( 13, 66) = 0.169955E+01
-PKER_SWETH( 13, 67) = 0.170231E+01
-PKER_SWETH( 13, 68) = 0.170489E+01
-PKER_SWETH( 13, 69) = 0.170732E+01
-PKER_SWETH( 13, 70) = 0.170960E+01
-PKER_SWETH( 13, 71) = 0.171174E+01
-PKER_SWETH( 13, 72) = 0.171375E+01
-PKER_SWETH( 13, 73) = 0.171564E+01
-PKER_SWETH( 13, 74) = 0.171741E+01
-PKER_SWETH( 13, 75) = 0.171907E+01
-PKER_SWETH( 13, 76) = 0.172064E+01
-PKER_SWETH( 13, 77) = 0.172210E+01
-PKER_SWETH( 13, 78) = 0.172348E+01
-PKER_SWETH( 13, 79) = 0.172477E+01
-PKER_SWETH( 13, 80) = 0.172599E+01
-PKER_SWETH( 14, 1) = 0.185337E+01
-PKER_SWETH( 14, 2) = 0.166060E+01
-PKER_SWETH( 14, 3) = 0.147961E+01
-PKER_SWETH( 14, 4) = 0.130976E+01
-PKER_SWETH( 14, 5) = 0.115060E+01
-PKER_SWETH( 14, 6) = 0.100191E+01
-PKER_SWETH( 14, 7) = 0.863788E+00
-PKER_SWETH( 14, 8) = 0.736793E+00
-PKER_SWETH( 14, 9) = 0.621950E+00
-PKER_SWETH( 14, 10) = 0.520776E+00
-PKER_SWETH( 14, 11) = 0.434983E+00
-PKER_SWETH( 14, 12) = 0.366291E+00
-PKER_SWETH( 14, 13) = 0.316372E+00
-PKER_SWETH( 14, 14) = 0.285641E+00
-PKER_SWETH( 14, 15) = 0.273863E+00
-PKER_SWETH( 14, 16) = 0.280100E+00
-PKER_SWETH( 14, 17) = 0.301904E+00
-PKER_SWETH( 14, 18) = 0.336737E+00
-PKER_SWETH( 14, 19) = 0.381763E+00
-PKER_SWETH( 14, 20) = 0.434146E+00
-PKER_SWETH( 14, 21) = 0.491424E+00
-PKER_SWETH( 14, 22) = 0.551565E+00
-PKER_SWETH( 14, 23) = 0.612952E+00
-PKER_SWETH( 14, 24) = 0.674250E+00
-PKER_SWETH( 14, 25) = 0.734405E+00
-PKER_SWETH( 14, 26) = 0.792509E+00
-PKER_SWETH( 14, 27) = 0.847809E+00
-PKER_SWETH( 14, 28) = 0.899720E+00
-PKER_SWETH( 14, 29) = 0.947851E+00
-PKER_SWETH( 14, 30) = 0.992022E+00
-PKER_SWETH( 14, 31) = 0.103225E+01
-PKER_SWETH( 14, 32) = 0.106869E+01
-PKER_SWETH( 14, 33) = 0.110164E+01
-PKER_SWETH( 14, 34) = 0.113141E+01
-PKER_SWETH( 14, 35) = 0.115833E+01
-PKER_SWETH( 14, 36) = 0.118275E+01
-PKER_SWETH( 14, 37) = 0.120497E+01
-PKER_SWETH( 14, 38) = 0.122524E+01
-PKER_SWETH( 14, 39) = 0.124380E+01
-PKER_SWETH( 14, 40) = 0.126084E+01
-PKER_SWETH( 14, 41) = 0.127655E+01
-PKER_SWETH( 14, 42) = 0.129106E+01
-PKER_SWETH( 14, 43) = 0.130450E+01
-PKER_SWETH( 14, 44) = 0.131696E+01
-PKER_SWETH( 14, 45) = 0.132855E+01
-PKER_SWETH( 14, 46) = 0.133935E+01
-PKER_SWETH( 14, 47) = 0.134941E+01
-PKER_SWETH( 14, 48) = 0.135880E+01
-PKER_SWETH( 14, 49) = 0.136757E+01
-PKER_SWETH( 14, 50) = 0.137577E+01
-PKER_SWETH( 14, 51) = 0.138345E+01
-PKER_SWETH( 14, 52) = 0.139064E+01
-PKER_SWETH( 14, 53) = 0.139737E+01
-PKER_SWETH( 14, 54) = 0.140367E+01
-PKER_SWETH( 14, 55) = 0.140959E+01
-PKER_SWETH( 14, 56) = 0.141513E+01
-PKER_SWETH( 14, 57) = 0.142033E+01
-PKER_SWETH( 14, 58) = 0.142520E+01
-PKER_SWETH( 14, 59) = 0.142978E+01
-PKER_SWETH( 14, 60) = 0.143407E+01
-PKER_SWETH( 14, 61) = 0.143810E+01
-PKER_SWETH( 14, 62) = 0.144188E+01
-PKER_SWETH( 14, 63) = 0.144542E+01
-PKER_SWETH( 14, 64) = 0.144876E+01
-PKER_SWETH( 14, 65) = 0.145188E+01
-PKER_SWETH( 14, 66) = 0.145482E+01
-PKER_SWETH( 14, 67) = 0.145757E+01
-PKER_SWETH( 14, 68) = 0.146016E+01
-PKER_SWETH( 14, 69) = 0.146259E+01
-PKER_SWETH( 14, 70) = 0.146487E+01
-PKER_SWETH( 14, 71) = 0.146701E+01
-PKER_SWETH( 14, 72) = 0.146902E+01
-PKER_SWETH( 14, 73) = 0.147090E+01
-PKER_SWETH( 14, 74) = 0.147267E+01
-PKER_SWETH( 14, 75) = 0.147434E+01
-PKER_SWETH( 14, 76) = 0.147590E+01
-PKER_SWETH( 14, 77) = 0.147737E+01
-PKER_SWETH( 14, 78) = 0.147874E+01
-PKER_SWETH( 14, 79) = 0.148004E+01
-PKER_SWETH( 14, 80) = 0.148125E+01
-PKER_SWETH( 15, 1) = 0.203610E+01
-PKER_SWETH( 15, 2) = 0.184336E+01
-PKER_SWETH( 15, 3) = 0.166233E+01
-PKER_SWETH( 15, 4) = 0.149229E+01
-PKER_SWETH( 15, 5) = 0.133259E+01
-PKER_SWETH( 15, 6) = 0.118265E+01
-PKER_SWETH( 15, 7) = 0.104202E+01
-PKER_SWETH( 15, 8) = 0.910402E+00
-PKER_SWETH( 15, 9) = 0.787789E+00
-PKER_SWETH( 15, 10) = 0.674500E+00
-PKER_SWETH( 15, 11) = 0.571280E+00
-PKER_SWETH( 15, 12) = 0.479328E+00
-PKER_SWETH( 15, 13) = 0.400096E+00
-PKER_SWETH( 15, 14) = 0.335213E+00
-PKER_SWETH( 15, 15) = 0.286253E+00
-PKER_SWETH( 15, 16) = 0.254024E+00
-PKER_SWETH( 15, 17) = 0.238776E+00
-PKER_SWETH( 15, 18) = 0.239689E+00
-PKER_SWETH( 15, 19) = 0.255453E+00
-PKER_SWETH( 15, 20) = 0.283677E+00
-PKER_SWETH( 15, 21) = 0.321870E+00
-PKER_SWETH( 15, 22) = 0.367476E+00
-PKER_SWETH( 15, 23) = 0.418056E+00
-PKER_SWETH( 15, 24) = 0.471544E+00
-PKER_SWETH( 15, 25) = 0.526175E+00
-PKER_SWETH( 15, 26) = 0.580531E+00
-PKER_SWETH( 15, 27) = 0.633468E+00
-PKER_SWETH( 15, 28) = 0.684080E+00
-PKER_SWETH( 15, 29) = 0.731716E+00
-PKER_SWETH( 15, 30) = 0.775955E+00
-PKER_SWETH( 15, 31) = 0.816603E+00
-PKER_SWETH( 15, 32) = 0.853662E+00
-PKER_SWETH( 15, 33) = 0.887282E+00
-PKER_SWETH( 15, 34) = 0.917709E+00
-PKER_SWETH( 15, 35) = 0.945240E+00
-PKER_SWETH( 15, 36) = 0.970182E+00
-PKER_SWETH( 15, 37) = 0.992831E+00
-PKER_SWETH( 15, 38) = 0.101346E+01
-PKER_SWETH( 15, 39) = 0.103231E+01
-PKER_SWETH( 15, 40) = 0.104959E+01
-PKER_SWETH( 15, 41) = 0.106548E+01
-PKER_SWETH( 15, 42) = 0.108014E+01
-PKER_SWETH( 15, 43) = 0.109369E+01
-PKER_SWETH( 15, 44) = 0.110624E+01
-PKER_SWETH( 15, 45) = 0.111790E+01
-PKER_SWETH( 15, 46) = 0.112875E+01
-PKER_SWETH( 15, 47) = 0.113885E+01
-PKER_SWETH( 15, 48) = 0.114828E+01
-PKER_SWETH( 15, 49) = 0.115708E+01
-PKER_SWETH( 15, 50) = 0.116530E+01
-PKER_SWETH( 15, 51) = 0.117299E+01
-PKER_SWETH( 15, 52) = 0.118019E+01
-PKER_SWETH( 15, 53) = 0.118693E+01
-PKER_SWETH( 15, 54) = 0.119324E+01
-PKER_SWETH( 15, 55) = 0.119916E+01
-PKER_SWETH( 15, 56) = 0.120471E+01
-PKER_SWETH( 15, 57) = 0.120991E+01
-PKER_SWETH( 15, 58) = 0.121479E+01
-PKER_SWETH( 15, 59) = 0.121936E+01
-PKER_SWETH( 15, 60) = 0.122366E+01
-PKER_SWETH( 15, 61) = 0.122769E+01
-PKER_SWETH( 15, 62) = 0.123147E+01
-PKER_SWETH( 15, 63) = 0.123502E+01
-PKER_SWETH( 15, 64) = 0.123835E+01
-PKER_SWETH( 15, 65) = 0.124147E+01
-PKER_SWETH( 15, 66) = 0.124441E+01
-PKER_SWETH( 15, 67) = 0.124717E+01
-PKER_SWETH( 15, 68) = 0.124975E+01
-PKER_SWETH( 15, 69) = 0.125218E+01
-PKER_SWETH( 15, 70) = 0.125446E+01
-PKER_SWETH( 15, 71) = 0.125660E+01
-PKER_SWETH( 15, 72) = 0.125861E+01
-PKER_SWETH( 15, 73) = 0.126050E+01
-PKER_SWETH( 15, 74) = 0.126227E+01
-PKER_SWETH( 15, 75) = 0.126393E+01
-PKER_SWETH( 15, 76) = 0.126550E+01
-PKER_SWETH( 15, 77) = 0.126696E+01
-PKER_SWETH( 15, 78) = 0.126834E+01
-PKER_SWETH( 15, 79) = 0.126963E+01
-PKER_SWETH( 15, 80) = 0.127085E+01
-PKER_SWETH( 16, 1) = 0.219318E+01
-PKER_SWETH( 16, 2) = 0.200050E+01
-PKER_SWETH( 16, 3) = 0.181953E+01
-PKER_SWETH( 16, 4) = 0.164954E+01
-PKER_SWETH( 16, 5) = 0.148986E+01
-PKER_SWETH( 16, 6) = 0.133986E+01
-PKER_SWETH( 16, 7) = 0.119894E+01
-PKER_SWETH( 16, 8) = 0.106658E+01
-PKER_SWETH( 16, 9) = 0.942332E+00
-PKER_SWETH( 16, 10) = 0.825890E+00
-PKER_SWETH( 16, 11) = 0.717136E+00
-PKER_SWETH( 16, 12) = 0.616243E+00
-PKER_SWETH( 16, 13) = 0.523726E+00
-PKER_SWETH( 16, 14) = 0.440499E+00
-PKER_SWETH( 16, 15) = 0.367802E+00
-PKER_SWETH( 16, 16) = 0.307111E+00
-PKER_SWETH( 16, 17) = 0.259898E+00
-PKER_SWETH( 16, 18) = 0.227152E+00
-PKER_SWETH( 16, 19) = 0.209525E+00
-PKER_SWETH( 16, 20) = 0.206680E+00
-PKER_SWETH( 16, 21) = 0.217492E+00
-PKER_SWETH( 16, 22) = 0.240214E+00
-PKER_SWETH( 16, 23) = 0.272625E+00
-PKER_SWETH( 16, 24) = 0.312313E+00
-PKER_SWETH( 16, 25) = 0.356881E+00
-PKER_SWETH( 16, 26) = 0.404226E+00
-PKER_SWETH( 16, 27) = 0.452518E+00
-PKER_SWETH( 16, 28) = 0.500271E+00
-PKER_SWETH( 16, 29) = 0.546362E+00
-PKER_SWETH( 16, 30) = 0.589978E+00
-PKER_SWETH( 16, 31) = 0.630616E+00
-PKER_SWETH( 16, 32) = 0.668036E+00
-PKER_SWETH( 16, 33) = 0.702206E+00
-PKER_SWETH( 16, 34) = 0.733247E+00
-PKER_SWETH( 16, 35) = 0.761379E+00
-PKER_SWETH( 16, 36) = 0.786868E+00
-PKER_SWETH( 16, 37) = 0.809991E+00
-PKER_SWETH( 16, 38) = 0.831017E+00
-PKER_SWETH( 16, 39) = 0.850192E+00
-PKER_SWETH( 16, 40) = 0.867735E+00
-PKER_SWETH( 16, 41) = 0.883835E+00
-PKER_SWETH( 16, 42) = 0.898655E+00
-PKER_SWETH( 16, 43) = 0.912335E+00
-PKER_SWETH( 16, 44) = 0.924994E+00
-PKER_SWETH( 16, 45) = 0.936734E+00
-PKER_SWETH( 16, 46) = 0.947641E+00
-PKER_SWETH( 16, 47) = 0.957793E+00
-PKER_SWETH( 16, 48) = 0.967254E+00
-PKER_SWETH( 16, 49) = 0.976083E+00
-PKER_SWETH( 16, 50) = 0.984329E+00
-PKER_SWETH( 16, 51) = 0.992038E+00
-PKER_SWETH( 16, 52) = 0.999250E+00
-PKER_SWETH( 16, 53) = 0.100600E+01
-PKER_SWETH( 16, 54) = 0.101232E+01
-PKER_SWETH( 16, 55) = 0.101825E+01
-PKER_SWETH( 16, 56) = 0.102380E+01
-PKER_SWETH( 16, 57) = 0.102900E+01
-PKER_SWETH( 16, 58) = 0.103389E+01
-PKER_SWETH( 16, 59) = 0.103847E+01
-PKER_SWETH( 16, 60) = 0.104276E+01
-PKER_SWETH( 16, 61) = 0.104679E+01
-PKER_SWETH( 16, 62) = 0.105057E+01
-PKER_SWETH( 16, 63) = 0.105412E+01
-PKER_SWETH( 16, 64) = 0.105746E+01
-PKER_SWETH( 16, 65) = 0.106058E+01
-PKER_SWETH( 16, 66) = 0.106352E+01
-PKER_SWETH( 16, 67) = 0.106627E+01
-PKER_SWETH( 16, 68) = 0.106886E+01
-PKER_SWETH( 16, 69) = 0.107129E+01
-PKER_SWETH( 16, 70) = 0.107357E+01
-PKER_SWETH( 16, 71) = 0.107571E+01
-PKER_SWETH( 16, 72) = 0.107772E+01
-PKER_SWETH( 16, 73) = 0.107961E+01
-PKER_SWETH( 16, 74) = 0.108138E+01
-PKER_SWETH( 16, 75) = 0.108304E+01
-PKER_SWETH( 16, 76) = 0.108461E+01
-PKER_SWETH( 16, 77) = 0.108607E+01
-PKER_SWETH( 16, 78) = 0.108745E+01
-PKER_SWETH( 16, 79) = 0.108874E+01
-PKER_SWETH( 16, 80) = 0.108996E+01
-PKER_SWETH( 17, 1) = 0.232820E+01
-PKER_SWETH( 17, 2) = 0.213556E+01
-PKER_SWETH( 17, 3) = 0.195464E+01
-PKER_SWETH( 17, 4) = 0.178471E+01
-PKER_SWETH( 17, 5) = 0.162511E+01
-PKER_SWETH( 17, 6) = 0.147518E+01
-PKER_SWETH( 17, 7) = 0.133432E+01
-PKER_SWETH( 17, 8) = 0.120198E+01
-PKER_SWETH( 17, 9) = 0.107762E+01
-PKER_SWETH( 17, 10) = 0.960766E+00
-PKER_SWETH( 17, 11) = 0.851000E+00
-PKER_SWETH( 17, 12) = 0.748002E+00
-PKER_SWETH( 17, 13) = 0.651604E+00
-PKER_SWETH( 17, 14) = 0.561851E+00
-PKER_SWETH( 17, 15) = 0.479102E+00
-PKER_SWETH( 17, 16) = 0.404036E+00
-PKER_SWETH( 17, 17) = 0.337673E+00
-PKER_SWETH( 17, 18) = 0.281335E+00
-PKER_SWETH( 17, 19) = 0.236404E+00
-PKER_SWETH( 17, 20) = 0.203985E+00
-PKER_SWETH( 17, 21) = 0.184918E+00
-PKER_SWETH( 17, 22) = 0.179297E+00
-PKER_SWETH( 17, 23) = 0.186284E+00
-PKER_SWETH( 17, 24) = 0.204524E+00
-PKER_SWETH( 17, 25) = 0.232026E+00
-PKER_SWETH( 17, 26) = 0.266485E+00
-PKER_SWETH( 17, 27) = 0.305597E+00
-PKER_SWETH( 17, 28) = 0.347234E+00
-PKER_SWETH( 17, 29) = 0.389540E+00
-PKER_SWETH( 17, 30) = 0.431069E+00
-PKER_SWETH( 17, 31) = 0.470786E+00
-PKER_SWETH( 17, 32) = 0.508025E+00
-PKER_SWETH( 17, 33) = 0.542446E+00
-PKER_SWETH( 17, 34) = 0.573958E+00
-PKER_SWETH( 17, 35) = 0.602638E+00
-PKER_SWETH( 17, 36) = 0.628669E+00
-PKER_SWETH( 17, 37) = 0.652288E+00
-PKER_SWETH( 17, 38) = 0.673743E+00
-PKER_SWETH( 17, 39) = 0.693278E+00
-PKER_SWETH( 17, 40) = 0.711115E+00
-PKER_SWETH( 17, 41) = 0.727452E+00
-PKER_SWETH( 17, 42) = 0.742461E+00
-PKER_SWETH( 17, 43) = 0.756290E+00
-PKER_SWETH( 17, 44) = 0.769066E+00
-PKER_SWETH( 17, 45) = 0.780897E+00
-PKER_SWETH( 17, 46) = 0.791877E+00
-PKER_SWETH( 17, 47) = 0.802084E+00
-PKER_SWETH( 17, 48) = 0.811588E+00
-PKER_SWETH( 17, 49) = 0.820450E+00
-PKER_SWETH( 17, 50) = 0.828722E+00
-PKER_SWETH( 17, 51) = 0.836452E+00
-PKER_SWETH( 17, 52) = 0.843679E+00
-PKER_SWETH( 17, 53) = 0.850442E+00
-PKER_SWETH( 17, 54) = 0.856774E+00
-PKER_SWETH( 17, 55) = 0.862705E+00
-PKER_SWETH( 17, 56) = 0.868263E+00
-PKER_SWETH( 17, 57) = 0.873473E+00
-PKER_SWETH( 17, 58) = 0.878358E+00
-PKER_SWETH( 17, 59) = 0.882940E+00
-PKER_SWETH( 17, 60) = 0.887238E+00
-PKER_SWETH( 17, 61) = 0.891270E+00
-PKER_SWETH( 17, 62) = 0.895054E+00
-PKER_SWETH( 17, 63) = 0.898605E+00
-PKER_SWETH( 17, 64) = 0.901937E+00
-PKER_SWETH( 17, 65) = 0.905065E+00
-PKER_SWETH( 17, 66) = 0.908001E+00
-PKER_SWETH( 17, 67) = 0.910757E+00
-PKER_SWETH( 17, 68) = 0.913344E+00
-PKER_SWETH( 17, 69) = 0.915773E+00
-PKER_SWETH( 17, 70) = 0.918054E+00
-PKER_SWETH( 17, 71) = 0.920194E+00
-PKER_SWETH( 17, 72) = 0.922205E+00
-PKER_SWETH( 17, 73) = 0.924092E+00
-PKER_SWETH( 17, 74) = 0.925864E+00
-PKER_SWETH( 17, 75) = 0.927527E+00
-PKER_SWETH( 17, 76) = 0.929089E+00
-PKER_SWETH( 17, 77) = 0.930556E+00
-PKER_SWETH( 17, 78) = 0.931933E+00
-PKER_SWETH( 17, 79) = 0.933226E+00
-PKER_SWETH( 17, 80) = 0.934440E+00
-PKER_SWETH( 18, 1) = 0.244426E+01
-PKER_SWETH( 18, 2) = 0.225165E+01
-PKER_SWETH( 18, 3) = 0.207077E+01
-PKER_SWETH( 18, 4) = 0.190089E+01
-PKER_SWETH( 18, 5) = 0.174134E+01
-PKER_SWETH( 18, 6) = 0.159148E+01
-PKER_SWETH( 18, 7) = 0.145070E+01
-PKER_SWETH( 18, 8) = 0.131845E+01
-PKER_SWETH( 18, 9) = 0.119418E+01
-PKER_SWETH( 18, 10) = 0.107741E+01
-PKER_SWETH( 18, 11) = 0.967645E+00
-PKER_SWETH( 18, 12) = 0.864466E+00
-PKER_SWETH( 18, 13) = 0.767483E+00
-PKER_SWETH( 18, 14) = 0.676380E+00
-PKER_SWETH( 18, 15) = 0.590956E+00
-PKER_SWETH( 18, 16) = 0.511180E+00
-PKER_SWETH( 18, 17) = 0.437265E+00
-PKER_SWETH( 18, 18) = 0.369736E+00
-PKER_SWETH( 18, 19) = 0.309412E+00
-PKER_SWETH( 18, 20) = 0.257467E+00
-PKER_SWETH( 18, 21) = 0.215162E+00
-PKER_SWETH( 18, 22) = 0.183675E+00
-PKER_SWETH( 18, 23) = 0.164021E+00
-PKER_SWETH( 18, 24) = 0.156371E+00
-PKER_SWETH( 18, 25) = 0.160477E+00
-PKER_SWETH( 18, 26) = 0.175011E+00
-PKER_SWETH( 18, 27) = 0.198290E+00
-PKER_SWETH( 18, 28) = 0.228145E+00
-PKER_SWETH( 18, 29) = 0.262275E+00
-PKER_SWETH( 18, 30) = 0.298583E+00
-PKER_SWETH( 18, 31) = 0.335289E+00
-PKER_SWETH( 18, 32) = 0.371047E+00
-PKER_SWETH( 18, 33) = 0.404965E+00
-PKER_SWETH( 18, 34) = 0.436538E+00
-PKER_SWETH( 18, 35) = 0.465569E+00
-PKER_SWETH( 18, 36) = 0.492067E+00
-PKER_SWETH( 18, 37) = 0.516168E+00
-PKER_SWETH( 18, 38) = 0.538069E+00
-PKER_SWETH( 18, 39) = 0.557992E+00
-PKER_SWETH( 18, 40) = 0.576154E+00
-PKER_SWETH( 18, 41) = 0.592758E+00
-PKER_SWETH( 18, 42) = 0.607981E+00
-PKER_SWETH( 18, 43) = 0.621981E+00
-PKER_SWETH( 18, 44) = 0.634891E+00
-PKER_SWETH( 18, 45) = 0.646828E+00
-PKER_SWETH( 18, 46) = 0.657889E+00
-PKER_SWETH( 18, 47) = 0.668161E+00
-PKER_SWETH( 18, 48) = 0.677715E+00
-PKER_SWETH( 18, 49) = 0.686616E+00
-PKER_SWETH( 18, 50) = 0.694918E+00
-PKER_SWETH( 18, 51) = 0.702670E+00
-PKER_SWETH( 18, 52) = 0.709916E+00
-PKER_SWETH( 18, 53) = 0.716693E+00
-PKER_SWETH( 18, 54) = 0.723035E+00
-PKER_SWETH( 18, 55) = 0.728975E+00
-PKER_SWETH( 18, 56) = 0.734540E+00
-PKER_SWETH( 18, 57) = 0.739755E+00
-PKER_SWETH( 18, 58) = 0.744644E+00
-PKER_SWETH( 18, 59) = 0.749229E+00
-PKER_SWETH( 18, 60) = 0.753529E+00
-PKER_SWETH( 18, 61) = 0.757563E+00
-PKER_SWETH( 18, 62) = 0.761348E+00
-PKER_SWETH( 18, 63) = 0.764900E+00
-PKER_SWETH( 18, 64) = 0.768233E+00
-PKER_SWETH( 18, 65) = 0.771362E+00
-PKER_SWETH( 18, 66) = 0.774299E+00
-PKER_SWETH( 18, 67) = 0.777055E+00
-PKER_SWETH( 18, 68) = 0.779643E+00
-PKER_SWETH( 18, 69) = 0.782072E+00
-PKER_SWETH( 18, 70) = 0.784352E+00
-PKER_SWETH( 18, 71) = 0.786494E+00
-PKER_SWETH( 18, 72) = 0.788504E+00
-PKER_SWETH( 18, 73) = 0.790391E+00
-PKER_SWETH( 18, 74) = 0.792163E+00
-PKER_SWETH( 18, 75) = 0.793827E+00
-PKER_SWETH( 18, 76) = 0.795389E+00
-PKER_SWETH( 18, 77) = 0.796856E+00
-PKER_SWETH( 18, 78) = 0.798233E+00
-PKER_SWETH( 18, 79) = 0.799526E+00
-PKER_SWETH( 18, 80) = 0.800740E+00
-PKER_SWETH( 19, 1) = 0.254402E+01
-PKER_SWETH( 19, 2) = 0.235144E+01
-PKER_SWETH( 19, 3) = 0.217058E+01
-PKER_SWETH( 19, 4) = 0.200074E+01
-PKER_SWETH( 19, 5) = 0.184123E+01
-PKER_SWETH( 19, 6) = 0.169142E+01
-PKER_SWETH( 19, 7) = 0.155070E+01
-PKER_SWETH( 19, 8) = 0.141853E+01
-PKER_SWETH( 19, 9) = 0.129435E+01
-PKER_SWETH( 19, 10) = 0.117768E+01
-PKER_SWETH( 19, 11) = 0.106804E+01
-PKER_SWETH( 19, 12) = 0.964977E+00
-PKER_SWETH( 19, 13) = 0.868080E+00
-PKER_SWETH( 19, 14) = 0.776954E+00
-PKER_SWETH( 19, 15) = 0.691245E+00
-PKER_SWETH( 19, 16) = 0.610649E+00
-PKER_SWETH( 19, 17) = 0.534950E+00
-PKER_SWETH( 19, 18) = 0.464066E+00
-PKER_SWETH( 19, 19) = 0.398112E+00
-PKER_SWETH( 19, 20) = 0.337468E+00
-PKER_SWETH( 19, 21) = 0.282820E+00
-PKER_SWETH( 19, 22) = 0.235174E+00
-PKER_SWETH( 19, 23) = 0.195690E+00
-PKER_SWETH( 19, 24) = 0.165560E+00
-PKER_SWETH( 19, 25) = 0.145895E+00
-PKER_SWETH( 19, 26) = 0.137050E+00
-PKER_SWETH( 19, 27) = 0.138837E+00
-PKER_SWETH( 19, 28) = 0.150447E+00
-PKER_SWETH( 19, 29) = 0.170093E+00
-PKER_SWETH( 19, 30) = 0.195782E+00
-PKER_SWETH( 19, 31) = 0.225337E+00
-PKER_SWETH( 19, 32) = 0.256709E+00
-PKER_SWETH( 19, 33) = 0.288246E+00
-PKER_SWETH( 19, 34) = 0.318764E+00
-PKER_SWETH( 19, 35) = 0.347537E+00
-PKER_SWETH( 19, 36) = 0.374195E+00
-PKER_SWETH( 19, 37) = 0.398646E+00
-PKER_SWETH( 19, 38) = 0.420953E+00
-PKER_SWETH( 19, 39) = 0.441268E+00
-PKER_SWETH( 19, 40) = 0.459778E+00
-PKER_SWETH( 19, 41) = 0.476676E+00
-PKER_SWETH( 19, 42) = 0.492140E+00
-PKER_SWETH( 19, 43) = 0.506333E+00
-PKER_SWETH( 19, 44) = 0.519398E+00
-PKER_SWETH( 19, 45) = 0.531456E+00
-PKER_SWETH( 19, 46) = 0.542613E+00
-PKER_SWETH( 19, 47) = 0.552959E+00
-PKER_SWETH( 19, 48) = 0.562571E+00
-PKER_SWETH( 19, 49) = 0.571516E+00
-PKER_SWETH( 19, 50) = 0.579853E+00
-PKER_SWETH( 19, 51) = 0.587632E+00
-PKER_SWETH( 19, 52) = 0.594898E+00
-PKER_SWETH( 19, 53) = 0.601692E+00
-PKER_SWETH( 19, 54) = 0.608047E+00
-PKER_SWETH( 19, 55) = 0.613996E+00
-PKER_SWETH( 19, 56) = 0.619568E+00
-PKER_SWETH( 19, 57) = 0.624789E+00
-PKER_SWETH( 19, 58) = 0.629683E+00
-PKER_SWETH( 19, 59) = 0.634271E+00
-PKER_SWETH( 19, 60) = 0.638574E+00
-PKER_SWETH( 19, 61) = 0.642610E+00
-PKER_SWETH( 19, 62) = 0.646397E+00
-PKER_SWETH( 19, 63) = 0.649950E+00
-PKER_SWETH( 19, 64) = 0.653285E+00
-PKER_SWETH( 19, 65) = 0.656414E+00
-PKER_SWETH( 19, 66) = 0.659351E+00
-PKER_SWETH( 19, 67) = 0.662108E+00
-PKER_SWETH( 19, 68) = 0.664696E+00
-PKER_SWETH( 19, 69) = 0.667125E+00
-PKER_SWETH( 19, 70) = 0.669406E+00
-PKER_SWETH( 19, 71) = 0.671547E+00
-PKER_SWETH( 19, 72) = 0.673558E+00
-PKER_SWETH( 19, 73) = 0.675445E+00
-PKER_SWETH( 19, 74) = 0.677217E+00
-PKER_SWETH( 19, 75) = 0.678881E+00
-PKER_SWETH( 19, 76) = 0.680443E+00
-PKER_SWETH( 19, 77) = 0.681910E+00
-PKER_SWETH( 19, 78) = 0.683287E+00
-PKER_SWETH( 19, 79) = 0.684580E+00
-PKER_SWETH( 19, 80) = 0.685794E+00
-PKER_SWETH( 20, 1) = 0.262978E+01
-PKER_SWETH( 20, 2) = 0.243721E+01
-PKER_SWETH( 20, 3) = 0.225638E+01
-PKER_SWETH( 20, 4) = 0.208656E+01
-PKER_SWETH( 20, 5) = 0.192708E+01
-PKER_SWETH( 20, 6) = 0.177731E+01
-PKER_SWETH( 20, 7) = 0.163664E+01
-PKER_SWETH( 20, 8) = 0.150452E+01
-PKER_SWETH( 20, 9) = 0.138041E+01
-PKER_SWETH( 20, 10) = 0.126382E+01
-PKER_SWETH( 20, 11) = 0.115428E+01
-PKER_SWETH( 20, 12) = 0.105134E+01
-PKER_SWETH( 20, 13) = 0.954579E+00
-PKER_SWETH( 20, 14) = 0.863605E+00
-PKER_SWETH( 20, 15) = 0.778041E+00
-PKER_SWETH( 20, 16) = 0.697535E+00
-PKER_SWETH( 20, 17) = 0.621762E+00
-PKER_SWETH( 20, 18) = 0.550437E+00
-PKER_SWETH( 20, 19) = 0.483341E+00
-PKER_SWETH( 20, 20) = 0.420355E+00
-PKER_SWETH( 20, 21) = 0.361532E+00
-PKER_SWETH( 20, 22) = 0.307144E+00
-PKER_SWETH( 20, 23) = 0.257751E+00
-PKER_SWETH( 20, 24) = 0.214224E+00
-PKER_SWETH( 20, 25) = 0.177634E+00
-PKER_SWETH( 20, 26) = 0.149163E+00
-PKER_SWETH( 20, 27) = 0.129901E+00
-PKER_SWETH( 20, 28) = 0.120388E+00
-PKER_SWETH( 20, 29) = 0.120600E+00
-PKER_SWETH( 20, 30) = 0.129674E+00
-PKER_SWETH( 20, 31) = 0.146215E+00
-PKER_SWETH( 20, 32) = 0.168189E+00
-PKER_SWETH( 20, 33) = 0.193536E+00
-PKER_SWETH( 20, 34) = 0.220388E+00
-PKER_SWETH( 20, 35) = 0.247256E+00
-PKER_SWETH( 20, 36) = 0.273135E+00
-PKER_SWETH( 20, 37) = 0.297440E+00
-PKER_SWETH( 20, 38) = 0.319918E+00
-PKER_SWETH( 20, 39) = 0.340533E+00
-PKER_SWETH( 20, 40) = 0.359368E+00
-PKER_SWETH( 20, 41) = 0.376568E+00
-PKER_SWETH( 20, 42) = 0.392294E+00
-PKER_SWETH( 20, 43) = 0.406704E+00
-PKER_SWETH( 20, 44) = 0.419944E+00
-PKER_SWETH( 20, 45) = 0.432141E+00
-PKER_SWETH( 20, 46) = 0.443408E+00
-PKER_SWETH( 20, 47) = 0.453840E+00
-PKER_SWETH( 20, 48) = 0.463519E+00
-PKER_SWETH( 20, 49) = 0.472516E+00
-PKER_SWETH( 20, 50) = 0.480893E+00
-PKER_SWETH( 20, 51) = 0.488704E+00
-PKER_SWETH( 20, 52) = 0.495994E+00
-PKER_SWETH( 20, 53) = 0.502806E+00
-PKER_SWETH( 20, 54) = 0.509176E+00
-PKER_SWETH( 20, 55) = 0.515136E+00
-PKER_SWETH( 20, 56) = 0.520717E+00
-PKER_SWETH( 20, 57) = 0.525944E+00
-PKER_SWETH( 20, 58) = 0.530843E+00
-PKER_SWETH( 20, 59) = 0.535436E+00
-PKER_SWETH( 20, 60) = 0.539742E+00
-PKER_SWETH( 20, 61) = 0.543780E+00
-PKER_SWETH( 20, 62) = 0.547569E+00
-PKER_SWETH( 20, 63) = 0.551124E+00
-PKER_SWETH( 20, 64) = 0.554459E+00
-PKER_SWETH( 20, 65) = 0.557589E+00
-PKER_SWETH( 20, 66) = 0.560527E+00
-PKER_SWETH( 20, 67) = 0.563285E+00
-PKER_SWETH( 20, 68) = 0.565873E+00
-PKER_SWETH( 20, 69) = 0.568303E+00
-PKER_SWETH( 20, 70) = 0.570584E+00
-PKER_SWETH( 20, 71) = 0.572725E+00
-PKER_SWETH( 20, 72) = 0.574736E+00
-PKER_SWETH( 20, 73) = 0.576623E+00
-PKER_SWETH( 20, 74) = 0.578396E+00
-PKER_SWETH( 20, 75) = 0.580059E+00
-PKER_SWETH( 20, 76) = 0.581622E+00
-PKER_SWETH( 20, 77) = 0.583089E+00
-PKER_SWETH( 20, 78) = 0.584466E+00
-PKER_SWETH( 20, 79) = 0.585759E+00
-PKER_SWETH( 20, 80) = 0.586973E+00
-PKER_SWETH( 21, 1) = 0.270350E+01
-PKER_SWETH( 21, 2) = 0.251094E+01
-PKER_SWETH( 21, 3) = 0.233012E+01
-PKER_SWETH( 21, 4) = 0.216033E+01
-PKER_SWETH( 21, 5) = 0.200087E+01
-PKER_SWETH( 21, 6) = 0.185113E+01
-PKER_SWETH( 21, 7) = 0.171049E+01
-PKER_SWETH( 21, 8) = 0.157841E+01
-PKER_SWETH( 21, 9) = 0.145436E+01
-PKER_SWETH( 21, 10) = 0.133783E+01
-PKER_SWETH( 21, 11) = 0.122836E+01
-PKER_SWETH( 21, 12) = 0.112551E+01
-PKER_SWETH( 21, 13) = 0.102886E+01
-PKER_SWETH( 21, 14) = 0.938019E+00
-PKER_SWETH( 21, 15) = 0.852611E+00
-PKER_SWETH( 21, 16) = 0.772284E+00
-PKER_SWETH( 21, 17) = 0.696702E+00
-PKER_SWETH( 21, 18) = 0.625548E+00
-PKER_SWETH( 21, 19) = 0.558526E+00
-PKER_SWETH( 21, 20) = 0.495373E+00
-PKER_SWETH( 21, 21) = 0.435871E+00
-PKER_SWETH( 21, 22) = 0.379887E+00
-PKER_SWETH( 21, 23) = 0.327422E+00
-PKER_SWETH( 21, 24) = 0.278677E+00
-PKER_SWETH( 21, 25) = 0.234111E+00
-PKER_SWETH( 21, 26) = 0.194477E+00
-PKER_SWETH( 21, 27) = 0.160772E+00
-PKER_SWETH( 21, 28) = 0.134139E+00
-PKER_SWETH( 21, 29) = 0.115631E+00
-PKER_SWETH( 21, 30) = 0.105849E+00
-PKER_SWETH( 21, 31) = 0.104894E+00
-PKER_SWETH( 21, 32) = 0.112009E+00
-PKER_SWETH( 21, 33) = 0.125779E+00
-PKER_SWETH( 21, 34) = 0.144390E+00
-PKER_SWETH( 21, 35) = 0.165937E+00
-PKER_SWETH( 21, 36) = 0.188727E+00
-PKER_SWETH( 21, 37) = 0.211465E+00
-PKER_SWETH( 21, 38) = 0.233317E+00
-PKER_SWETH( 21, 39) = 0.253821E+00
-PKER_SWETH( 21, 40) = 0.272792E+00
-PKER_SWETH( 21, 41) = 0.290222E+00
-PKER_SWETH( 21, 42) = 0.306192E+00
-PKER_SWETH( 21, 43) = 0.320827E+00
-PKER_SWETH( 21, 44) = 0.334258E+00
-PKER_SWETH( 21, 45) = 0.346612E+00
-PKER_SWETH( 21, 46) = 0.358004E+00
-PKER_SWETH( 21, 47) = 0.368535E+00
-PKER_SWETH( 21, 48) = 0.378292E+00
-PKER_SWETH( 21, 49) = 0.387350E+00
-PKER_SWETH( 21, 50) = 0.395774E+00
-PKER_SWETH( 21, 51) = 0.403621E+00
-PKER_SWETH( 21, 52) = 0.410940E+00
-PKER_SWETH( 21, 53) = 0.417773E+00
-PKER_SWETH( 21, 54) = 0.424160E+00
-PKER_SWETH( 21, 55) = 0.430133E+00
-PKER_SWETH( 21, 56) = 0.435724E+00
-PKER_SWETH( 21, 57) = 0.440959E+00
-PKER_SWETH( 21, 58) = 0.445864E+00
-PKER_SWETH( 21, 59) = 0.450461E+00
-PKER_SWETH( 21, 60) = 0.454770E+00
-PKER_SWETH( 21, 61) = 0.458812E+00
-PKER_SWETH( 21, 62) = 0.462603E+00
-PKER_SWETH( 21, 63) = 0.466159E+00
-PKER_SWETH( 21, 64) = 0.469496E+00
-PKER_SWETH( 21, 65) = 0.472627E+00
-PKER_SWETH( 21, 66) = 0.475565E+00
-PKER_SWETH( 21, 67) = 0.478324E+00
-PKER_SWETH( 21, 68) = 0.480912E+00
-PKER_SWETH( 21, 69) = 0.483343E+00
-PKER_SWETH( 21, 70) = 0.485624E+00
-PKER_SWETH( 21, 71) = 0.487766E+00
-PKER_SWETH( 21, 72) = 0.489776E+00
-PKER_SWETH( 21, 73) = 0.491664E+00
-PKER_SWETH( 21, 74) = 0.493436E+00
-PKER_SWETH( 21, 75) = 0.495100E+00
-PKER_SWETH( 21, 76) = 0.496662E+00
-PKER_SWETH( 21, 77) = 0.498129E+00
-PKER_SWETH( 21, 78) = 0.499507E+00
-PKER_SWETH( 21, 79) = 0.500800E+00
-PKER_SWETH( 21, 80) = 0.502014E+00
-PKER_SWETH( 22, 1) = 0.276687E+01
-PKER_SWETH( 22, 2) = 0.257432E+01
-PKER_SWETH( 22, 3) = 0.239352E+01
-PKER_SWETH( 22, 4) = 0.222373E+01
-PKER_SWETH( 22, 5) = 0.206430E+01
-PKER_SWETH( 22, 6) = 0.191457E+01
-PKER_SWETH( 22, 7) = 0.177397E+01
-PKER_SWETH( 22, 8) = 0.164192E+01
-PKER_SWETH( 22, 9) = 0.151790E+01
-PKER_SWETH( 22, 10) = 0.140142E+01
-PKER_SWETH( 22, 11) = 0.129200E+01
-PKER_SWETH( 22, 12) = 0.118922E+01
-PKER_SWETH( 22, 13) = 0.109265E+01
-PKER_SWETH( 22, 14) = 0.100191E+01
-PKER_SWETH( 22, 15) = 0.916622E+00
-PKER_SWETH( 22, 16) = 0.836441E+00
-PKER_SWETH( 22, 17) = 0.761032E+00
-PKER_SWETH( 22, 18) = 0.690082E+00
-PKER_SWETH( 22, 19) = 0.623289E+00
-PKER_SWETH( 22, 20) = 0.560368E+00
-PKER_SWETH( 22, 21) = 0.501051E+00
-PKER_SWETH( 22, 22) = 0.445092E+00
-PKER_SWETH( 22, 23) = 0.392286E+00
-PKER_SWETH( 22, 24) = 0.342491E+00
-PKER_SWETH( 22, 25) = 0.295682E+00
-PKER_SWETH( 22, 26) = 0.252001E+00
-PKER_SWETH( 22, 27) = 0.211840E+00
-PKER_SWETH( 22, 28) = 0.175856E+00
-PKER_SWETH( 22, 29) = 0.144964E+00
-PKER_SWETH( 22, 30) = 0.120253E+00
-PKER_SWETH( 22, 31) = 0.102740E+00
-PKER_SWETH( 22, 32) = 0.930354E-01
-PKER_SWETH( 22, 33) = 0.912465E-01
-PKER_SWETH( 22, 34) = 0.967189E-01
-PKER_SWETH( 22, 35) = 0.108086E+00
-PKER_SWETH( 22, 36) = 0.123713E+00
-PKER_SWETH( 22, 37) = 0.141868E+00
-PKER_SWETH( 22, 38) = 0.161070E+00
-PKER_SWETH( 22, 39) = 0.180228E+00
-PKER_SWETH( 22, 40) = 0.198647E+00
-PKER_SWETH( 22, 41) = 0.215954E+00
-PKER_SWETH( 22, 42) = 0.232007E+00
-PKER_SWETH( 22, 43) = 0.246802E+00
-PKER_SWETH( 22, 44) = 0.260407E+00
-PKER_SWETH( 22, 45) = 0.272922E+00
-PKER_SWETH( 22, 46) = 0.284451E+00
-PKER_SWETH( 22, 47) = 0.295094E+00
-PKER_SWETH( 22, 48) = 0.304940E+00
-PKER_SWETH( 22, 49) = 0.314068E+00
-PKER_SWETH( 22, 50) = 0.322546E+00
-PKER_SWETH( 22, 51) = 0.330436E+00
-PKER_SWETH( 22, 52) = 0.337787E+00
-PKER_SWETH( 22, 53) = 0.344646E+00
-PKER_SWETH( 22, 54) = 0.351052E+00
-PKER_SWETH( 22, 55) = 0.357040E+00
-PKER_SWETH( 22, 56) = 0.362643E+00
-PKER_SWETH( 22, 57) = 0.367887E+00
-PKER_SWETH( 22, 58) = 0.372799E+00
-PKER_SWETH( 22, 59) = 0.377401E+00
-PKER_SWETH( 22, 60) = 0.381715E+00
-PKER_SWETH( 22, 61) = 0.385759E+00
-PKER_SWETH( 22, 62) = 0.389553E+00
-PKER_SWETH( 22, 63) = 0.393111E+00
-PKER_SWETH( 22, 64) = 0.396449E+00
-PKER_SWETH( 22, 65) = 0.399581E+00
-PKER_SWETH( 22, 66) = 0.402521E+00
-PKER_SWETH( 22, 67) = 0.405280E+00
-PKER_SWETH( 22, 68) = 0.407869E+00
-PKER_SWETH( 22, 69) = 0.410300E+00
-PKER_SWETH( 22, 70) = 0.412581E+00
-PKER_SWETH( 22, 71) = 0.414723E+00
-PKER_SWETH( 22, 72) = 0.416734E+00
-PKER_SWETH( 22, 73) = 0.418622E+00
-PKER_SWETH( 22, 74) = 0.420394E+00
-PKER_SWETH( 22, 75) = 0.422058E+00
-PKER_SWETH( 22, 76) = 0.423621E+00
-PKER_SWETH( 22, 77) = 0.425088E+00
-PKER_SWETH( 22, 78) = 0.426465E+00
-PKER_SWETH( 22, 79) = 0.427758E+00
-PKER_SWETH( 22, 80) = 0.428973E+00
-PKER_SWETH( 23, 1) = 0.282135E+01
-PKER_SWETH( 23, 2) = 0.262881E+01
-PKER_SWETH( 23, 3) = 0.244801E+01
-PKER_SWETH( 23, 4) = 0.227824E+01
-PKER_SWETH( 23, 5) = 0.211881E+01
-PKER_SWETH( 23, 6) = 0.196911E+01
-PKER_SWETH( 23, 7) = 0.182852E+01
-PKER_SWETH( 23, 8) = 0.169649E+01
-PKER_SWETH( 23, 9) = 0.157250E+01
-PKER_SWETH( 23, 10) = 0.145606E+01
-PKER_SWETH( 23, 11) = 0.134668E+01
-PKER_SWETH( 23, 12) = 0.124395E+01
-PKER_SWETH( 23, 13) = 0.114744E+01
-PKER_SWETH( 23, 14) = 0.105678E+01
-PKER_SWETH( 23, 15) = 0.971578E+00
-PKER_SWETH( 23, 16) = 0.891505E+00
-PKER_SWETH( 23, 17) = 0.816228E+00
-PKER_SWETH( 23, 18) = 0.745437E+00
-PKER_SWETH( 23, 19) = 0.678835E+00
-PKER_SWETH( 23, 20) = 0.616140E+00
-PKER_SWETH( 23, 21) = 0.557084E+00
-PKER_SWETH( 23, 22) = 0.501408E+00
-PKER_SWETH( 23, 23) = 0.448869E+00
-PKER_SWETH( 23, 24) = 0.399242E+00
-PKER_SWETH( 23, 25) = 0.352334E+00
-PKER_SWETH( 23, 26) = 0.308004E+00
-PKER_SWETH( 23, 27) = 0.266213E+00
-PKER_SWETH( 23, 28) = 0.227070E+00
-PKER_SWETH( 23, 29) = 0.190904E+00
-PKER_SWETH( 23, 30) = 0.158318E+00
-PKER_SWETH( 23, 31) = 0.130143E+00
-PKER_SWETH( 23, 32) = 0.107409E+00
-PKER_SWETH( 23, 33) = 0.910480E-01
-PKER_SWETH( 23, 34) = 0.816578E-01
-PKER_SWETH( 23, 35) = 0.793319E-01
-PKER_SWETH( 23, 36) = 0.833790E-01
-PKER_SWETH( 23, 37) = 0.926780E-01
-PKER_SWETH( 23, 38) = 0.105642E+00
-PKER_SWETH( 23, 39) = 0.120818E+00
-PKER_SWETH( 23, 40) = 0.136925E+00
-PKER_SWETH( 23, 41) = 0.153032E+00
-PKER_SWETH( 23, 42) = 0.168561E+00
-PKER_SWETH( 23, 43) = 0.183201E+00
-PKER_SWETH( 23, 44) = 0.196832E+00
-PKER_SWETH( 23, 45) = 0.209446E+00
-PKER_SWETH( 23, 46) = 0.221092E+00
-PKER_SWETH( 23, 47) = 0.231845E+00
-PKER_SWETH( 23, 48) = 0.241786E+00
-PKER_SWETH( 23, 49) = 0.250993E+00
-PKER_SWETH( 23, 50) = 0.259534E+00
-PKER_SWETH( 23, 51) = 0.267472E+00
-PKER_SWETH( 23, 52) = 0.274862E+00
-PKER_SWETH( 23, 53) = 0.281750E+00
-PKER_SWETH( 23, 54) = 0.288179E+00
-PKER_SWETH( 23, 55) = 0.294186E+00
-PKER_SWETH( 23, 56) = 0.299801E+00
-PKER_SWETH( 23, 57) = 0.305056E+00
-PKER_SWETH( 23, 58) = 0.309976E+00
-PKER_SWETH( 23, 59) = 0.314585E+00
-PKER_SWETH( 23, 60) = 0.318903E+00
-PKER_SWETH( 23, 61) = 0.322951E+00
-PKER_SWETH( 23, 62) = 0.326748E+00
-PKER_SWETH( 23, 63) = 0.330308E+00
-PKER_SWETH( 23, 64) = 0.333648E+00
-PKER_SWETH( 23, 65) = 0.336782E+00
-PKER_SWETH( 23, 66) = 0.339722E+00
-PKER_SWETH( 23, 67) = 0.342482E+00
-PKER_SWETH( 23, 68) = 0.345072E+00
-PKER_SWETH( 23, 69) = 0.347503E+00
-PKER_SWETH( 23, 70) = 0.349785E+00
-PKER_SWETH( 23, 71) = 0.351927E+00
-PKER_SWETH( 23, 72) = 0.353938E+00
-PKER_SWETH( 23, 73) = 0.355826E+00
-PKER_SWETH( 23, 74) = 0.357599E+00
-PKER_SWETH( 23, 75) = 0.359263E+00
-PKER_SWETH( 23, 76) = 0.360825E+00
-PKER_SWETH( 23, 77) = 0.362292E+00
-PKER_SWETH( 23, 78) = 0.363670E+00
-PKER_SWETH( 23, 79) = 0.364963E+00
-PKER_SWETH( 23, 80) = 0.366177E+00
-PKER_SWETH( 24, 1) = 0.286818E+01
-PKER_SWETH( 24, 2) = 0.267565E+01
-PKER_SWETH( 24, 3) = 0.249486E+01
-PKER_SWETH( 24, 4) = 0.232509E+01
-PKER_SWETH( 24, 5) = 0.216568E+01
-PKER_SWETH( 24, 6) = 0.201598E+01
-PKER_SWETH( 24, 7) = 0.187541E+01
-PKER_SWETH( 24, 8) = 0.174340E+01
-PKER_SWETH( 24, 9) = 0.161943E+01
-PKER_SWETH( 24, 10) = 0.150301E+01
-PKER_SWETH( 24, 11) = 0.139367E+01
-PKER_SWETH( 24, 12) = 0.129097E+01
-PKER_SWETH( 24, 13) = 0.119451E+01
-PKER_SWETH( 24, 14) = 0.110390E+01
-PKER_SWETH( 24, 15) = 0.101877E+01
-PKER_SWETH( 24, 16) = 0.938776E+00
-PKER_SWETH( 24, 17) = 0.863598E+00
-PKER_SWETH( 24, 18) = 0.792926E+00
-PKER_SWETH( 24, 19) = 0.726468E+00
-PKER_SWETH( 24, 20) = 0.663947E+00
-PKER_SWETH( 24, 21) = 0.605099E+00
-PKER_SWETH( 24, 22) = 0.549672E+00
-PKER_SWETH( 24, 23) = 0.497422E+00
-PKER_SWETH( 24, 24) = 0.448119E+00
-PKER_SWETH( 24, 25) = 0.401541E+00
-PKER_SWETH( 24, 26) = 0.357483E+00
-PKER_SWETH( 24, 27) = 0.315767E+00
-PKER_SWETH( 24, 28) = 0.276262E+00
-PKER_SWETH( 24, 29) = 0.238920E+00
-PKER_SWETH( 24, 30) = 0.203837E+00
-PKER_SWETH( 24, 31) = 0.171306E+00
-PKER_SWETH( 24, 32) = 0.141868E+00
-PKER_SWETH( 24, 33) = 0.116305E+00
-PKER_SWETH( 24, 34) = 0.955523E-01
-PKER_SWETH( 24, 35) = 0.804455E-01
-PKER_SWETH( 24, 36) = 0.715185E-01
-PKER_SWETH( 24, 37) = 0.688403E-01
-PKER_SWETH( 24, 38) = 0.717494E-01
-PKER_SWETH( 24, 39) = 0.791749E-01
-PKER_SWETH( 24, 40) = 0.898679E-01
-PKER_SWETH( 24, 41) = 0.102464E+00
-PKER_SWETH( 24, 42) = 0.115917E+00
-PKER_SWETH( 24, 43) = 0.129449E+00
-PKER_SWETH( 24, 44) = 0.142559E+00
-PKER_SWETH( 24, 45) = 0.154980E+00
-PKER_SWETH( 24, 46) = 0.166600E+00
-PKER_SWETH( 24, 47) = 0.177401E+00
-PKER_SWETH( 24, 48) = 0.187413E+00
-PKER_SWETH( 24, 49) = 0.196693E+00
-PKER_SWETH( 24, 50) = 0.205299E+00
-PKER_SWETH( 24, 51) = 0.213291E+00
-PKER_SWETH( 24, 52) = 0.220724E+00
-PKER_SWETH( 24, 53) = 0.227647E+00
-PKER_SWETH( 24, 54) = 0.234103E+00
-PKER_SWETH( 24, 55) = 0.240129E+00
-PKER_SWETH( 24, 56) = 0.245761E+00
-PKER_SWETH( 24, 57) = 0.251028E+00
-PKER_SWETH( 24, 58) = 0.255958E+00
-PKER_SWETH( 24, 59) = 0.260573E+00
-PKER_SWETH( 24, 60) = 0.264898E+00
-PKER_SWETH( 24, 61) = 0.268950E+00
-PKER_SWETH( 24, 62) = 0.272750E+00
-PKER_SWETH( 24, 63) = 0.276313E+00
-PKER_SWETH( 24, 64) = 0.279654E+00
-PKER_SWETH( 24, 65) = 0.282790E+00
-PKER_SWETH( 24, 66) = 0.285731E+00
-PKER_SWETH( 24, 67) = 0.288492E+00
-PKER_SWETH( 24, 68) = 0.291083E+00
-PKER_SWETH( 24, 69) = 0.293514E+00
-PKER_SWETH( 24, 70) = 0.295797E+00
-PKER_SWETH( 24, 71) = 0.297939E+00
-PKER_SWETH( 24, 72) = 0.299950E+00
-PKER_SWETH( 24, 73) = 0.301839E+00
-PKER_SWETH( 24, 74) = 0.303611E+00
-PKER_SWETH( 24, 75) = 0.305276E+00
-PKER_SWETH( 24, 76) = 0.306838E+00
-PKER_SWETH( 24, 77) = 0.308305E+00
-PKER_SWETH( 24, 78) = 0.309683E+00
-PKER_SWETH( 24, 79) = 0.310976E+00
-PKER_SWETH( 24, 80) = 0.312190E+00
-PKER_SWETH( 25, 1) = 0.290844E+01
-PKER_SWETH( 25, 2) = 0.271591E+01
-PKER_SWETH( 25, 3) = 0.253512E+01
-PKER_SWETH( 25, 4) = 0.236537E+01
-PKER_SWETH( 25, 5) = 0.220596E+01
-PKER_SWETH( 25, 6) = 0.205627E+01
-PKER_SWETH( 25, 7) = 0.191571E+01
-PKER_SWETH( 25, 8) = 0.178372E+01
-PKER_SWETH( 25, 9) = 0.165977E+01
-PKER_SWETH( 25, 10) = 0.154336E+01
-PKER_SWETH( 25, 11) = 0.143405E+01
-PKER_SWETH( 25, 12) = 0.133138E+01
-PKER_SWETH( 25, 13) = 0.123495E+01
-PKER_SWETH( 25, 14) = 0.114438E+01
-PKER_SWETH( 25, 15) = 0.105930E+01
-PKER_SWETH( 25, 16) = 0.979367E+00
-PKER_SWETH( 25, 17) = 0.904262E+00
-PKER_SWETH( 25, 18) = 0.833678E+00
-PKER_SWETH( 25, 19) = 0.767328E+00
-PKER_SWETH( 25, 20) = 0.704937E+00
-PKER_SWETH( 25, 21) = 0.646247E+00
-PKER_SWETH( 25, 22) = 0.591008E+00
-PKER_SWETH( 25, 23) = 0.538986E+00
-PKER_SWETH( 25, 24) = 0.489953E+00
-PKER_SWETH( 25, 25) = 0.443691E+00
-PKER_SWETH( 25, 26) = 0.399991E+00
-PKER_SWETH( 25, 27) = 0.358654E+00
-PKER_SWETH( 25, 28) = 0.319494E+00
-PKER_SWETH( 25, 29) = 0.282349E+00
-PKER_SWETH( 25, 30) = 0.247103E+00
-PKER_SWETH( 25, 31) = 0.213715E+00
-PKER_SWETH( 25, 32) = 0.182272E+00
-PKER_SWETH( 25, 33) = 0.153051E+00
-PKER_SWETH( 25, 34) = 0.126549E+00
-PKER_SWETH( 25, 35) = 0.103476E+00
-PKER_SWETH( 25, 36) = 0.846703E-01
-PKER_SWETH( 25, 37) = 0.708667E-01
-PKER_SWETH( 25, 38) = 0.625066E-01
-PKER_SWETH( 25, 39) = 0.595888E-01
-PKER_SWETH( 25, 40) = 0.615364E-01
-PKER_SWETH( 25, 41) = 0.674190E-01
-PKER_SWETH( 25, 42) = 0.760906E-01
-PKER_SWETH( 25, 43) = 0.865049E-01
-PKER_SWETH( 25, 44) = 0.977255E-01
-PKER_SWETH( 25, 45) = 0.109092E+00
-PKER_SWETH( 25, 46) = 0.120184E+00
-PKER_SWETH( 25, 47) = 0.130756E+00
-PKER_SWETH( 25, 48) = 0.140699E+00
-PKER_SWETH( 25, 49) = 0.149985E+00
-PKER_SWETH( 25, 50) = 0.158628E+00
-PKER_SWETH( 25, 51) = 0.166665E+00
-PKER_SWETH( 25, 52) = 0.174140E+00
-PKER_SWETH( 25, 53) = 0.181099E+00
-PKER_SWETH( 25, 54) = 0.187585E+00
-PKER_SWETH( 25, 55) = 0.193635E+00
-PKER_SWETH( 25, 56) = 0.199285E+00
-PKER_SWETH( 25, 57) = 0.204567E+00
-PKER_SWETH( 25, 58) = 0.209507E+00
-PKER_SWETH( 25, 59) = 0.214131E+00
-PKER_SWETH( 25, 60) = 0.218462E+00
-PKER_SWETH( 25, 61) = 0.222520E+00
-PKER_SWETH( 25, 62) = 0.226323E+00
-PKER_SWETH( 25, 63) = 0.229889E+00
-PKER_SWETH( 25, 64) = 0.233233E+00
-PKER_SWETH( 25, 65) = 0.236370E+00
-PKER_SWETH( 25, 66) = 0.239313E+00
-PKER_SWETH( 25, 67) = 0.242075E+00
-PKER_SWETH( 25, 68) = 0.244666E+00
-PKER_SWETH( 25, 69) = 0.247098E+00
-PKER_SWETH( 25, 70) = 0.249381E+00
-PKER_SWETH( 25, 71) = 0.251524E+00
-PKER_SWETH( 25, 72) = 0.253536E+00
-PKER_SWETH( 25, 73) = 0.255424E+00
-PKER_SWETH( 25, 74) = 0.257197E+00
-PKER_SWETH( 25, 75) = 0.258862E+00
-PKER_SWETH( 25, 76) = 0.260424E+00
-PKER_SWETH( 25, 77) = 0.261891E+00
-PKER_SWETH( 25, 78) = 0.263269E+00
-PKER_SWETH( 25, 79) = 0.264562E+00
-PKER_SWETH( 25, 80) = 0.265777E+00
-PKER_SWETH( 26, 1) = 0.294305E+01
-PKER_SWETH( 26, 2) = 0.275052E+01
-PKER_SWETH( 26, 3) = 0.256974E+01
-PKER_SWETH( 26, 4) = 0.239999E+01
-PKER_SWETH( 26, 5) = 0.224059E+01
-PKER_SWETH( 26, 6) = 0.209091E+01
-PKER_SWETH( 26, 7) = 0.195036E+01
-PKER_SWETH( 26, 8) = 0.181837E+01
-PKER_SWETH( 26, 9) = 0.169443E+01
-PKER_SWETH( 26, 10) = 0.157804E+01
-PKER_SWETH( 26, 11) = 0.146874E+01
-PKER_SWETH( 26, 12) = 0.136610E+01
-PKER_SWETH( 26, 13) = 0.126970E+01
-PKER_SWETH( 26, 14) = 0.117916E+01
-PKER_SWETH( 26, 15) = 0.109411E+01
-PKER_SWETH( 26, 16) = 0.101423E+01
-PKER_SWETH( 26, 17) = 0.939177E+00
-PKER_SWETH( 26, 18) = 0.868660E+00
-PKER_SWETH( 26, 19) = 0.802390E+00
-PKER_SWETH( 26, 20) = 0.740096E+00
-PKER_SWETH( 26, 21) = 0.681523E+00
-PKER_SWETH( 26, 22) = 0.626426E+00
-PKER_SWETH( 26, 23) = 0.574575E+00
-PKER_SWETH( 26, 24) = 0.525747E+00
-PKER_SWETH( 26, 25) = 0.479731E+00
-PKER_SWETH( 26, 26) = 0.436323E+00
-PKER_SWETH( 26, 27) = 0.395326E+00
-PKER_SWETH( 26, 28) = 0.356552E+00
-PKER_SWETH( 26, 29) = 0.319822E+00
-PKER_SWETH( 26, 30) = 0.284971E+00
-PKER_SWETH( 26, 31) = 0.251857E+00
-PKER_SWETH( 26, 32) = 0.220380E+00
-PKER_SWETH( 26, 33) = 0.190516E+00
-PKER_SWETH( 26, 34) = 0.162358E+00
-PKER_SWETH( 26, 35) = 0.136166E+00
-PKER_SWETH( 26, 36) = 0.112402E+00
-PKER_SWETH( 26, 37) = 0.917043E-01
-PKER_SWETH( 26, 38) = 0.747934E-01
-PKER_SWETH( 26, 39) = 0.622865E-01
-PKER_SWETH( 26, 40) = 0.545394E-01
-PKER_SWETH( 26, 41) = 0.514887E-01
-PKER_SWETH( 26, 42) = 0.526217E-01
-PKER_SWETH( 26, 43) = 0.571686E-01
-PKER_SWETH( 26, 44) = 0.641718E-01
-PKER_SWETH( 26, 45) = 0.727187E-01
-PKER_SWETH( 26, 46) = 0.820521E-01
-PKER_SWETH( 26, 47) = 0.916095E-01
-PKER_SWETH( 26, 48) = 0.101013E+00
-PKER_SWETH( 26, 49) = 0.110038E+00
-PKER_SWETH( 26, 50) = 0.118576E+00
-PKER_SWETH( 26, 51) = 0.126587E+00
-PKER_SWETH( 26, 52) = 0.134073E+00
-PKER_SWETH( 26, 53) = 0.141055E+00
-PKER_SWETH( 26, 54) = 0.147566E+00
-PKER_SWETH( 26, 55) = 0.153640E+00
-PKER_SWETH( 26, 56) = 0.159310E+00
-PKER_SWETH( 26, 57) = 0.164608E+00
-PKER_SWETH( 26, 58) = 0.169561E+00
-PKER_SWETH( 26, 59) = 0.174195E+00
-PKER_SWETH( 26, 60) = 0.178533E+00
-PKER_SWETH( 26, 61) = 0.182597E+00
-PKER_SWETH( 26, 62) = 0.186405E+00
-PKER_SWETH( 26, 63) = 0.189974E+00
-PKER_SWETH( 26, 64) = 0.193321E+00
-PKER_SWETH( 26, 65) = 0.196460E+00
-PKER_SWETH( 26, 66) = 0.199405E+00
-PKER_SWETH( 26, 67) = 0.202168E+00
-PKER_SWETH( 26, 68) = 0.204760E+00
-PKER_SWETH( 26, 69) = 0.207193E+00
-PKER_SWETH( 26, 70) = 0.209476E+00
-PKER_SWETH( 26, 71) = 0.211620E+00
-PKER_SWETH( 26, 72) = 0.213632E+00
-PKER_SWETH( 26, 73) = 0.215520E+00
-PKER_SWETH( 26, 74) = 0.217293E+00
-PKER_SWETH( 26, 75) = 0.218958E+00
-PKER_SWETH( 26, 76) = 0.220521E+00
-PKER_SWETH( 26, 77) = 0.221988E+00
-PKER_SWETH( 26, 78) = 0.223366E+00
-PKER_SWETH( 26, 79) = 0.224659E+00
-PKER_SWETH( 26, 80) = 0.225873E+00
-PKER_SWETH( 27, 1) = 0.297280E+01
-PKER_SWETH( 27, 2) = 0.278028E+01
-PKER_SWETH( 27, 3) = 0.259950E+01
-PKER_SWETH( 27, 4) = 0.242975E+01
-PKER_SWETH( 27, 5) = 0.227036E+01
-PKER_SWETH( 27, 6) = 0.212068E+01
-PKER_SWETH( 27, 7) = 0.198014E+01
-PKER_SWETH( 27, 8) = 0.184816E+01
-PKER_SWETH( 27, 9) = 0.172423E+01
-PKER_SWETH( 27, 10) = 0.160785E+01
-PKER_SWETH( 27, 11) = 0.149857E+01
-PKER_SWETH( 27, 12) = 0.139594E+01
-PKER_SWETH( 27, 13) = 0.129956E+01
-PKER_SWETH( 27, 14) = 0.120904E+01
-PKER_SWETH( 27, 15) = 0.112402E+01
-PKER_SWETH( 27, 16) = 0.104417E+01
-PKER_SWETH( 27, 17) = 0.969162E+00
-PKER_SWETH( 27, 18) = 0.898695E+00
-PKER_SWETH( 27, 19) = 0.832485E+00
-PKER_SWETH( 27, 20) = 0.770264E+00
-PKER_SWETH( 27, 21) = 0.711779E+00
-PKER_SWETH( 27, 22) = 0.656788E+00
-PKER_SWETH( 27, 23) = 0.605065E+00
-PKER_SWETH( 27, 24) = 0.556391E+00
-PKER_SWETH( 27, 25) = 0.510561E+00
-PKER_SWETH( 27, 26) = 0.467374E+00
-PKER_SWETH( 27, 27) = 0.426642E+00
-PKER_SWETH( 27, 28) = 0.388179E+00
-PKER_SWETH( 27, 29) = 0.351811E+00
-PKER_SWETH( 27, 30) = 0.317368E+00
-PKER_SWETH( 27, 31) = 0.284691E+00
-PKER_SWETH( 27, 32) = 0.253635E+00
-PKER_SWETH( 27, 33) = 0.224082E+00
-PKER_SWETH( 27, 34) = 0.195956E+00
-PKER_SWETH( 27, 35) = 0.169252E+00
-PKER_SWETH( 27, 36) = 0.144075E+00
-PKER_SWETH( 27, 37) = 0.120679E+00
-PKER_SWETH( 27, 38) = 0.994785E-01
-PKER_SWETH( 27, 39) = 0.810353E-01
-PKER_SWETH( 27, 40) = 0.659439E-01
-PKER_SWETH( 27, 41) = 0.546937E-01
-PKER_SWETH( 27, 42) = 0.475503E-01
-PKER_SWETH( 27, 43) = 0.444351E-01
-PKER_SWETH( 27, 44) = 0.449018E-01
-PKER_SWETH( 27, 45) = 0.483126E-01
-PKER_SWETH( 27, 46) = 0.538981E-01
-PKER_SWETH( 27, 47) = 0.608791E-01
-PKER_SWETH( 27, 48) = 0.686363E-01
-PKER_SWETH( 27, 49) = 0.766733E-01
-PKER_SWETH( 27, 50) = 0.846559E-01
-PKER_SWETH( 27, 51) = 0.923787E-01
-PKER_SWETH( 27, 52) = 0.997309E-01
-PKER_SWETH( 27, 53) = 0.106662E+00
-PKER_SWETH( 27, 54) = 0.113163E+00
-PKER_SWETH( 27, 55) = 0.119245E+00
-PKER_SWETH( 27, 56) = 0.124928E+00
-PKER_SWETH( 27, 57) = 0.130240E+00
-PKER_SWETH( 27, 58) = 0.135206E+00
-PKER_SWETH( 27, 59) = 0.139851E+00
-PKER_SWETH( 27, 60) = 0.144198E+00
-PKER_SWETH( 27, 61) = 0.148269E+00
-PKER_SWETH( 27, 62) = 0.152082E+00
-PKER_SWETH( 27, 63) = 0.155655E+00
-PKER_SWETH( 27, 64) = 0.159005E+00
-PKER_SWETH( 27, 65) = 0.162147E+00
-PKER_SWETH( 27, 66) = 0.165093E+00
-PKER_SWETH( 27, 67) = 0.167857E+00
-PKER_SWETH( 27, 68) = 0.170451E+00
-PKER_SWETH( 27, 69) = 0.172885E+00
-PKER_SWETH( 27, 70) = 0.175169E+00
-PKER_SWETH( 27, 71) = 0.177313E+00
-PKER_SWETH( 27, 72) = 0.179325E+00
-PKER_SWETH( 27, 73) = 0.181214E+00
-PKER_SWETH( 27, 74) = 0.182987E+00
-PKER_SWETH( 27, 75) = 0.184652E+00
-PKER_SWETH( 27, 76) = 0.186215E+00
-PKER_SWETH( 27, 77) = 0.187682E+00
-PKER_SWETH( 27, 78) = 0.189060E+00
-PKER_SWETH( 27, 79) = 0.190353E+00
-PKER_SWETH( 27, 80) = 0.191568E+00
-PKER_SWETH( 28, 1) = 0.299838E+01
-PKER_SWETH( 28, 2) = 0.280586E+01
-PKER_SWETH( 28, 3) = 0.262509E+01
-PKER_SWETH( 28, 4) = 0.245534E+01
-PKER_SWETH( 28, 5) = 0.229595E+01
-PKER_SWETH( 28, 6) = 0.214628E+01
-PKER_SWETH( 28, 7) = 0.200574E+01
-PKER_SWETH( 28, 8) = 0.187377E+01
-PKER_SWETH( 28, 9) = 0.174984E+01
-PKER_SWETH( 28, 10) = 0.163347E+01
-PKER_SWETH( 28, 11) = 0.152420E+01
-PKER_SWETH( 28, 12) = 0.142158E+01
-PKER_SWETH( 28, 13) = 0.132521E+01
-PKER_SWETH( 28, 14) = 0.123471E+01
-PKER_SWETH( 28, 15) = 0.114972E+01
-PKER_SWETH( 28, 16) = 0.106990E+01
-PKER_SWETH( 28, 17) = 0.994917E+00
-PKER_SWETH( 28, 18) = 0.924488E+00
-PKER_SWETH( 28, 19) = 0.858323E+00
-PKER_SWETH( 28, 20) = 0.796157E+00
-PKER_SWETH( 28, 21) = 0.737738E+00
-PKER_SWETH( 28, 22) = 0.682827E+00
-PKER_SWETH( 28, 23) = 0.631200E+00
-PKER_SWETH( 28, 24) = 0.582642E+00
-PKER_SWETH( 28, 25) = 0.536951E+00
-PKER_SWETH( 28, 26) = 0.493931E+00
-PKER_SWETH( 28, 27) = 0.453399E+00
-PKER_SWETH( 28, 28) = 0.415175E+00
-PKER_SWETH( 28, 29) = 0.379089E+00
-PKER_SWETH( 28, 30) = 0.344975E+00
-PKER_SWETH( 28, 31) = 0.312676E+00
-PKER_SWETH( 28, 32) = 0.282042E+00
-PKER_SWETH( 28, 33) = 0.252934E+00
-PKER_SWETH( 28, 34) = 0.225231E+00
-PKER_SWETH( 28, 35) = 0.198839E+00
-PKER_SWETH( 28, 36) = 0.173711E+00
-PKER_SWETH( 28, 37) = 0.149866E+00
-PKER_SWETH( 28, 38) = 0.127421E+00
-PKER_SWETH( 28, 39) = 0.106617E+00
-PKER_SWETH( 28, 40) = 0.878209E-01
-PKER_SWETH( 28, 41) = 0.714924E-01
-PKER_SWETH( 28, 42) = 0.581156E-01
-PKER_SWETH( 28, 43) = 0.480527E-01
-PKER_SWETH( 28, 44) = 0.414985E-01
-PKER_SWETH( 28, 45) = 0.383577E-01
-PKER_SWETH( 28, 46) = 0.382797E-01
-PKER_SWETH( 28, 47) = 0.407482E-01
-PKER_SWETH( 28, 48) = 0.451150E-01
-PKER_SWETH( 28, 49) = 0.507946E-01
-PKER_SWETH( 28, 50) = 0.572113E-01
-PKER_SWETH( 28, 51) = 0.639668E-01
-PKER_SWETH( 28, 52) = 0.707541E-01
-PKER_SWETH( 28, 53) = 0.773754E-01
-PKER_SWETH( 28, 54) = 0.837189E-01
-PKER_SWETH( 28, 55) = 0.897291E-01
-PKER_SWETH( 28, 56) = 0.953867E-01
-PKER_SWETH( 28, 57) = 0.100694E+00
-PKER_SWETH( 28, 58) = 0.105664E+00
-PKER_SWETH( 28, 59) = 0.110317E+00
-PKER_SWETH( 28, 60) = 0.114672E+00
-PKER_SWETH( 28, 61) = 0.118749E+00
-PKER_SWETH( 28, 62) = 0.122568E+00
-PKER_SWETH( 28, 63) = 0.126146E+00
-PKER_SWETH( 28, 64) = 0.129500E+00
-PKER_SWETH( 28, 65) = 0.132644E+00
-PKER_SWETH( 28, 66) = 0.135593E+00
-PKER_SWETH( 28, 67) = 0.138358E+00
-PKER_SWETH( 28, 68) = 0.140953E+00
-PKER_SWETH( 28, 69) = 0.143388E+00
-PKER_SWETH( 28, 70) = 0.145673E+00
-PKER_SWETH( 28, 71) = 0.147817E+00
-PKER_SWETH( 28, 72) = 0.149830E+00
-PKER_SWETH( 28, 73) = 0.151720E+00
-PKER_SWETH( 28, 74) = 0.153493E+00
-PKER_SWETH( 28, 75) = 0.155158E+00
-PKER_SWETH( 28, 76) = 0.156721E+00
-PKER_SWETH( 28, 77) = 0.158189E+00
-PKER_SWETH( 28, 78) = 0.159566E+00
-PKER_SWETH( 28, 79) = 0.160860E+00
-PKER_SWETH( 28, 80) = 0.162074E+00
-PKER_SWETH( 29, 1) = 0.302037E+01
-PKER_SWETH( 29, 2) = 0.282785E+01
-PKER_SWETH( 29, 3) = 0.264708E+01
-PKER_SWETH( 29, 4) = 0.247733E+01
-PKER_SWETH( 29, 5) = 0.231795E+01
-PKER_SWETH( 29, 6) = 0.216828E+01
-PKER_SWETH( 29, 7) = 0.202774E+01
-PKER_SWETH( 29, 8) = 0.189578E+01
-PKER_SWETH( 29, 9) = 0.177186E+01
-PKER_SWETH( 29, 10) = 0.165550E+01
-PKER_SWETH( 29, 11) = 0.154623E+01
-PKER_SWETH( 29, 12) = 0.144362E+01
-PKER_SWETH( 29, 13) = 0.134726E+01
-PKER_SWETH( 29, 14) = 0.125678E+01
-PKER_SWETH( 29, 15) = 0.117180E+01
-PKER_SWETH( 29, 16) = 0.109200E+01
-PKER_SWETH( 29, 17) = 0.101704E+01
-PKER_SWETH( 29, 18) = 0.946641E+00
-PKER_SWETH( 29, 19) = 0.880511E+00
-PKER_SWETH( 29, 20) = 0.818386E+00
-PKER_SWETH( 29, 21) = 0.760017E+00
-PKER_SWETH( 29, 22) = 0.705166E+00
-PKER_SWETH( 29, 23) = 0.653611E+00
-PKER_SWETH( 29, 24) = 0.605141E+00
-PKER_SWETH( 29, 25) = 0.559554E+00
-PKER_SWETH( 29, 26) = 0.516661E+00
-PKER_SWETH( 29, 27) = 0.476280E+00
-PKER_SWETH( 29, 28) = 0.438237E+00
-PKER_SWETH( 29, 29) = 0.402366E+00
-PKER_SWETH( 29, 30) = 0.368507E+00
-PKER_SWETH( 29, 31) = 0.336506E+00
-PKER_SWETH( 29, 32) = 0.306215E+00
-PKER_SWETH( 29, 33) = 0.277495E+00
-PKER_SWETH( 29, 34) = 0.250215E+00
-PKER_SWETH( 29, 35) = 0.224259E+00
-PKER_SWETH( 29, 36) = 0.199530E+00
-PKER_SWETH( 29, 37) = 0.175964E+00
-PKER_SWETH( 29, 38) = 0.153542E+00
-PKER_SWETH( 29, 39) = 0.132307E+00
-PKER_SWETH( 29, 40) = 0.112384E+00
-PKER_SWETH( 29, 41) = 0.939910E-01
-PKER_SWETH( 29, 42) = 0.774349E-01
-PKER_SWETH( 29, 43) = 0.630791E-01
-PKER_SWETH( 29, 44) = 0.512792E-01
-PKER_SWETH( 29, 45) = 0.423126E-01
-PKER_SWETH( 29, 46) = 0.363101E-01
-PKER_SWETH( 29, 47) = 0.331775E-01
-PKER_SWETH( 29, 48) = 0.326477E-01
-PKER_SWETH( 29, 49) = 0.343305E-01
-PKER_SWETH( 29, 50) = 0.376967E-01
-PKER_SWETH( 29, 51) = 0.422455E-01
-PKER_SWETH( 29, 52) = 0.475526E-01
-PKER_SWETH( 29, 53) = 0.532189E-01
-PKER_SWETH( 29, 54) = 0.589849E-01
-PKER_SWETH( 29, 55) = 0.646660E-01
-PKER_SWETH( 29, 56) = 0.701465E-01
-PKER_SWETH( 29, 57) = 0.753653E-01
-PKER_SWETH( 29, 58) = 0.802963E-01
-PKER_SWETH( 29, 59) = 0.849346E-01
-PKER_SWETH( 29, 60) = 0.892870E-01
-PKER_SWETH( 29, 61) = 0.933669E-01
-PKER_SWETH( 29, 62) = 0.971899E-01
-PKER_SWETH( 29, 63) = 0.100772E+00
-PKER_SWETH( 29, 64) = 0.104130E+00
-PKER_SWETH( 29, 65) = 0.107277E+00
-PKER_SWETH( 29, 66) = 0.110228E+00
-PKER_SWETH( 29, 67) = 0.112996E+00
-PKER_SWETH( 29, 68) = 0.115592E+00
-PKER_SWETH( 29, 69) = 0.118028E+00
-PKER_SWETH( 29, 70) = 0.120314E+00
-PKER_SWETH( 29, 71) = 0.122459E+00
-PKER_SWETH( 29, 72) = 0.124472E+00
-PKER_SWETH( 29, 73) = 0.126362E+00
-PKER_SWETH( 29, 74) = 0.128136E+00
-PKER_SWETH( 29, 75) = 0.129801E+00
-PKER_SWETH( 29, 76) = 0.131364E+00
-PKER_SWETH( 29, 77) = 0.132832E+00
-PKER_SWETH( 29, 78) = 0.134210E+00
-PKER_SWETH( 29, 79) = 0.135504E+00
-PKER_SWETH( 29, 80) = 0.136718E+00
-PKER_SWETH( 30, 1) = 0.303928E+01
-PKER_SWETH( 30, 2) = 0.284676E+01
-PKER_SWETH( 30, 3) = 0.266599E+01
-PKER_SWETH( 30, 4) = 0.249624E+01
-PKER_SWETH( 30, 5) = 0.233686E+01
-PKER_SWETH( 30, 6) = 0.218719E+01
-PKER_SWETH( 30, 7) = 0.204666E+01
-PKER_SWETH( 30, 8) = 0.191470E+01
-PKER_SWETH( 30, 9) = 0.179078E+01
-PKER_SWETH( 30, 10) = 0.167442E+01
-PKER_SWETH( 30, 11) = 0.156516E+01
-PKER_SWETH( 30, 12) = 0.146256E+01
-PKER_SWETH( 30, 13) = 0.136622E+01
-PKER_SWETH( 30, 14) = 0.127574E+01
-PKER_SWETH( 30, 15) = 0.119078E+01
-PKER_SWETH( 30, 16) = 0.111099E+01
-PKER_SWETH( 30, 17) = 0.103605E+01
-PKER_SWETH( 30, 18) = 0.965671E+00
-PKER_SWETH( 30, 19) = 0.899567E+00
-PKER_SWETH( 30, 20) = 0.837473E+00
-PKER_SWETH( 30, 21) = 0.779142E+00
-PKER_SWETH( 30, 22) = 0.724337E+00
-PKER_SWETH( 30, 23) = 0.672837E+00
-PKER_SWETH( 30, 24) = 0.624432E+00
-PKER_SWETH( 30, 25) = 0.578925E+00
-PKER_SWETH( 30, 26) = 0.536127E+00
-PKER_SWETH( 30, 27) = 0.495860E+00
-PKER_SWETH( 30, 28) = 0.457954E+00
-PKER_SWETH( 30, 29) = 0.422247E+00
-PKER_SWETH( 30, 30) = 0.388582E+00
-PKER_SWETH( 30, 31) = 0.356811E+00
-PKER_SWETH( 30, 32) = 0.326789E+00
-PKER_SWETH( 30, 33) = 0.298379E+00
-PKER_SWETH( 30, 34) = 0.271451E+00
-PKER_SWETH( 30, 35) = 0.245883E+00
-PKER_SWETH( 30, 36) = 0.221565E+00
-PKER_SWETH( 30, 37) = 0.198403E+00
-PKER_SWETH( 30, 38) = 0.176331E+00
-PKER_SWETH( 30, 39) = 0.155312E+00
-PKER_SWETH( 30, 40) = 0.135357E+00
-PKER_SWETH( 30, 41) = 0.116524E+00
-PKER_SWETH( 30, 42) = 0.989392E-01
-PKER_SWETH( 30, 43) = 0.827844E-01
-PKER_SWETH( 30, 44) = 0.682941E-01
-PKER_SWETH( 30, 45) = 0.557411E-01
-PKER_SWETH( 30, 46) = 0.453780E-01
-PKER_SWETH( 30, 47) = 0.373956E-01
-PKER_SWETH( 30, 48) = 0.318890E-01
-PKER_SWETH( 30, 49) = 0.287932E-01
-PKER_SWETH( 30, 50) = 0.279056E-01
-PKER_SWETH( 30, 51) = 0.289252E-01
-PKER_SWETH( 30, 52) = 0.314497E-01
-PKER_SWETH( 30, 53) = 0.350753E-01
-PKER_SWETH( 30, 54) = 0.394126E-01
-PKER_SWETH( 30, 55) = 0.441591E-01
-PKER_SWETH( 30, 56) = 0.490560E-01
-PKER_SWETH( 30, 57) = 0.539285E-01
-PKER_SWETH( 30, 58) = 0.586660E-01
-PKER_SWETH( 30, 59) = 0.632018E-01
-PKER_SWETH( 30, 60) = 0.675041E-01
-PKER_SWETH( 30, 61) = 0.715618E-01
-PKER_SWETH( 30, 62) = 0.753768E-01
-PKER_SWETH( 30, 63) = 0.789578E-01
-PKER_SWETH( 30, 64) = 0.823165E-01
-PKER_SWETH( 30, 65) = 0.854661E-01
-PKER_SWETH( 30, 66) = 0.884195E-01
-PKER_SWETH( 30, 67) = 0.911893E-01
-PKER_SWETH( 30, 68) = 0.937873E-01
-PKER_SWETH( 30, 69) = 0.962245E-01
-PKER_SWETH( 30, 70) = 0.985113E-01
-PKER_SWETH( 30, 71) = 0.100657E+00
-PKER_SWETH( 30, 72) = 0.102671E+00
-PKER_SWETH( 30, 73) = 0.104561E+00
-PKER_SWETH( 30, 74) = 0.106336E+00
-PKER_SWETH( 30, 75) = 0.108001E+00
-PKER_SWETH( 30, 76) = 0.109565E+00
-PKER_SWETH( 30, 77) = 0.111032E+00
-PKER_SWETH( 30, 78) = 0.112410E+00
-PKER_SWETH( 30, 79) = 0.113704E+00
-PKER_SWETH( 30, 80) = 0.114919E+00
-PKER_SWETH( 31, 1) = 0.305553E+01
-PKER_SWETH( 31, 2) = 0.286301E+01
-PKER_SWETH( 31, 3) = 0.268224E+01
-PKER_SWETH( 31, 4) = 0.251250E+01
-PKER_SWETH( 31, 5) = 0.235311E+01
-PKER_SWETH( 31, 6) = 0.220345E+01
-PKER_SWETH( 31, 7) = 0.206292E+01
-PKER_SWETH( 31, 8) = 0.193096E+01
-PKER_SWETH( 31, 9) = 0.180705E+01
-PKER_SWETH( 31, 10) = 0.169070E+01
-PKER_SWETH( 31, 11) = 0.158144E+01
-PKER_SWETH( 31, 12) = 0.147884E+01
-PKER_SWETH( 31, 13) = 0.138250E+01
-PKER_SWETH( 31, 14) = 0.129204E+01
-PKER_SWETH( 31, 15) = 0.120708E+01
-PKER_SWETH( 31, 16) = 0.112730E+01
-PKER_SWETH( 31, 17) = 0.105238E+01
-PKER_SWETH( 31, 18) = 0.982019E+00
-PKER_SWETH( 31, 19) = 0.915935E+00
-PKER_SWETH( 31, 20) = 0.853866E+00
-PKER_SWETH( 31, 21) = 0.795563E+00
-PKER_SWETH( 31, 22) = 0.740792E+00
-PKER_SWETH( 31, 23) = 0.689334E+00
-PKER_SWETH( 31, 24) = 0.640979E+00
-PKER_SWETH( 31, 25) = 0.595532E+00
-PKER_SWETH( 31, 26) = 0.552807E+00
-PKER_SWETH( 31, 27) = 0.512627E+00
-PKER_SWETH( 31, 28) = 0.474825E+00
-PKER_SWETH( 31, 29) = 0.439242E+00
-PKER_SWETH( 31, 30) = 0.405725E+00
-PKER_SWETH( 31, 31) = 0.374129E+00
-PKER_SWETH( 31, 32) = 0.344315E+00
-PKER_SWETH( 31, 33) = 0.316148E+00
-PKER_SWETH( 31, 34) = 0.289501E+00
-PKER_SWETH( 31, 35) = 0.264250E+00
-PKER_SWETH( 31, 36) = 0.240283E+00
-PKER_SWETH( 31, 37) = 0.217497E+00
-PKER_SWETH( 31, 38) = 0.195805E+00
-PKER_SWETH( 31, 39) = 0.175138E+00
-PKER_SWETH( 31, 40) = 0.155459E+00
-PKER_SWETH( 31, 41) = 0.136759E+00
-PKER_SWETH( 31, 42) = 0.119070E+00
-PKER_SWETH( 31, 43) = 0.102460E+00
-PKER_SWETH( 31, 44) = 0.870355E-01
-PKER_SWETH( 31, 45) = 0.729376E-01
-PKER_SWETH( 31, 46) = 0.603312E-01
-PKER_SWETH( 31, 47) = 0.493977E-01
-PKER_SWETH( 31, 48) = 0.403119E-01
-PKER_SWETH( 31, 49) = 0.332066E-01
-PKER_SWETH( 31, 50) = 0.281507E-01
-PKER_SWETH( 31, 51) = 0.251051E-01
-PKER_SWETH( 31, 52) = 0.239393E-01
-PKER_SWETH( 31, 53) = 0.244191E-01
-PKER_SWETH( 31, 54) = 0.262352E-01
-PKER_SWETH( 31, 55) = 0.290735E-01
-PKER_SWETH( 31, 56) = 0.326082E-01
-PKER_SWETH( 31, 57) = 0.365596E-01
-PKER_SWETH( 31, 58) = 0.407050E-01
-PKER_SWETH( 31, 59) = 0.448811E-01
-PKER_SWETH( 31, 60) = 0.489754E-01
-PKER_SWETH( 31, 61) = 0.529184E-01
-PKER_SWETH( 31, 62) = 0.566739E-01
-PKER_SWETH( 31, 63) = 0.602262E-01
-PKER_SWETH( 31, 64) = 0.635723E-01
-PKER_SWETH( 31, 65) = 0.667174E-01
-PKER_SWETH( 31, 66) = 0.696701E-01
-PKER_SWETH( 31, 67) = 0.724406E-01
-PKER_SWETH( 31, 68) = 0.750398E-01
-PKER_SWETH( 31, 69) = 0.774782E-01
-PKER_SWETH( 31, 70) = 0.797661E-01
-PKER_SWETH( 31, 71) = 0.819129E-01
-PKER_SWETH( 31, 72) = 0.839275E-01
-PKER_SWETH( 31, 73) = 0.858182E-01
-PKER_SWETH( 31, 74) = 0.875929E-01
-PKER_SWETH( 31, 75) = 0.892587E-01
-PKER_SWETH( 31, 76) = 0.908224E-01
-PKER_SWETH( 31, 77) = 0.922904E-01
-PKER_SWETH( 31, 78) = 0.936685E-01
-PKER_SWETH( 31, 79) = 0.949623E-01
-PKER_SWETH( 31, 80) = 0.961771E-01
-PKER_SWETH( 32, 1) = 0.306950E+01
-PKER_SWETH( 32, 2) = 0.287698E+01
-PKER_SWETH( 32, 3) = 0.269621E+01
-PKER_SWETH( 32, 4) = 0.252647E+01
-PKER_SWETH( 32, 5) = 0.236709E+01
-PKER_SWETH( 32, 6) = 0.221743E+01
-PKER_SWETH( 32, 7) = 0.207690E+01
-PKER_SWETH( 32, 8) = 0.194494E+01
-PKER_SWETH( 32, 9) = 0.182103E+01
-PKER_SWETH( 32, 10) = 0.170468E+01
-PKER_SWETH( 32, 11) = 0.159543E+01
-PKER_SWETH( 32, 12) = 0.149284E+01
-PKER_SWETH( 32, 13) = 0.139651E+01
-PKER_SWETH( 32, 14) = 0.130604E+01
-PKER_SWETH( 32, 15) = 0.122110E+01
-PKER_SWETH( 32, 16) = 0.114133E+01
-PKER_SWETH( 32, 17) = 0.106641E+01
-PKER_SWETH( 32, 18) = 0.996065E+00
-PKER_SWETH( 32, 19) = 0.929996E+00
-PKER_SWETH( 32, 20) = 0.867945E+00
-PKER_SWETH( 32, 21) = 0.809665E+00
-PKER_SWETH( 32, 22) = 0.754921E+00
-PKER_SWETH( 32, 23) = 0.703494E+00
-PKER_SWETH( 32, 24) = 0.655177E+00
-PKER_SWETH( 32, 25) = 0.609776E+00
-PKER_SWETH( 32, 26) = 0.567105E+00
-PKER_SWETH( 32, 27) = 0.526991E+00
-PKER_SWETH( 32, 28) = 0.489268E+00
-PKER_SWETH( 32, 29) = 0.453780E+00
-PKER_SWETH( 32, 30) = 0.420376E+00
-PKER_SWETH( 32, 31) = 0.388915E+00
-PKER_SWETH( 32, 32) = 0.359260E+00
-PKER_SWETH( 32, 33) = 0.331282E+00
-PKER_SWETH( 32, 34) = 0.304853E+00
-PKER_SWETH( 32, 35) = 0.279856E+00
-PKER_SWETH( 32, 36) = 0.256176E+00
-PKER_SWETH( 32, 37) = 0.233707E+00
-PKER_SWETH( 32, 38) = 0.212354E+00
-PKER_SWETH( 32, 39) = 0.192034E+00
-PKER_SWETH( 32, 40) = 0.172684E+00
-PKER_SWETH( 32, 41) = 0.154264E+00
-PKER_SWETH( 32, 42) = 0.136760E+00
-PKER_SWETH( 32, 43) = 0.120188E+00
-PKER_SWETH( 32, 44) = 0.104591E+00
-PKER_SWETH( 32, 45) = 0.900321E-01
-PKER_SWETH( 32, 46) = 0.765907E-01
-PKER_SWETH( 32, 47) = 0.643573E-01
-PKER_SWETH( 32, 48) = 0.534353E-01
-PKER_SWETH( 32, 49) = 0.439379E-01
-PKER_SWETH( 32, 50) = 0.359735E-01
-PKER_SWETH( 32, 51) = 0.296431E-01
-PKER_SWETH( 32, 52) = 0.249980E-01
-PKER_SWETH( 32, 53) = 0.220226E-01
-PKER_SWETH( 32, 54) = 0.206377E-01
-PKER_SWETH( 32, 55) = 0.206814E-01
-PKER_SWETH( 32, 56) = 0.219135E-01
-PKER_SWETH( 32, 57) = 0.240858E-01
-PKER_SWETH( 32, 58) = 0.269346E-01
-PKER_SWETH( 32, 59) = 0.302057E-01
-PKER_SWETH( 32, 60) = 0.337067E-01
-PKER_SWETH( 32, 61) = 0.372783E-01
-PKER_SWETH( 32, 62) = 0.408119E-01
-PKER_SWETH( 32, 63) = 0.442381E-01
-PKER_SWETH( 32, 64) = 0.475167E-01
-PKER_SWETH( 32, 65) = 0.506273E-01
-PKER_SWETH( 32, 66) = 0.535634E-01
-PKER_SWETH( 32, 67) = 0.563269E-01
-PKER_SWETH( 32, 68) = 0.589236E-01
-PKER_SWETH( 32, 69) = 0.613616E-01
-PKER_SWETH( 32, 70) = 0.636498E-01
-PKER_SWETH( 32, 71) = 0.657972E-01
-PKER_SWETH( 32, 72) = 0.678125E-01
-PKER_SWETH( 32, 73) = 0.697038E-01
-PKER_SWETH( 32, 74) = 0.714789E-01
-PKER_SWETH( 32, 75) = 0.731451E-01
-PKER_SWETH( 32, 76) = 0.747091E-01
-PKER_SWETH( 32, 77) = 0.761773E-01
-PKER_SWETH( 32, 78) = 0.775556E-01
-PKER_SWETH( 32, 79) = 0.788495E-01
-PKER_SWETH( 32, 80) = 0.800644E-01
-PKER_SWETH( 33, 1) = 0.308151E+01
-PKER_SWETH( 33, 2) = 0.288900E+01
-PKER_SWETH( 33, 3) = 0.270823E+01
-PKER_SWETH( 33, 4) = 0.253849E+01
-PKER_SWETH( 33, 5) = 0.237910E+01
-PKER_SWETH( 33, 6) = 0.222945E+01
-PKER_SWETH( 33, 7) = 0.208892E+01
-PKER_SWETH( 33, 8) = 0.195696E+01
-PKER_SWETH( 33, 9) = 0.183305E+01
-PKER_SWETH( 33, 10) = 0.171671E+01
-PKER_SWETH( 33, 11) = 0.160746E+01
-PKER_SWETH( 33, 12) = 0.150487E+01
-PKER_SWETH( 33, 13) = 0.140854E+01
-PKER_SWETH( 33, 14) = 0.131808E+01
-PKER_SWETH( 33, 15) = 0.123314E+01
-PKER_SWETH( 33, 16) = 0.115338E+01
-PKER_SWETH( 33, 17) = 0.107847E+01
-PKER_SWETH( 33, 18) = 0.100813E+01
-PKER_SWETH( 33, 19) = 0.942077E+00
-PKER_SWETH( 33, 20) = 0.880040E+00
-PKER_SWETH( 33, 21) = 0.821776E+00
-PKER_SWETH( 33, 22) = 0.767053E+00
-PKER_SWETH( 33, 23) = 0.715650E+00
-PKER_SWETH( 33, 24) = 0.667363E+00
-PKER_SWETH( 33, 25) = 0.621996E+00
-PKER_SWETH( 33, 26) = 0.579368E+00
-PKER_SWETH( 33, 27) = 0.539304E+00
-PKER_SWETH( 33, 28) = 0.501641E+00
-PKER_SWETH( 33, 29) = 0.466224E+00
-PKER_SWETH( 33, 30) = 0.432907E+00
-PKER_SWETH( 33, 31) = 0.401549E+00
-PKER_SWETH( 33, 32) = 0.372017E+00
-PKER_SWETH( 33, 33) = 0.344183E+00
-PKER_SWETH( 33, 34) = 0.317925E+00
-PKER_SWETH( 33, 35) = 0.293127E+00
-PKER_SWETH( 33, 36) = 0.269676E+00
-PKER_SWETH( 33, 37) = 0.247466E+00
-PKER_SWETH( 33, 38) = 0.226399E+00
-PKER_SWETH( 33, 39) = 0.206386E+00
-PKER_SWETH( 33, 40) = 0.187349E+00
-PKER_SWETH( 33, 41) = 0.169229E+00
-PKER_SWETH( 33, 42) = 0.151986E+00
-PKER_SWETH( 33, 43) = 0.135605E+00
-PKER_SWETH( 33, 44) = 0.120096E+00
-PKER_SWETH( 33, 45) = 0.105487E+00
-PKER_SWETH( 33, 46) = 0.918186E-01
-PKER_SWETH( 33, 47) = 0.791379E-01
-PKER_SWETH( 33, 48) = 0.674909E-01
-PKER_SWETH( 33, 49) = 0.569228E-01
-PKER_SWETH( 33, 50) = 0.474840E-01
-PKER_SWETH( 33, 51) = 0.392391E-01
-PKER_SWETH( 33, 52) = 0.322557E-01
-PKER_SWETH( 33, 53) = 0.266021E-01
-PKER_SWETH( 33, 54) = 0.223338E-01
-PKER_SWETH( 33, 55) = 0.194489E-01
-PKER_SWETH( 33, 56) = 0.179097E-01
-PKER_SWETH( 33, 57) = 0.176019E-01
-PKER_SWETH( 33, 58) = 0.183558E-01
-PKER_SWETH( 33, 59) = 0.199729E-01
-PKER_SWETH( 33, 60) = 0.222260E-01
-PKER_SWETH( 33, 61) = 0.249199E-01
-PKER_SWETH( 33, 62) = 0.278561E-01
-PKER_SWETH( 33, 63) = 0.309016E-01
-PKER_SWETH( 33, 64) = 0.339479E-01
-PKER_SWETH( 33, 65) = 0.369229E-01
-PKER_SWETH( 33, 66) = 0.397837E-01
-PKER_SWETH( 33, 67) = 0.425074E-01
-PKER_SWETH( 33, 68) = 0.450841E-01
-PKER_SWETH( 33, 69) = 0.475128E-01
-PKER_SWETH( 33, 70) = 0.497970E-01
-PKER_SWETH( 33, 71) = 0.519430E-01
-PKER_SWETH( 33, 72) = 0.539580E-01
-PKER_SWETH( 33, 73) = 0.558495E-01
-PKER_SWETH( 33, 74) = 0.576250E-01
-PKER_SWETH( 33, 75) = 0.592915E-01
-PKER_SWETH( 33, 76) = 0.608558E-01
-PKER_SWETH( 33, 77) = 0.623242E-01
-PKER_SWETH( 33, 78) = 0.637027E-01
-PKER_SWETH( 33, 79) = 0.649969E-01
-PKER_SWETH( 33, 80) = 0.662118E-01
-PKER_SWETH( 34, 1) = 0.309184E+01
-PKER_SWETH( 34, 2) = 0.289932E+01
-PKER_SWETH( 34, 3) = 0.271856E+01
-PKER_SWETH( 34, 4) = 0.254882E+01
-PKER_SWETH( 34, 5) = 0.238943E+01
-PKER_SWETH( 34, 6) = 0.223978E+01
-PKER_SWETH( 34, 7) = 0.209925E+01
-PKER_SWETH( 34, 8) = 0.196729E+01
-PKER_SWETH( 34, 9) = 0.184339E+01
-PKER_SWETH( 34, 10) = 0.172704E+01
-PKER_SWETH( 34, 11) = 0.161779E+01
-PKER_SWETH( 34, 12) = 0.151521E+01
-PKER_SWETH( 34, 13) = 0.141888E+01
-PKER_SWETH( 34, 14) = 0.132843E+01
-PKER_SWETH( 34, 15) = 0.124349E+01
-PKER_SWETH( 34, 16) = 0.116373E+01
-PKER_SWETH( 34, 17) = 0.108884E+01
-PKER_SWETH( 34, 18) = 0.101851E+01
-PKER_SWETH( 34, 19) = 0.952457E+00
-PKER_SWETH( 34, 20) = 0.890431E+00
-PKER_SWETH( 34, 21) = 0.832180E+00
-PKER_SWETH( 34, 22) = 0.777472E+00
-PKER_SWETH( 34, 23) = 0.726088E+00
-PKER_SWETH( 34, 24) = 0.677823E+00
-PKER_SWETH( 34, 25) = 0.632484E+00
-PKER_SWETH( 34, 26) = 0.589887E+00
-PKER_SWETH( 34, 27) = 0.549861E+00
-PKER_SWETH( 34, 28) = 0.512245E+00
-PKER_SWETH( 34, 29) = 0.476883E+00
-PKER_SWETH( 34, 30) = 0.443632E+00
-PKER_SWETH( 34, 31) = 0.412352E+00
-PKER_SWETH( 34, 32) = 0.382914E+00
-PKER_SWETH( 34, 33) = 0.355191E+00
-PKER_SWETH( 34, 34) = 0.329066E+00
-PKER_SWETH( 34, 35) = 0.304422E+00
-PKER_SWETH( 34, 36) = 0.281152E+00
-PKER_SWETH( 34, 37) = 0.259150E+00
-PKER_SWETH( 34, 38) = 0.238318E+00
-PKER_SWETH( 34, 39) = 0.218563E+00
-PKER_SWETH( 34, 40) = 0.199802E+00
-PKER_SWETH( 34, 41) = 0.181964E+00
-PKER_SWETH( 34, 42) = 0.164992E+00
-PKER_SWETH( 34, 43) = 0.148849E+00
-PKER_SWETH( 34, 44) = 0.133519E+00
-PKER_SWETH( 34, 45) = 0.119007E+00
-PKER_SWETH( 34, 46) = 0.105335E+00
-PKER_SWETH( 34, 47) = 0.925328E-01
-PKER_SWETH( 34, 48) = 0.806299E-01
-PKER_SWETH( 34, 49) = 0.696479E-01
-PKER_SWETH( 34, 50) = 0.595995E-01
-PKER_SWETH( 34, 51) = 0.504941E-01
-PKER_SWETH( 34, 52) = 0.423461E-01
-PKER_SWETH( 34, 53) = 0.351838E-01
-PKER_SWETH( 34, 54) = 0.290506E-01
-PKER_SWETH( 34, 55) = 0.239993E-01
-PKER_SWETH( 34, 56) = 0.200739E-01
-PKER_SWETH( 34, 57) = 0.172988E-01
-PKER_SWETH( 34, 58) = 0.156604E-01
-PKER_SWETH( 34, 59) = 0.150796E-01
-PKER_SWETH( 34, 60) = 0.154392E-01
-PKER_SWETH( 34, 61) = 0.165933E-01
-PKER_SWETH( 34, 62) = 0.183494E-01
-PKER_SWETH( 34, 63) = 0.205301E-01
-PKER_SWETH( 34, 64) = 0.229866E-01
-PKER_SWETH( 34, 65) = 0.255714E-01
-PKER_SWETH( 34, 66) = 0.281888E-01
-PKER_SWETH( 34, 67) = 0.307678E-01
-PKER_SWETH( 34, 68) = 0.332620E-01
-PKER_SWETH( 34, 69) = 0.356458E-01
-PKER_SWETH( 34, 70) = 0.379067E-01
-PKER_SWETH( 34, 71) = 0.400413E-01
-PKER_SWETH( 34, 72) = 0.420509E-01
-PKER_SWETH( 34, 73) = 0.439402E-01
-PKER_SWETH( 34, 74) = 0.457149E-01
-PKER_SWETH( 34, 75) = 0.473812E-01
-PKER_SWETH( 34, 76) = 0.489457E-01
-PKER_SWETH( 34, 77) = 0.504143E-01
-PKER_SWETH( 34, 78) = 0.517930E-01
-PKER_SWETH( 34, 79) = 0.530872E-01
-PKER_SWETH( 34, 80) = 0.543023E-01
-PKER_SWETH( 35, 1) = 0.310072E+01
-PKER_SWETH( 35, 2) = 0.290820E+01
-PKER_SWETH( 35, 3) = 0.272743E+01
-PKER_SWETH( 35, 4) = 0.255770E+01
-PKER_SWETH( 35, 5) = 0.239831E+01
-PKER_SWETH( 35, 6) = 0.224866E+01
-PKER_SWETH( 35, 7) = 0.210813E+01
-PKER_SWETH( 35, 8) = 0.197617E+01
-PKER_SWETH( 35, 9) = 0.185227E+01
-PKER_SWETH( 35, 10) = 0.173593E+01
-PKER_SWETH( 35, 11) = 0.162668E+01
-PKER_SWETH( 35, 12) = 0.152410E+01
-PKER_SWETH( 35, 13) = 0.142777E+01
-PKER_SWETH( 35, 14) = 0.133732E+01
-PKER_SWETH( 35, 15) = 0.125239E+01
-PKER_SWETH( 35, 16) = 0.117264E+01
-PKER_SWETH( 35, 17) = 0.109774E+01
-PKER_SWETH( 35, 18) = 0.102742E+01
-PKER_SWETH( 35, 19) = 0.961377E+00
-PKER_SWETH( 35, 20) = 0.899359E+00
-PKER_SWETH( 35, 21) = 0.841118E+00
-PKER_SWETH( 35, 22) = 0.786422E+00
-PKER_SWETH( 35, 23) = 0.735052E+00
-PKER_SWETH( 35, 24) = 0.686804E+00
-PKER_SWETH( 35, 25) = 0.641485E+00
-PKER_SWETH( 35, 26) = 0.598913E+00
-PKER_SWETH( 35, 27) = 0.558917E+00
-PKER_SWETH( 35, 28) = 0.521336E+00
-PKER_SWETH( 35, 29) = 0.486016E+00
-PKER_SWETH( 35, 30) = 0.452815E+00
-PKER_SWETH( 35, 31) = 0.421596E+00
-PKER_SWETH( 35, 32) = 0.392230E+00
-PKER_SWETH( 35, 33) = 0.364593E+00
-PKER_SWETH( 35, 34) = 0.338569E+00
-PKER_SWETH( 35, 35) = 0.314046E+00
-PKER_SWETH( 35, 36) = 0.290917E+00
-PKER_SWETH( 35, 37) = 0.269079E+00
-PKER_SWETH( 35, 38) = 0.248435E+00
-PKER_SWETH( 35, 39) = 0.228893E+00
-PKER_SWETH( 35, 40) = 0.210367E+00
-PKER_SWETH( 35, 41) = 0.192778E+00
-PKER_SWETH( 35, 42) = 0.176061E+00
-PKER_SWETH( 35, 43) = 0.160161E+00
-PKER_SWETH( 35, 44) = 0.145044E+00
-PKER_SWETH( 35, 45) = 0.130694E+00
-PKER_SWETH( 35, 46) = 0.117114E+00
-PKER_SWETH( 35, 47) = 0.104322E+00
-PKER_SWETH( 35, 48) = 0.923406E-01
-PKER_SWETH( 35, 49) = 0.811910E-01
-PKER_SWETH( 35, 50) = 0.708831E-01
-PKER_SWETH( 35, 51) = 0.614129E-01
-PKER_SWETH( 35, 52) = 0.527674E-01
-PKER_SWETH( 35, 53) = 0.449295E-01
-PKER_SWETH( 35, 54) = 0.378928E-01
-PKER_SWETH( 35, 55) = 0.316644E-01
-PKER_SWETH( 35, 56) = 0.262678E-01
-PKER_SWETH( 35, 57) = 0.217486E-01
-PKER_SWETH( 35, 58) = 0.181484E-01
-PKER_SWETH( 35, 59) = 0.154956E-01
-PKER_SWETH( 35, 60) = 0.137987E-01
-PKER_SWETH( 35, 61) = 0.130148E-01
-PKER_SWETH( 35, 62) = 0.130605E-01
-PKER_SWETH( 35, 63) = 0.138245E-01
-PKER_SWETH( 35, 64) = 0.151576E-01
-PKER_SWETH( 35, 65) = 0.169108E-01
-PKER_SWETH( 35, 66) = 0.189375E-01
-PKER_SWETH( 35, 67) = 0.211232E-01
-PKER_SWETH( 35, 68) = 0.233664E-01
-PKER_SWETH( 35, 69) = 0.255967E-01
-PKER_SWETH( 35, 70) = 0.277686E-01
-PKER_SWETH( 35, 71) = 0.298534E-01
-PKER_SWETH( 35, 72) = 0.318366E-01
-PKER_SWETH( 35, 73) = 0.337123E-01
-PKER_SWETH( 35, 74) = 0.354804E-01
-PKER_SWETH( 35, 75) = 0.371439E-01
-PKER_SWETH( 35, 76) = 0.387070E-01
-PKER_SWETH( 35, 77) = 0.401752E-01
-PKER_SWETH( 35, 78) = 0.415538E-01
-PKER_SWETH( 35, 79) = 0.428482E-01
-PKER_SWETH( 35, 80) = 0.440634E-01
-PKER_SWETH( 36, 1) = 0.310835E+01
-PKER_SWETH( 36, 2) = 0.291584E+01
-PKER_SWETH( 36, 3) = 0.273507E+01
-PKER_SWETH( 36, 4) = 0.256533E+01
-PKER_SWETH( 36, 5) = 0.240595E+01
-PKER_SWETH( 36, 6) = 0.225629E+01
-PKER_SWETH( 36, 7) = 0.211576E+01
-PKER_SWETH( 36, 8) = 0.198381E+01
-PKER_SWETH( 36, 9) = 0.185991E+01
-PKER_SWETH( 36, 10) = 0.174357E+01
-PKER_SWETH( 36, 11) = 0.163432E+01
-PKER_SWETH( 36, 12) = 0.153174E+01
-PKER_SWETH( 36, 13) = 0.143542E+01
-PKER_SWETH( 36, 14) = 0.134497E+01
-PKER_SWETH( 36, 15) = 0.126004E+01
-PKER_SWETH( 36, 16) = 0.118029E+01
-PKER_SWETH( 36, 17) = 0.110540E+01
-PKER_SWETH( 36, 18) = 0.103508E+01
-PKER_SWETH( 36, 19) = 0.969041E+00
-PKER_SWETH( 36, 20) = 0.907030E+00
-PKER_SWETH( 36, 21) = 0.848797E+00
-PKER_SWETH( 36, 22) = 0.794110E+00
-PKER_SWETH( 36, 23) = 0.742752E+00
-PKER_SWETH( 36, 24) = 0.694517E+00
-PKER_SWETH( 36, 25) = 0.649214E+00
-PKER_SWETH( 36, 26) = 0.606660E+00
-PKER_SWETH( 36, 27) = 0.566687E+00
-PKER_SWETH( 36, 28) = 0.529133E+00
-PKER_SWETH( 36, 29) = 0.493846E+00
-PKER_SWETH( 36, 30) = 0.460684E+00
-PKER_SWETH( 36, 31) = 0.429511E+00
-PKER_SWETH( 36, 32) = 0.400200E+00
-PKER_SWETH( 36, 33) = 0.372629E+00
-PKER_SWETH( 36, 34) = 0.346683E+00
-PKER_SWETH( 36, 35) = 0.322253E+00
-PKER_SWETH( 36, 36) = 0.299234E+00
-PKER_SWETH( 36, 37) = 0.277524E+00
-PKER_SWETH( 36, 38) = 0.257030E+00
-PKER_SWETH( 36, 39) = 0.237660E+00
-PKER_SWETH( 36, 40) = 0.219327E+00
-PKER_SWETH( 36, 41) = 0.201951E+00
-PKER_SWETH( 36, 42) = 0.185459E+00
-PKER_SWETH( 36, 43) = 0.169789E+00
-PKER_SWETH( 36, 44) = 0.154891E+00
-PKER_SWETH( 36, 45) = 0.140732E+00
-PKER_SWETH( 36, 46) = 0.127296E+00
-PKER_SWETH( 36, 47) = 0.114586E+00
-PKER_SWETH( 36, 48) = 0.102615E+00
-PKER_SWETH( 36, 49) = 0.914036E-01
-PKER_SWETH( 36, 50) = 0.809677E-01
-PKER_SWETH( 36, 51) = 0.713107E-01
-PKER_SWETH( 36, 52) = 0.624220E-01
-PKER_SWETH( 36, 53) = 0.542774E-01
-PKER_SWETH( 36, 54) = 0.468457E-01
-PKER_SWETH( 36, 55) = 0.400966E-01
-PKER_SWETH( 36, 56) = 0.340102E-01
-PKER_SWETH( 36, 57) = 0.285833E-01
-PKER_SWETH( 36, 58) = 0.238305E-01
-PKER_SWETH( 36, 59) = 0.197847E-01
-PKER_SWETH( 36, 60) = 0.164873E-01
-PKER_SWETH( 36, 61) = 0.139717E-01
-PKER_SWETH( 36, 62) = 0.122567E-01
-PKER_SWETH( 36, 63) = 0.113235E-01
-PKER_SWETH( 36, 64) = 0.111235E-01
-PKER_SWETH( 36, 65) = 0.115692E-01
-PKER_SWETH( 36, 66) = 0.125432E-01
-PKER_SWETH( 36, 67) = 0.139260E-01
-PKER_SWETH( 36, 68) = 0.155897E-01
-PKER_SWETH( 36, 69) = 0.174230E-01
-PKER_SWETH( 36, 70) = 0.193355E-01
-PKER_SWETH( 36, 71) = 0.212597E-01
-PKER_SWETH( 36, 72) = 0.231475E-01
-PKER_SWETH( 36, 73) = 0.249689E-01
-PKER_SWETH( 36, 74) = 0.267074E-01
-PKER_SWETH( 36, 75) = 0.283553E-01
-PKER_SWETH( 36, 76) = 0.299107E-01
-PKER_SWETH( 36, 77) = 0.313752E-01
-PKER_SWETH( 36, 78) = 0.327522E-01
-PKER_SWETH( 36, 79) = 0.340458E-01
-PKER_SWETH( 36, 80) = 0.352608E-01
-PKER_SWETH( 37, 1) = 0.311491E+01
-PKER_SWETH( 37, 2) = 0.292240E+01
-PKER_SWETH( 37, 3) = 0.274163E+01
-PKER_SWETH( 37, 4) = 0.257189E+01
-PKER_SWETH( 37, 5) = 0.241251E+01
-PKER_SWETH( 37, 6) = 0.226285E+01
-PKER_SWETH( 37, 7) = 0.212233E+01
-PKER_SWETH( 37, 8) = 0.199038E+01
-PKER_SWETH( 37, 9) = 0.186647E+01
-PKER_SWETH( 37, 10) = 0.175013E+01
-PKER_SWETH( 37, 11) = 0.164089E+01
-PKER_SWETH( 37, 12) = 0.153831E+01
-PKER_SWETH( 37, 13) = 0.144199E+01
-PKER_SWETH( 37, 14) = 0.135154E+01
-PKER_SWETH( 37, 15) = 0.126661E+01
-PKER_SWETH( 37, 16) = 0.118686E+01
-PKER_SWETH( 37, 17) = 0.111198E+01
-PKER_SWETH( 37, 18) = 0.104166E+01
-PKER_SWETH( 37, 19) = 0.975628E+00
-PKER_SWETH( 37, 20) = 0.913622E+00
-PKER_SWETH( 37, 21) = 0.855395E+00
-PKER_SWETH( 37, 22) = 0.800715E+00
-PKER_SWETH( 37, 23) = 0.749365E+00
-PKER_SWETH( 37, 24) = 0.701141E+00
-PKER_SWETH( 37, 25) = 0.655850E+00
-PKER_SWETH( 37, 26) = 0.613311E+00
-PKER_SWETH( 37, 27) = 0.573355E+00
-PKER_SWETH( 37, 28) = 0.535822E+00
-PKER_SWETH( 37, 29) = 0.500560E+00
-PKER_SWETH( 37, 30) = 0.467427E+00
-PKER_SWETH( 37, 31) = 0.436290E+00
-PKER_SWETH( 37, 32) = 0.407022E+00
-PKER_SWETH( 37, 33) = 0.379502E+00
-PKER_SWETH( 37, 34) = 0.353617E+00
-PKER_SWETH( 37, 35) = 0.329258E+00
-PKER_SWETH( 37, 36) = 0.306324E+00
-PKER_SWETH( 37, 37) = 0.284715E+00
-PKER_SWETH( 37, 38) = 0.264339E+00
-PKER_SWETH( 37, 39) = 0.245105E+00
-PKER_SWETH( 37, 40) = 0.226928E+00
-PKER_SWETH( 37, 41) = 0.209728E+00
-PKER_SWETH( 37, 42) = 0.193429E+00
-PKER_SWETH( 37, 43) = 0.177964E+00
-PKER_SWETH( 37, 44) = 0.163274E+00
-PKER_SWETH( 37, 45) = 0.149312E+00
-PKER_SWETH( 37, 46) = 0.136048E+00
-PKER_SWETH( 37, 47) = 0.123465E+00
-PKER_SWETH( 37, 48) = 0.111565E+00
-PKER_SWETH( 37, 49) = 0.100361E+00
-PKER_SWETH( 37, 50) = 0.898685E-01
-PKER_SWETH( 37, 51) = 0.801011E-01
-PKER_SWETH( 37, 52) = 0.710600E-01
-PKER_SWETH( 37, 53) = 0.627312E-01
-PKER_SWETH( 37, 54) = 0.550863E-01
-PKER_SWETH( 37, 55) = 0.480884E-01
-PKER_SWETH( 37, 56) = 0.416969E-01
-PKER_SWETH( 37, 57) = 0.358758E-01
-PKER_SWETH( 37, 58) = 0.306011E-01
-PKER_SWETH( 37, 59) = 0.258627E-01
-PKER_SWETH( 37, 60) = 0.216705E-01
-PKER_SWETH( 37, 61) = 0.180510E-01
-PKER_SWETH( 37, 62) = 0.150380E-01
-PKER_SWETH( 37, 63) = 0.126706E-01
-PKER_SWETH( 37, 64) = 0.109714E-01
-PKER_SWETH( 37, 65) = 0.993843E-02
-PKER_SWETH( 37, 66) = 0.954608E-02
-PKER_SWETH( 37, 67) = 0.973463E-02
-PKER_SWETH( 37, 68) = 0.104102E-01
-PKER_SWETH( 37, 69) = 0.114756E-01
-PKER_SWETH( 37, 70) = 0.128242E-01
-PKER_SWETH( 37, 71) = 0.143505E-01
-PKER_SWETH( 37, 72) = 0.159749E-01
-PKER_SWETH( 37, 73) = 0.176289E-01
-PKER_SWETH( 37, 74) = 0.192657E-01
-PKER_SWETH( 37, 75) = 0.208546E-01
-PKER_SWETH( 37, 76) = 0.223773E-01
-PKER_SWETH( 37, 77) = 0.238244E-01
-PKER_SWETH( 37, 78) = 0.251923E-01
-PKER_SWETH( 37, 79) = 0.264816E-01
-PKER_SWETH( 37, 80) = 0.276945E-01
-PKER_SWETH( 38, 1) = 0.312055E+01
-PKER_SWETH( 38, 2) = 0.292804E+01
-PKER_SWETH( 38, 3) = 0.274727E+01
-PKER_SWETH( 38, 4) = 0.257753E+01
-PKER_SWETH( 38, 5) = 0.241815E+01
-PKER_SWETH( 38, 6) = 0.226850E+01
-PKER_SWETH( 38, 7) = 0.212797E+01
-PKER_SWETH( 38, 8) = 0.199602E+01
-PKER_SWETH( 38, 9) = 0.187212E+01
-PKER_SWETH( 38, 10) = 0.175578E+01
-PKER_SWETH( 38, 11) = 0.164653E+01
-PKER_SWETH( 38, 12) = 0.154395E+01
-PKER_SWETH( 38, 13) = 0.144763E+01
-PKER_SWETH( 38, 14) = 0.135719E+01
-PKER_SWETH( 38, 15) = 0.127226E+01
-PKER_SWETH( 38, 16) = 0.119252E+01
-PKER_SWETH( 38, 17) = 0.111763E+01
-PKER_SWETH( 38, 18) = 0.104732E+01
-PKER_SWETH( 38, 19) = 0.981289E+00
-PKER_SWETH( 38, 20) = 0.919287E+00
-PKER_SWETH( 38, 21) = 0.861064E+00
-PKER_SWETH( 38, 22) = 0.806390E+00
-PKER_SWETH( 38, 23) = 0.755047E+00
-PKER_SWETH( 38, 24) = 0.706830E+00
-PKER_SWETH( 38, 25) = 0.661549E+00
-PKER_SWETH( 38, 26) = 0.619021E+00
-PKER_SWETH( 38, 27) = 0.579079E+00
-PKER_SWETH( 38, 28) = 0.541562E+00
-PKER_SWETH( 38, 29) = 0.506319E+00
-PKER_SWETH( 38, 30) = 0.473210E+00
-PKER_SWETH( 38, 31) = 0.442100E+00
-PKER_SWETH( 38, 32) = 0.412864E+00
-PKER_SWETH( 38, 33) = 0.385384E+00
-PKER_SWETH( 38, 34) = 0.359545E+00
-PKER_SWETH( 38, 35) = 0.335242E+00
-PKER_SWETH( 38, 36) = 0.312374E+00
-PKER_SWETH( 38, 37) = 0.290843E+00
-PKER_SWETH( 38, 38) = 0.270558E+00
-PKER_SWETH( 38, 39) = 0.251432E+00
-PKER_SWETH( 38, 40) = 0.233380E+00
-PKER_SWETH( 38, 41) = 0.216322E+00
-PKER_SWETH( 38, 42) = 0.200184E+00
-PKER_SWETH( 38, 43) = 0.184895E+00
-PKER_SWETH( 38, 44) = 0.170391E+00
-PKER_SWETH( 38, 45) = 0.156618E+00
-PKER_SWETH( 38, 46) = 0.143532E+00
-PKER_SWETH( 38, 47) = 0.131103E+00
-PKER_SWETH( 38, 48) = 0.119316E+00
-PKER_SWETH( 38, 49) = 0.108173E+00
-PKER_SWETH( 38, 50) = 0.976829E-01
-PKER_SWETH( 38, 51) = 0.878612E-01
-PKER_SWETH( 38, 52) = 0.787186E-01
-PKER_SWETH( 38, 53) = 0.702546E-01
-PKER_SWETH( 38, 54) = 0.624546E-01
-PKER_SWETH( 38, 55) = 0.552898E-01
-PKER_SWETH( 38, 56) = 0.487209E-01
-PKER_SWETH( 38, 57) = 0.427048E-01
-PKER_SWETH( 38, 58) = 0.371990E-01
-PKER_SWETH( 38, 59) = 0.321674E-01
-PKER_SWETH( 38, 60) = 0.275855E-01
-PKER_SWETH( 38, 61) = 0.234416E-01
-PKER_SWETH( 38, 62) = 0.197400E-01
-PKER_SWETH( 38, 63) = 0.165029E-01
-PKER_SWETH( 38, 64) = 0.137600E-01
-PKER_SWETH( 38, 65) = 0.115447E-01
-PKER_SWETH( 38, 66) = 0.988906E-02
-PKER_SWETH( 38, 67) = 0.879852E-02
-PKER_SWETH( 38, 68) = 0.826489E-02
-PKER_SWETH( 38, 69) = 0.824680E-02
-PKER_SWETH( 38, 70) = 0.867704E-02
-PKER_SWETH( 38, 71) = 0.947507E-02
-PKER_SWETH( 38, 72) = 0.105465E-01
-PKER_SWETH( 38, 73) = 0.118092E-01
-PKER_SWETH( 38, 74) = 0.131773E-01
-PKER_SWETH( 38, 75) = 0.145933E-01
-PKER_SWETH( 38, 76) = 0.160093E-01
-PKER_SWETH( 38, 77) = 0.173932E-01
-PKER_SWETH( 38, 78) = 0.187254E-01
-PKER_SWETH( 38, 79) = 0.199952E-01
-PKER_SWETH( 38, 80) = 0.211980E-01
-PKER_SWETH( 39, 1) = 0.312540E+01
-PKER_SWETH( 39, 2) = 0.293289E+01
-PKER_SWETH( 39, 3) = 0.275212E+01
-PKER_SWETH( 39, 4) = 0.258238E+01
-PKER_SWETH( 39, 5) = 0.242300E+01
-PKER_SWETH( 39, 6) = 0.227335E+01
-PKER_SWETH( 39, 7) = 0.213282E+01
-PKER_SWETH( 39, 8) = 0.200087E+01
-PKER_SWETH( 39, 9) = 0.187697E+01
-PKER_SWETH( 39, 10) = 0.176063E+01
-PKER_SWETH( 39, 11) = 0.165139E+01
-PKER_SWETH( 39, 12) = 0.154881E+01
-PKER_SWETH( 39, 13) = 0.145249E+01
-PKER_SWETH( 39, 14) = 0.136204E+01
-PKER_SWETH( 39, 15) = 0.127712E+01
-PKER_SWETH( 39, 16) = 0.119737E+01
-PKER_SWETH( 39, 17) = 0.112249E+01
-PKER_SWETH( 39, 18) = 0.105218E+01
-PKER_SWETH( 39, 19) = 0.986154E+00
-PKER_SWETH( 39, 20) = 0.924155E+00
-PKER_SWETH( 39, 21) = 0.865936E+00
-PKER_SWETH( 39, 22) = 0.811266E+00
-PKER_SWETH( 39, 23) = 0.759928E+00
-PKER_SWETH( 39, 24) = 0.711718E+00
-PKER_SWETH( 39, 25) = 0.666443E+00
-PKER_SWETH( 39, 26) = 0.623925E+00
-PKER_SWETH( 39, 27) = 0.583993E+00
-PKER_SWETH( 39, 28) = 0.546488E+00
-PKER_SWETH( 39, 29) = 0.511260E+00
-PKER_SWETH( 39, 30) = 0.478169E+00
-PKER_SWETH( 39, 31) = 0.447081E+00
-PKER_SWETH( 39, 32) = 0.417870E+00
-PKER_SWETH( 39, 33) = 0.390420E+00
-PKER_SWETH( 39, 34) = 0.364617E+00
-PKER_SWETH( 39, 35) = 0.340357E+00
-PKER_SWETH( 39, 36) = 0.317540E+00
-PKER_SWETH( 39, 37) = 0.296070E+00
-PKER_SWETH( 39, 38) = 0.275857E+00
-PKER_SWETH( 39, 39) = 0.256815E+00
-PKER_SWETH( 39, 40) = 0.238861E+00
-PKER_SWETH( 39, 41) = 0.221918E+00
-PKER_SWETH( 39, 42) = 0.205910E+00
-PKER_SWETH( 39, 43) = 0.190767E+00
-PKER_SWETH( 39, 44) = 0.176424E+00
-PKER_SWETH( 39, 45) = 0.162820E+00
-PKER_SWETH( 39, 46) = 0.149905E+00
-PKER_SWETH( 39, 47) = 0.137638E+00
-PKER_SWETH( 39, 48) = 0.125990E+00
-PKER_SWETH( 39, 49) = 0.114947E+00
-PKER_SWETH( 39, 50) = 0.104510E+00
-PKER_SWETH( 39, 51) = 0.946861E-01
-PKER_SWETH( 39, 52) = 0.854898E-01
-PKER_SWETH( 39, 53) = 0.769298E-01
-PKER_SWETH( 39, 54) = 0.690050E-01
-PKER_SWETH( 39, 55) = 0.617007E-01
-PKER_SWETH( 39, 56) = 0.549886E-01
-PKER_SWETH( 39, 57) = 0.488307E-01
-PKER_SWETH( 39, 58) = 0.431836E-01
-PKER_SWETH( 39, 59) = 0.380031E-01
-PKER_SWETH( 39, 60) = 0.332495E-01
-PKER_SWETH( 39, 61) = 0.288898E-01
-PKER_SWETH( 39, 62) = 0.249005E-01
-PKER_SWETH( 39, 63) = 0.212702E-01
-PKER_SWETH( 39, 64) = 0.180010E-01
-PKER_SWETH( 39, 65) = 0.151081E-01
-PKER_SWETH( 39, 66) = 0.126179E-01
-PKER_SWETH( 39, 67) = 0.105619E-01
-PKER_SWETH( 39, 68) = 0.896792E-02
-PKER_SWETH( 39, 69) = 0.785453E-02
-PKER_SWETH( 39, 70) = 0.722272E-02
-PKER_SWETH( 39, 71) = 0.704369E-02
-PKER_SWETH( 39, 72) = 0.727131E-02
-PKER_SWETH( 39, 73) = 0.784505E-02
-PKER_SWETH( 39, 74) = 0.868311E-02
-PKER_SWETH( 39, 75) = 0.970864E-02
-PKER_SWETH( 39, 76) = 0.108569E-01
-PKER_SWETH( 39, 77) = 0.120624E-01
-PKER_SWETH( 39, 78) = 0.132824E-01
-PKER_SWETH( 39, 79) = 0.144849E-01
-PKER_SWETH( 39, 80) = 0.156487E-01
-PKER_SWETH( 40, 1) = 0.312957E+01
-PKER_SWETH( 40, 2) = 0.293706E+01
-PKER_SWETH( 40, 3) = 0.275629E+01
-PKER_SWETH( 40, 4) = 0.258655E+01
-PKER_SWETH( 40, 5) = 0.242717E+01
-PKER_SWETH( 40, 6) = 0.227752E+01
-PKER_SWETH( 40, 7) = 0.213699E+01
-PKER_SWETH( 40, 8) = 0.200504E+01
-PKER_SWETH( 40, 9) = 0.188114E+01
-PKER_SWETH( 40, 10) = 0.176480E+01
-PKER_SWETH( 40, 11) = 0.165556E+01
-PKER_SWETH( 40, 12) = 0.155298E+01
-PKER_SWETH( 40, 13) = 0.145666E+01
-PKER_SWETH( 40, 14) = 0.136622E+01
-PKER_SWETH( 40, 15) = 0.128129E+01
-PKER_SWETH( 40, 16) = 0.120155E+01
-PKER_SWETH( 40, 17) = 0.112667E+01
-PKER_SWETH( 40, 18) = 0.105636E+01
-PKER_SWETH( 40, 19) = 0.990335E+00
-PKER_SWETH( 40, 20) = 0.928339E+00
-PKER_SWETH( 40, 21) = 0.870123E+00
-PKER_SWETH( 40, 22) = 0.815456E+00
-PKER_SWETH( 40, 23) = 0.764122E+00
-PKER_SWETH( 40, 24) = 0.715917E+00
-PKER_SWETH( 40, 25) = 0.670648E+00
-PKER_SWETH( 40, 26) = 0.628136E+00
-PKER_SWETH( 40, 27) = 0.588213E+00
-PKER_SWETH( 40, 28) = 0.550717E+00
-PKER_SWETH( 40, 29) = 0.515501E+00
-PKER_SWETH( 40, 30) = 0.482423E+00
-PKER_SWETH( 40, 31) = 0.451352E+00
-PKER_SWETH( 40, 32) = 0.422161E+00
-PKER_SWETH( 40, 33) = 0.394734E+00
-PKER_SWETH( 40, 34) = 0.368959E+00
-PKER_SWETH( 40, 35) = 0.344733E+00
-PKER_SWETH( 40, 36) = 0.321955E+00
-PKER_SWETH( 40, 37) = 0.300532E+00
-PKER_SWETH( 40, 38) = 0.280375E+00
-PKER_SWETH( 40, 39) = 0.261398E+00
-PKER_SWETH( 40, 40) = 0.243522E+00
-PKER_SWETH( 40, 41) = 0.226669E+00
-PKER_SWETH( 40, 42) = 0.210766E+00
-PKER_SWETH( 40, 43) = 0.195742E+00
-PKER_SWETH( 40, 44) = 0.181533E+00
-PKER_SWETH( 40, 45) = 0.168076E+00
-PKER_SWETH( 40, 46) = 0.155315E+00
-PKER_SWETH( 40, 47) = 0.143204E+00
-PKER_SWETH( 40, 48) = 0.131702E+00
-PKER_SWETH( 40, 49) = 0.120785E+00
-PKER_SWETH( 40, 50) = 0.110437E+00
-PKER_SWETH( 40, 51) = 0.100659E+00
-PKER_SWETH( 40, 52) = 0.914575E-01
-PKER_SWETH( 40, 53) = 0.828446E-01
-PKER_SWETH( 40, 54) = 0.748281E-01
-PKER_SWETH( 40, 55) = 0.674064E-01
-PKER_SWETH( 40, 56) = 0.605652E-01
-PKER_SWETH( 40, 57) = 0.542777E-01
-PKER_SWETH( 40, 58) = 0.485071E-01
-PKER_SWETH( 40, 59) = 0.432118E-01
-PKER_SWETH( 40, 60) = 0.383491E-01
-PKER_SWETH( 40, 61) = 0.338780E-01
-PKER_SWETH( 40, 62) = 0.297634E-01
-PKER_SWETH( 40, 63) = 0.259760E-01
-PKER_SWETH( 40, 64) = 0.224957E-01
-PKER_SWETH( 40, 65) = 0.193110E-01
-PKER_SWETH( 40, 66) = 0.164227E-01
-PKER_SWETH( 40, 67) = 0.138417E-01
-PKER_SWETH( 40, 68) = 0.115876E-01
-PKER_SWETH( 40, 69) = 0.969034E-02
-PKER_SWETH( 40, 70) = 0.817663E-02
-PKER_SWETH( 40, 71) = 0.706594E-02
-PKER_SWETH( 40, 72) = 0.636811E-02
-PKER_SWETH( 40, 73) = 0.606885E-02
-PKER_SWETH( 40, 74) = 0.613458E-02
-PKER_SWETH( 40, 75) = 0.651889E-02
-PKER_SWETH( 40, 76) = 0.715696E-02
-PKER_SWETH( 40, 77) = 0.798335E-02
-PKER_SWETH( 40, 78) = 0.893308E-02
-PKER_SWETH( 40, 79) = 0.995468E-02
-PKER_SWETH( 40, 80) = 0.110025E-01
+ PKER_SWETH( 1, 1) = 0.615237E+01
+ PKER_SWETH( 1, 2) = 0.637080E+01
+ PKER_SWETH( 1, 3) = 0.658231E+01
+ PKER_SWETH( 1, 4) = 0.678858E+01
+ PKER_SWETH( 1, 5) = 0.699129E+01
+ PKER_SWETH( 1, 6) = 0.719213E+01
+ PKER_SWETH( 1, 7) = 0.739259E+01
+ PKER_SWETH( 1, 8) = 0.759386E+01
+ PKER_SWETH( 1, 9) = 0.779656E+01
+ PKER_SWETH( 1, 10) = 0.800053E+01
+ PKER_SWETH( 1, 11) = 0.820465E+01
+ PKER_SWETH( 1, 12) = 0.840686E+01
+ PKER_SWETH( 1, 13) = 0.860429E+01
+ PKER_SWETH( 1, 14) = 0.879377E+01
+ PKER_SWETH( 1, 15) = 0.897226E+01
+ PKER_SWETH( 1, 16) = 0.913741E+01
+ PKER_SWETH( 1, 17) = 0.928778E+01
+ PKER_SWETH( 1, 18) = 0.942293E+01
+ PKER_SWETH( 1, 19) = 0.954325E+01
+ PKER_SWETH( 1, 20) = 0.964973E+01
+ PKER_SWETH( 1, 21) = 0.974368E+01
+ PKER_SWETH( 1, 22) = 0.982656E+01
+ PKER_SWETH( 1, 23) = 0.989979E+01
+ PKER_SWETH( 1, 24) = 0.996470E+01
+ PKER_SWETH( 1, 25) = 0.100225E+02
+ PKER_SWETH( 1, 26) = 0.100741E+02
+ PKER_SWETH( 1, 27) = 0.101205E+02
+ PKER_SWETH( 1, 28) = 0.101624E+02
+ PKER_SWETH( 1, 29) = 0.102004E+02
+ PKER_SWETH( 1, 30) = 0.102350E+02
+ PKER_SWETH( 1, 31) = 0.102667E+02
+ PKER_SWETH( 1, 32) = 0.102957E+02
+ PKER_SWETH( 1, 33) = 0.103224E+02
+ PKER_SWETH( 1, 34) = 0.103471E+02
+ PKER_SWETH( 1, 35) = 0.103699E+02
+ PKER_SWETH( 1, 36) = 0.103911E+02
+ PKER_SWETH( 1, 37) = 0.104108E+02
+ PKER_SWETH( 1, 38) = 0.104291E+02
+ PKER_SWETH( 1, 39) = 0.104461E+02
+ PKER_SWETH( 1, 40) = 0.104620E+02
+ PKER_SWETH( 1, 41) = 0.104769E+02
+ PKER_SWETH( 1, 42) = 0.104908E+02
+ PKER_SWETH( 1, 43) = 0.105038E+02
+ PKER_SWETH( 1, 44) = 0.105159E+02
+ PKER_SWETH( 1, 45) = 0.105273E+02
+ PKER_SWETH( 1, 46) = 0.105380E+02
+ PKER_SWETH( 1, 47) = 0.105480E+02
+ PKER_SWETH( 1, 48) = 0.105573E+02
+ PKER_SWETH( 1, 49) = 0.105661E+02
+ PKER_SWETH( 1, 50) = 0.105744E+02
+ PKER_SWETH( 1, 51) = 0.105821E+02
+ PKER_SWETH( 1, 52) = 0.105893E+02
+ PKER_SWETH( 1, 53) = 0.105961E+02
+ PKER_SWETH( 1, 54) = 0.106025E+02
+ PKER_SWETH( 1, 55) = 0.106085E+02
+ PKER_SWETH( 1, 56) = 0.106141E+02
+ PKER_SWETH( 1, 57) = 0.106194E+02
+ PKER_SWETH( 1, 58) = 0.106244E+02
+ PKER_SWETH( 1, 59) = 0.106290E+02
+ PKER_SWETH( 1, 60) = 0.106334E+02
+ PKER_SWETH( 1, 61) = 0.106375E+02
+ PKER_SWETH( 1, 62) = 0.106413E+02
+ PKER_SWETH( 1, 63) = 0.106450E+02
+ PKER_SWETH( 1, 64) = 0.106483E+02
+ PKER_SWETH( 1, 65) = 0.106515E+02
+ PKER_SWETH( 1, 66) = 0.106545E+02
+ PKER_SWETH( 1, 67) = 0.106573E+02
+ PKER_SWETH( 1, 68) = 0.106600E+02
+ PKER_SWETH( 1, 69) = 0.106624E+02
+ PKER_SWETH( 1, 70) = 0.106648E+02
+ PKER_SWETH( 1, 71) = 0.106669E+02
+ PKER_SWETH( 1, 72) = 0.106690E+02
+ PKER_SWETH( 1, 73) = 0.106709E+02
+ PKER_SWETH( 1, 74) = 0.106727E+02
+ PKER_SWETH( 1, 75) = 0.106744E+02
+ PKER_SWETH( 1, 76) = 0.106760E+02
+ PKER_SWETH( 1, 77) = 0.106775E+02
+ PKER_SWETH( 1, 78) = 0.106789E+02
+ PKER_SWETH( 1, 79) = 0.106802E+02
+ PKER_SWETH( 1, 80) = 0.106815E+02
+ PKER_SWETH( 2, 1) = 0.482432E+01
+ PKER_SWETH( 2, 2) = 0.503595E+01
+ PKER_SWETH( 2, 3) = 0.523941E+01
+ PKER_SWETH( 2, 4) = 0.543608E+01
+ PKER_SWETH( 2, 5) = 0.562743E+01
+ PKER_SWETH( 2, 6) = 0.581495E+01
+ PKER_SWETH( 2, 7) = 0.600013E+01
+ PKER_SWETH( 2, 8) = 0.618431E+01
+ PKER_SWETH( 2, 9) = 0.636855E+01
+ PKER_SWETH( 2, 10) = 0.655341E+01
+ PKER_SWETH( 2, 11) = 0.673880E+01
+ PKER_SWETH( 2, 12) = 0.692377E+01
+ PKER_SWETH( 2, 13) = 0.710655E+01
+ PKER_SWETH( 2, 14) = 0.728471E+01
+ PKER_SWETH( 2, 15) = 0.745548E+01
+ PKER_SWETH( 2, 16) = 0.761628E+01
+ PKER_SWETH( 2, 17) = 0.776507E+01
+ PKER_SWETH( 2, 18) = 0.790065E+01
+ PKER_SWETH( 2, 19) = 0.802264E+01
+ PKER_SWETH( 2, 20) = 0.813143E+01
+ PKER_SWETH( 2, 21) = 0.822788E+01
+ PKER_SWETH( 2, 22) = 0.831318E+01
+ PKER_SWETH( 2, 23) = 0.838861E+01
+ PKER_SWETH( 2, 24) = 0.845542E+01
+ PKER_SWETH( 2, 25) = 0.851480E+01
+ PKER_SWETH( 2, 26) = 0.856779E+01
+ PKER_SWETH( 2, 27) = 0.861528E+01
+ PKER_SWETH( 2, 28) = 0.865805E+01
+ PKER_SWETH( 2, 29) = 0.869674E+01
+ PKER_SWETH( 2, 30) = 0.873190E+01
+ PKER_SWETH( 2, 31) = 0.876398E+01
+ PKER_SWETH( 2, 32) = 0.879336E+01
+ PKER_SWETH( 2, 33) = 0.882036E+01
+ PKER_SWETH( 2, 34) = 0.884525E+01
+ PKER_SWETH( 2, 35) = 0.886825E+01
+ PKER_SWETH( 2, 36) = 0.888956E+01
+ PKER_SWETH( 2, 37) = 0.890934E+01
+ PKER_SWETH( 2, 38) = 0.892772E+01
+ PKER_SWETH( 2, 39) = 0.894485E+01
+ PKER_SWETH( 2, 40) = 0.896081E+01
+ PKER_SWETH( 2, 41) = 0.897571E+01
+ PKER_SWETH( 2, 42) = 0.898963E+01
+ PKER_SWETH( 2, 43) = 0.900265E+01
+ PKER_SWETH( 2, 44) = 0.901483E+01
+ PKER_SWETH( 2, 45) = 0.902623E+01
+ PKER_SWETH( 2, 46) = 0.903690E+01
+ PKER_SWETH( 2, 47) = 0.904690E+01
+ PKER_SWETH( 2, 48) = 0.905628E+01
+ PKER_SWETH( 2, 49) = 0.906507E+01
+ PKER_SWETH( 2, 50) = 0.907331E+01
+ PKER_SWETH( 2, 51) = 0.908104E+01
+ PKER_SWETH( 2, 52) = 0.908830E+01
+ PKER_SWETH( 2, 53) = 0.909510E+01
+ PKER_SWETH( 2, 54) = 0.910149E+01
+ PKER_SWETH( 2, 55) = 0.910748E+01
+ PKER_SWETH( 2, 56) = 0.911311E+01
+ PKER_SWETH( 2, 57) = 0.911839E+01
+ PKER_SWETH( 2, 58) = 0.912334E+01
+ PKER_SWETH( 2, 59) = 0.912799E+01
+ PKER_SWETH( 2, 60) = 0.913236E+01
+ PKER_SWETH( 2, 61) = 0.913646E+01
+ PKER_SWETH( 2, 62) = 0.914031E+01
+ PKER_SWETH( 2, 63) = 0.914392E+01
+ PKER_SWETH( 2, 64) = 0.914731E+01
+ PKER_SWETH( 2, 65) = 0.915050E+01
+ PKER_SWETH( 2, 66) = 0.915349E+01
+ PKER_SWETH( 2, 67) = 0.915630E+01
+ PKER_SWETH( 2, 68) = 0.915894E+01
+ PKER_SWETH( 2, 69) = 0.916141E+01
+ PKER_SWETH( 2, 70) = 0.916374E+01
+ PKER_SWETH( 2, 71) = 0.916592E+01
+ PKER_SWETH( 2, 72) = 0.916797E+01
+ PKER_SWETH( 2, 73) = 0.916989E+01
+ PKER_SWETH( 2, 74) = 0.917170E+01
+ PKER_SWETH( 2, 75) = 0.917339E+01
+ PKER_SWETH( 2, 76) = 0.917499E+01
+ PKER_SWETH( 2, 77) = 0.917648E+01
+ PKER_SWETH( 2, 78) = 0.917789E+01
+ PKER_SWETH( 2, 79) = 0.917921E+01
+ PKER_SWETH( 2, 80) = 0.918044E+01
+ PKER_SWETH( 3, 1) = 0.368905E+01
+ PKER_SWETH( 3, 2) = 0.389478E+01
+ PKER_SWETH( 3, 3) = 0.409193E+01
+ PKER_SWETH( 3, 4) = 0.428141E+01
+ PKER_SWETH( 3, 5) = 0.446434E+01
+ PKER_SWETH( 3, 6) = 0.464196E+01
+ PKER_SWETH( 3, 7) = 0.481560E+01
+ PKER_SWETH( 3, 8) = 0.498655E+01
+ PKER_SWETH( 3, 9) = 0.515601E+01
+ PKER_SWETH( 3, 10) = 0.532493E+01
+ PKER_SWETH( 3, 11) = 0.549382E+01
+ PKER_SWETH( 3, 12) = 0.566262E+01
+ PKER_SWETH( 3, 13) = 0.583056E+01
+ PKER_SWETH( 3, 14) = 0.599610E+01
+ PKER_SWETH( 3, 15) = 0.615716E+01
+ PKER_SWETH( 3, 16) = 0.631137E+01
+ PKER_SWETH( 3, 17) = 0.645651E+01
+ PKER_SWETH( 3, 18) = 0.659082E+01
+ PKER_SWETH( 3, 19) = 0.671329E+01
+ PKER_SWETH( 3, 20) = 0.682361E+01
+ PKER_SWETH( 3, 21) = 0.692215E+01
+ PKER_SWETH( 3, 22) = 0.700968E+01
+ PKER_SWETH( 3, 23) = 0.708726E+01
+ PKER_SWETH( 3, 24) = 0.715602E+01
+ PKER_SWETH( 3, 25) = 0.721708E+01
+ PKER_SWETH( 3, 26) = 0.727148E+01
+ PKER_SWETH( 3, 27) = 0.732015E+01
+ PKER_SWETH( 3, 28) = 0.736386E+01
+ PKER_SWETH( 3, 29) = 0.740332E+01
+ PKER_SWETH( 3, 30) = 0.743910E+01
+ PKER_SWETH( 3, 31) = 0.747167E+01
+ PKER_SWETH( 3, 32) = 0.750144E+01
+ PKER_SWETH( 3, 33) = 0.752875E+01
+ PKER_SWETH( 3, 34) = 0.755388E+01
+ PKER_SWETH( 3, 35) = 0.757707E+01
+ PKER_SWETH( 3, 36) = 0.759853E+01
+ PKER_SWETH( 3, 37) = 0.761842E+01
+ PKER_SWETH( 3, 38) = 0.763691E+01
+ PKER_SWETH( 3, 39) = 0.765410E+01
+ PKER_SWETH( 3, 40) = 0.767013E+01
+ PKER_SWETH( 3, 41) = 0.768507E+01
+ PKER_SWETH( 3, 42) = 0.769903E+01
+ PKER_SWETH( 3, 43) = 0.771207E+01
+ PKER_SWETH( 3, 44) = 0.772427E+01
+ PKER_SWETH( 3, 45) = 0.773569E+01
+ PKER_SWETH( 3, 46) = 0.774638E+01
+ PKER_SWETH( 3, 47) = 0.775639E+01
+ PKER_SWETH( 3, 48) = 0.776578E+01
+ PKER_SWETH( 3, 49) = 0.777457E+01
+ PKER_SWETH( 3, 50) = 0.778282E+01
+ PKER_SWETH( 3, 51) = 0.779056E+01
+ PKER_SWETH( 3, 52) = 0.779781E+01
+ PKER_SWETH( 3, 53) = 0.780462E+01
+ PKER_SWETH( 3, 54) = 0.781101E+01
+ PKER_SWETH( 3, 55) = 0.781700E+01
+ PKER_SWETH( 3, 56) = 0.782263E+01
+ PKER_SWETH( 3, 57) = 0.782791E+01
+ PKER_SWETH( 3, 58) = 0.783287E+01
+ PKER_SWETH( 3, 59) = 0.783752E+01
+ PKER_SWETH( 3, 60) = 0.784189E+01
+ PKER_SWETH( 3, 61) = 0.784599E+01
+ PKER_SWETH( 3, 62) = 0.784984E+01
+ PKER_SWETH( 3, 63) = 0.785345E+01
+ PKER_SWETH( 3, 64) = 0.785684E+01
+ PKER_SWETH( 3, 65) = 0.786003E+01
+ PKER_SWETH( 3, 66) = 0.786302E+01
+ PKER_SWETH( 3, 67) = 0.786583E+01
+ PKER_SWETH( 3, 68) = 0.786846E+01
+ PKER_SWETH( 3, 69) = 0.787094E+01
+ PKER_SWETH( 3, 70) = 0.787326E+01
+ PKER_SWETH( 3, 71) = 0.787545E+01
+ PKER_SWETH( 3, 72) = 0.787750E+01
+ PKER_SWETH( 3, 73) = 0.787942E+01
+ PKER_SWETH( 3, 74) = 0.788123E+01
+ PKER_SWETH( 3, 75) = 0.788292E+01
+ PKER_SWETH( 3, 76) = 0.788452E+01
+ PKER_SWETH( 3, 77) = 0.788601E+01
+ PKER_SWETH( 3, 78) = 0.788742E+01
+ PKER_SWETH( 3, 79) = 0.788874E+01
+ PKER_SWETH( 3, 80) = 0.788997E+01
+ PKER_SWETH( 4, 1) = 0.272364E+01
+ PKER_SWETH( 4, 2) = 0.292170E+01
+ PKER_SWETH( 4, 3) = 0.311233E+01
+ PKER_SWETH( 4, 4) = 0.329553E+01
+ PKER_SWETH( 4, 5) = 0.347178E+01
+ PKER_SWETH( 4, 6) = 0.364187E+01
+ PKER_SWETH( 4, 7) = 0.380681E+01
+ PKER_SWETH( 4, 8) = 0.396771E+01
+ PKER_SWETH( 4, 9) = 0.412569E+01
+ PKER_SWETH( 4, 10) = 0.428181E+01
+ PKER_SWETH( 4, 11) = 0.443691E+01
+ PKER_SWETH( 4, 12) = 0.459147E+01
+ PKER_SWETH( 4, 13) = 0.474544E+01
+ PKER_SWETH( 4, 14) = 0.489819E+01
+ PKER_SWETH( 4, 15) = 0.504840E+01
+ PKER_SWETH( 4, 16) = 0.519429E+01
+ PKER_SWETH( 4, 17) = 0.533381E+01
+ PKER_SWETH( 4, 18) = 0.546505E+01
+ PKER_SWETH( 4, 19) = 0.558652E+01
+ PKER_SWETH( 4, 20) = 0.569735E+01
+ PKER_SWETH( 4, 21) = 0.579731E+01
+ PKER_SWETH( 4, 22) = 0.588672E+01
+ PKER_SWETH( 4, 23) = 0.596630E+01
+ PKER_SWETH( 4, 24) = 0.603698E+01
+ PKER_SWETH( 4, 25) = 0.609976E+01
+ PKER_SWETH( 4, 26) = 0.615566E+01
+ PKER_SWETH( 4, 27) = 0.620557E+01
+ PKER_SWETH( 4, 28) = 0.625032E+01
+ PKER_SWETH( 4, 29) = 0.629062E+01
+ PKER_SWETH( 4, 30) = 0.632707E+01
+ PKER_SWETH( 4, 31) = 0.636018E+01
+ PKER_SWETH( 4, 32) = 0.639038E+01
+ PKER_SWETH( 4, 33) = 0.641803E+01
+ PKER_SWETH( 4, 34) = 0.644343E+01
+ PKER_SWETH( 4, 35) = 0.646684E+01
+ PKER_SWETH( 4, 36) = 0.648846E+01
+ PKER_SWETH( 4, 37) = 0.650849E+01
+ PKER_SWETH( 4, 38) = 0.652707E+01
+ PKER_SWETH( 4, 39) = 0.654435E+01
+ PKER_SWETH( 4, 40) = 0.656044E+01
+ PKER_SWETH( 4, 41) = 0.657544E+01
+ PKER_SWETH( 4, 42) = 0.658943E+01
+ PKER_SWETH( 4, 43) = 0.660251E+01
+ PKER_SWETH( 4, 44) = 0.661473E+01
+ PKER_SWETH( 4, 45) = 0.662617E+01
+ PKER_SWETH( 4, 46) = 0.663687E+01
+ PKER_SWETH( 4, 47) = 0.664690E+01
+ PKER_SWETH( 4, 48) = 0.665629E+01
+ PKER_SWETH( 4, 49) = 0.666510E+01
+ PKER_SWETH( 4, 50) = 0.667335E+01
+ PKER_SWETH( 4, 51) = 0.668109E+01
+ PKER_SWETH( 4, 52) = 0.668835E+01
+ PKER_SWETH( 4, 53) = 0.669516E+01
+ PKER_SWETH( 4, 54) = 0.670155E+01
+ PKER_SWETH( 4, 55) = 0.670755E+01
+ PKER_SWETH( 4, 56) = 0.671318E+01
+ PKER_SWETH( 4, 57) = 0.671846E+01
+ PKER_SWETH( 4, 58) = 0.672342E+01
+ PKER_SWETH( 4, 59) = 0.672807E+01
+ PKER_SWETH( 4, 60) = 0.673244E+01
+ PKER_SWETH( 4, 61) = 0.673654E+01
+ PKER_SWETH( 4, 62) = 0.674039E+01
+ PKER_SWETH( 4, 63) = 0.674400E+01
+ PKER_SWETH( 4, 64) = 0.674739E+01
+ PKER_SWETH( 4, 65) = 0.675058E+01
+ PKER_SWETH( 4, 66) = 0.675357E+01
+ PKER_SWETH( 4, 67) = 0.675638E+01
+ PKER_SWETH( 4, 68) = 0.675902E+01
+ PKER_SWETH( 4, 69) = 0.676149E+01
+ PKER_SWETH( 4, 70) = 0.676382E+01
+ PKER_SWETH( 4, 71) = 0.676600E+01
+ PKER_SWETH( 4, 72) = 0.676805E+01
+ PKER_SWETH( 4, 73) = 0.676997E+01
+ PKER_SWETH( 4, 74) = 0.677178E+01
+ PKER_SWETH( 4, 75) = 0.677348E+01
+ PKER_SWETH( 4, 76) = 0.677507E+01
+ PKER_SWETH( 4, 77) = 0.677656E+01
+ PKER_SWETH( 4, 78) = 0.677797E+01
+ PKER_SWETH( 4, 79) = 0.677929E+01
+ PKER_SWETH( 4, 80) = 0.678053E+01
+ PKER_SWETH( 5, 1) = 0.191873E+01
+ PKER_SWETH( 5, 2) = 0.210156E+01
+ PKER_SWETH( 5, 3) = 0.228144E+01
+ PKER_SWETH( 5, 4) = 0.245647E+01
+ PKER_SWETH( 5, 5) = 0.262578E+01
+ PKER_SWETH( 5, 6) = 0.278922E+01
+ PKER_SWETH( 5, 7) = 0.294715E+01
+ PKER_SWETH( 5, 8) = 0.310025E+01
+ PKER_SWETH( 5, 9) = 0.324939E+01
+ PKER_SWETH( 5, 10) = 0.339551E+01
+ PKER_SWETH( 5, 11) = 0.353950E+01
+ PKER_SWETH( 5, 12) = 0.368211E+01
+ PKER_SWETH( 5, 13) = 0.382377E+01
+ PKER_SWETH( 5, 14) = 0.396446E+01
+ PKER_SWETH( 5, 15) = 0.410364E+01
+ PKER_SWETH( 5, 16) = 0.424020E+01
+ PKER_SWETH( 5, 17) = 0.437258E+01
+ PKER_SWETH( 5, 18) = 0.449905E+01
+ PKER_SWETH( 5, 19) = 0.461795E+01
+ PKER_SWETH( 5, 20) = 0.472801E+01
+ PKER_SWETH( 5, 21) = 0.482849E+01
+ PKER_SWETH( 5, 22) = 0.491922E+01
+ PKER_SWETH( 5, 23) = 0.500049E+01
+ PKER_SWETH( 5, 24) = 0.507296E+01
+ PKER_SWETH( 5, 25) = 0.513746E+01
+ PKER_SWETH( 5, 26) = 0.519489E+01
+ PKER_SWETH( 5, 27) = 0.524613E+01
+ PKER_SWETH( 5, 28) = 0.529199E+01
+ PKER_SWETH( 5, 29) = 0.533320E+01
+ PKER_SWETH( 5, 30) = 0.537039E+01
+ PKER_SWETH( 5, 31) = 0.540410E+01
+ PKER_SWETH( 5, 32) = 0.543477E+01
+ PKER_SWETH( 5, 33) = 0.546280E+01
+ PKER_SWETH( 5, 34) = 0.548850E+01
+ PKER_SWETH( 5, 35) = 0.551214E+01
+ PKER_SWETH( 5, 36) = 0.553395E+01
+ PKER_SWETH( 5, 37) = 0.555413E+01
+ PKER_SWETH( 5, 38) = 0.557283E+01
+ PKER_SWETH( 5, 39) = 0.559020E+01
+ PKER_SWETH( 5, 40) = 0.560636E+01
+ PKER_SWETH( 5, 41) = 0.562141E+01
+ PKER_SWETH( 5, 42) = 0.563545E+01
+ PKER_SWETH( 5, 43) = 0.564856E+01
+ PKER_SWETH( 5, 44) = 0.566081E+01
+ PKER_SWETH( 5, 45) = 0.567227E+01
+ PKER_SWETH( 5, 46) = 0.568299E+01
+ PKER_SWETH( 5, 47) = 0.569303E+01
+ PKER_SWETH( 5, 48) = 0.570244E+01
+ PKER_SWETH( 5, 49) = 0.571125E+01
+ PKER_SWETH( 5, 50) = 0.571951E+01
+ PKER_SWETH( 5, 51) = 0.572725E+01
+ PKER_SWETH( 5, 52) = 0.573452E+01
+ PKER_SWETH( 5, 53) = 0.574133E+01
+ PKER_SWETH( 5, 54) = 0.574773E+01
+ PKER_SWETH( 5, 55) = 0.575372E+01
+ PKER_SWETH( 5, 56) = 0.575935E+01
+ PKER_SWETH( 5, 57) = 0.576463E+01
+ PKER_SWETH( 5, 58) = 0.576959E+01
+ PKER_SWETH( 5, 59) = 0.577425E+01
+ PKER_SWETH( 5, 60) = 0.577862E+01
+ PKER_SWETH( 5, 61) = 0.578272E+01
+ PKER_SWETH( 5, 62) = 0.578657E+01
+ PKER_SWETH( 5, 63) = 0.579018E+01
+ PKER_SWETH( 5, 64) = 0.579357E+01
+ PKER_SWETH( 5, 65) = 0.579676E+01
+ PKER_SWETH( 5, 66) = 0.579975E+01
+ PKER_SWETH( 5, 67) = 0.580256E+01
+ PKER_SWETH( 5, 68) = 0.580520E+01
+ PKER_SWETH( 5, 69) = 0.580767E+01
+ PKER_SWETH( 5, 70) = 0.581000E+01
+ PKER_SWETH( 5, 71) = 0.581218E+01
+ PKER_SWETH( 5, 72) = 0.581423E+01
+ PKER_SWETH( 5, 73) = 0.581615E+01
+ PKER_SWETH( 5, 74) = 0.581796E+01
+ PKER_SWETH( 5, 75) = 0.581966E+01
+ PKER_SWETH( 5, 76) = 0.582125E+01
+ PKER_SWETH( 5, 77) = 0.582275E+01
+ PKER_SWETH( 5, 78) = 0.582415E+01
+ PKER_SWETH( 5, 79) = 0.582547E+01
+ PKER_SWETH( 5, 80) = 0.582671E+01
+ PKER_SWETH( 6, 1) = 0.128538E+01
+ PKER_SWETH( 6, 2) = 0.143580E+01
+ PKER_SWETH( 6, 3) = 0.159310E+01
+ PKER_SWETH( 6, 4) = 0.175236E+01
+ PKER_SWETH( 6, 5) = 0.191039E+01
+ PKER_SWETH( 6, 6) = 0.206519E+01
+ PKER_SWETH( 6, 7) = 0.221578E+01
+ PKER_SWETH( 6, 8) = 0.236189E+01
+ PKER_SWETH( 6, 9) = 0.250376E+01
+ PKER_SWETH( 6, 10) = 0.264193E+01
+ PKER_SWETH( 6, 11) = 0.277711E+01
+ PKER_SWETH( 6, 12) = 0.291003E+01
+ PKER_SWETH( 6, 13) = 0.304132E+01
+ PKER_SWETH( 6, 14) = 0.317134E+01
+ PKER_SWETH( 6, 15) = 0.330011E+01
+ PKER_SWETH( 6, 16) = 0.342714E+01
+ PKER_SWETH( 6, 17) = 0.355150E+01
+ PKER_SWETH( 6, 18) = 0.367186E+01
+ PKER_SWETH( 6, 19) = 0.378671E+01
+ PKER_SWETH( 6, 20) = 0.389463E+01
+ PKER_SWETH( 6, 21) = 0.399453E+01
+ PKER_SWETH( 6, 22) = 0.408580E+01
+ PKER_SWETH( 6, 23) = 0.416829E+01
+ PKER_SWETH( 6, 24) = 0.424230E+01
+ PKER_SWETH( 6, 25) = 0.430841E+01
+ PKER_SWETH( 6, 26) = 0.436736E+01
+ PKER_SWETH( 6, 27) = 0.441996E+01
+ PKER_SWETH( 6, 28) = 0.446700E+01
+ PKER_SWETH( 6, 29) = 0.450920E+01
+ PKER_SWETH( 6, 30) = 0.454719E+01
+ PKER_SWETH( 6, 31) = 0.458156E+01
+ PKER_SWETH( 6, 32) = 0.461276E+01
+ PKER_SWETH( 6, 33) = 0.464121E+01
+ PKER_SWETH( 6, 34) = 0.466724E+01
+ PKER_SWETH( 6, 35) = 0.469115E+01
+ PKER_SWETH( 6, 36) = 0.471317E+01
+ PKER_SWETH( 6, 37) = 0.473351E+01
+ PKER_SWETH( 6, 38) = 0.475234E+01
+ PKER_SWETH( 6, 39) = 0.476981E+01
+ PKER_SWETH( 6, 40) = 0.478604E+01
+ PKER_SWETH( 6, 41) = 0.480116E+01
+ PKER_SWETH( 6, 42) = 0.481525E+01
+ PKER_SWETH( 6, 43) = 0.482840E+01
+ PKER_SWETH( 6, 44) = 0.484068E+01
+ PKER_SWETH( 6, 45) = 0.485216E+01
+ PKER_SWETH( 6, 46) = 0.486290E+01
+ PKER_SWETH( 6, 47) = 0.487296E+01
+ PKER_SWETH( 6, 48) = 0.488237E+01
+ PKER_SWETH( 6, 49) = 0.489119E+01
+ PKER_SWETH( 6, 50) = 0.489946E+01
+ PKER_SWETH( 6, 51) = 0.490721E+01
+ PKER_SWETH( 6, 52) = 0.491448E+01
+ PKER_SWETH( 6, 53) = 0.492130E+01
+ PKER_SWETH( 6, 54) = 0.492769E+01
+ PKER_SWETH( 6, 55) = 0.493369E+01
+ PKER_SWETH( 6, 56) = 0.493932E+01
+ PKER_SWETH( 6, 57) = 0.494461E+01
+ PKER_SWETH( 6, 58) = 0.494957E+01
+ PKER_SWETH( 6, 59) = 0.495422E+01
+ PKER_SWETH( 6, 60) = 0.495859E+01
+ PKER_SWETH( 6, 61) = 0.496269E+01
+ PKER_SWETH( 6, 62) = 0.496654E+01
+ PKER_SWETH( 6, 63) = 0.497016E+01
+ PKER_SWETH( 6, 64) = 0.497355E+01
+ PKER_SWETH( 6, 65) = 0.497674E+01
+ PKER_SWETH( 6, 66) = 0.497973E+01
+ PKER_SWETH( 6, 67) = 0.498254E+01
+ PKER_SWETH( 6, 68) = 0.498518E+01
+ PKER_SWETH( 6, 69) = 0.498765E+01
+ PKER_SWETH( 6, 70) = 0.498998E+01
+ PKER_SWETH( 6, 71) = 0.499216E+01
+ PKER_SWETH( 6, 72) = 0.499421E+01
+ PKER_SWETH( 6, 73) = 0.499613E+01
+ PKER_SWETH( 6, 74) = 0.499794E+01
+ PKER_SWETH( 6, 75) = 0.499964E+01
+ PKER_SWETH( 6, 76) = 0.500123E+01
+ PKER_SWETH( 6, 77) = 0.500272E+01
+ PKER_SWETH( 6, 78) = 0.500413E+01
+ PKER_SWETH( 6, 79) = 0.500545E+01
+ PKER_SWETH( 6, 80) = 0.500669E+01
+ PKER_SWETH( 7, 1) = 0.856768E+00
+ PKER_SWETH( 7, 2) = 0.947769E+00
+ PKER_SWETH( 7, 3) = 0.106025E+01
+ PKER_SWETH( 7, 4) = 0.118718E+01
+ PKER_SWETH( 7, 5) = 0.132214E+01
+ PKER_SWETH( 7, 6) = 0.146072E+01
+ PKER_SWETH( 7, 7) = 0.159954E+01
+ PKER_SWETH( 7, 8) = 0.173657E+01
+ PKER_SWETH( 7, 9) = 0.187073E+01
+ PKER_SWETH( 7, 10) = 0.200163E+01
+ PKER_SWETH( 7, 11) = 0.212938E+01
+ PKER_SWETH( 7, 12) = 0.225437E+01
+ PKER_SWETH( 7, 13) = 0.237711E+01
+ PKER_SWETH( 7, 14) = 0.249807E+01
+ PKER_SWETH( 7, 15) = 0.261757E+01
+ PKER_SWETH( 7, 16) = 0.273559E+01
+ PKER_SWETH( 7, 17) = 0.285173E+01
+ PKER_SWETH( 7, 18) = 0.296518E+01
+ PKER_SWETH( 7, 19) = 0.307480E+01
+ PKER_SWETH( 7, 20) = 0.317928E+01
+ PKER_SWETH( 7, 21) = 0.327741E+01
+ PKER_SWETH( 7, 22) = 0.336826E+01
+ PKER_SWETH( 7, 23) = 0.345129E+01
+ PKER_SWETH( 7, 24) = 0.352643E+01
+ PKER_SWETH( 7, 25) = 0.359394E+01
+ PKER_SWETH( 7, 26) = 0.365434E+01
+ PKER_SWETH( 7, 27) = 0.370832E+01
+ PKER_SWETH( 7, 28) = 0.375657E+01
+ PKER_SWETH( 7, 29) = 0.379981E+01
+ PKER_SWETH( 7, 30) = 0.383869E+01
+ PKER_SWETH( 7, 31) = 0.387377E+01
+ PKER_SWETH( 7, 32) = 0.390555E+01
+ PKER_SWETH( 7, 33) = 0.393446E+01
+ PKER_SWETH( 7, 34) = 0.396087E+01
+ PKER_SWETH( 7, 35) = 0.398507E+01
+ PKER_SWETH( 7, 36) = 0.400732E+01
+ PKER_SWETH( 7, 37) = 0.402784E+01
+ PKER_SWETH( 7, 38) = 0.404682E+01
+ PKER_SWETH( 7, 39) = 0.406440E+01
+ PKER_SWETH( 7, 40) = 0.408073E+01
+ PKER_SWETH( 7, 41) = 0.409591E+01
+ PKER_SWETH( 7, 42) = 0.411006E+01
+ PKER_SWETH( 7, 43) = 0.412325E+01
+ PKER_SWETH( 7, 44) = 0.413556E+01
+ PKER_SWETH( 7, 45) = 0.414707E+01
+ PKER_SWETH( 7, 46) = 0.415783E+01
+ PKER_SWETH( 7, 47) = 0.416790E+01
+ PKER_SWETH( 7, 48) = 0.417733E+01
+ PKER_SWETH( 7, 49) = 0.418616E+01
+ PKER_SWETH( 7, 50) = 0.419444E+01
+ PKER_SWETH( 7, 51) = 0.420220E+01
+ PKER_SWETH( 7, 52) = 0.420947E+01
+ PKER_SWETH( 7, 53) = 0.421629E+01
+ PKER_SWETH( 7, 54) = 0.422269E+01
+ PKER_SWETH( 7, 55) = 0.422869E+01
+ PKER_SWETH( 7, 56) = 0.423433E+01
+ PKER_SWETH( 7, 57) = 0.423961E+01
+ PKER_SWETH( 7, 58) = 0.424457E+01
+ PKER_SWETH( 7, 59) = 0.424923E+01
+ PKER_SWETH( 7, 60) = 0.425360E+01
+ PKER_SWETH( 7, 61) = 0.425770E+01
+ PKER_SWETH( 7, 62) = 0.426155E+01
+ PKER_SWETH( 7, 63) = 0.426517E+01
+ PKER_SWETH( 7, 64) = 0.426856E+01
+ PKER_SWETH( 7, 65) = 0.427175E+01
+ PKER_SWETH( 7, 66) = 0.427474E+01
+ PKER_SWETH( 7, 67) = 0.427755E+01
+ PKER_SWETH( 7, 68) = 0.428018E+01
+ PKER_SWETH( 7, 69) = 0.428266E+01
+ PKER_SWETH( 7, 70) = 0.428498E+01
+ PKER_SWETH( 7, 71) = 0.428717E+01
+ PKER_SWETH( 7, 72) = 0.428922E+01
+ PKER_SWETH( 7, 73) = 0.429114E+01
+ PKER_SWETH( 7, 74) = 0.429295E+01
+ PKER_SWETH( 7, 75) = 0.429464E+01
+ PKER_SWETH( 7, 76) = 0.429624E+01
+ PKER_SWETH( 7, 77) = 0.429773E+01
+ PKER_SWETH( 7, 78) = 0.429914E+01
+ PKER_SWETH( 7, 79) = 0.430046E+01
+ PKER_SWETH( 7, 80) = 0.430169E+01
+ PKER_SWETH( 8, 1) = 0.666288E+00
+ PKER_SWETH( 8, 2) = 0.672636E+00
+ PKER_SWETH( 8, 3) = 0.713972E+00
+ PKER_SWETH( 8, 4) = 0.783974E+00
+ PKER_SWETH( 8, 5) = 0.875298E+00
+ PKER_SWETH( 8, 6) = 0.981698E+00
+ PKER_SWETH( 8, 7) = 0.109726E+01
+ PKER_SWETH( 8, 8) = 0.121759E+01
+ PKER_SWETH( 8, 9) = 0.133955E+01
+ PKER_SWETH( 8, 10) = 0.146099E+01
+ PKER_SWETH( 8, 11) = 0.158073E+01
+ PKER_SWETH( 8, 12) = 0.169826E+01
+ PKER_SWETH( 8, 13) = 0.181355E+01
+ PKER_SWETH( 8, 14) = 0.192680E+01
+ PKER_SWETH( 8, 15) = 0.203828E+01
+ PKER_SWETH( 8, 16) = 0.214820E+01
+ PKER_SWETH( 8, 17) = 0.225651E+01
+ PKER_SWETH( 8, 18) = 0.236285E+01
+ PKER_SWETH( 8, 19) = 0.246652E+01
+ PKER_SWETH( 8, 20) = 0.256652E+01
+ PKER_SWETH( 8, 21) = 0.266174E+01
+ PKER_SWETH( 8, 22) = 0.275113E+01
+ PKER_SWETH( 8, 23) = 0.283388E+01
+ PKER_SWETH( 8, 24) = 0.290956E+01
+ PKER_SWETH( 8, 25) = 0.297812E+01
+ PKER_SWETH( 8, 26) = 0.303979E+01
+ PKER_SWETH( 8, 27) = 0.309508E+01
+ PKER_SWETH( 8, 28) = 0.314456E+01
+ PKER_SWETH( 8, 29) = 0.318889E+01
+ PKER_SWETH( 8, 30) = 0.322870E+01
+ PKER_SWETH( 8, 31) = 0.326456E+01
+ PKER_SWETH( 8, 32) = 0.329698E+01
+ PKER_SWETH( 8, 33) = 0.332641E+01
+ PKER_SWETH( 8, 34) = 0.335322E+01
+ PKER_SWETH( 8, 35) = 0.337775E+01
+ PKER_SWETH( 8, 36) = 0.340027E+01
+ PKER_SWETH( 8, 37) = 0.342099E+01
+ PKER_SWETH( 8, 38) = 0.344013E+01
+ PKER_SWETH( 8, 39) = 0.345784E+01
+ PKER_SWETH( 8, 40) = 0.347427E+01
+ PKER_SWETH( 8, 41) = 0.348953E+01
+ PKER_SWETH( 8, 42) = 0.350374E+01
+ PKER_SWETH( 8, 43) = 0.351697E+01
+ PKER_SWETH( 8, 44) = 0.352933E+01
+ PKER_SWETH( 8, 45) = 0.354087E+01
+ PKER_SWETH( 8, 46) = 0.355165E+01
+ PKER_SWETH( 8, 47) = 0.356174E+01
+ PKER_SWETH( 8, 48) = 0.357118E+01
+ PKER_SWETH( 8, 49) = 0.358003E+01
+ PKER_SWETH( 8, 50) = 0.358831E+01
+ PKER_SWETH( 8, 51) = 0.359607E+01
+ PKER_SWETH( 8, 52) = 0.360335E+01
+ PKER_SWETH( 8, 53) = 0.361018E+01
+ PKER_SWETH( 8, 54) = 0.361658E+01
+ PKER_SWETH( 8, 55) = 0.362259E+01
+ PKER_SWETH( 8, 56) = 0.362822E+01
+ PKER_SWETH( 8, 57) = 0.363351E+01
+ PKER_SWETH( 8, 58) = 0.363847E+01
+ PKER_SWETH( 8, 59) = 0.364313E+01
+ PKER_SWETH( 8, 60) = 0.364750E+01
+ PKER_SWETH( 8, 61) = 0.365160E+01
+ PKER_SWETH( 8, 62) = 0.365545E+01
+ PKER_SWETH( 8, 63) = 0.365907E+01
+ PKER_SWETH( 8, 64) = 0.366246E+01
+ PKER_SWETH( 8, 65) = 0.366565E+01
+ PKER_SWETH( 8, 66) = 0.366864E+01
+ PKER_SWETH( 8, 67) = 0.367145E+01
+ PKER_SWETH( 8, 68) = 0.367408E+01
+ PKER_SWETH( 8, 69) = 0.367656E+01
+ PKER_SWETH( 8, 70) = 0.367889E+01
+ PKER_SWETH( 8, 71) = 0.368107E+01
+ PKER_SWETH( 8, 72) = 0.368312E+01
+ PKER_SWETH( 8, 73) = 0.368504E+01
+ PKER_SWETH( 8, 74) = 0.368685E+01
+ PKER_SWETH( 8, 75) = 0.368855E+01
+ PKER_SWETH( 8, 76) = 0.369014E+01
+ PKER_SWETH( 8, 77) = 0.369163E+01
+ PKER_SWETH( 8, 78) = 0.369304E+01
+ PKER_SWETH( 8, 79) = 0.369436E+01
+ PKER_SWETH( 8, 80) = 0.369560E+01
+ PKER_SWETH( 9, 1) = 0.707414E+00
+ PKER_SWETH( 9, 2) = 0.624644E+00
+ PKER_SWETH( 9, 3) = 0.580795E+00
+ PKER_SWETH( 9, 4) = 0.573199E+00
+ PKER_SWETH( 9, 5) = 0.598399E+00
+ PKER_SWETH( 9, 6) = 0.650444E+00
+ PKER_SWETH( 9, 7) = 0.723705E+00
+ PKER_SWETH( 9, 8) = 0.812303E+00
+ PKER_SWETH( 9, 9) = 0.910888E+00
+ PKER_SWETH( 9, 10) = 0.101536E+01
+ PKER_SWETH( 9, 11) = 0.112252E+01
+ PKER_SWETH( 9, 12) = 0.123028E+01
+ PKER_SWETH( 9, 13) = 0.133733E+01
+ PKER_SWETH( 9, 14) = 0.144307E+01
+ PKER_SWETH( 9, 15) = 0.154726E+01
+ PKER_SWETH( 9, 16) = 0.164991E+01
+ PKER_SWETH( 9, 17) = 0.175103E+01
+ PKER_SWETH( 9, 18) = 0.185052E+01
+ PKER_SWETH( 9, 19) = 0.194801E+01
+ PKER_SWETH( 9, 20) = 0.204288E+01
+ PKER_SWETH( 9, 21) = 0.213426E+01
+ PKER_SWETH( 9, 22) = 0.222119E+01
+ PKER_SWETH( 9, 23) = 0.230275E+01
+ PKER_SWETH( 9, 24) = 0.237826E+01
+ PKER_SWETH( 9, 25) = 0.244736E+01
+ PKER_SWETH( 9, 26) = 0.251001E+01
+ PKER_SWETH( 9, 27) = 0.256645E+01
+ PKER_SWETH( 9, 28) = 0.261712E+01
+ PKER_SWETH( 9, 29) = 0.266256E+01
+ PKER_SWETH( 9, 30) = 0.270334E+01
+ PKER_SWETH( 9, 31) = 0.274003E+01
+ PKER_SWETH( 9, 32) = 0.277315E+01
+ PKER_SWETH( 9, 33) = 0.280314E+01
+ PKER_SWETH( 9, 34) = 0.283042E+01
+ PKER_SWETH( 9, 35) = 0.285531E+01
+ PKER_SWETH( 9, 36) = 0.287812E+01
+ PKER_SWETH( 9, 37) = 0.289907E+01
+ PKER_SWETH( 9, 38) = 0.291839E+01
+ PKER_SWETH( 9, 39) = 0.293624E+01
+ PKER_SWETH( 9, 40) = 0.295278E+01
+ PKER_SWETH( 9, 41) = 0.296813E+01
+ PKER_SWETH( 9, 42) = 0.298241E+01
+ PKER_SWETH( 9, 43) = 0.299570E+01
+ PKER_SWETH( 9, 44) = 0.300810E+01
+ PKER_SWETH( 9, 45) = 0.301967E+01
+ PKER_SWETH( 9, 46) = 0.303048E+01
+ PKER_SWETH( 9, 47) = 0.304059E+01
+ PKER_SWETH( 9, 48) = 0.305005E+01
+ PKER_SWETH( 9, 49) = 0.305890E+01
+ PKER_SWETH( 9, 50) = 0.306720E+01
+ PKER_SWETH( 9, 51) = 0.307497E+01
+ PKER_SWETH( 9, 52) = 0.308225E+01
+ PKER_SWETH( 9, 53) = 0.308908E+01
+ PKER_SWETH( 9, 54) = 0.309549E+01
+ PKER_SWETH( 9, 55) = 0.310150E+01
+ PKER_SWETH( 9, 56) = 0.310713E+01
+ PKER_SWETH( 9, 57) = 0.311242E+01
+ PKER_SWETH( 9, 58) = 0.311739E+01
+ PKER_SWETH( 9, 59) = 0.312204E+01
+ PKER_SWETH( 9, 60) = 0.312642E+01
+ PKER_SWETH( 9, 61) = 0.313052E+01
+ PKER_SWETH( 9, 62) = 0.313437E+01
+ PKER_SWETH( 9, 63) = 0.313799E+01
+ PKER_SWETH( 9, 64) = 0.314138E+01
+ PKER_SWETH( 9, 65) = 0.314457E+01
+ PKER_SWETH( 9, 66) = 0.314756E+01
+ PKER_SWETH( 9, 67) = 0.315037E+01
+ PKER_SWETH( 9, 68) = 0.315301E+01
+ PKER_SWETH( 9, 69) = 0.315548E+01
+ PKER_SWETH( 9, 70) = 0.315781E+01
+ PKER_SWETH( 9, 71) = 0.315999E+01
+ PKER_SWETH( 9, 72) = 0.316204E+01
+ PKER_SWETH( 9, 73) = 0.316396E+01
+ PKER_SWETH( 9, 74) = 0.316577E+01
+ PKER_SWETH( 9, 75) = 0.316747E+01
+ PKER_SWETH( 9, 76) = 0.316906E+01
+ PKER_SWETH( 9, 77) = 0.317056E+01
+ PKER_SWETH( 9, 78) = 0.317196E+01
+ PKER_SWETH( 9, 79) = 0.317328E+01
+ PKER_SWETH( 9, 80) = 0.317452E+01
+ PKER_SWETH( 10, 1) = 0.911913E+00
+ PKER_SWETH( 10, 2) = 0.763036E+00
+ PKER_SWETH( 10, 3) = 0.645536E+00
+ PKER_SWETH( 10, 4) = 0.561056E+00
+ PKER_SWETH( 10, 5) = 0.510613E+00
+ PKER_SWETH( 10, 6) = 0.492913E+00
+ PKER_SWETH( 10, 7) = 0.504602E+00
+ PKER_SWETH( 10, 8) = 0.541947E+00
+ PKER_SWETH( 10, 9) = 0.599761E+00
+ PKER_SWETH( 10, 10) = 0.673026E+00
+ PKER_SWETH( 10, 11) = 0.756871E+00
+ PKER_SWETH( 10, 12) = 0.847450E+00
+ PKER_SWETH( 10, 13) = 0.941685E+00
+ PKER_SWETH( 10, 14) = 0.103741E+01
+ PKER_SWETH( 10, 15) = 0.113330E+01
+ PKER_SWETH( 10, 16) = 0.122855E+01
+ PKER_SWETH( 10, 17) = 0.132276E+01
+ PKER_SWETH( 10, 18) = 0.141568E+01
+ PKER_SWETH( 10, 19) = 0.150707E+01
+ PKER_SWETH( 10, 20) = 0.159652E+01
+ PKER_SWETH( 10, 21) = 0.168345E+01
+ PKER_SWETH( 10, 22) = 0.176708E+01
+ PKER_SWETH( 10, 23) = 0.184656E+01
+ PKER_SWETH( 10, 24) = 0.192110E+01
+ PKER_SWETH( 10, 25) = 0.199011E+01
+ PKER_SWETH( 10, 26) = 0.205330E+01
+ PKER_SWETH( 10, 27) = 0.211065E+01
+ PKER_SWETH( 10, 28) = 0.216238E+01
+ PKER_SWETH( 10, 29) = 0.220889E+01
+ PKER_SWETH( 10, 30) = 0.225067E+01
+ PKER_SWETH( 10, 31) = 0.228824E+01
+ PKER_SWETH( 10, 32) = 0.232210E+01
+ PKER_SWETH( 10, 33) = 0.235272E+01
+ PKER_SWETH( 10, 34) = 0.238050E+01
+ PKER_SWETH( 10, 35) = 0.240580E+01
+ PKER_SWETH( 10, 36) = 0.242893E+01
+ PKER_SWETH( 10, 37) = 0.245014E+01
+ PKER_SWETH( 10, 38) = 0.246966E+01
+ PKER_SWETH( 10, 39) = 0.248768E+01
+ PKER_SWETH( 10, 40) = 0.250434E+01
+ PKER_SWETH( 10, 41) = 0.251979E+01
+ PKER_SWETH( 10, 42) = 0.253415E+01
+ PKER_SWETH( 10, 43) = 0.254750E+01
+ PKER_SWETH( 10, 44) = 0.255994E+01
+ PKER_SWETH( 10, 45) = 0.257155E+01
+ PKER_SWETH( 10, 46) = 0.258239E+01
+ PKER_SWETH( 10, 47) = 0.259252E+01
+ PKER_SWETH( 10, 48) = 0.260200E+01
+ PKER_SWETH( 10, 49) = 0.261087E+01
+ PKER_SWETH( 10, 50) = 0.261917E+01
+ PKER_SWETH( 10, 51) = 0.262696E+01
+ PKER_SWETH( 10, 52) = 0.263425E+01
+ PKER_SWETH( 10, 53) = 0.264108E+01
+ PKER_SWETH( 10, 54) = 0.264749E+01
+ PKER_SWETH( 10, 55) = 0.265350E+01
+ PKER_SWETH( 10, 56) = 0.265914E+01
+ PKER_SWETH( 10, 57) = 0.266443E+01
+ PKER_SWETH( 10, 58) = 0.266940E+01
+ PKER_SWETH( 10, 59) = 0.267406E+01
+ PKER_SWETH( 10, 60) = 0.267843E+01
+ PKER_SWETH( 10, 61) = 0.268253E+01
+ PKER_SWETH( 10, 62) = 0.268639E+01
+ PKER_SWETH( 10, 63) = 0.269000E+01
+ PKER_SWETH( 10, 64) = 0.269340E+01
+ PKER_SWETH( 10, 65) = 0.269659E+01
+ PKER_SWETH( 10, 66) = 0.269958E+01
+ PKER_SWETH( 10, 67) = 0.270239E+01
+ PKER_SWETH( 10, 68) = 0.270502E+01
+ PKER_SWETH( 10, 69) = 0.270750E+01
+ PKER_SWETH( 10, 70) = 0.270983E+01
+ PKER_SWETH( 10, 71) = 0.271201E+01
+ PKER_SWETH( 10, 72) = 0.271406E+01
+ PKER_SWETH( 10, 73) = 0.271598E+01
+ PKER_SWETH( 10, 74) = 0.271779E+01
+ PKER_SWETH( 10, 75) = 0.271949E+01
+ PKER_SWETH( 10, 76) = 0.272108E+01
+ PKER_SWETH( 10, 77) = 0.272257E+01
+ PKER_SWETH( 10, 78) = 0.272398E+01
+ PKER_SWETH( 10, 79) = 0.272530E+01
+ PKER_SWETH( 10, 80) = 0.272654E+01
+ PKER_SWETH( 11, 1) = 0.118545E+01
+ PKER_SWETH( 11, 2) = 0.100295E+01
+ PKER_SWETH( 11, 3) = 0.841340E+00
+ PKER_SWETH( 11, 4) = 0.703241E+00
+ PKER_SWETH( 11, 5) = 0.591315E+00
+ PKER_SWETH( 11, 6) = 0.507481E+00
+ PKER_SWETH( 11, 7) = 0.452983E+00
+ PKER_SWETH( 11, 8) = 0.427344E+00
+ PKER_SWETH( 11, 9) = 0.428797E+00
+ PKER_SWETH( 11, 10) = 0.453908E+00
+ PKER_SWETH( 11, 11) = 0.498674E+00
+ PKER_SWETH( 11, 12) = 0.558774E+00
+ PKER_SWETH( 11, 13) = 0.629851E+00
+ PKER_SWETH( 11, 14) = 0.708336E+00
+ PKER_SWETH( 11, 15) = 0.791265E+00
+ PKER_SWETH( 11, 16) = 0.876433E+00
+ PKER_SWETH( 11, 17) = 0.962409E+00
+ PKER_SWETH( 11, 18) = 0.104825E+01
+ PKER_SWETH( 11, 19) = 0.113333E+01
+ PKER_SWETH( 11, 20) = 0.121716E+01
+ PKER_SWETH( 11, 21) = 0.129924E+01
+ PKER_SWETH( 11, 22) = 0.137896E+01
+ PKER_SWETH( 11, 23) = 0.145558E+01
+ PKER_SWETH( 11, 24) = 0.152835E+01
+ PKER_SWETH( 11, 25) = 0.159658E+01
+ PKER_SWETH( 11, 26) = 0.165976E+01
+ PKER_SWETH( 11, 27) = 0.171764E+01
+ PKER_SWETH( 11, 28) = 0.177021E+01
+ PKER_SWETH( 11, 29) = 0.181769E+01
+ PKER_SWETH( 11, 30) = 0.186044E+01
+ PKER_SWETH( 11, 31) = 0.189891E+01
+ PKER_SWETH( 11, 32) = 0.193356E+01
+ PKER_SWETH( 11, 33) = 0.196485E+01
+ PKER_SWETH( 11, 34) = 0.199318E+01
+ PKER_SWETH( 11, 35) = 0.201894E+01
+ PKER_SWETH( 11, 36) = 0.204243E+01
+ PKER_SWETH( 11, 37) = 0.206393E+01
+ PKER_SWETH( 11, 38) = 0.208369E+01
+ PKER_SWETH( 11, 39) = 0.210188E+01
+ PKER_SWETH( 11, 40) = 0.211869E+01
+ PKER_SWETH( 11, 41) = 0.213425E+01
+ PKER_SWETH( 11, 42) = 0.214869E+01
+ PKER_SWETH( 11, 43) = 0.216211E+01
+ PKER_SWETH( 11, 44) = 0.217461E+01
+ PKER_SWETH( 11, 45) = 0.218626E+01
+ PKER_SWETH( 11, 46) = 0.219713E+01
+ PKER_SWETH( 11, 47) = 0.220729E+01
+ PKER_SWETH( 11, 48) = 0.221679E+01
+ PKER_SWETH( 11, 49) = 0.222567E+01
+ PKER_SWETH( 11, 50) = 0.223399E+01
+ PKER_SWETH( 11, 51) = 0.224178E+01
+ PKER_SWETH( 11, 52) = 0.224908E+01
+ PKER_SWETH( 11, 53) = 0.225592E+01
+ PKER_SWETH( 11, 54) = 0.226233E+01
+ PKER_SWETH( 11, 55) = 0.226835E+01
+ PKER_SWETH( 11, 56) = 0.227399E+01
+ PKER_SWETH( 11, 57) = 0.227928E+01
+ PKER_SWETH( 11, 58) = 0.228425E+01
+ PKER_SWETH( 11, 59) = 0.228891E+01
+ PKER_SWETH( 11, 60) = 0.229329E+01
+ PKER_SWETH( 11, 61) = 0.229739E+01
+ PKER_SWETH( 11, 62) = 0.230124E+01
+ PKER_SWETH( 11, 63) = 0.230486E+01
+ PKER_SWETH( 11, 64) = 0.230826E+01
+ PKER_SWETH( 11, 65) = 0.231144E+01
+ PKER_SWETH( 11, 66) = 0.231444E+01
+ PKER_SWETH( 11, 67) = 0.231724E+01
+ PKER_SWETH( 11, 68) = 0.231988E+01
+ PKER_SWETH( 11, 69) = 0.232236E+01
+ PKER_SWETH( 11, 70) = 0.232468E+01
+ PKER_SWETH( 11, 71) = 0.232687E+01
+ PKER_SWETH( 11, 72) = 0.232892E+01
+ PKER_SWETH( 11, 73) = 0.233084E+01
+ PKER_SWETH( 11, 74) = 0.233265E+01
+ PKER_SWETH( 11, 75) = 0.233434E+01
+ PKER_SWETH( 11, 76) = 0.233594E+01
+ PKER_SWETH( 11, 77) = 0.233743E+01
+ PKER_SWETH( 11, 78) = 0.233884E+01
+ PKER_SWETH( 11, 79) = 0.234016E+01
+ PKER_SWETH( 11, 80) = 0.234140E+01
+ PKER_SWETH( 12, 1) = 0.145894E+01
+ PKER_SWETH( 12, 2) = 0.126502E+01
+ PKER_SWETH( 12, 3) = 0.108573E+01
+ PKER_SWETH( 12, 4) = 0.922022E+00
+ PKER_SWETH( 12, 5) = 0.775551E+00
+ PKER_SWETH( 12, 6) = 0.648490E+00
+ PKER_SWETH( 12, 7) = 0.543095E+00
+ PKER_SWETH( 12, 8) = 0.461483E+00
+ PKER_SWETH( 12, 9) = 0.405081E+00
+ PKER_SWETH( 12, 10) = 0.373938E+00
+ PKER_SWETH( 12, 11) = 0.367149E+00
+ PKER_SWETH( 12, 12) = 0.382311E+00
+ PKER_SWETH( 12, 13) = 0.416306E+00
+ PKER_SWETH( 12, 14) = 0.465232E+00
+ PKER_SWETH( 12, 15) = 0.525344E+00
+ PKER_SWETH( 12, 16) = 0.593373E+00
+ PKER_SWETH( 12, 17) = 0.666351E+00
+ PKER_SWETH( 12, 18) = 0.742209E+00
+ PKER_SWETH( 12, 19) = 0.819328E+00
+ PKER_SWETH( 12, 20) = 0.896597E+00
+ PKER_SWETH( 12, 21) = 0.973187E+00
+ PKER_SWETH( 12, 22) = 0.104838E+01
+ PKER_SWETH( 12, 23) = 0.112146E+01
+ PKER_SWETH( 12, 24) = 0.119172E+01
+ PKER_SWETH( 12, 25) = 0.125842E+01
+ PKER_SWETH( 12, 26) = 0.132096E+01
+ PKER_SWETH( 12, 27) = 0.137888E+01
+ PKER_SWETH( 12, 28) = 0.143197E+01
+ PKER_SWETH( 12, 29) = 0.148024E+01
+ PKER_SWETH( 12, 30) = 0.152388E+01
+ PKER_SWETH( 12, 31) = 0.156323E+01
+ PKER_SWETH( 12, 32) = 0.159870E+01
+ PKER_SWETH( 12, 33) = 0.163070E+01
+ PKER_SWETH( 12, 34) = 0.165963E+01
+ PKER_SWETH( 12, 35) = 0.168589E+01
+ PKER_SWETH( 12, 36) = 0.170978E+01
+ PKER_SWETH( 12, 37) = 0.173161E+01
+ PKER_SWETH( 12, 38) = 0.175162E+01
+ PKER_SWETH( 12, 39) = 0.177002E+01
+ PKER_SWETH( 12, 40) = 0.178699E+01
+ PKER_SWETH( 12, 41) = 0.180268E+01
+ PKER_SWETH( 12, 42) = 0.181722E+01
+ PKER_SWETH( 12, 43) = 0.183072E+01
+ PKER_SWETH( 12, 44) = 0.184328E+01
+ PKER_SWETH( 12, 45) = 0.185498E+01
+ PKER_SWETH( 12, 46) = 0.186588E+01
+ PKER_SWETH( 12, 47) = 0.187607E+01
+ PKER_SWETH( 12, 48) = 0.188559E+01
+ PKER_SWETH( 12, 49) = 0.189449E+01
+ PKER_SWETH( 12, 50) = 0.190282E+01
+ PKER_SWETH( 12, 51) = 0.191063E+01
+ PKER_SWETH( 12, 52) = 0.191793E+01
+ PKER_SWETH( 12, 53) = 0.192478E+01
+ PKER_SWETH( 12, 54) = 0.193120E+01
+ PKER_SWETH( 12, 55) = 0.193722E+01
+ PKER_SWETH( 12, 56) = 0.194286E+01
+ PKER_SWETH( 12, 57) = 0.194816E+01
+ PKER_SWETH( 12, 58) = 0.195313E+01
+ PKER_SWETH( 12, 59) = 0.195779E+01
+ PKER_SWETH( 12, 60) = 0.196217E+01
+ PKER_SWETH( 12, 61) = 0.196627E+01
+ PKER_SWETH( 12, 62) = 0.197013E+01
+ PKER_SWETH( 12, 63) = 0.197374E+01
+ PKER_SWETH( 12, 64) = 0.197714E+01
+ PKER_SWETH( 12, 65) = 0.198033E+01
+ PKER_SWETH( 12, 66) = 0.198332E+01
+ PKER_SWETH( 12, 67) = 0.198613E+01
+ PKER_SWETH( 12, 68) = 0.198877E+01
+ PKER_SWETH( 12, 69) = 0.199124E+01
+ PKER_SWETH( 12, 70) = 0.199357E+01
+ PKER_SWETH( 12, 71) = 0.199575E+01
+ PKER_SWETH( 12, 72) = 0.199780E+01
+ PKER_SWETH( 12, 73) = 0.199973E+01
+ PKER_SWETH( 12, 74) = 0.200153E+01
+ PKER_SWETH( 12, 75) = 0.200323E+01
+ PKER_SWETH( 12, 76) = 0.200482E+01
+ PKER_SWETH( 12, 77) = 0.200632E+01
+ PKER_SWETH( 12, 78) = 0.200772E+01
+ PKER_SWETH( 12, 79) = 0.200904E+01
+ PKER_SWETH( 12, 80) = 0.201028E+01
+ PKER_SWETH( 13, 1) = 0.170405E+01
+ PKER_SWETH( 13, 2) = 0.150769E+01
+ PKER_SWETH( 13, 3) = 0.132375E+01
+ PKER_SWETH( 13, 4) = 0.115199E+01
+ PKER_SWETH( 13, 5) = 0.992573E+00
+ PKER_SWETH( 13, 6) = 0.846175E+00
+ PKER_SWETH( 13, 7) = 0.713998E+00
+ PKER_SWETH( 13, 8) = 0.597806E+00
+ PKER_SWETH( 13, 9) = 0.499584E+00
+ PKER_SWETH( 13, 10) = 0.421275E+00
+ PKER_SWETH( 13, 11) = 0.364551E+00
+ PKER_SWETH( 13, 12) = 0.329932E+00
+ PKER_SWETH( 13, 13) = 0.316966E+00
+ PKER_SWETH( 13, 14) = 0.324306E+00
+ PKER_SWETH( 13, 15) = 0.349233E+00
+ PKER_SWETH( 13, 16) = 0.388790E+00
+ PKER_SWETH( 13, 17) = 0.439524E+00
+ PKER_SWETH( 13, 18) = 0.498464E+00
+ PKER_SWETH( 13, 19) = 0.562783E+00
+ PKER_SWETH( 13, 20) = 0.630325E+00
+ PKER_SWETH( 13, 21) = 0.699430E+00
+ PKER_SWETH( 13, 22) = 0.768779E+00
+ PKER_SWETH( 13, 23) = 0.837340E+00
+ PKER_SWETH( 13, 24) = 0.904222E+00
+ PKER_SWETH( 13, 25) = 0.968619E+00
+ PKER_SWETH( 13, 26) = 0.102980E+01
+ PKER_SWETH( 13, 27) = 0.108719E+01
+ PKER_SWETH( 13, 28) = 0.114036E+01
+ PKER_SWETH( 13, 29) = 0.118912E+01
+ PKER_SWETH( 13, 30) = 0.123349E+01
+ PKER_SWETH( 13, 31) = 0.127366E+01
+ PKER_SWETH( 13, 32) = 0.130993E+01
+ PKER_SWETH( 13, 33) = 0.134267E+01
+ PKER_SWETH( 13, 34) = 0.137225E+01
+ PKER_SWETH( 13, 35) = 0.139905E+01
+ PKER_SWETH( 13, 36) = 0.142339E+01
+ PKER_SWETH( 13, 37) = 0.144558E+01
+ PKER_SWETH( 13, 38) = 0.146588E+01
+ PKER_SWETH( 13, 39) = 0.148451E+01
+ PKER_SWETH( 13, 40) = 0.150167E+01
+ PKER_SWETH( 13, 41) = 0.151750E+01
+ PKER_SWETH( 13, 42) = 0.153215E+01
+ PKER_SWETH( 13, 43) = 0.154574E+01
+ PKER_SWETH( 13, 44) = 0.155836E+01
+ PKER_SWETH( 13, 45) = 0.157012E+01
+ PKER_SWETH( 13, 46) = 0.158107E+01
+ PKER_SWETH( 13, 47) = 0.159129E+01
+ PKER_SWETH( 13, 48) = 0.160083E+01
+ PKER_SWETH( 13, 49) = 0.160975E+01
+ PKER_SWETH( 13, 50) = 0.161810E+01
+ PKER_SWETH( 13, 51) = 0.162591E+01
+ PKER_SWETH( 13, 52) = 0.163323E+01
+ PKER_SWETH( 13, 53) = 0.164009E+01
+ PKER_SWETH( 13, 54) = 0.164651E+01
+ PKER_SWETH( 13, 55) = 0.165254E+01
+ PKER_SWETH( 13, 56) = 0.165818E+01
+ PKER_SWETH( 13, 57) = 0.166348E+01
+ PKER_SWETH( 13, 58) = 0.166845E+01
+ PKER_SWETH( 13, 59) = 0.167312E+01
+ PKER_SWETH( 13, 60) = 0.167749E+01
+ PKER_SWETH( 13, 61) = 0.168160E+01
+ PKER_SWETH( 13, 62) = 0.168546E+01
+ PKER_SWETH( 13, 63) = 0.168907E+01
+ PKER_SWETH( 13, 64) = 0.169247E+01
+ PKER_SWETH( 13, 65) = 0.169566E+01
+ PKER_SWETH( 13, 66) = 0.169865E+01
+ PKER_SWETH( 13, 67) = 0.170146E+01
+ PKER_SWETH( 13, 68) = 0.170410E+01
+ PKER_SWETH( 13, 69) = 0.170658E+01
+ PKER_SWETH( 13, 70) = 0.170890E+01
+ PKER_SWETH( 13, 71) = 0.171108E+01
+ PKER_SWETH( 13, 72) = 0.171313E+01
+ PKER_SWETH( 13, 73) = 0.171506E+01
+ PKER_SWETH( 13, 74) = 0.171687E+01
+ PKER_SWETH( 13, 75) = 0.171856E+01
+ PKER_SWETH( 13, 76) = 0.172016E+01
+ PKER_SWETH( 13, 77) = 0.172165E+01
+ PKER_SWETH( 13, 78) = 0.172306E+01
+ PKER_SWETH( 13, 79) = 0.172437E+01
+ PKER_SWETH( 13, 80) = 0.172561E+01
+ PKER_SWETH( 14, 1) = 0.191644E+01
+ PKER_SWETH( 14, 2) = 0.171981E+01
+ PKER_SWETH( 14, 3) = 0.153516E+01
+ PKER_SWETH( 14, 4) = 0.136183E+01
+ PKER_SWETH( 14, 5) = 0.119931E+01
+ PKER_SWETH( 14, 6) = 0.104729E+01
+ PKER_SWETH( 14, 7) = 0.905766E+00
+ PKER_SWETH( 14, 8) = 0.775129E+00
+ PKER_SWETH( 14, 9) = 0.656292E+00
+ PKER_SWETH( 14, 10) = 0.550615E+00
+ PKER_SWETH( 14, 11) = 0.459778E+00
+ PKER_SWETH( 14, 12) = 0.385647E+00
+ PKER_SWETH( 14, 13) = 0.329785E+00
+ PKER_SWETH( 14, 14) = 0.293160E+00
+ PKER_SWETH( 14, 15) = 0.275937E+00
+ PKER_SWETH( 14, 16) = 0.276977E+00
+ PKER_SWETH( 14, 17) = 0.294714E+00
+ PKER_SWETH( 14, 18) = 0.326332E+00
+ PKER_SWETH( 14, 19) = 0.369117E+00
+ PKER_SWETH( 14, 20) = 0.420187E+00
+ PKER_SWETH( 14, 21) = 0.476869E+00
+ PKER_SWETH( 14, 22) = 0.536997E+00
+ PKER_SWETH( 14, 23) = 0.598735E+00
+ PKER_SWETH( 14, 24) = 0.660650E+00
+ PKER_SWETH( 14, 25) = 0.721544E+00
+ PKER_SWETH( 14, 26) = 0.780441E+00
+ PKER_SWETH( 14, 27) = 0.836536E+00
+ PKER_SWETH( 14, 28) = 0.889213E+00
+ PKER_SWETH( 14, 29) = 0.938066E+00
+ PKER_SWETH( 14, 30) = 0.982909E+00
+ PKER_SWETH( 14, 31) = 0.102375E+01
+ PKER_SWETH( 14, 32) = 0.106077E+01
+ PKER_SWETH( 14, 33) = 0.109424E+01
+ PKER_SWETH( 14, 34) = 0.112450E+01
+ PKER_SWETH( 14, 35) = 0.115187E+01
+ PKER_SWETH( 14, 36) = 0.117671E+01
+ PKER_SWETH( 14, 37) = 0.119930E+01
+ PKER_SWETH( 14, 38) = 0.121993E+01
+ PKER_SWETH( 14, 39) = 0.123882E+01
+ PKER_SWETH( 14, 40) = 0.125618E+01
+ PKER_SWETH( 14, 41) = 0.127218E+01
+ PKER_SWETH( 14, 42) = 0.128696E+01
+ PKER_SWETH( 14, 43) = 0.130065E+01
+ PKER_SWETH( 14, 44) = 0.131335E+01
+ PKER_SWETH( 14, 45) = 0.132516E+01
+ PKER_SWETH( 14, 46) = 0.133616E+01
+ PKER_SWETH( 14, 47) = 0.134642E+01
+ PKER_SWETH( 14, 48) = 0.135599E+01
+ PKER_SWETH( 14, 49) = 0.136494E+01
+ PKER_SWETH( 14, 50) = 0.137330E+01
+ PKER_SWETH( 14, 51) = 0.138113E+01
+ PKER_SWETH( 14, 52) = 0.138846E+01
+ PKER_SWETH( 14, 53) = 0.139532E+01
+ PKER_SWETH( 14, 54) = 0.140175E+01
+ PKER_SWETH( 14, 55) = 0.140778E+01
+ PKER_SWETH( 14, 56) = 0.141343E+01
+ PKER_SWETH( 14, 57) = 0.141874E+01
+ PKER_SWETH( 14, 58) = 0.142371E+01
+ PKER_SWETH( 14, 59) = 0.142837E+01
+ PKER_SWETH( 14, 60) = 0.143275E+01
+ PKER_SWETH( 14, 61) = 0.143686E+01
+ PKER_SWETH( 14, 62) = 0.144072E+01
+ PKER_SWETH( 14, 63) = 0.144434E+01
+ PKER_SWETH( 14, 64) = 0.144773E+01
+ PKER_SWETH( 14, 65) = 0.145092E+01
+ PKER_SWETH( 14, 66) = 0.145391E+01
+ PKER_SWETH( 14, 67) = 0.145672E+01
+ PKER_SWETH( 14, 68) = 0.145936E+01
+ PKER_SWETH( 14, 69) = 0.146184E+01
+ PKER_SWETH( 14, 70) = 0.146416E+01
+ PKER_SWETH( 14, 71) = 0.146635E+01
+ PKER_SWETH( 14, 72) = 0.146840E+01
+ PKER_SWETH( 14, 73) = 0.147032E+01
+ PKER_SWETH( 14, 74) = 0.147213E+01
+ PKER_SWETH( 14, 75) = 0.147383E+01
+ PKER_SWETH( 14, 76) = 0.147542E+01
+ PKER_SWETH( 14, 77) = 0.147692E+01
+ PKER_SWETH( 14, 78) = 0.147832E+01
+ PKER_SWETH( 14, 79) = 0.147964E+01
+ PKER_SWETH( 14, 80) = 0.148088E+01
+ PKER_SWETH( 15, 1) = 0.209919E+01
+ PKER_SWETH( 15, 2) = 0.190259E+01
+ PKER_SWETH( 15, 3) = 0.171794E+01
+ PKER_SWETH( 15, 4) = 0.154449E+01
+ PKER_SWETH( 15, 5) = 0.138158E+01
+ PKER_SWETH( 15, 6) = 0.122859E+01
+ PKER_SWETH( 15, 7) = 0.108503E+01
+ PKER_SWETH( 15, 8) = 0.950547E+00
+ PKER_SWETH( 15, 9) = 0.825033E+00
+ PKER_SWETH( 15, 10) = 0.708693E+00
+ PKER_SWETH( 15, 11) = 0.602154E+00
+ PKER_SWETH( 15, 12) = 0.506482E+00
+ PKER_SWETH( 15, 13) = 0.423037E+00
+ PKER_SWETH( 15, 14) = 0.353533E+00
+ PKER_SWETH( 15, 15) = 0.299551E+00
+ PKER_SWETH( 15, 16) = 0.262102E+00
+ PKER_SWETH( 15, 17) = 0.241884E+00
+ PKER_SWETH( 15, 18) = 0.238413E+00
+ PKER_SWETH( 15, 19) = 0.250171E+00
+ PKER_SWETH( 15, 20) = 0.275347E+00
+ PKER_SWETH( 15, 21) = 0.311363E+00
+ PKER_SWETH( 15, 22) = 0.355624E+00
+ PKER_SWETH( 15, 23) = 0.405543E+00
+ PKER_SWETH( 15, 24) = 0.458917E+00
+ PKER_SWETH( 15, 25) = 0.513821E+00
+ PKER_SWETH( 15, 26) = 0.568682E+00
+ PKER_SWETH( 15, 27) = 0.622251E+00
+ PKER_SWETH( 15, 28) = 0.673551E+00
+ PKER_SWETH( 15, 29) = 0.721876E+00
+ PKER_SWETH( 15, 30) = 0.766778E+00
+ PKER_SWETH( 15, 31) = 0.808050E+00
+ PKER_SWETH( 15, 32) = 0.845689E+00
+ PKER_SWETH( 15, 33) = 0.879844E+00
+ PKER_SWETH( 15, 34) = 0.910766E+00
+ PKER_SWETH( 15, 35) = 0.938752E+00
+ PKER_SWETH( 15, 36) = 0.964114E+00
+ PKER_SWETH( 15, 37) = 0.987153E+00
+ PKER_SWETH( 15, 38) = 0.100814E+01
+ PKER_SWETH( 15, 39) = 0.102733E+01
+ PKER_SWETH( 15, 40) = 0.104492E+01
+ PKER_SWETH( 15, 41) = 0.106110E+01
+ PKER_SWETH( 15, 42) = 0.107603E+01
+ PKER_SWETH( 15, 43) = 0.108984E+01
+ PKER_SWETH( 15, 44) = 0.110263E+01
+ PKER_SWETH( 15, 45) = 0.111451E+01
+ PKER_SWETH( 15, 46) = 0.112557E+01
+ PKER_SWETH( 15, 47) = 0.113587E+01
+ PKER_SWETH( 15, 48) = 0.114547E+01
+ PKER_SWETH( 15, 49) = 0.115444E+01
+ PKER_SWETH( 15, 50) = 0.116283E+01
+ PKER_SWETH( 15, 51) = 0.117067E+01
+ PKER_SWETH( 15, 52) = 0.117801E+01
+ PKER_SWETH( 15, 53) = 0.118488E+01
+ PKER_SWETH( 15, 54) = 0.119132E+01
+ PKER_SWETH( 15, 55) = 0.119736E+01
+ PKER_SWETH( 15, 56) = 0.120301E+01
+ PKER_SWETH( 15, 57) = 0.120832E+01
+ PKER_SWETH( 15, 58) = 0.121329E+01
+ PKER_SWETH( 15, 59) = 0.121796E+01
+ PKER_SWETH( 15, 60) = 0.122234E+01
+ PKER_SWETH( 15, 61) = 0.122645E+01
+ PKER_SWETH( 15, 62) = 0.123031E+01
+ PKER_SWETH( 15, 63) = 0.123393E+01
+ PKER_SWETH( 15, 64) = 0.123732E+01
+ PKER_SWETH( 15, 65) = 0.124051E+01
+ PKER_SWETH( 15, 66) = 0.124351E+01
+ PKER_SWETH( 15, 67) = 0.124632E+01
+ PKER_SWETH( 15, 68) = 0.124896E+01
+ PKER_SWETH( 15, 69) = 0.125143E+01
+ PKER_SWETH( 15, 70) = 0.125376E+01
+ PKER_SWETH( 15, 71) = 0.125594E+01
+ PKER_SWETH( 15, 72) = 0.125799E+01
+ PKER_SWETH( 15, 73) = 0.125992E+01
+ PKER_SWETH( 15, 74) = 0.126172E+01
+ PKER_SWETH( 15, 75) = 0.126342E+01
+ PKER_SWETH( 15, 76) = 0.126501E+01
+ PKER_SWETH( 15, 77) = 0.126651E+01
+ PKER_SWETH( 15, 78) = 0.126792E+01
+ PKER_SWETH( 15, 79) = 0.126923E+01
+ PKER_SWETH( 15, 80) = 0.127047E+01
+ PKER_SWETH( 16, 1) = 0.225627E+01
+ PKER_SWETH( 16, 2) = 0.205974E+01
+ PKER_SWETH( 16, 3) = 0.187515E+01
+ PKER_SWETH( 16, 4) = 0.170176E+01
+ PKER_SWETH( 16, 5) = 0.153889E+01
+ PKER_SWETH( 16, 6) = 0.138588E+01
+ PKER_SWETH( 16, 7) = 0.124213E+01
+ PKER_SWETH( 16, 8) = 0.110710E+01
+ PKER_SWETH( 16, 9) = 0.980292E+00
+ PKER_SWETH( 16, 10) = 0.861366E+00
+ PKER_SWETH( 16, 11) = 0.750132E+00
+ PKER_SWETH( 16, 12) = 0.646663E+00
+ PKER_SWETH( 16, 13) = 0.551374E+00
+ PKER_SWETH( 16, 14) = 0.465058E+00
+ PKER_SWETH( 16, 15) = 0.388869E+00
+ PKER_SWETH( 16, 16) = 0.324265E+00
+ PKER_SWETH( 16, 17) = 0.272776E+00
+ PKER_SWETH( 16, 18) = 0.235577E+00
+ PKER_SWETH( 16, 19) = 0.213511E+00
+ PKER_SWETH( 16, 20) = 0.206520E+00
+ PKER_SWETH( 16, 21) = 0.213797E+00
+ PKER_SWETH( 16, 22) = 0.233640E+00
+ PKER_SWETH( 16, 23) = 0.263928E+00
+ PKER_SWETH( 16, 24) = 0.302257E+00
+ PKER_SWETH( 16, 25) = 0.346122E+00
+ PKER_SWETH( 16, 26) = 0.393290E+00
+ PKER_SWETH( 16, 27) = 0.441774E+00
+ PKER_SWETH( 16, 28) = 0.489947E+00
+ PKER_SWETH( 16, 29) = 0.536578E+00
+ PKER_SWETH( 16, 30) = 0.580787E+00
+ PKER_SWETH( 16, 31) = 0.622021E+00
+ PKER_SWETH( 16, 32) = 0.660014E+00
+ PKER_SWETH( 16, 33) = 0.694722E+00
+ PKER_SWETH( 16, 34) = 0.726265E+00
+ PKER_SWETH( 16, 35) = 0.754860E+00
+ PKER_SWETH( 16, 36) = 0.780775E+00
+ PKER_SWETH( 16, 37) = 0.804293E+00
+ PKER_SWETH( 16, 38) = 0.825685E+00
+ PKER_SWETH( 16, 39) = 0.845200E+00
+ PKER_SWETH( 16, 40) = 0.863058E+00
+ PKER_SWETH( 16, 41) = 0.879451E+00
+ PKER_SWETH( 16, 42) = 0.894545E+00
+ PKER_SWETH( 16, 43) = 0.908480E+00
+ PKER_SWETH( 16, 44) = 0.921377E+00
+ PKER_SWETH( 16, 45) = 0.933340E+00
+ PKER_SWETH( 16, 46) = 0.944457E+00
+ PKER_SWETH( 16, 47) = 0.954804E+00
+ PKER_SWETH( 16, 48) = 0.964449E+00
+ PKER_SWETH( 16, 49) = 0.973449E+00
+ PKER_SWETH( 16, 50) = 0.981857E+00
+ PKER_SWETH( 16, 51) = 0.989717E+00
+ PKER_SWETH( 16, 52) = 0.997071E+00
+ PKER_SWETH( 16, 53) = 0.100395E+01
+ PKER_SWETH( 16, 54) = 0.101040E+01
+ PKER_SWETH( 16, 55) = 0.101644E+01
+ PKER_SWETH( 16, 56) = 0.102211E+01
+ PKER_SWETH( 16, 57) = 0.102741E+01
+ PKER_SWETH( 16, 58) = 0.103239E+01
+ PKER_SWETH( 16, 59) = 0.103706E+01
+ PKER_SWETH( 16, 60) = 0.104144E+01
+ PKER_SWETH( 16, 61) = 0.104556E+01
+ PKER_SWETH( 16, 62) = 0.104941E+01
+ PKER_SWETH( 16, 63) = 0.105303E+01
+ PKER_SWETH( 16, 64) = 0.105643E+01
+ PKER_SWETH( 16, 65) = 0.105962E+01
+ PKER_SWETH( 16, 66) = 0.106262E+01
+ PKER_SWETH( 16, 67) = 0.106543E+01
+ PKER_SWETH( 16, 68) = 0.106807E+01
+ PKER_SWETH( 16, 69) = 0.107054E+01
+ PKER_SWETH( 16, 70) = 0.107287E+01
+ PKER_SWETH( 16, 71) = 0.107505E+01
+ PKER_SWETH( 16, 72) = 0.107710E+01
+ PKER_SWETH( 16, 73) = 0.107903E+01
+ PKER_SWETH( 16, 74) = 0.108083E+01
+ PKER_SWETH( 16, 75) = 0.108253E+01
+ PKER_SWETH( 16, 76) = 0.108412E+01
+ PKER_SWETH( 16, 77) = 0.108562E+01
+ PKER_SWETH( 16, 78) = 0.108703E+01
+ PKER_SWETH( 16, 79) = 0.108834E+01
+ PKER_SWETH( 16, 80) = 0.108958E+01
+ PKER_SWETH( 17, 1) = 0.239130E+01
+ PKER_SWETH( 17, 2) = 0.219480E+01
+ PKER_SWETH( 17, 3) = 0.201026E+01
+ PKER_SWETH( 17, 4) = 0.183694E+01
+ PKER_SWETH( 17, 5) = 0.167414E+01
+ PKER_SWETH( 17, 6) = 0.152122E+01
+ PKER_SWETH( 17, 7) = 0.137754E+01
+ PKER_SWETH( 17, 8) = 0.124255E+01
+ PKER_SWETH( 17, 9) = 0.111570E+01
+ PKER_SWETH( 17, 10) = 0.996495E+00
+ PKER_SWETH( 17, 11) = 0.884490E+00
+ PKER_SWETH( 17, 12) = 0.779332E+00
+ PKER_SWETH( 17, 13) = 0.680798E+00
+ PKER_SWETH( 17, 14) = 0.588860E+00
+ PKER_SWETH( 17, 15) = 0.503782E+00
+ PKER_SWETH( 17, 16) = 0.426137E+00
+ PKER_SWETH( 17, 17) = 0.356873E+00
+ PKER_SWETH( 17, 18) = 0.297270E+00
+ PKER_SWETH( 17, 19) = 0.248688E+00
+ PKER_SWETH( 17, 20) = 0.212450E+00
+ PKER_SWETH( 17, 21) = 0.189516E+00
+ PKER_SWETH( 17, 22) = 0.180089E+00
+ PKER_SWETH( 17, 23) = 0.183781E+00
+ PKER_SWETH( 17, 24) = 0.199287E+00
+ PKER_SWETH( 17, 25) = 0.224789E+00
+ PKER_SWETH( 17, 26) = 0.257938E+00
+ PKER_SWETH( 17, 27) = 0.296342E+00
+ PKER_SWETH( 17, 28) = 0.337770E+00
+ PKER_SWETH( 17, 29) = 0.380196E+00
+ PKER_SWETH( 17, 30) = 0.422074E+00
+ PKER_SWETH( 17, 31) = 0.462252E+00
+ PKER_SWETH( 17, 32) = 0.499999E+00
+ PKER_SWETH( 17, 33) = 0.534934E+00
+ PKER_SWETH( 17, 34) = 0.566940E+00
+ PKER_SWETH( 17, 35) = 0.596084E+00
+ PKER_SWETH( 17, 36) = 0.622549E+00
+ PKER_SWETH( 17, 37) = 0.646567E+00
+ PKER_SWETH( 17, 38) = 0.668394E+00
+ PKER_SWETH( 17, 39) = 0.688272E+00
+ PKER_SWETH( 17, 40) = 0.706427E+00
+ PKER_SWETH( 17, 41) = 0.723060E+00
+ PKER_SWETH( 17, 42) = 0.738344E+00
+ PKER_SWETH( 17, 43) = 0.752430E+00
+ PKER_SWETH( 17, 44) = 0.765446E+00
+ PKER_SWETH( 17, 45) = 0.777501E+00
+ PKER_SWETH( 17, 46) = 0.788690E+00
+ PKER_SWETH( 17, 47) = 0.799094E+00
+ PKER_SWETH( 17, 48) = 0.808782E+00
+ PKER_SWETH( 17, 49) = 0.817816E+00
+ PKER_SWETH( 17, 50) = 0.826250E+00
+ PKER_SWETH( 17, 51) = 0.834130E+00
+ PKER_SWETH( 17, 52) = 0.841500E+00
+ PKER_SWETH( 17, 53) = 0.848396E+00
+ PKER_SWETH( 17, 54) = 0.854853E+00
+ PKER_SWETH( 17, 55) = 0.860901E+00
+ PKER_SWETH( 17, 56) = 0.866570E+00
+ PKER_SWETH( 17, 57) = 0.871883E+00
+ PKER_SWETH( 17, 58) = 0.876865E+00
+ PKER_SWETH( 17, 59) = 0.881538E+00
+ PKER_SWETH( 17, 60) = 0.885922E+00
+ PKER_SWETH( 17, 61) = 0.890034E+00
+ PKER_SWETH( 17, 62) = 0.893893E+00
+ PKER_SWETH( 17, 63) = 0.897515E+00
+ PKER_SWETH( 17, 64) = 0.900914E+00
+ PKER_SWETH( 17, 65) = 0.904104E+00
+ PKER_SWETH( 17, 66) = 0.907099E+00
+ PKER_SWETH( 17, 67) = 0.909910E+00
+ PKER_SWETH( 17, 68) = 0.912549E+00
+ PKER_SWETH( 17, 69) = 0.915026E+00
+ PKER_SWETH( 17, 70) = 0.917352E+00
+ PKER_SWETH( 17, 71) = 0.919536E+00
+ PKER_SWETH( 17, 72) = 0.921586E+00
+ PKER_SWETH( 17, 73) = 0.923511E+00
+ PKER_SWETH( 17, 74) = 0.925319E+00
+ PKER_SWETH( 17, 75) = 0.927015E+00
+ PKER_SWETH( 17, 76) = 0.928609E+00
+ PKER_SWETH( 17, 77) = 0.930105E+00
+ PKER_SWETH( 17, 78) = 0.931509E+00
+ PKER_SWETH( 17, 79) = 0.932828E+00
+ PKER_SWETH( 17, 80) = 0.934067E+00
+ PKER_SWETH( 18, 1) = 0.250736E+01
+ PKER_SWETH( 18, 2) = 0.231089E+01
+ PKER_SWETH( 18, 3) = 0.212639E+01
+ PKER_SWETH( 18, 4) = 0.195312E+01
+ PKER_SWETH( 18, 5) = 0.179038E+01
+ PKER_SWETH( 18, 6) = 0.163752E+01
+ PKER_SWETH( 18, 7) = 0.149393E+01
+ PKER_SWETH( 18, 8) = 0.135903E+01
+ PKER_SWETH( 18, 9) = 0.123229E+01
+ PKER_SWETH( 18, 10) = 0.111318E+01
+ PKER_SWETH( 18, 11) = 0.100122E+01
+ PKER_SWETH( 18, 12) = 0.895967E+00
+ PKER_SWETH( 18, 13) = 0.797018E+00
+ PKER_SWETH( 18, 14) = 0.704029E+00
+ PKER_SWETH( 18, 15) = 0.616756E+00
+ PKER_SWETH( 18, 16) = 0.535113E+00
+ PKER_SWETH( 18, 17) = 0.459233E+00
+ PKER_SWETH( 18, 18) = 0.389543E+00
+ PKER_SWETH( 18, 19) = 0.326796E+00
+ PKER_SWETH( 18, 20) = 0.272095E+00
+ PKER_SWETH( 18, 21) = 0.226702E+00
+ PKER_SWETH( 18, 22) = 0.191896E+00
+ PKER_SWETH( 18, 23) = 0.168801E+00
+ PKER_SWETH( 18, 24) = 0.157853E+00
+ PKER_SWETH( 18, 25) = 0.158846E+00
+ PKER_SWETH( 18, 26) = 0.170918E+00
+ PKER_SWETH( 18, 27) = 0.192288E+00
+ PKER_SWETH( 18, 28) = 0.220881E+00
+ PKER_SWETH( 18, 29) = 0.254306E+00
+ PKER_SWETH( 18, 30) = 0.290385E+00
+ PKER_SWETH( 18, 31) = 0.327168E+00
+ PKER_SWETH( 18, 32) = 0.363206E+00
+ PKER_SWETH( 18, 33) = 0.397516E+00
+ PKER_SWETH( 18, 34) = 0.429526E+00
+ PKER_SWETH( 18, 35) = 0.458999E+00
+ PKER_SWETH( 18, 36) = 0.485922E+00
+ PKER_SWETH( 18, 37) = 0.510423E+00
+ PKER_SWETH( 18, 38) = 0.532699E+00
+ PKER_SWETH( 18, 39) = 0.552969E+00
+ PKER_SWETH( 18, 40) = 0.571453E+00
+ PKER_SWETH( 18, 41) = 0.588356E+00
+ PKER_SWETH( 18, 42) = 0.603857E+00
+ PKER_SWETH( 18, 43) = 0.618115E+00
+ PKER_SWETH( 18, 44) = 0.631267E+00
+ PKER_SWETH( 18, 45) = 0.643428E+00
+ PKER_SWETH( 18, 46) = 0.654700E+00
+ PKER_SWETH( 18, 47) = 0.665169E+00
+ PKER_SWETH( 18, 48) = 0.674907E+00
+ PKER_SWETH( 18, 49) = 0.683980E+00
+ PKER_SWETH( 18, 50) = 0.692444E+00
+ PKER_SWETH( 18, 51) = 0.700348E+00
+ PKER_SWETH( 18, 52) = 0.707736E+00
+ PKER_SWETH( 18, 53) = 0.714646E+00
+ PKER_SWETH( 18, 54) = 0.721114E+00
+ PKER_SWETH( 18, 55) = 0.727171E+00
+ PKER_SWETH( 18, 56) = 0.732846E+00
+ PKER_SWETH( 18, 57) = 0.738165E+00
+ PKER_SWETH( 18, 58) = 0.743151E+00
+ PKER_SWETH( 18, 59) = 0.747827E+00
+ PKER_SWETH( 18, 60) = 0.752213E+00
+ PKER_SWETH( 18, 61) = 0.756327E+00
+ PKER_SWETH( 18, 62) = 0.760188E+00
+ PKER_SWETH( 18, 63) = 0.763810E+00
+ PKER_SWETH( 18, 64) = 0.767210E+00
+ PKER_SWETH( 18, 65) = 0.770401E+00
+ PKER_SWETH( 18, 66) = 0.773396E+00
+ PKER_SWETH( 18, 67) = 0.776208E+00
+ PKER_SWETH( 18, 68) = 0.778847E+00
+ PKER_SWETH( 18, 69) = 0.781325E+00
+ PKER_SWETH( 18, 70) = 0.783651E+00
+ PKER_SWETH( 18, 71) = 0.785835E+00
+ PKER_SWETH( 18, 72) = 0.787885E+00
+ PKER_SWETH( 18, 73) = 0.789810E+00
+ PKER_SWETH( 18, 74) = 0.791618E+00
+ PKER_SWETH( 18, 75) = 0.793315E+00
+ PKER_SWETH( 18, 76) = 0.794908E+00
+ PKER_SWETH( 18, 77) = 0.796404E+00
+ PKER_SWETH( 18, 78) = 0.797809E+00
+ PKER_SWETH( 18, 79) = 0.799128E+00
+ PKER_SWETH( 18, 80) = 0.800366E+00
+ PKER_SWETH( 19, 1) = 0.260712E+01
+ PKER_SWETH( 19, 2) = 0.241068E+01
+ PKER_SWETH( 19, 3) = 0.222621E+01
+ PKER_SWETH( 19, 4) = 0.205297E+01
+ PKER_SWETH( 19, 5) = 0.189027E+01
+ PKER_SWETH( 19, 6) = 0.173746E+01
+ PKER_SWETH( 19, 7) = 0.159394E+01
+ PKER_SWETH( 19, 8) = 0.145912E+01
+ PKER_SWETH( 19, 9) = 0.133246E+01
+ PKER_SWETH( 19, 10) = 0.121346E+01
+ PKER_SWETH( 19, 11) = 0.110163E+01
+ PKER_SWETH( 19, 12) = 0.996507E+00
+ PKER_SWETH( 19, 13) = 0.897673E+00
+ PKER_SWETH( 19, 14) = 0.804722E+00
+ PKER_SWETH( 19, 15) = 0.717285E+00
+ PKER_SWETH( 19, 16) = 0.635038E+00
+ PKER_SWETH( 19, 17) = 0.557733E+00
+ PKER_SWETH( 19, 18) = 0.485242E+00
+ PKER_SWETH( 19, 19) = 0.417618E+00
+ PKER_SWETH( 19, 20) = 0.355152E+00
+ PKER_SWETH( 19, 21) = 0.298466E+00
+ PKER_SWETH( 19, 22) = 0.248486E+00
+ PKER_SWETH( 19, 23) = 0.206362E+00
+ PKER_SWETH( 19, 24) = 0.173382E+00
+ PKER_SWETH( 19, 25) = 0.150641E+00
+ PKER_SWETH( 19, 26) = 0.138811E+00
+ PKER_SWETH( 19, 27) = 0.137940E+00
+ PKER_SWETH( 19, 28) = 0.147153E+00
+ PKER_SWETH( 19, 29) = 0.165086E+00
+ PKER_SWETH( 19, 30) = 0.189581E+00
+ PKER_SWETH( 19, 31) = 0.218462E+00
+ PKER_SWETH( 19, 32) = 0.249591E+00
+ PKER_SWETH( 19, 33) = 0.281174E+00
+ PKER_SWETH( 19, 34) = 0.311929E+00
+ PKER_SWETH( 19, 35) = 0.341031E+00
+ PKER_SWETH( 19, 36) = 0.368064E+00
+ PKER_SWETH( 19, 37) = 0.392893E+00
+ PKER_SWETH( 19, 38) = 0.415567E+00
+ PKER_SWETH( 19, 39) = 0.436229E+00
+ PKER_SWETH( 19, 40) = 0.455063E+00
+ PKER_SWETH( 19, 41) = 0.472262E+00
+ PKER_SWETH( 19, 42) = 0.488006E+00
+ PKER_SWETH( 19, 43) = 0.502461E+00
+ PKER_SWETH( 19, 44) = 0.515768E+00
+ PKER_SWETH( 19, 45) = 0.528053E+00
+ PKER_SWETH( 19, 46) = 0.539421E+00
+ PKER_SWETH( 19, 47) = 0.549964E+00
+ PKER_SWETH( 19, 48) = 0.559761E+00
+ PKER_SWETH( 19, 49) = 0.568879E+00
+ PKER_SWETH( 19, 50) = 0.577378E+00
+ PKER_SWETH( 19, 51) = 0.585309E+00
+ PKER_SWETH( 19, 52) = 0.592718E+00
+ PKER_SWETH( 19, 53) = 0.599645E+00
+ PKER_SWETH( 19, 54) = 0.606125E+00
+ PKER_SWETH( 19, 55) = 0.612192E+00
+ PKER_SWETH( 19, 56) = 0.617874E+00
+ PKER_SWETH( 19, 57) = 0.623199E+00
+ PKER_SWETH( 19, 58) = 0.628190E+00
+ PKER_SWETH( 19, 59) = 0.632869E+00
+ PKER_SWETH( 19, 60) = 0.637258E+00
+ PKER_SWETH( 19, 61) = 0.641374E+00
+ PKER_SWETH( 19, 62) = 0.645237E+00
+ PKER_SWETH( 19, 63) = 0.648860E+00
+ PKER_SWETH( 19, 64) = 0.652261E+00
+ PKER_SWETH( 19, 65) = 0.655453E+00
+ PKER_SWETH( 19, 66) = 0.658449E+00
+ PKER_SWETH( 19, 67) = 0.661261E+00
+ PKER_SWETH( 19, 68) = 0.663901E+00
+ PKER_SWETH( 19, 69) = 0.666379E+00
+ PKER_SWETH( 19, 70) = 0.668705E+00
+ PKER_SWETH( 19, 71) = 0.670889E+00
+ PKER_SWETH( 19, 72) = 0.672939E+00
+ PKER_SWETH( 19, 73) = 0.674865E+00
+ PKER_SWETH( 19, 74) = 0.676672E+00
+ PKER_SWETH( 19, 75) = 0.678369E+00
+ PKER_SWETH( 19, 76) = 0.679963E+00
+ PKER_SWETH( 19, 77) = 0.681459E+00
+ PKER_SWETH( 19, 78) = 0.682863E+00
+ PKER_SWETH( 19, 79) = 0.684182E+00
+ PKER_SWETH( 19, 80) = 0.685421E+00
+ PKER_SWETH( 20, 1) = 0.269288E+01
+ PKER_SWETH( 20, 2) = 0.249646E+01
+ PKER_SWETH( 20, 3) = 0.231201E+01
+ PKER_SWETH( 20, 4) = 0.213879E+01
+ PKER_SWETH( 20, 5) = 0.197613E+01
+ PKER_SWETH( 20, 6) = 0.182336E+01
+ PKER_SWETH( 20, 7) = 0.167988E+01
+ PKER_SWETH( 20, 8) = 0.154512E+01
+ PKER_SWETH( 20, 9) = 0.141853E+01
+ PKER_SWETH( 20, 10) = 0.129961E+01
+ PKER_SWETH( 20, 11) = 0.118788E+01
+ PKER_SWETH( 20, 12) = 0.108288E+01
+ PKER_SWETH( 20, 13) = 0.984187E+00
+ PKER_SWETH( 20, 14) = 0.891397E+00
+ PKER_SWETH( 20, 15) = 0.804124E+00
+ PKER_SWETH( 20, 16) = 0.722009E+00
+ PKER_SWETH( 20, 17) = 0.644714E+00
+ PKER_SWETH( 20, 18) = 0.571940E+00
+ PKER_SWETH( 20, 19) = 0.503441E+00
+ PKER_SWETH( 20, 20) = 0.439066E+00
+ PKER_SWETH( 20, 21) = 0.378811E+00
+ PKER_SWETH( 20, 22) = 0.322879E+00
+ PKER_SWETH( 20, 23) = 0.271763E+00
+ PKER_SWETH( 20, 24) = 0.226263E+00
+ PKER_SWETH( 20, 25) = 0.187406E+00
+ PKER_SWETH( 20, 26) = 0.156446E+00
+ PKER_SWETH( 20, 27) = 0.134517E+00
+ PKER_SWETH( 20, 28) = 0.122305E+00
+ PKER_SWETH( 20, 29) = 0.120067E+00
+ PKER_SWETH( 20, 30) = 0.127125E+00
+ PKER_SWETH( 20, 31) = 0.142001E+00
+ PKER_SWETH( 20, 32) = 0.162875E+00
+ PKER_SWETH( 20, 33) = 0.187599E+00
+ PKER_SWETH( 20, 34) = 0.214210E+00
+ PKER_SWETH( 20, 35) = 0.241099E+00
+ PKER_SWETH( 20, 36) = 0.267168E+00
+ PKER_SWETH( 20, 37) = 0.291755E+00
+ PKER_SWETH( 20, 38) = 0.314552E+00
+ PKER_SWETH( 20, 39) = 0.335492E+00
+ PKER_SWETH( 20, 40) = 0.354644E+00
+ PKER_SWETH( 20, 41) = 0.372144E+00
+ PKER_SWETH( 20, 42) = 0.388151E+00
+ PKER_SWETH( 20, 43) = 0.402823E+00
+ PKER_SWETH( 20, 44) = 0.416308E+00
+ PKER_SWETH( 20, 45) = 0.428733E+00
+ PKER_SWETH( 20, 46) = 0.440212E+00
+ PKER_SWETH( 20, 47) = 0.450843E+00
+ PKER_SWETH( 20, 48) = 0.460707E+00
+ PKER_SWETH( 20, 49) = 0.469878E+00
+ PKER_SWETH( 20, 50) = 0.478418E+00
+ PKER_SWETH( 20, 51) = 0.486380E+00
+ PKER_SWETH( 20, 52) = 0.493813E+00
+ PKER_SWETH( 20, 53) = 0.500759E+00
+ PKER_SWETH( 20, 54) = 0.507254E+00
+ PKER_SWETH( 20, 55) = 0.513332E+00
+ PKER_SWETH( 20, 56) = 0.519023E+00
+ PKER_SWETH( 20, 57) = 0.524354E+00
+ PKER_SWETH( 20, 58) = 0.529350E+00
+ PKER_SWETH( 20, 59) = 0.534034E+00
+ PKER_SWETH( 20, 60) = 0.538425E+00
+ PKER_SWETH( 20, 61) = 0.542544E+00
+ PKER_SWETH( 20, 62) = 0.546409E+00
+ PKER_SWETH( 20, 63) = 0.550034E+00
+ PKER_SWETH( 20, 64) = 0.553436E+00
+ PKER_SWETH( 20, 65) = 0.556629E+00
+ PKER_SWETH( 20, 66) = 0.559625E+00
+ PKER_SWETH( 20, 67) = 0.562438E+00
+ PKER_SWETH( 20, 68) = 0.565078E+00
+ PKER_SWETH( 20, 69) = 0.567556E+00
+ PKER_SWETH( 20, 70) = 0.569883E+00
+ PKER_SWETH( 20, 71) = 0.572067E+00
+ PKER_SWETH( 20, 72) = 0.574118E+00
+ PKER_SWETH( 20, 73) = 0.576043E+00
+ PKER_SWETH( 20, 74) = 0.577850E+00
+ PKER_SWETH( 20, 75) = 0.579548E+00
+ PKER_SWETH( 20, 76) = 0.581141E+00
+ PKER_SWETH( 20, 77) = 0.582637E+00
+ PKER_SWETH( 20, 78) = 0.584042E+00
+ PKER_SWETH( 20, 79) = 0.585361E+00
+ PKER_SWETH( 20, 80) = 0.586599E+00
+ PKER_SWETH( 21, 1) = 0.276660E+01
+ PKER_SWETH( 21, 2) = 0.257019E+01
+ PKER_SWETH( 21, 3) = 0.238576E+01
+ PKER_SWETH( 21, 4) = 0.221256E+01
+ PKER_SWETH( 21, 5) = 0.204992E+01
+ PKER_SWETH( 21, 6) = 0.189718E+01
+ PKER_SWETH( 21, 7) = 0.175373E+01
+ PKER_SWETH( 21, 8) = 0.161901E+01
+ PKER_SWETH( 21, 9) = 0.149248E+01
+ PKER_SWETH( 21, 10) = 0.137362E+01
+ PKER_SWETH( 21, 11) = 0.126196E+01
+ PKER_SWETH( 21, 12) = 0.115706E+01
+ PKER_SWETH( 21, 13) = 0.105848E+01
+ PKER_SWETH( 21, 14) = 0.965820E+00
+ PKER_SWETH( 21, 15) = 0.878708E+00
+ PKER_SWETH( 21, 16) = 0.796778E+00
+ PKER_SWETH( 21, 17) = 0.719688E+00
+ PKER_SWETH( 21, 18) = 0.647114E+00
+ PKER_SWETH( 21, 19) = 0.578752E+00
+ PKER_SWETH( 21, 20) = 0.514323E+00
+ PKER_SWETH( 21, 21) = 0.453593E+00
+ PKER_SWETH( 21, 22) = 0.396401E+00
+ PKER_SWETH( 21, 23) = 0.342701E+00
+ PKER_SWETH( 21, 24) = 0.292637E+00
+ PKER_SWETH( 21, 25) = 0.246605E+00
+ PKER_SWETH( 21, 26) = 0.205290E+00
+ PKER_SWETH( 21, 27) = 0.169646E+00
+ PKER_SWETH( 21, 28) = 0.140837E+00
+ PKER_SWETH( 21, 29) = 0.119992E+00
+ PKER_SWETH( 21, 30) = 0.107857E+00
+ PKER_SWETH( 21, 31) = 0.104691E+00
+ PKER_SWETH( 21, 32) = 0.109912E+00
+ PKER_SWETH( 21, 33) = 0.122241E+00
+ PKER_SWETH( 21, 34) = 0.139853E+00
+ PKER_SWETH( 21, 35) = 0.160815E+00
+ PKER_SWETH( 21, 36) = 0.183364E+00
+ PKER_SWETH( 21, 37) = 0.206102E+00
+ PKER_SWETH( 21, 38) = 0.228109E+00
+ PKER_SWETH( 21, 39) = 0.248850E+00
+ PKER_SWETH( 21, 40) = 0.268092E+00
+ PKER_SWETH( 21, 41) = 0.285801E+00
+ PKER_SWETH( 21, 42) = 0.302045E+00
+ PKER_SWETH( 21, 43) = 0.316939E+00
+ PKER_SWETH( 21, 44) = 0.330615E+00
+ PKER_SWETH( 21, 45) = 0.343198E+00
+ PKER_SWETH( 21, 46) = 0.354804E+00
+ PKER_SWETH( 21, 47) = 0.365535E+00
+ PKER_SWETH( 21, 48) = 0.375478E+00
+ PKER_SWETH( 21, 49) = 0.384710E+00
+ PKER_SWETH( 21, 50) = 0.393297E+00
+ PKER_SWETH( 21, 51) = 0.401296E+00
+ PKER_SWETH( 21, 52) = 0.408758E+00
+ PKER_SWETH( 21, 53) = 0.415725E+00
+ PKER_SWETH( 21, 54) = 0.422237E+00
+ PKER_SWETH( 21, 55) = 0.428328E+00
+ PKER_SWETH( 21, 56) = 0.434029E+00
+ PKER_SWETH( 21, 57) = 0.439368E+00
+ PKER_SWETH( 21, 58) = 0.444370E+00
+ PKER_SWETH( 21, 59) = 0.449059E+00
+ PKER_SWETH( 21, 60) = 0.453454E+00
+ PKER_SWETH( 21, 61) = 0.457576E+00
+ PKER_SWETH( 21, 62) = 0.461442E+00
+ PKER_SWETH( 21, 63) = 0.465069E+00
+ PKER_SWETH( 21, 64) = 0.468472E+00
+ PKER_SWETH( 21, 65) = 0.471666E+00
+ PKER_SWETH( 21, 66) = 0.474663E+00
+ PKER_SWETH( 21, 67) = 0.477476E+00
+ PKER_SWETH( 21, 68) = 0.480117E+00
+ PKER_SWETH( 21, 69) = 0.482596E+00
+ PKER_SWETH( 21, 70) = 0.484923E+00
+ PKER_SWETH( 21, 71) = 0.487107E+00
+ PKER_SWETH( 21, 72) = 0.489158E+00
+ PKER_SWETH( 21, 73) = 0.491083E+00
+ PKER_SWETH( 21, 74) = 0.492891E+00
+ PKER_SWETH( 21, 75) = 0.494588E+00
+ PKER_SWETH( 21, 76) = 0.496182E+00
+ PKER_SWETH( 21, 77) = 0.497678E+00
+ PKER_SWETH( 21, 78) = 0.499083E+00
+ PKER_SWETH( 21, 79) = 0.500402E+00
+ PKER_SWETH( 21, 80) = 0.501640E+00
+ PKER_SWETH( 22, 1) = 0.282997E+01
+ PKER_SWETH( 22, 2) = 0.263357E+01
+ PKER_SWETH( 22, 3) = 0.244915E+01
+ PKER_SWETH( 22, 4) = 0.227597E+01
+ PKER_SWETH( 22, 5) = 0.211334E+01
+ PKER_SWETH( 22, 6) = 0.196063E+01
+ PKER_SWETH( 22, 7) = 0.181721E+01
+ PKER_SWETH( 22, 8) = 0.168252E+01
+ PKER_SWETH( 22, 9) = 0.155602E+01
+ PKER_SWETH( 22, 10) = 0.143721E+01
+ PKER_SWETH( 22, 11) = 0.132561E+01
+ PKER_SWETH( 22, 12) = 0.122077E+01
+ PKER_SWETH( 22, 13) = 0.112227E+01
+ PKER_SWETH( 22, 14) = 0.102972E+01
+ PKER_SWETH( 22, 15) = 0.942728E+00
+ PKER_SWETH( 22, 16) = 0.860945E+00
+ PKER_SWETH( 22, 17) = 0.784032E+00
+ PKER_SWETH( 22, 18) = 0.711667E+00
+ PKER_SWETH( 22, 19) = 0.643543E+00
+ PKER_SWETH( 22, 20) = 0.579369E+00
+ PKER_SWETH( 22, 21) = 0.518868E+00
+ PKER_SWETH( 22, 22) = 0.461786E+00
+ PKER_SWETH( 22, 23) = 0.407901E+00
+ PKER_SWETH( 22, 24) = 0.357051E+00
+ PKER_SWETH( 22, 25) = 0.309171E+00
+ PKER_SWETH( 22, 26) = 0.264357E+00
+ PKER_SWETH( 22, 27) = 0.222939E+00
+ PKER_SWETH( 22, 28) = 0.185511E+00
+ PKER_SWETH( 22, 29) = 0.152956E+00
+ PKER_SWETH( 22, 30) = 0.126371E+00
+ PKER_SWETH( 22, 31) = 0.106799E+00
+ PKER_SWETH( 22, 32) = 0.950337E-01
+ PKER_SWETH( 22, 33) = 0.913020E-01
+ PKER_SWETH( 22, 34) = 0.950413E-01
+ PKER_SWETH( 22, 35) = 0.105099E+00
+ PKER_SWETH( 22, 36) = 0.119803E+00
+ PKER_SWETH( 22, 37) = 0.137435E+00
+ PKER_SWETH( 22, 38) = 0.156413E+00
+ PKER_SWETH( 22, 39) = 0.175558E+00
+ PKER_SWETH( 22, 40) = 0.194103E+00
+ PKER_SWETH( 22, 41) = 0.211605E+00
+ PKER_SWETH( 22, 42) = 0.227888E+00
+ PKER_SWETH( 22, 43) = 0.242923E+00
+ PKER_SWETH( 22, 44) = 0.256764E+00
+ PKER_SWETH( 22, 45) = 0.269505E+00
+ PKER_SWETH( 22, 46) = 0.281247E+00
+ PKER_SWETH( 22, 47) = 0.292089E+00
+ PKER_SWETH( 22, 48) = 0.302122E+00
+ PKER_SWETH( 22, 49) = 0.311425E+00
+ PKER_SWETH( 22, 50) = 0.320067E+00
+ PKER_SWETH( 22, 51) = 0.328110E+00
+ PKER_SWETH( 22, 52) = 0.335604E+00
+ PKER_SWETH( 22, 53) = 0.342597E+00
+ PKER_SWETH( 22, 54) = 0.349129E+00
+ PKER_SWETH( 22, 55) = 0.355235E+00
+ PKER_SWETH( 22, 56) = 0.360948E+00
+ PKER_SWETH( 22, 57) = 0.366296E+00
+ PKER_SWETH( 22, 58) = 0.371305E+00
+ PKER_SWETH( 22, 59) = 0.375999E+00
+ PKER_SWETH( 22, 60) = 0.380398E+00
+ PKER_SWETH( 22, 61) = 0.384523E+00
+ PKER_SWETH( 22, 62) = 0.388392E+00
+ PKER_SWETH( 22, 63) = 0.392021E+00
+ PKER_SWETH( 22, 64) = 0.395426E+00
+ PKER_SWETH( 22, 65) = 0.398621E+00
+ PKER_SWETH( 22, 66) = 0.401619E+00
+ PKER_SWETH( 22, 67) = 0.404433E+00
+ PKER_SWETH( 22, 68) = 0.407074E+00
+ PKER_SWETH( 22, 69) = 0.409553E+00
+ PKER_SWETH( 22, 70) = 0.411880E+00
+ PKER_SWETH( 22, 71) = 0.414065E+00
+ PKER_SWETH( 22, 72) = 0.416116E+00
+ PKER_SWETH( 22, 73) = 0.418041E+00
+ PKER_SWETH( 22, 74) = 0.419849E+00
+ PKER_SWETH( 22, 75) = 0.421547E+00
+ PKER_SWETH( 22, 76) = 0.423140E+00
+ PKER_SWETH( 22, 77) = 0.424636E+00
+ PKER_SWETH( 22, 78) = 0.426041E+00
+ PKER_SWETH( 22, 79) = 0.427360E+00
+ PKER_SWETH( 22, 80) = 0.428599E+00
+ PKER_SWETH( 23, 1) = 0.288445E+01
+ PKER_SWETH( 23, 2) = 0.268806E+01
+ PKER_SWETH( 23, 3) = 0.250364E+01
+ PKER_SWETH( 23, 4) = 0.233048E+01
+ PKER_SWETH( 23, 5) = 0.216786E+01
+ PKER_SWETH( 23, 6) = 0.201516E+01
+ PKER_SWETH( 23, 7) = 0.187176E+01
+ PKER_SWETH( 23, 8) = 0.173710E+01
+ PKER_SWETH( 23, 9) = 0.161063E+01
+ PKER_SWETH( 23, 10) = 0.149185E+01
+ PKER_SWETH( 23, 11) = 0.138029E+01
+ PKER_SWETH( 23, 12) = 0.127551E+01
+ PKER_SWETH( 23, 13) = 0.117707E+01
+ PKER_SWETH( 23, 14) = 0.108459E+01
+ PKER_SWETH( 23, 15) = 0.997690E+00
+ PKER_SWETH( 23, 16) = 0.916018E+00
+ PKER_SWETH( 23, 17) = 0.839238E+00
+ PKER_SWETH( 23, 18) = 0.767034E+00
+ PKER_SWETH( 23, 19) = 0.699104E+00
+ PKER_SWETH( 23, 20) = 0.635161E+00
+ PKER_SWETH( 23, 21) = 0.574928E+00
+ PKER_SWETH( 23, 22) = 0.518145E+00
+ PKER_SWETH( 23, 23) = 0.464561E+00
+ PKER_SWETH( 23, 24) = 0.413942E+00
+ PKER_SWETH( 23, 25) = 0.366084E+00
+ PKER_SWETH( 23, 26) = 0.320828E+00
+ PKER_SWETH( 23, 27) = 0.278103E+00
+ PKER_SWETH( 23, 28) = 0.237978E+00
+ PKER_SWETH( 23, 29) = 0.200731E+00
+ PKER_SWETH( 23, 30) = 0.166899E+00
+ PKER_SWETH( 23, 31) = 0.137289E+00
+ PKER_SWETH( 23, 32) = 0.112921E+00
+ PKER_SWETH( 23, 33) = 0.947715E-01
+ PKER_SWETH( 23, 34) = 0.835556E-01
+ PKER_SWETH( 23, 35) = 0.795022E-01
+ PKER_SWETH( 23, 36) = 0.820667E-01
+ PKER_SWETH( 23, 37) = 0.901434E-01
+ PKER_SWETH( 23, 38) = 0.102318E+00
+ PKER_SWETH( 23, 39) = 0.117002E+00
+ PKER_SWETH( 23, 40) = 0.132892E+00
+ PKER_SWETH( 23, 41) = 0.148969E+00
+ PKER_SWETH( 23, 42) = 0.164595E+00
+ PKER_SWETH( 23, 43) = 0.179397E+00
+ PKER_SWETH( 23, 44) = 0.193221E+00
+ PKER_SWETH( 23, 45) = 0.206041E+00
+ PKER_SWETH( 23, 46) = 0.217890E+00
+ PKER_SWETH( 23, 47) = 0.228840E+00
+ PKER_SWETH( 23, 48) = 0.238967E+00
+ PKER_SWETH( 23, 49) = 0.248348E+00
+ PKER_SWETH( 23, 50) = 0.257053E+00
+ PKER_SWETH( 23, 51) = 0.265145E+00
+ PKER_SWETH( 23, 52) = 0.272678E+00
+ PKER_SWETH( 23, 53) = 0.279701E+00
+ PKER_SWETH( 23, 54) = 0.286256E+00
+ PKER_SWETH( 23, 55) = 0.292380E+00
+ PKER_SWETH( 23, 56) = 0.298107E+00
+ PKER_SWETH( 23, 57) = 0.303465E+00
+ PKER_SWETH( 23, 58) = 0.308482E+00
+ PKER_SWETH( 23, 59) = 0.313182E+00
+ PKER_SWETH( 23, 60) = 0.317586E+00
+ PKER_SWETH( 23, 61) = 0.321715E+00
+ PKER_SWETH( 23, 62) = 0.325587E+00
+ PKER_SWETH( 23, 63) = 0.329218E+00
+ PKER_SWETH( 23, 64) = 0.332625E+00
+ PKER_SWETH( 23, 65) = 0.335821E+00
+ PKER_SWETH( 23, 66) = 0.338820E+00
+ PKER_SWETH( 23, 67) = 0.341635E+00
+ PKER_SWETH( 23, 68) = 0.344276E+00
+ PKER_SWETH( 23, 69) = 0.346756E+00
+ PKER_SWETH( 23, 70) = 0.349083E+00
+ PKER_SWETH( 23, 71) = 0.351269E+00
+ PKER_SWETH( 23, 72) = 0.353320E+00
+ PKER_SWETH( 23, 73) = 0.355245E+00
+ PKER_SWETH( 23, 74) = 0.357053E+00
+ PKER_SWETH( 23, 75) = 0.358751E+00
+ PKER_SWETH( 23, 76) = 0.360345E+00
+ PKER_SWETH( 23, 77) = 0.361841E+00
+ PKER_SWETH( 23, 78) = 0.363246E+00
+ PKER_SWETH( 23, 79) = 0.364565E+00
+ PKER_SWETH( 23, 80) = 0.365803E+00
+ PKER_SWETH( 24, 1) = 0.293128E+01
+ PKER_SWETH( 24, 2) = 0.273490E+01
+ PKER_SWETH( 24, 3) = 0.255049E+01
+ PKER_SWETH( 24, 4) = 0.237733E+01
+ PKER_SWETH( 24, 5) = 0.221473E+01
+ PKER_SWETH( 24, 6) = 0.206204E+01
+ PKER_SWETH( 24, 7) = 0.191865E+01
+ PKER_SWETH( 24, 8) = 0.178401E+01
+ PKER_SWETH( 24, 9) = 0.165756E+01
+ PKER_SWETH( 24, 10) = 0.153881E+01
+ PKER_SWETH( 24, 11) = 0.142728E+01
+ PKER_SWETH( 24, 12) = 0.132253E+01
+ PKER_SWETH( 24, 13) = 0.122414E+01
+ PKER_SWETH( 24, 14) = 0.113172E+01
+ PKER_SWETH( 24, 15) = 0.104489E+01
+ PKER_SWETH( 24, 16) = 0.963296E+00
+ PKER_SWETH( 24, 17) = 0.886615E+00
+ PKER_SWETH( 24, 18) = 0.814532E+00
+ PKER_SWETH( 24, 19) = 0.746748E+00
+ PKER_SWETH( 24, 20) = 0.682980E+00
+ PKER_SWETH( 24, 21) = 0.622959E+00
+ PKER_SWETH( 24, 22) = 0.566429E+00
+ PKER_SWETH( 24, 23) = 0.513140E+00
+ PKER_SWETH( 24, 24) = 0.462858E+00
+ PKER_SWETH( 24, 25) = 0.415356E+00
+ PKER_SWETH( 24, 26) = 0.370422E+00
+ PKER_SWETH( 24, 27) = 0.327867E+00
+ PKER_SWETH( 24, 28) = 0.287546E+00
+ PKER_SWETH( 24, 29) = 0.249386E+00
+ PKER_SWETH( 24, 30) = 0.213448E+00
+ PKER_SWETH( 24, 31) = 0.179979E+00
+ PKER_SWETH( 24, 32) = 0.149462E+00
+ PKER_SWETH( 24, 33) = 0.122655E+00
+ PKER_SWETH( 24, 34) = 0.100473E+00
+ PKER_SWETH( 24, 35) = 0.838046E-01
+ PKER_SWETH( 24, 36) = 0.732975E-01
+ PKER_SWETH( 24, 37) = 0.690734E-01
+ PKER_SWETH( 24, 38) = 0.706629E-01
+ PKER_SWETH( 24, 39) = 0.770847E-01
+ PKER_SWETH( 24, 40) = 0.870070E-01
+ PKER_SWETH( 24, 41) = 0.991818E-01
+ PKER_SWETH( 24, 42) = 0.112426E+00
+ PKER_SWETH( 24, 43) = 0.125916E+00
+ PKER_SWETH( 24, 44) = 0.139097E+00
+ PKER_SWETH( 24, 45) = 0.151650E+00
+ PKER_SWETH( 24, 46) = 0.163434E+00
+ PKER_SWETH( 24, 47) = 0.174410E+00
+ PKER_SWETH( 24, 48) = 0.184599E+00
+ PKER_SWETH( 24, 49) = 0.194049E+00
+ PKER_SWETH( 24, 50) = 0.202817E+00
+ PKER_SWETH( 24, 51) = 0.210962E+00
+ PKER_SWETH( 24, 52) = 0.218539E+00
+ PKER_SWETH( 24, 53) = 0.225596E+00
+ PKER_SWETH( 24, 54) = 0.232178E+00
+ PKER_SWETH( 24, 55) = 0.238323E+00
+ PKER_SWETH( 24, 56) = 0.244066E+00
+ PKER_SWETH( 24, 57) = 0.249437E+00
+ PKER_SWETH( 24, 58) = 0.254464E+00
+ PKER_SWETH( 24, 59) = 0.259171E+00
+ PKER_SWETH( 24, 60) = 0.263581E+00
+ PKER_SWETH( 24, 61) = 0.267714E+00
+ PKER_SWETH( 24, 62) = 0.271589E+00
+ PKER_SWETH( 24, 63) = 0.275223E+00
+ PKER_SWETH( 24, 64) = 0.278631E+00
+ PKER_SWETH( 24, 65) = 0.281829E+00
+ PKER_SWETH( 24, 66) = 0.284829E+00
+ PKER_SWETH( 24, 67) = 0.287645E+00
+ PKER_SWETH( 24, 68) = 0.290287E+00
+ PKER_SWETH( 24, 69) = 0.292767E+00
+ PKER_SWETH( 24, 70) = 0.295095E+00
+ PKER_SWETH( 24, 71) = 0.297281E+00
+ PKER_SWETH( 24, 72) = 0.299332E+00
+ PKER_SWETH( 24, 73) = 0.301258E+00
+ PKER_SWETH( 24, 74) = 0.303066E+00
+ PKER_SWETH( 24, 75) = 0.304764E+00
+ PKER_SWETH( 24, 76) = 0.306358E+00
+ PKER_SWETH( 24, 77) = 0.307854E+00
+ PKER_SWETH( 24, 78) = 0.309259E+00
+ PKER_SWETH( 24, 79) = 0.310578E+00
+ PKER_SWETH( 24, 80) = 0.311817E+00
+ PKER_SWETH( 25, 1) = 0.297154E+01
+ PKER_SWETH( 25, 2) = 0.277516E+01
+ PKER_SWETH( 25, 3) = 0.259076E+01
+ PKER_SWETH( 25, 4) = 0.241761E+01
+ PKER_SWETH( 25, 5) = 0.225501E+01
+ PKER_SWETH( 25, 6) = 0.210233E+01
+ PKER_SWETH( 25, 7) = 0.195896E+01
+ PKER_SWETH( 25, 8) = 0.182433E+01
+ PKER_SWETH( 25, 9) = 0.169789E+01
+ PKER_SWETH( 25, 10) = 0.157916E+01
+ PKER_SWETH( 25, 11) = 0.146766E+01
+ PKER_SWETH( 25, 12) = 0.136294E+01
+ PKER_SWETH( 25, 13) = 0.126459E+01
+ PKER_SWETH( 25, 14) = 0.117220E+01
+ PKER_SWETH( 25, 15) = 0.108542E+01
+ PKER_SWETH( 25, 16) = 0.100389E+01
+ PKER_SWETH( 25, 17) = 0.927285E+00
+ PKER_SWETH( 25, 18) = 0.855291E+00
+ PKER_SWETH( 25, 19) = 0.787616E+00
+ PKER_SWETH( 25, 20) = 0.723980E+00
+ PKER_SWETH( 25, 21) = 0.664118E+00
+ PKER_SWETH( 25, 22) = 0.607779E+00
+ PKER_SWETH( 25, 23) = 0.554721E+00
+ PKER_SWETH( 25, 24) = 0.504713E+00
+ PKER_SWETH( 25, 25) = 0.457533E+00
+ PKER_SWETH( 25, 26) = 0.412967E+00
+ PKER_SWETH( 25, 27) = 0.370812E+00
+ PKER_SWETH( 25, 28) = 0.330876E+00
+ PKER_SWETH( 25, 29) = 0.292989E+00
+ PKER_SWETH( 25, 30) = 0.257023E+00
+ PKER_SWETH( 25, 31) = 0.222915E+00
+ PKER_SWETH( 25, 32) = 0.190725E+00
+ PKER_SWETH( 25, 33) = 0.160684E+00
+ PKER_SWETH( 25, 34) = 0.133246E+00
+ PKER_SWETH( 25, 35) = 0.109094E+00
+ PKER_SWETH( 25, 36) = 0.890541E-01
+ PKER_SWETH( 25, 37) = 0.738827E-01
+ PKER_SWETH( 25, 38) = 0.641418E-01
+ PKER_SWETH( 25, 39) = 0.598974E-01
+ PKER_SWETH( 25, 40) = 0.606697E-01
+ PKER_SWETH( 25, 41) = 0.656428E-01
+ PKER_SWETH( 25, 42) = 0.736972E-01
+ PKER_SWETH( 25, 43) = 0.836895E-01
+ PKER_SWETH( 25, 44) = 0.947074E-01
+ PKER_SWETH( 25, 45) = 0.106025E+00
+ PKER_SWETH( 25, 46) = 0.117165E+00
+ PKER_SWETH( 25, 47) = 0.127842E+00
+ PKER_SWETH( 25, 48) = 0.137923E+00
+ PKER_SWETH( 25, 49) = 0.147359E+00
+ PKER_SWETH( 25, 50) = 0.156153E+00
+ PKER_SWETH( 25, 51) = 0.164338E+00
+ PKER_SWETH( 25, 52) = 0.171955E+00
+ PKER_SWETH( 25, 53) = 0.179048E+00
+ PKER_SWETH( 25, 54) = 0.185659E+00
+ PKER_SWETH( 25, 55) = 0.191828E+00
+ PKER_SWETH( 25, 56) = 0.197589E+00
+ PKER_SWETH( 25, 57) = 0.202975E+00
+ PKER_SWETH( 25, 58) = 0.208013E+00
+ PKER_SWETH( 25, 59) = 0.212728E+00
+ PKER_SWETH( 25, 60) = 0.217145E+00
+ PKER_SWETH( 25, 61) = 0.221283E+00
+ PKER_SWETH( 25, 62) = 0.225162E+00
+ PKER_SWETH( 25, 63) = 0.228799E+00
+ PKER_SWETH( 25, 64) = 0.232210E+00
+ PKER_SWETH( 25, 65) = 0.235409E+00
+ PKER_SWETH( 25, 66) = 0.238411E+00
+ PKER_SWETH( 25, 67) = 0.241227E+00
+ PKER_SWETH( 25, 68) = 0.243871E+00
+ PKER_SWETH( 25, 69) = 0.246352E+00
+ PKER_SWETH( 25, 70) = 0.248680E+00
+ PKER_SWETH( 25, 71) = 0.250866E+00
+ PKER_SWETH( 25, 72) = 0.252918E+00
+ PKER_SWETH( 25, 73) = 0.254844E+00
+ PKER_SWETH( 25, 74) = 0.256652E+00
+ PKER_SWETH( 25, 75) = 0.258350E+00
+ PKER_SWETH( 25, 76) = 0.259944E+00
+ PKER_SWETH( 25, 77) = 0.261440E+00
+ PKER_SWETH( 25, 78) = 0.262845E+00
+ PKER_SWETH( 25, 79) = 0.264164E+00
+ PKER_SWETH( 25, 80) = 0.265403E+00
+ PKER_SWETH( 26, 1) = 0.300615E+01
+ PKER_SWETH( 26, 2) = 0.280977E+01
+ PKER_SWETH( 26, 3) = 0.262538E+01
+ PKER_SWETH( 26, 4) = 0.245223E+01
+ PKER_SWETH( 26, 5) = 0.228964E+01
+ PKER_SWETH( 26, 6) = 0.213697E+01
+ PKER_SWETH( 26, 7) = 0.199360E+01
+ PKER_SWETH( 26, 8) = 0.185898E+01
+ PKER_SWETH( 26, 9) = 0.173256E+01
+ PKER_SWETH( 26, 10) = 0.161385E+01
+ PKER_SWETH( 26, 11) = 0.150236E+01
+ PKER_SWETH( 26, 12) = 0.139766E+01
+ PKER_SWETH( 26, 13) = 0.129933E+01
+ PKER_SWETH( 26, 14) = 0.120698E+01
+ PKER_SWETH( 26, 15) = 0.112024E+01
+ PKER_SWETH( 26, 16) = 0.103876E+01
+ PKER_SWETH( 26, 17) = 0.962205E+00
+ PKER_SWETH( 26, 18) = 0.890279E+00
+ PKER_SWETH( 26, 19) = 0.822684E+00
+ PKER_SWETH( 26, 20) = 0.759146E+00
+ PKER_SWETH( 26, 21) = 0.699404E+00
+ PKER_SWETH( 26, 22) = 0.643208E+00
+ PKER_SWETH( 26, 23) = 0.590322E+00
+ PKER_SWETH( 26, 24) = 0.540522E+00
+ PKER_SWETH( 26, 25) = 0.493591E+00
+ PKER_SWETH( 26, 26) = 0.449320E+00
+ PKER_SWETH( 26, 27) = 0.407511E+00
+ PKER_SWETH( 26, 28) = 0.367971E+00
+ PKER_SWETH( 26, 29) = 0.330516E+00
+ PKER_SWETH( 26, 30) = 0.294977E+00
+ PKER_SWETH( 26, 31) = 0.261206E+00
+ PKER_SWETH( 26, 32) = 0.229091E+00
+ PKER_SWETH( 26, 33) = 0.198592E+00
+ PKER_SWETH( 26, 34) = 0.169777E+00
+ PKER_SWETH( 26, 35) = 0.142869E+00
+ PKER_SWETH( 26, 36) = 0.118292E+00
+ PKER_SWETH( 26, 37) = 0.966610E-01
+ PKER_SWETH( 26, 38) = 0.786825E-01
+ PKER_SWETH( 26, 39) = 0.650023E-01
+ PKER_SWETH( 26, 40) = 0.560497E-01
+ PKER_SWETH( 26, 41) = 0.518524E-01
+ PKER_SWETH( 26, 42) = 0.519800E-01
+ PKER_SWETH( 26, 43) = 0.557183E-01
+ PKER_SWETH( 26, 44) = 0.621393E-01
+ PKER_SWETH( 26, 45) = 0.703233E-01
+ PKER_SWETH( 26, 46) = 0.794632E-01
+ PKER_SWETH( 26, 47) = 0.889548E-01
+ PKER_SWETH( 26, 48) = 0.983834E-01
+ PKER_SWETH( 26, 49) = 0.107490E+00
+ PKER_SWETH( 26, 50) = 0.116142E+00
+ PKER_SWETH( 26, 51) = 0.124280E+00
+ PKER_SWETH( 26, 52) = 0.131897E+00
+ PKER_SWETH( 26, 53) = 0.139007E+00
+ PKER_SWETH( 26, 54) = 0.145642E+00
+ PKER_SWETH( 26, 55) = 0.151833E+00
+ PKER_SWETH( 26, 56) = 0.157614E+00
+ PKER_SWETH( 26, 57) = 0.163015E+00
+ PKER_SWETH( 26, 58) = 0.168066E+00
+ PKER_SWETH( 26, 59) = 0.172792E+00
+ PKER_SWETH( 26, 60) = 0.177216E+00
+ PKER_SWETH( 26, 61) = 0.181360E+00
+ PKER_SWETH( 26, 62) = 0.185244E+00
+ PKER_SWETH( 26, 63) = 0.188884E+00
+ PKER_SWETH( 26, 64) = 0.192298E+00
+ PKER_SWETH( 26, 65) = 0.195499E+00
+ PKER_SWETH( 26, 66) = 0.198503E+00
+ PKER_SWETH( 26, 67) = 0.201320E+00
+ PKER_SWETH( 26, 68) = 0.203965E+00
+ PKER_SWETH( 26, 69) = 0.206446E+00
+ PKER_SWETH( 26, 70) = 0.208775E+00
+ PKER_SWETH( 26, 71) = 0.210961E+00
+ PKER_SWETH( 26, 72) = 0.213013E+00
+ PKER_SWETH( 26, 73) = 0.214940E+00
+ PKER_SWETH( 26, 74) = 0.216748E+00
+ PKER_SWETH( 26, 75) = 0.218446E+00
+ PKER_SWETH( 26, 76) = 0.220040E+00
+ PKER_SWETH( 26, 77) = 0.221537E+00
+ PKER_SWETH( 26, 78) = 0.222942E+00
+ PKER_SWETH( 26, 79) = 0.224261E+00
+ PKER_SWETH( 26, 80) = 0.225500E+00
+ PKER_SWETH( 27, 1) = 0.303590E+01
+ PKER_SWETH( 27, 2) = 0.283953E+01
+ PKER_SWETH( 27, 3) = 0.265514E+01
+ PKER_SWETH( 27, 4) = 0.248199E+01
+ PKER_SWETH( 27, 5) = 0.231941E+01
+ PKER_SWETH( 27, 6) = 0.216674E+01
+ PKER_SWETH( 27, 7) = 0.202338E+01
+ PKER_SWETH( 27, 8) = 0.188877E+01
+ PKER_SWETH( 27, 9) = 0.176236E+01
+ PKER_SWETH( 27, 10) = 0.164366E+01
+ PKER_SWETH( 27, 11) = 0.153218E+01
+ PKER_SWETH( 27, 12) = 0.142750E+01
+ PKER_SWETH( 27, 13) = 0.132919E+01
+ PKER_SWETH( 27, 14) = 0.123687E+01
+ PKER_SWETH( 27, 15) = 0.115015E+01
+ PKER_SWETH( 27, 16) = 0.106870E+01
+ PKER_SWETH( 27, 17) = 0.992194E+00
+ PKER_SWETH( 27, 18) = 0.920318E+00
+ PKER_SWETH( 27, 19) = 0.852785E+00
+ PKER_SWETH( 27, 20) = 0.789320E+00
+ PKER_SWETH( 27, 21) = 0.729667E+00
+ PKER_SWETH( 27, 22) = 0.673578E+00
+ PKER_SWETH( 27, 23) = 0.620822E+00
+ PKER_SWETH( 27, 24) = 0.571178E+00
+ PKER_SWETH( 27, 25) = 0.524434E+00
+ PKER_SWETH( 27, 26) = 0.480388E+00
+ PKER_SWETH( 27, 27) = 0.438846E+00
+ PKER_SWETH( 27, 28) = 0.399622E+00
+ PKER_SWETH( 27, 29) = 0.362534E+00
+ PKER_SWETH( 27, 30) = 0.327412E+00
+ PKER_SWETH( 27, 31) = 0.294092E+00
+ PKER_SWETH( 27, 32) = 0.262426E+00
+ PKER_SWETH( 27, 33) = 0.232290E+00
+ PKER_SWETH( 27, 34) = 0.203599E+00
+ PKER_SWETH( 27, 35) = 0.176334E+00
+ PKER_SWETH( 27, 36) = 0.150579E+00
+ PKER_SWETH( 27, 37) = 0.126557E+00
+ PKER_SWETH( 27, 38) = 0.104653E+00
+ PKER_SWETH( 27, 39) = 0.854039E-01
+ PKER_SWETH( 27, 40) = 0.693914E-01
+ PKER_SWETH( 27, 41) = 0.571427E-01
+ PKER_SWETH( 27, 42) = 0.489777E-01
+ PKER_SWETH( 27, 43) = 0.448639E-01
+ PKER_SWETH( 27, 44) = 0.444652E-01
+ PKER_SWETH( 27, 45) = 0.471717E-01
+ PKER_SWETH( 27, 46) = 0.522132E-01
+ PKER_SWETH( 27, 47) = 0.588533E-01
+ PKER_SWETH( 27, 48) = 0.664103E-01
+ PKER_SWETH( 27, 49) = 0.743760E-01
+ PKER_SWETH( 27, 50) = 0.823690E-01
+ PKER_SWETH( 27, 51) = 0.901537E-01
+ PKER_SWETH( 27, 52) = 0.975988E-01
+ PKER_SWETH( 27, 53) = 0.104637E+00
+ PKER_SWETH( 27, 54) = 0.111249E+00
+ PKER_SWETH( 27, 55) = 0.117442E+00
+ PKER_SWETH( 27, 56) = 0.123234E+00
+ PKER_SWETH( 27, 57) = 0.128648E+00
+ PKER_SWETH( 27, 58) = 0.133711E+00
+ PKER_SWETH( 27, 59) = 0.138448E+00
+ PKER_SWETH( 27, 60) = 0.142881E+00
+ PKER_SWETH( 27, 61) = 0.147032E+00
+ PKER_SWETH( 27, 62) = 0.150920E+00
+ PKER_SWETH( 27, 63) = 0.154565E+00
+ PKER_SWETH( 27, 64) = 0.157982E+00
+ PKER_SWETH( 27, 65) = 0.161186E+00
+ PKER_SWETH( 27, 66) = 0.164191E+00
+ PKER_SWETH( 27, 67) = 0.167010E+00
+ PKER_SWETH( 27, 68) = 0.169655E+00
+ PKER_SWETH( 27, 69) = 0.172138E+00
+ PKER_SWETH( 27, 70) = 0.174467E+00
+ PKER_SWETH( 27, 71) = 0.176654E+00
+ PKER_SWETH( 27, 72) = 0.178707E+00
+ PKER_SWETH( 27, 73) = 0.180633E+00
+ PKER_SWETH( 27, 74) = 0.182442E+00
+ PKER_SWETH( 27, 75) = 0.184140E+00
+ PKER_SWETH( 27, 76) = 0.185734E+00
+ PKER_SWETH( 27, 77) = 0.187231E+00
+ PKER_SWETH( 27, 78) = 0.188636E+00
+ PKER_SWETH( 27, 79) = 0.189955E+00
+ PKER_SWETH( 27, 80) = 0.191194E+00
+ PKER_SWETH( 28, 1) = 0.306148E+01
+ PKER_SWETH( 28, 2) = 0.286511E+01
+ PKER_SWETH( 28, 3) = 0.268072E+01
+ PKER_SWETH( 28, 4) = 0.250758E+01
+ PKER_SWETH( 28, 5) = 0.234500E+01
+ PKER_SWETH( 28, 6) = 0.219234E+01
+ PKER_SWETH( 28, 7) = 0.204898E+01
+ PKER_SWETH( 28, 8) = 0.191437E+01
+ PKER_SWETH( 28, 9) = 0.178797E+01
+ PKER_SWETH( 28, 10) = 0.166928E+01
+ PKER_SWETH( 28, 11) = 0.155782E+01
+ PKER_SWETH( 28, 12) = 0.145315E+01
+ PKER_SWETH( 28, 13) = 0.135485E+01
+ PKER_SWETH( 28, 14) = 0.126254E+01
+ PKER_SWETH( 28, 15) = 0.117585E+01
+ PKER_SWETH( 28, 16) = 0.109443E+01
+ PKER_SWETH( 28, 17) = 0.101795E+01
+ PKER_SWETH( 28, 18) = 0.946114E+00
+ PKER_SWETH( 28, 19) = 0.878627E+00
+ PKER_SWETH( 28, 20) = 0.815218E+00
+ PKER_SWETH( 28, 21) = 0.755631E+00
+ PKER_SWETH( 28, 22) = 0.699623E+00
+ PKER_SWETH( 28, 23) = 0.646965E+00
+ PKER_SWETH( 28, 24) = 0.597438E+00
+ PKER_SWETH( 28, 25) = 0.550835E+00
+ PKER_SWETH( 28, 26) = 0.506959E+00
+ PKER_SWETH( 28, 27) = 0.465619E+00
+ PKER_SWETH( 28, 28) = 0.426636E+00
+ PKER_SWETH( 28, 29) = 0.389834E+00
+ PKER_SWETH( 28, 30) = 0.355045E+00
+ PKER_SWETH( 28, 31) = 0.322108E+00
+ PKER_SWETH( 28, 32) = 0.290872E+00
+ PKER_SWETH( 28, 33) = 0.261193E+00
+ PKER_SWETH( 28, 34) = 0.232948E+00
+ PKER_SWETH( 28, 35) = 0.206039E+00
+ PKER_SWETH( 28, 36) = 0.180409E+00
+ PKER_SWETH( 28, 37) = 0.156068E+00
+ PKER_SWETH( 28, 38) = 0.133115E+00
+ PKER_SWETH( 28, 39) = 0.111765E+00
+ PKER_SWETH( 28, 40) = 0.923608E-01
+ PKER_SWETH( 28, 41) = 0.753445E-01
+ PKER_SWETH( 28, 42) = 0.611817E-01
+ PKER_SWETH( 28, 43) = 0.502690E-01
+ PKER_SWETH( 28, 44) = 0.428431E-01
+ PKER_SWETH( 28, 45) = 0.388528E-01
+ PKER_SWETH( 28, 46) = 0.380123E-01
+ PKER_SWETH( 28, 47) = 0.398568E-01
+ PKER_SWETH( 28, 48) = 0.437542E-01
+ PKER_SWETH( 28, 49) = 0.490872E-01
+ PKER_SWETH( 28, 50) = 0.553254E-01
+ PKER_SWETH( 28, 51) = 0.619931E-01
+ PKER_SWETH( 28, 52) = 0.687719E-01
+ PKER_SWETH( 28, 53) = 0.754350E-01
+ PKER_SWETH( 28, 54) = 0.818527E-01
+ PKER_SWETH( 28, 55) = 0.879516E-01
+ PKER_SWETH( 28, 56) = 0.937041E-01
+ PKER_SWETH( 28, 57) = 0.991077E-01
+ PKER_SWETH( 28, 58) = 0.104172E+00
+ PKER_SWETH( 28, 59) = 0.108914E+00
+ PKER_SWETH( 28, 60) = 0.113354E+00
+ PKER_SWETH( 28, 61) = 0.117512E+00
+ PKER_SWETH( 28, 62) = 0.121407E+00
+ PKER_SWETH( 28, 63) = 0.125056E+00
+ PKER_SWETH( 28, 64) = 0.128476E+00
+ PKER_SWETH( 28, 65) = 0.131683E+00
+ PKER_SWETH( 28, 66) = 0.134690E+00
+ PKER_SWETH( 28, 67) = 0.137511E+00
+ PKER_SWETH( 28, 68) = 0.140158E+00
+ PKER_SWETH( 28, 69) = 0.142641E+00
+ PKER_SWETH( 28, 70) = 0.144972E+00
+ PKER_SWETH( 28, 71) = 0.147159E+00
+ PKER_SWETH( 28, 72) = 0.149212E+00
+ PKER_SWETH( 28, 73) = 0.151139E+00
+ PKER_SWETH( 28, 74) = 0.152948E+00
+ PKER_SWETH( 28, 75) = 0.154646E+00
+ PKER_SWETH( 28, 76) = 0.156240E+00
+ PKER_SWETH( 28, 77) = 0.157737E+00
+ PKER_SWETH( 28, 78) = 0.159143E+00
+ PKER_SWETH( 28, 79) = 0.160462E+00
+ PKER_SWETH( 28, 80) = 0.161701E+00
+ PKER_SWETH( 29, 1) = 0.308347E+01
+ PKER_SWETH( 29, 2) = 0.288710E+01
+ PKER_SWETH( 29, 3) = 0.270272E+01
+ PKER_SWETH( 29, 4) = 0.252958E+01
+ PKER_SWETH( 29, 5) = 0.236700E+01
+ PKER_SWETH( 29, 6) = 0.221434E+01
+ PKER_SWETH( 29, 7) = 0.207099E+01
+ PKER_SWETH( 29, 8) = 0.193639E+01
+ PKER_SWETH( 29, 9) = 0.180999E+01
+ PKER_SWETH( 29, 10) = 0.169130E+01
+ PKER_SWETH( 29, 11) = 0.157985E+01
+ PKER_SWETH( 29, 12) = 0.147519E+01
+ PKER_SWETH( 29, 13) = 0.137691E+01
+ PKER_SWETH( 29, 14) = 0.128461E+01
+ PKER_SWETH( 29, 15) = 0.119793E+01
+ PKER_SWETH( 29, 16) = 0.111653E+01
+ PKER_SWETH( 29, 17) = 0.104008E+01
+ PKER_SWETH( 29, 18) = 0.968270E+00
+ PKER_SWETH( 29, 19) = 0.900817E+00
+ PKER_SWETH( 29, 20) = 0.837451E+00
+ PKER_SWETH( 29, 21) = 0.777915E+00
+ PKER_SWETH( 29, 22) = 0.721968E+00
+ PKER_SWETH( 29, 23) = 0.669383E+00
+ PKER_SWETH( 29, 24) = 0.619944E+00
+ PKER_SWETH( 29, 25) = 0.573448E+00
+ PKER_SWETH( 29, 26) = 0.529699E+00
+ PKER_SWETH( 29, 27) = 0.488512E+00
+ PKER_SWETH( 29, 28) = 0.449712E+00
+ PKER_SWETH( 29, 29) = 0.413127E+00
+ PKER_SWETH( 29, 30) = 0.378596E+00
+ PKER_SWETH( 29, 31) = 0.345961E+00
+ PKER_SWETH( 29, 32) = 0.315072E+00
+ PKER_SWETH( 29, 33) = 0.285787E+00
+ PKER_SWETH( 29, 34) = 0.257972E+00
+ PKER_SWETH( 29, 35) = 0.231509E+00
+ PKER_SWETH( 29, 36) = 0.206298E+00
+ PKER_SWETH( 29, 37) = 0.182272E+00
+ PKER_SWETH( 29, 38) = 0.159406E+00
+ PKER_SWETH( 29, 39) = 0.137733E+00
+ PKER_SWETH( 29, 40) = 0.117365E+00
+ PKER_SWETH( 29, 41) = 0.984979E-01
+ PKER_SWETH( 29, 42) = 0.814212E-01
+ PKER_SWETH( 29, 43) = 0.664782E-01
+ PKER_SWETH( 29, 44) = 0.540142E-01
+ PKER_SWETH( 29, 45) = 0.443303E-01
+ PKER_SWETH( 29, 46) = 0.375787E-01
+ PKER_SWETH( 29, 47) = 0.337194E-01
+ PKER_SWETH( 29, 48) = 0.325388E-01
+ PKER_SWETH( 29, 49) = 0.336514E-01
+ PKER_SWETH( 29, 50) = 0.365861E-01
+ PKER_SWETH( 29, 51) = 0.408448E-01
+ PKER_SWETH( 29, 52) = 0.459450E-01
+ PKER_SWETH( 29, 53) = 0.515262E-01
+ PKER_SWETH( 29, 54) = 0.572696E-01
+ PKER_SWETH( 29, 55) = 0.629759E-01
+ PKER_SWETH( 29, 56) = 0.685136E-01
+ PKER_SWETH( 29, 57) = 0.738057E-01
+ PKER_SWETH( 29, 58) = 0.788178E-01
+ PKER_SWETH( 29, 59) = 0.835388E-01
+ PKER_SWETH( 29, 60) = 0.879729E-01
+ PKER_SWETH( 29, 61) = 0.921314E-01
+ PKER_SWETH( 29, 62) = 0.960291E-01
+ PKER_SWETH( 29, 63) = 0.996821E-01
+ PKER_SWETH( 29, 64) = 0.103106E+00
+ PKER_SWETH( 29, 65) = 0.106316E+00
+ PKER_SWETH( 29, 66) = 0.109326E+00
+ PKER_SWETH( 29, 67) = 0.112149E+00
+ PKER_SWETH( 29, 68) = 0.114797E+00
+ PKER_SWETH( 29, 69) = 0.117281E+00
+ PKER_SWETH( 29, 70) = 0.119613E+00
+ PKER_SWETH( 29, 71) = 0.121801E+00
+ PKER_SWETH( 29, 72) = 0.123854E+00
+ PKER_SWETH( 29, 73) = 0.125782E+00
+ PKER_SWETH( 29, 74) = 0.127591E+00
+ PKER_SWETH( 29, 75) = 0.129289E+00
+ PKER_SWETH( 29, 76) = 0.130884E+00
+ PKER_SWETH( 29, 77) = 0.132381E+00
+ PKER_SWETH( 29, 78) = 0.133786E+00
+ PKER_SWETH( 29, 79) = 0.135106E+00
+ PKER_SWETH( 29, 80) = 0.136344E+00
+ PKER_SWETH( 30, 1) = 0.310238E+01
+ PKER_SWETH( 30, 2) = 0.290601E+01
+ PKER_SWETH( 30, 3) = 0.272162E+01
+ PKER_SWETH( 30, 4) = 0.254849E+01
+ PKER_SWETH( 30, 5) = 0.238591E+01
+ PKER_SWETH( 30, 6) = 0.223325E+01
+ PKER_SWETH( 30, 7) = 0.208991E+01
+ PKER_SWETH( 30, 8) = 0.195531E+01
+ PKER_SWETH( 30, 9) = 0.182891E+01
+ PKER_SWETH( 30, 10) = 0.171023E+01
+ PKER_SWETH( 30, 11) = 0.159878E+01
+ PKER_SWETH( 30, 12) = 0.149413E+01
+ PKER_SWETH( 30, 13) = 0.139586E+01
+ PKER_SWETH( 30, 14) = 0.130357E+01
+ PKER_SWETH( 30, 15) = 0.121691E+01
+ PKER_SWETH( 30, 16) = 0.113552E+01
+ PKER_SWETH( 30, 17) = 0.105909E+01
+ PKER_SWETH( 30, 18) = 0.987301E+00
+ PKER_SWETH( 30, 19) = 0.919876E+00
+ PKER_SWETH( 30, 20) = 0.856541E+00
+ PKER_SWETH( 30, 21) = 0.797043E+00
+ PKER_SWETH( 30, 22) = 0.741143E+00
+ PKER_SWETH( 30, 23) = 0.688613E+00
+ PKER_SWETH( 30, 24) = 0.639241E+00
+ PKER_SWETH( 30, 25) = 0.592825E+00
+ PKER_SWETH( 30, 26) = 0.549173E+00
+ PKER_SWETH( 30, 27) = 0.508102E+00
+ PKER_SWETH( 30, 28) = 0.469441E+00
+ PKER_SWETH( 30, 29) = 0.433022E+00
+ PKER_SWETH( 30, 30) = 0.398687E+00
+ PKER_SWETH( 30, 31) = 0.366284E+00
+ PKER_SWETH( 30, 32) = 0.335667E+00
+ PKER_SWETH( 30, 33) = 0.306696E+00
+ PKER_SWETH( 30, 34) = 0.279238E+00
+ PKER_SWETH( 30, 35) = 0.253167E+00
+ PKER_SWETH( 30, 36) = 0.228374E+00
+ PKER_SWETH( 30, 37) = 0.204762E+00
+ PKER_SWETH( 30, 38) = 0.182262E+00
+ PKER_SWETH( 30, 39) = 0.160835E+00
+ PKER_SWETH( 30, 40) = 0.140485E+00
+ PKER_SWETH( 30, 41) = 0.121268E+00
+ PKER_SWETH( 30, 42) = 0.103293E+00
+ PKER_SWETH( 30, 43) = 0.867296E-01
+ PKER_SWETH( 30, 44) = 0.717964E-01
+ PKER_SWETH( 30, 45) = 0.587461E-01
+ PKER_SWETH( 30, 46) = 0.478245E-01
+ PKER_SWETH( 30, 47) = 0.392417E-01
+ PKER_SWETH( 30, 48) = 0.331060E-01
+ PKER_SWETH( 30, 49) = 0.293783E-01
+ PKER_SWETH( 30, 50) = 0.279234E-01
+ PKER_SWETH( 30, 51) = 0.284480E-01
+ PKER_SWETH( 30, 52) = 0.305694E-01
+ PKER_SWETH( 30, 53) = 0.339106E-01
+ PKER_SWETH( 30, 54) = 0.380759E-01
+ PKER_SWETH( 30, 55) = 0.427144E-01
+ PKER_SWETH( 30, 56) = 0.475751E-01
+ PKER_SWETH( 30, 57) = 0.524601E-01
+ PKER_SWETH( 30, 58) = 0.572399E-01
+ PKER_SWETH( 30, 59) = 0.618346E-01
+ PKER_SWETH( 30, 60) = 0.662050E-01
+ PKER_SWETH( 30, 61) = 0.703339E-01
+ PKER_SWETH( 30, 62) = 0.742197E-01
+ PKER_SWETH( 30, 63) = 0.778693E-01
+ PKER_SWETH( 30, 64) = 0.812936E-01
+ PKER_SWETH( 30, 65) = 0.845052E-01
+ PKER_SWETH( 30, 66) = 0.875171E-01
+ PKER_SWETH( 30, 67) = 0.903420E-01
+ PKER_SWETH( 30, 68) = 0.929917E-01
+ PKER_SWETH( 30, 69) = 0.954775E-01
+ PKER_SWETH( 30, 70) = 0.978099E-01
+ PKER_SWETH( 30, 71) = 0.999987E-01
+ PKER_SWETH( 30, 72) = 0.102053E+00
+ PKER_SWETH( 30, 73) = 0.103981E+00
+ PKER_SWETH( 30, 74) = 0.105790E+00
+ PKER_SWETH( 30, 75) = 0.107489E+00
+ PKER_SWETH( 30, 76) = 0.109084E+00
+ PKER_SWETH( 30, 77) = 0.110581E+00
+ PKER_SWETH( 30, 78) = 0.111986E+00
+ PKER_SWETH( 30, 79) = 0.113306E+00
+ PKER_SWETH( 30, 80) = 0.114545E+00
+ PKER_SWETH( 31, 1) = 0.311863E+01
+ PKER_SWETH( 31, 2) = 0.292226E+01
+ PKER_SWETH( 31, 3) = 0.273788E+01
+ PKER_SWETH( 31, 4) = 0.256474E+01
+ PKER_SWETH( 31, 5) = 0.240217E+01
+ PKER_SWETH( 31, 6) = 0.224951E+01
+ PKER_SWETH( 31, 7) = 0.210617E+01
+ PKER_SWETH( 31, 8) = 0.197157E+01
+ PKER_SWETH( 31, 9) = 0.184518E+01
+ PKER_SWETH( 31, 10) = 0.172650E+01
+ PKER_SWETH( 31, 11) = 0.161506E+01
+ PKER_SWETH( 31, 12) = 0.151041E+01
+ PKER_SWETH( 31, 13) = 0.141215E+01
+ PKER_SWETH( 31, 14) = 0.131987E+01
+ PKER_SWETH( 31, 15) = 0.123322E+01
+ PKER_SWETH( 31, 16) = 0.115184E+01
+ PKER_SWETH( 31, 17) = 0.107542E+01
+ PKER_SWETH( 31, 18) = 0.100365E+01
+ PKER_SWETH( 31, 19) = 0.936246E+00
+ PKER_SWETH( 31, 20) = 0.872936E+00
+ PKER_SWETH( 31, 21) = 0.813467E+00
+ PKER_SWETH( 31, 22) = 0.757602E+00
+ PKER_SWETH( 31, 23) = 0.705114E+00
+ PKER_SWETH( 31, 24) = 0.655793E+00
+ PKER_SWETH( 31, 25) = 0.609438E+00
+ PKER_SWETH( 31, 26) = 0.565859E+00
+ PKER_SWETH( 31, 27) = 0.524877E+00
+ PKER_SWETH( 31, 28) = 0.486320E+00
+ PKER_SWETH( 31, 29) = 0.450027E+00
+ PKER_SWETH( 31, 30) = 0.415842E+00
+ PKER_SWETH( 31, 31) = 0.383618E+00
+ PKER_SWETH( 31, 32) = 0.353211E+00
+ PKER_SWETH( 31, 33) = 0.324485E+00
+ PKER_SWETH( 31, 34) = 0.297310E+00
+ PKER_SWETH( 31, 35) = 0.271562E+00
+ PKER_SWETH( 31, 36) = 0.247124E+00
+ PKER_SWETH( 31, 37) = 0.223892E+00
+ PKER_SWETH( 31, 38) = 0.201777E+00
+ PKER_SWETH( 31, 39) = 0.180710E+00
+ PKER_SWETH( 31, 40) = 0.160650E+00
+ PKER_SWETH( 31, 41) = 0.141588E+00
+ PKER_SWETH( 31, 42) = 0.123552E+00
+ PKER_SWETH( 31, 43) = 0.106604E+00
+ PKER_SWETH( 31, 44) = 0.908414E-01
+ PKER_SWETH( 31, 45) = 0.763931E-01
+ PKER_SWETH( 31, 46) = 0.634109E-01
+ PKER_SWETH( 31, 47) = 0.520606E-01
+ PKER_SWETH( 31, 48) = 0.425084E-01
+ PKER_SWETH( 31, 49) = 0.349021E-01
+ PKER_SWETH( 31, 50) = 0.293151E-01
+ PKER_SWETH( 31, 51) = 0.257350E-01
+ PKER_SWETH( 31, 52) = 0.240679E-01
+ PKER_SWETH( 31, 53) = 0.241097E-01
+ PKER_SWETH( 31, 54) = 0.255670E-01
+ PKER_SWETH( 31, 55) = 0.281346E-01
+ PKER_SWETH( 31, 56) = 0.314877E-01
+ PKER_SWETH( 31, 57) = 0.353359E-01
+ PKER_SWETH( 31, 58) = 0.394363E-01
+ PKER_SWETH( 31, 59) = 0.436099E-01
+ PKER_SWETH( 31, 60) = 0.477319E-01
+ PKER_SWETH( 31, 61) = 0.517211E-01
+ PKER_SWETH( 31, 62) = 0.555332E-01
+ PKER_SWETH( 31, 63) = 0.591462E-01
+ PKER_SWETH( 31, 64) = 0.625536E-01
+ PKER_SWETH( 31, 65) = 0.657586E-01
+ PKER_SWETH( 31, 66) = 0.687686E-01
+ PKER_SWETH( 31, 67) = 0.715936E-01
+ PKER_SWETH( 31, 68) = 0.742443E-01
+ PKER_SWETH( 31, 69) = 0.767313E-01
+ PKER_SWETH( 31, 70) = 0.790647E-01
+ PKER_SWETH( 31, 71) = 0.812543E-01
+ PKER_SWETH( 31, 72) = 0.833091E-01
+ PKER_SWETH( 31, 73) = 0.852376E-01
+ PKER_SWETH( 31, 74) = 0.870477E-01
+ PKER_SWETH( 31, 75) = 0.887468E-01
+ PKER_SWETH( 31, 76) = 0.903417E-01
+ PKER_SWETH( 31, 77) = 0.918390E-01
+ PKER_SWETH( 31, 78) = 0.932447E-01
+ PKER_SWETH( 31, 79) = 0.945644E-01
+ PKER_SWETH( 31, 80) = 0.958034E-01
+ PKER_SWETH( 32, 1) = 0.313260E+01
+ PKER_SWETH( 32, 2) = 0.293624E+01
+ PKER_SWETH( 32, 3) = 0.275185E+01
+ PKER_SWETH( 32, 4) = 0.257872E+01
+ PKER_SWETH( 32, 5) = 0.241614E+01
+ PKER_SWETH( 32, 6) = 0.226349E+01
+ PKER_SWETH( 32, 7) = 0.212015E+01
+ PKER_SWETH( 32, 8) = 0.198555E+01
+ PKER_SWETH( 32, 9) = 0.185917E+01
+ PKER_SWETH( 32, 10) = 0.174049E+01
+ PKER_SWETH( 32, 11) = 0.162905E+01
+ PKER_SWETH( 32, 12) = 0.152441E+01
+ PKER_SWETH( 32, 13) = 0.142615E+01
+ PKER_SWETH( 32, 14) = 0.133388E+01
+ PKER_SWETH( 32, 15) = 0.124723E+01
+ PKER_SWETH( 32, 16) = 0.116587E+01
+ PKER_SWETH( 32, 17) = 0.108946E+01
+ PKER_SWETH( 32, 18) = 0.101770E+01
+ PKER_SWETH( 32, 19) = 0.950309E+00
+ PKER_SWETH( 32, 20) = 0.887017E+00
+ PKER_SWETH( 32, 21) = 0.827571E+00
+ PKER_SWETH( 32, 22) = 0.771732E+00
+ PKER_SWETH( 32, 23) = 0.719277E+00
+ PKER_SWETH( 32, 24) = 0.669995E+00
+ PKER_SWETH( 32, 25) = 0.623686E+00
+ PKER_SWETH( 32, 26) = 0.580163E+00
+ PKER_SWETH( 32, 27) = 0.539247E+00
+ PKER_SWETH( 32, 28) = 0.500771E+00
+ PKER_SWETH( 32, 29) = 0.464574E+00
+ PKER_SWETH( 32, 30) = 0.430504E+00
+ PKER_SWETH( 32, 31) = 0.398415E+00
+ PKER_SWETH( 32, 32) = 0.368170E+00
+ PKER_SWETH( 32, 33) = 0.339635E+00
+ PKER_SWETH( 32, 34) = 0.312682E+00
+ PKER_SWETH( 32, 35) = 0.287189E+00
+ PKER_SWETH( 32, 36) = 0.263042E+00
+ PKER_SWETH( 32, 37) = 0.240131E+00
+ PKER_SWETH( 32, 38) = 0.218359E+00
+ PKER_SWETH( 32, 39) = 0.197643E+00
+ PKER_SWETH( 32, 40) = 0.177917E+00
+ PKER_SWETH( 32, 41) = 0.159141E+00
+ PKER_SWETH( 32, 42) = 0.141300E+00
+ PKER_SWETH( 32, 43) = 0.124409E+00
+ PKER_SWETH( 32, 44) = 0.108506E+00
+ PKER_SWETH( 32, 45) = 0.936524E-01
+ PKER_SWETH( 32, 46) = 0.799192E-01
+ PKER_SWETH( 32, 47) = 0.673874E-01
+ PKER_SWETH( 32, 48) = 0.561491E-01
+ PKER_SWETH( 32, 49) = 0.463031E-01
+ PKER_SWETH( 32, 50) = 0.379538E-01
+ PKER_SWETH( 32, 51) = 0.312049E-01
+ PKER_SWETH( 32, 52) = 0.261105E-01
+ PKER_SWETH( 32, 53) = 0.226845E-01
+ PKER_SWETH( 32, 54) = 0.208720E-01
+ PKER_SWETH( 32, 55) = 0.205205E-01
+ PKER_SWETH( 32, 56) = 0.214305E-01
+ PKER_SWETH( 32, 57) = 0.233522E-01
+ PKER_SWETH( 32, 58) = 0.260139E-01
+ PKER_SWETH( 32, 59) = 0.291765E-01
+ PKER_SWETH( 32, 60) = 0.326186E-01
+ PKER_SWETH( 32, 61) = 0.361785E-01
+ PKER_SWETH( 32, 62) = 0.397295E-01
+ PKER_SWETH( 32, 63) = 0.431912E-01
+ PKER_SWETH( 32, 64) = 0.465163E-01
+ PKER_SWETH( 32, 65) = 0.496779E-01
+ PKER_SWETH( 32, 66) = 0.526668E-01
+ PKER_SWETH( 32, 67) = 0.554823E-01
+ PKER_SWETH( 32, 68) = 0.581292E-01
+ PKER_SWETH( 32, 69) = 0.606151E-01
+ PKER_SWETH( 32, 70) = 0.629486E-01
+ PKER_SWETH( 32, 71) = 0.651387E-01
+ PKER_SWETH( 32, 72) = 0.671941E-01
+ PKER_SWETH( 32, 73) = 0.691232E-01
+ PKER_SWETH( 32, 74) = 0.709337E-01
+ PKER_SWETH( 32, 75) = 0.726332E-01
+ PKER_SWETH( 32, 76) = 0.742284E-01
+ PKER_SWETH( 32, 77) = 0.757259E-01
+ PKER_SWETH( 32, 78) = 0.771318E-01
+ PKER_SWETH( 32, 79) = 0.784516E-01
+ PKER_SWETH( 32, 80) = 0.796907E-01
+ PKER_SWETH( 33, 1) = 0.314461E+01
+ PKER_SWETH( 33, 2) = 0.294825E+01
+ PKER_SWETH( 33, 3) = 0.276386E+01
+ PKER_SWETH( 33, 4) = 0.259073E+01
+ PKER_SWETH( 33, 5) = 0.242816E+01
+ PKER_SWETH( 33, 6) = 0.227551E+01
+ PKER_SWETH( 33, 7) = 0.213217E+01
+ PKER_SWETH( 33, 8) = 0.199757E+01
+ PKER_SWETH( 33, 9) = 0.187119E+01
+ PKER_SWETH( 33, 10) = 0.175251E+01
+ PKER_SWETH( 33, 11) = 0.164108E+01
+ PKER_SWETH( 33, 12) = 0.153644E+01
+ PKER_SWETH( 33, 13) = 0.143818E+01
+ PKER_SWETH( 33, 14) = 0.134592E+01
+ PKER_SWETH( 33, 15) = 0.125928E+01
+ PKER_SWETH( 33, 16) = 0.117792E+01
+ PKER_SWETH( 33, 17) = 0.110152E+01
+ PKER_SWETH( 33, 18) = 0.102977E+01
+ PKER_SWETH( 33, 19) = 0.962391E+00
+ PKER_SWETH( 33, 20) = 0.899114E+00
+ PKER_SWETH( 33, 21) = 0.839685E+00
+ PKER_SWETH( 33, 22) = 0.783867E+00
+ PKER_SWETH( 33, 23) = 0.731436E+00
+ PKER_SWETH( 33, 24) = 0.682183E+00
+ PKER_SWETH( 33, 25) = 0.635910E+00
+ PKER_SWETH( 33, 26) = 0.592429E+00
+ PKER_SWETH( 33, 27) = 0.551564E+00
+ PKER_SWETH( 33, 28) = 0.513149E+00
+ PKER_SWETH( 33, 29) = 0.477025E+00
+ PKER_SWETH( 33, 30) = 0.443042E+00
+ PKER_SWETH( 33, 31) = 0.411059E+00
+ PKER_SWETH( 33, 32) = 0.380937E+00
+ PKER_SWETH( 33, 33) = 0.352549E+00
+ PKER_SWETH( 33, 34) = 0.325769E+00
+ PKER_SWETH( 33, 35) = 0.300478E+00
+ PKER_SWETH( 33, 36) = 0.276562E+00
+ PKER_SWETH( 33, 37) = 0.253913E+00
+ PKER_SWETH( 33, 38) = 0.232431E+00
+ PKER_SWETH( 33, 39) = 0.212025E+00
+ PKER_SWETH( 33, 40) = 0.192616E+00
+ PKER_SWETH( 33, 41) = 0.174143E+00
+ PKER_SWETH( 33, 42) = 0.156567E+00
+ PKER_SWETH( 33, 43) = 0.139871E+00
+ PKER_SWETH( 33, 44) = 0.124064E+00
+ PKER_SWETH( 33, 45) = 0.109173E+00
+ PKER_SWETH( 33, 46) = 0.952378E-01
+ PKER_SWETH( 33, 47) = 0.823015E-01
+ PKER_SWETH( 33, 48) = 0.704036E-01
+ PKER_SWETH( 33, 49) = 0.595823E-01
+ PKER_SWETH( 33, 50) = 0.498785E-01
+ PKER_SWETH( 33, 51) = 0.413438E-01
+ PKER_SWETH( 33, 52) = 0.340421E-01
+ PKER_SWETH( 33, 53) = 0.280430E-01
+ PKER_SWETH( 33, 54) = 0.233974E-01
+ PKER_SWETH( 33, 55) = 0.201291E-01
+ PKER_SWETH( 33, 56) = 0.182206E-01
+ PKER_SWETH( 33, 57) = 0.175675E-01
+ PKER_SWETH( 33, 58) = 0.180229E-01
+ PKER_SWETH( 33, 59) = 0.194061E-01
+ PKER_SWETH( 33, 60) = 0.214879E-01
+ PKER_SWETH( 33, 61) = 0.240570E-01
+ PKER_SWETH( 33, 62) = 0.269359E-01
+ PKER_SWETH( 33, 63) = 0.299571E-01
+ PKER_SWETH( 33, 64) = 0.330093E-01
+ PKER_SWETH( 33, 65) = 0.360092E-01
+ PKER_SWETH( 33, 66) = 0.389073E-01
+ PKER_SWETH( 33, 67) = 0.416736E-01
+ PKER_SWETH( 33, 68) = 0.442952E-01
+ PKER_SWETH( 33, 69) = 0.467690E-01
+ PKER_SWETH( 33, 70) = 0.490971E-01
+ PKER_SWETH( 33, 71) = 0.512851E-01
+ PKER_SWETH( 33, 72) = 0.533399E-01
+ PKER_SWETH( 33, 73) = 0.552690E-01
+ PKER_SWETH( 33, 74) = 0.570798E-01
+ PKER_SWETH( 33, 75) = 0.587796E-01
+ PKER_SWETH( 33, 76) = 0.603751E-01
+ PKER_SWETH( 33, 77) = 0.618729E-01
+ PKER_SWETH( 33, 78) = 0.632789E-01
+ PKER_SWETH( 33, 79) = 0.645989E-01
+ PKER_SWETH( 33, 80) = 0.658382E-01
+ PKER_SWETH( 34, 1) = 0.315494E+01
+ PKER_SWETH( 34, 2) = 0.295858E+01
+ PKER_SWETH( 34, 3) = 0.277419E+01
+ PKER_SWETH( 34, 4) = 0.260106E+01
+ PKER_SWETH( 34, 5) = 0.243849E+01
+ PKER_SWETH( 34, 6) = 0.228584E+01
+ PKER_SWETH( 34, 7) = 0.214250E+01
+ PKER_SWETH( 34, 8) = 0.200790E+01
+ PKER_SWETH( 34, 9) = 0.188152E+01
+ PKER_SWETH( 34, 10) = 0.176285E+01
+ PKER_SWETH( 34, 11) = 0.165142E+01
+ PKER_SWETH( 34, 12) = 0.154678E+01
+ PKER_SWETH( 34, 13) = 0.144853E+01
+ PKER_SWETH( 34, 14) = 0.135626E+01
+ PKER_SWETH( 34, 15) = 0.126963E+01
+ PKER_SWETH( 34, 16) = 0.118827E+01
+ PKER_SWETH( 34, 17) = 0.111188E+01
+ PKER_SWETH( 34, 18) = 0.104014E+01
+ PKER_SWETH( 34, 19) = 0.972772E+00
+ PKER_SWETH( 34, 20) = 0.909506E+00
+ PKER_SWETH( 34, 21) = 0.850090E+00
+ PKER_SWETH( 34, 22) = 0.794288E+00
+ PKER_SWETH( 34, 23) = 0.741876E+00
+ PKER_SWETH( 34, 24) = 0.692646E+00
+ PKER_SWETH( 34, 25) = 0.646400E+00
+ PKER_SWETH( 34, 26) = 0.602952E+00
+ PKER_SWETH( 34, 27) = 0.562126E+00
+ PKER_SWETH( 34, 28) = 0.523757E+00
+ PKER_SWETH( 34, 29) = 0.487689E+00
+ PKER_SWETH( 34, 30) = 0.453773E+00
+ PKER_SWETH( 34, 31) = 0.421869E+00
+ PKER_SWETH( 34, 32) = 0.391843E+00
+ PKER_SWETH( 34, 33) = 0.363568E+00
+ PKER_SWETH( 34, 34) = 0.336921E+00
+ PKER_SWETH( 34, 35) = 0.311787E+00
+ PKER_SWETH( 34, 36) = 0.288054E+00
+ PKER_SWETH( 34, 37) = 0.265616E+00
+ PKER_SWETH( 34, 38) = 0.244371E+00
+ PKER_SWETH( 34, 39) = 0.224227E+00
+ PKER_SWETH( 34, 40) = 0.205097E+00
+ PKER_SWETH( 34, 41) = 0.186910E+00
+ PKER_SWETH( 34, 42) = 0.169607E+00
+ PKER_SWETH( 34, 43) = 0.153151E+00
+ PKER_SWETH( 34, 44) = 0.137525E+00
+ PKER_SWETH( 34, 45) = 0.122734E+00
+ PKER_SWETH( 34, 46) = 0.108800E+00
+ PKER_SWETH( 34, 47) = 0.957515E-01
+ PKER_SWETH( 34, 48) = 0.836164E-01
+ PKER_SWETH( 34, 49) = 0.724132E-01
+ PKER_SWETH( 34, 50) = 0.621505E-01
+ PKER_SWETH( 34, 51) = 0.528311E-01
+ PKER_SWETH( 34, 52) = 0.444613E-01
+ PKER_SWETH( 34, 53) = 0.370591E-01
+ PKER_SWETH( 34, 54) = 0.306644E-01
+ PKER_SWETH( 34, 55) = 0.253251E-01
+ PKER_SWETH( 34, 56) = 0.210858E-01
+ PKER_SWETH( 34, 57) = 0.179868E-01
+ PKER_SWETH( 34, 58) = 0.160241E-01
+ PKER_SWETH( 34, 59) = 0.151403E-01
+ PKER_SWETH( 34, 60) = 0.152366E-01
+ PKER_SWETH( 34, 61) = 0.161644E-01
+ PKER_SWETH( 34, 62) = 0.177533E-01
+ PKER_SWETH( 34, 63) = 0.198251E-01
+ PKER_SWETH( 34, 64) = 0.222044E-01
+ PKER_SWETH( 34, 65) = 0.247619E-01
+ PKER_SWETH( 34, 66) = 0.273765E-01
+ PKER_SWETH( 34, 67) = 0.299716E-01
+ PKER_SWETH( 34, 68) = 0.324948E-01
+ PKER_SWETH( 34, 69) = 0.349138E-01
+ PKER_SWETH( 34, 70) = 0.372131E-01
+ PKER_SWETH( 34, 71) = 0.393864E-01
+ PKER_SWETH( 34, 72) = 0.414343E-01
+ PKER_SWETH( 34, 73) = 0.433604E-01
+ PKER_SWETH( 34, 74) = 0.451700E-01
+ PKER_SWETH( 34, 75) = 0.468695E-01
+ PKER_SWETH( 34, 76) = 0.484650E-01
+ PKER_SWETH( 34, 77) = 0.499630E-01
+ PKER_SWETH( 34, 78) = 0.513692E-01
+ PKER_SWETH( 34, 79) = 0.526893E-01
+ PKER_SWETH( 34, 80) = 0.539287E-01
+ PKER_SWETH( 35, 1) = 0.316382E+01
+ PKER_SWETH( 35, 2) = 0.296745E+01
+ PKER_SWETH( 35, 3) = 0.278307E+01
+ PKER_SWETH( 35, 4) = 0.260994E+01
+ PKER_SWETH( 35, 5) = 0.244737E+01
+ PKER_SWETH( 35, 6) = 0.229472E+01
+ PKER_SWETH( 35, 7) = 0.215138E+01
+ PKER_SWETH( 35, 8) = 0.201679E+01
+ PKER_SWETH( 35, 9) = 0.189041E+01
+ PKER_SWETH( 35, 10) = 0.177173E+01
+ PKER_SWETH( 35, 11) = 0.166030E+01
+ PKER_SWETH( 35, 12) = 0.155567E+01
+ PKER_SWETH( 35, 13) = 0.145742E+01
+ PKER_SWETH( 35, 14) = 0.136516E+01
+ PKER_SWETH( 35, 15) = 0.127853E+01
+ PKER_SWETH( 35, 16) = 0.119718E+01
+ PKER_SWETH( 35, 17) = 0.112079E+01
+ PKER_SWETH( 35, 18) = 0.104905E+01
+ PKER_SWETH( 35, 19) = 0.981692E+00
+ PKER_SWETH( 35, 20) = 0.918434E+00
+ PKER_SWETH( 35, 21) = 0.859029E+00
+ PKER_SWETH( 35, 22) = 0.803239E+00
+ PKER_SWETH( 35, 23) = 0.750842E+00
+ PKER_SWETH( 35, 24) = 0.701629E+00
+ PKER_SWETH( 35, 25) = 0.655404E+00
+ PKER_SWETH( 35, 26) = 0.611980E+00
+ PKER_SWETH( 35, 27) = 0.571185E+00
+ PKER_SWETH( 35, 28) = 0.532852E+00
+ PKER_SWETH( 35, 29) = 0.496827E+00
+ PKER_SWETH( 35, 30) = 0.462962E+00
+ PKER_SWETH( 35, 31) = 0.431119E+00
+ PKER_SWETH( 35, 32) = 0.401166E+00
+ PKER_SWETH( 35, 33) = 0.372978E+00
+ PKER_SWETH( 35, 34) = 0.346435E+00
+ PKER_SWETH( 35, 35) = 0.321423E+00
+ PKER_SWETH( 35, 36) = 0.297833E+00
+ PKER_SWETH( 35, 37) = 0.275561E+00
+ PKER_SWETH( 35, 38) = 0.254507E+00
+ PKER_SWETH( 35, 39) = 0.234578E+00
+ PKER_SWETH( 35, 40) = 0.215686E+00
+ PKER_SWETH( 35, 41) = 0.197751E+00
+ PKER_SWETH( 35, 42) = 0.180705E+00
+ PKER_SWETH( 35, 43) = 0.164495E+00
+ PKER_SWETH( 35, 44) = 0.149084E+00
+ PKER_SWETH( 35, 45) = 0.134456E+00
+ PKER_SWETH( 35, 46) = 0.120615E+00
+ PKER_SWETH( 35, 47) = 0.107577E+00
+ PKER_SWETH( 35, 48) = 0.953661E-01
+ PKER_SWETH( 35, 49) = 0.840018E-01
+ PKER_SWETH( 35, 50) = 0.734926E-01
+ PKER_SWETH( 35, 51) = 0.638322E-01
+ PKER_SWETH( 35, 52) = 0.550036E-01
+ PKER_SWETH( 35, 53) = 0.469852E-01
+ PKER_SWETH( 35, 54) = 0.397621E-01
+ PKER_SWETH( 35, 55) = 0.333353E-01
+ PKER_SWETH( 35, 56) = 0.277239E-01
+ PKER_SWETH( 35, 57) = 0.229657E-01
+ PKER_SWETH( 35, 58) = 0.191037E-01
+ PKER_SWETH( 35, 59) = 0.161795E-01
+ PKER_SWETH( 35, 60) = 0.142064E-01
+ PKER_SWETH( 35, 61) = 0.131510E-01
+ PKER_SWETH( 35, 62) = 0.129597E-01
+ PKER_SWETH( 35, 63) = 0.135198E-01
+ PKER_SWETH( 35, 64) = 0.146888E-01
+ PKER_SWETH( 35, 65) = 0.163281E-01
+ PKER_SWETH( 35, 66) = 0.182882E-01
+ PKER_SWETH( 35, 67) = 0.204331E-01
+ PKER_SWETH( 35, 68) = 0.226652E-01
+ PKER_SWETH( 35, 69) = 0.249047E-01
+ PKER_SWETH( 35, 70) = 0.270982E-01
+ PKER_SWETH( 35, 71) = 0.292114E-01
+ PKER_SWETH( 35, 72) = 0.312269E-01
+ PKER_SWETH( 35, 73) = 0.331361E-01
+ PKER_SWETH( 35, 74) = 0.349374E-01
+ PKER_SWETH( 35, 75) = 0.366329E-01
+ PKER_SWETH( 35, 76) = 0.382268E-01
+ PKER_SWETH( 35, 77) = 0.397241E-01
+ PKER_SWETH( 35, 78) = 0.411301E-01
+ PKER_SWETH( 35, 79) = 0.424503E-01
+ PKER_SWETH( 35, 80) = 0.436897E-01
+ PKER_SWETH( 36, 1) = 0.317145E+01
+ PKER_SWETH( 36, 2) = 0.297509E+01
+ PKER_SWETH( 36, 3) = 0.279070E+01
+ PKER_SWETH( 36, 4) = 0.261757E+01
+ PKER_SWETH( 36, 5) = 0.245500E+01
+ PKER_SWETH( 36, 6) = 0.230235E+01
+ PKER_SWETH( 36, 7) = 0.215901E+01
+ PKER_SWETH( 36, 8) = 0.202442E+01
+ PKER_SWETH( 36, 9) = 0.189804E+01
+ PKER_SWETH( 36, 10) = 0.177937E+01
+ PKER_SWETH( 36, 11) = 0.166794E+01
+ PKER_SWETH( 36, 12) = 0.156331E+01
+ PKER_SWETH( 36, 13) = 0.146506E+01
+ PKER_SWETH( 36, 14) = 0.137280E+01
+ PKER_SWETH( 36, 15) = 0.128617E+01
+ PKER_SWETH( 36, 16) = 0.120483E+01
+ PKER_SWETH( 36, 17) = 0.112844E+01
+ PKER_SWETH( 36, 18) = 0.105671E+01
+ PKER_SWETH( 36, 19) = 0.989358E+00
+ PKER_SWETH( 36, 20) = 0.926106E+00
+ PKER_SWETH( 36, 21) = 0.866709E+00
+ PKER_SWETH( 36, 22) = 0.810928E+00
+ PKER_SWETH( 36, 23) = 0.758542E+00
+ PKER_SWETH( 36, 24) = 0.709343E+00
+ PKER_SWETH( 36, 25) = 0.663134E+00
+ PKER_SWETH( 36, 26) = 0.619730E+00
+ PKER_SWETH( 36, 27) = 0.578957E+00
+ PKER_SWETH( 36, 28) = 0.540652E+00
+ PKER_SWETH( 36, 29) = 0.504659E+00
+ PKER_SWETH( 36, 30) = 0.470834E+00
+ PKER_SWETH( 36, 31) = 0.439039E+00
+ PKER_SWETH( 36, 32) = 0.409142E+00
+ PKER_SWETH( 36, 33) = 0.381020E+00
+ PKER_SWETH( 36, 34) = 0.354557E+00
+ PKER_SWETH( 36, 35) = 0.329639E+00
+ PKER_SWETH( 36, 36) = 0.306160E+00
+ PKER_SWETH( 36, 37) = 0.284019E+00
+ PKER_SWETH( 36, 38) = 0.263117E+00
+ PKER_SWETH( 36, 39) = 0.243361E+00
+ PKER_SWETH( 36, 40) = 0.224665E+00
+ PKER_SWETH( 36, 41) = 0.206945E+00
+ PKER_SWETH( 36, 42) = 0.190128E+00
+ PKER_SWETH( 36, 43) = 0.174150E+00
+ PKER_SWETH( 36, 44) = 0.158961E+00
+ PKER_SWETH( 36, 45) = 0.144526E+00
+ PKER_SWETH( 36, 46) = 0.130829E+00
+ PKER_SWETH( 36, 47) = 0.117873E+00
+ PKER_SWETH( 36, 48) = 0.105672E+00
+ PKER_SWETH( 36, 49) = 0.942459E-01
+ PKER_SWETH( 36, 50) = 0.836094E-01
+ PKER_SWETH( 36, 51) = 0.737662E-01
+ PKER_SWETH( 36, 52) = 0.647037E-01
+ PKER_SWETH( 36, 53) = 0.563958E-01
+ PKER_SWETH( 36, 54) = 0.488078E-01
+ PKER_SWETH( 36, 55) = 0.419058E-01
+ PKER_SWETH( 36, 56) = 0.356633E-01
+ PKER_SWETH( 36, 57) = 0.300718E-01
+ PKER_SWETH( 36, 58) = 0.251413E-01
+ PKER_SWETH( 36, 59) = 0.208989E-01
+ PKER_SWETH( 36, 60) = 0.173840E-01
+ PKER_SWETH( 36, 61) = 0.146412E-01
+ PKER_SWETH( 36, 62) = 0.126895E-01
+ PKER_SWETH( 36, 63) = 0.115219E-01
+ PKER_SWETH( 36, 64) = 0.111061E-01
+ PKER_SWETH( 36, 65) = 0.113656E-01
+ PKER_SWETH( 36, 66) = 0.121884E-01
+ PKER_SWETH( 36, 67) = 0.134579E-01
+ PKER_SWETH( 36, 68) = 0.150470E-01
+ PKER_SWETH( 36, 69) = 0.168388E-01
+ PKER_SWETH( 36, 70) = 0.187349E-01
+ PKER_SWETH( 36, 71) = 0.206605E-01
+ PKER_SWETH( 36, 72) = 0.225628E-01
+ PKER_SWETH( 36, 73) = 0.244065E-01
+ PKER_SWETH( 36, 74) = 0.261718E-01
+ PKER_SWETH( 36, 75) = 0.278484E-01
+ PKER_SWETH( 36, 76) = 0.294325E-01
+ PKER_SWETH( 36, 77) = 0.309251E-01
+ PKER_SWETH( 36, 78) = 0.323289E-01
+ PKER_SWETH( 36, 79) = 0.336481E-01
+ PKER_SWETH( 36, 80) = 0.348872E-01
+ PKER_SWETH( 37, 1) = 0.317801E+01
+ PKER_SWETH( 37, 2) = 0.298165E+01
+ PKER_SWETH( 37, 3) = 0.279727E+01
+ PKER_SWETH( 37, 4) = 0.262413E+01
+ PKER_SWETH( 37, 5) = 0.246156E+01
+ PKER_SWETH( 37, 6) = 0.230891E+01
+ PKER_SWETH( 37, 7) = 0.216558E+01
+ PKER_SWETH( 37, 8) = 0.203099E+01
+ PKER_SWETH( 37, 9) = 0.190461E+01
+ PKER_SWETH( 37, 10) = 0.178594E+01
+ PKER_SWETH( 37, 11) = 0.167451E+01
+ PKER_SWETH( 37, 12) = 0.156988E+01
+ PKER_SWETH( 37, 13) = 0.147163E+01
+ PKER_SWETH( 37, 14) = 0.137938E+01
+ PKER_SWETH( 37, 15) = 0.129275E+01
+ PKER_SWETH( 37, 16) = 0.121140E+01
+ PKER_SWETH( 37, 17) = 0.113502E+01
+ PKER_SWETH( 37, 18) = 0.106330E+01
+ PKER_SWETH( 37, 19) = 0.995945E+00
+ PKER_SWETH( 37, 20) = 0.932699E+00
+ PKER_SWETH( 37, 21) = 0.873307E+00
+ PKER_SWETH( 37, 22) = 0.817534E+00
+ PKER_SWETH( 37, 23) = 0.765157E+00
+ PKER_SWETH( 37, 24) = 0.715968E+00
+ PKER_SWETH( 37, 25) = 0.669771E+00
+ PKER_SWETH( 37, 26) = 0.626382E+00
+ PKER_SWETH( 37, 27) = 0.585627E+00
+ PKER_SWETH( 37, 28) = 0.547343E+00
+ PKER_SWETH( 37, 29) = 0.511376E+00
+ PKER_SWETH( 37, 30) = 0.477581E+00
+ PKER_SWETH( 37, 31) = 0.445822E+00
+ PKER_SWETH( 37, 32) = 0.415968E+00
+ PKER_SWETH( 37, 33) = 0.387898E+00
+ PKER_SWETH( 37, 34) = 0.361496E+00
+ PKER_SWETH( 37, 35) = 0.336651E+00
+ PKER_SWETH( 37, 36) = 0.313259E+00
+ PKER_SWETH( 37, 37) = 0.291219E+00
+ PKER_SWETH( 37, 38) = 0.270437E+00
+ PKER_SWETH( 37, 39) = 0.250820E+00
+ PKER_SWETH( 37, 40) = 0.232282E+00
+ PKER_SWETH( 37, 41) = 0.214740E+00
+ PKER_SWETH( 37, 42) = 0.198119E+00
+ PKER_SWETH( 37, 43) = 0.182349E+00
+ PKER_SWETH( 37, 44) = 0.167369E+00
+ PKER_SWETH( 37, 45) = 0.153134E+00
+ PKER_SWETH( 37, 46) = 0.139610E+00
+ PKER_SWETH( 37, 47) = 0.126783E+00
+ PKER_SWETH( 37, 48) = 0.114653E+00
+ PKER_SWETH( 37, 49) = 0.103232E+00
+ PKER_SWETH( 37, 50) = 0.925378E-01
+ PKER_SWETH( 37, 51) = 0.825827E-01
+ PKER_SWETH( 37, 52) = 0.733675E-01
+ PKER_SWETH( 37, 53) = 0.648776E-01
+ PKER_SWETH( 37, 54) = 0.570830E-01
+ PKER_SWETH( 37, 55) = 0.499450E-01
+ PKER_SWETH( 37, 56) = 0.434200E-01
+ PKER_SWETH( 37, 57) = 0.374691E-01
+ PKER_SWETH( 37, 58) = 0.320636E-01
+ PKER_SWETH( 37, 59) = 0.271887E-01
+ PKER_SWETH( 37, 60) = 0.228498E-01
+ PKER_SWETH( 37, 61) = 0.190676E-01
+ PKER_SWETH( 37, 62) = 0.158762E-01
+ PKER_SWETH( 37, 63) = 0.133176E-01
+ PKER_SWETH( 37, 64) = 0.114155E-01
+ PKER_SWETH( 37, 65) = 0.101818E-01
+ PKER_SWETH( 37, 66) = 0.960151E-02
+ PKER_SWETH( 37, 67) = 0.961729E-02
+ PKER_SWETH( 37, 68) = 0.101533E-01
+ PKER_SWETH( 37, 69) = 0.111109E-01
+ PKER_SWETH( 37, 70) = 0.123790E-01
+ PKER_SWETH( 37, 71) = 0.138599E-01
+ PKER_SWETH( 37, 72) = 0.154599E-01
+ PKER_SWETH( 37, 73) = 0.171104E-01
+ PKER_SWETH( 37, 74) = 0.187566E-01
+ PKER_SWETH( 37, 75) = 0.203627E-01
+ PKER_SWETH( 37, 76) = 0.219075E-01
+ PKER_SWETH( 37, 77) = 0.233786E-01
+ PKER_SWETH( 37, 78) = 0.247714E-01
+ PKER_SWETH( 37, 79) = 0.260851E-01
+ PKER_SWETH( 37, 80) = 0.273215E-01
+ PKER_SWETH( 38, 1) = 0.318365E+01
+ PKER_SWETH( 38, 2) = 0.298729E+01
+ PKER_SWETH( 38, 3) = 0.280291E+01
+ PKER_SWETH( 38, 4) = 0.262978E+01
+ PKER_SWETH( 38, 5) = 0.246721E+01
+ PKER_SWETH( 38, 6) = 0.231456E+01
+ PKER_SWETH( 38, 7) = 0.217122E+01
+ PKER_SWETH( 38, 8) = 0.203663E+01
+ PKER_SWETH( 38, 9) = 0.191025E+01
+ PKER_SWETH( 38, 10) = 0.179158E+01
+ PKER_SWETH( 38, 11) = 0.168015E+01
+ PKER_SWETH( 38, 12) = 0.157552E+01
+ PKER_SWETH( 38, 13) = 0.147728E+01
+ PKER_SWETH( 38, 14) = 0.138502E+01
+ PKER_SWETH( 38, 15) = 0.129840E+01
+ PKER_SWETH( 38, 16) = 0.121706E+01
+ PKER_SWETH( 38, 17) = 0.114068E+01
+ PKER_SWETH( 38, 18) = 0.106895E+01
+ PKER_SWETH( 38, 19) = 0.100161E+01
+ PKER_SWETH( 38, 20) = 0.938364E+00
+ PKER_SWETH( 38, 21) = 0.878977E+00
+ PKER_SWETH( 38, 22) = 0.823209E+00
+ PKER_SWETH( 38, 23) = 0.770839E+00
+ PKER_SWETH( 38, 24) = 0.721658E+00
+ PKER_SWETH( 38, 25) = 0.675471E+00
+ PKER_SWETH( 38, 26) = 0.632094E+00
+ PKER_SWETH( 38, 27) = 0.591352E+00
+ PKER_SWETH( 38, 28) = 0.553085E+00
+ PKER_SWETH( 38, 29) = 0.517137E+00
+ PKER_SWETH( 38, 30) = 0.483366E+00
+ PKER_SWETH( 38, 31) = 0.451634E+00
+ PKER_SWETH( 38, 32) = 0.421814E+00
+ PKER_SWETH( 38, 33) = 0.393784E+00
+ PKER_SWETH( 38, 34) = 0.367429E+00
+ PKER_SWETH( 38, 35) = 0.342641E+00
+ PKER_SWETH( 38, 36) = 0.319316E+00
+ PKER_SWETH( 38, 37) = 0.297355E+00
+ PKER_SWETH( 38, 38) = 0.276666E+00
+ PKER_SWETH( 38, 39) = 0.257158E+00
+ PKER_SWETH( 38, 40) = 0.238746E+00
+ PKER_SWETH( 38, 41) = 0.221350E+00
+ PKER_SWETH( 38, 42) = 0.204891E+00
+ PKER_SWETH( 38, 43) = 0.189299E+00
+ PKER_SWETH( 38, 44) = 0.174508E+00
+ PKER_SWETH( 38, 45) = 0.160464E+00
+ PKER_SWETH( 38, 46) = 0.147120E+00
+ PKER_SWETH( 38, 47) = 0.134448E+00
+ PKER_SWETH( 38, 48) = 0.122432E+00
+ PKER_SWETH( 38, 49) = 0.111072E+00
+ PKER_SWETH( 38, 50) = 0.100379E+00
+ PKER_SWETH( 38, 51) = 0.903681E-01
+ PKER_SWETH( 38, 52) = 0.810492E-01
+ PKER_SWETH( 38, 53) = 0.724222E-01
+ PKER_SWETH( 38, 54) = 0.644714E-01
+ PKER_SWETH( 38, 55) = 0.571675E-01
+ PKER_SWETH( 38, 56) = 0.504700E-01
+ PKER_SWETH( 38, 57) = 0.443333E-01
+ PKER_SWETH( 38, 58) = 0.387134E-01
+ PKER_SWETH( 38, 59) = 0.335716E-01
+ PKER_SWETH( 38, 60) = 0.288792E-01
+ PKER_SWETH( 38, 61) = 0.246214E-01
+ PKER_SWETH( 38, 62) = 0.207986E-01
+ PKER_SWETH( 38, 63) = 0.174274E-01
+ PKER_SWETH( 38, 64) = 0.145371E-01
+ PKER_SWETH( 38, 65) = 0.121635E-01
+ PKER_SWETH( 38, 66) = 0.103355E-01
+ PKER_SWETH( 38, 67) = 0.907165E-02
+ PKER_SWETH( 38, 68) = 0.837324E-02
+ PKER_SWETH( 38, 69) = 0.820126E-02
+ PKER_SWETH( 38, 70) = 0.849900E-02
+ PKER_SWETH( 38, 71) = 0.919422E-02
+ PKER_SWETH( 38, 72) = 0.101904E-01
+ PKER_SWETH( 38, 73) = 0.113982E-01
+ PKER_SWETH( 38, 74) = 0.127419E-01
+ PKER_SWETH( 38, 75) = 0.141481E-01
+ PKER_SWETH( 38, 76) = 0.155678E-01
+ PKER_SWETH( 38, 77) = 0.169638E-01
+ PKER_SWETH( 38, 78) = 0.183137E-01
+ PKER_SWETH( 38, 79) = 0.196037E-01
+ PKER_SWETH( 38, 80) = 0.208275E-01
+ PKER_SWETH( 39, 1) = 0.318850E+01
+ PKER_SWETH( 39, 2) = 0.299214E+01
+ PKER_SWETH( 39, 3) = 0.280776E+01
+ PKER_SWETH( 39, 4) = 0.263463E+01
+ PKER_SWETH( 39, 5) = 0.247206E+01
+ PKER_SWETH( 39, 6) = 0.231941E+01
+ PKER_SWETH( 39, 7) = 0.217607E+01
+ PKER_SWETH( 39, 8) = 0.204148E+01
+ PKER_SWETH( 39, 9) = 0.191510E+01
+ PKER_SWETH( 39, 10) = 0.179644E+01
+ PKER_SWETH( 39, 11) = 0.168501E+01
+ PKER_SWETH( 39, 12) = 0.158038E+01
+ PKER_SWETH( 39, 13) = 0.148213E+01
+ PKER_SWETH( 39, 14) = 0.138988E+01
+ PKER_SWETH( 39, 15) = 0.130326E+01
+ PKER_SWETH( 39, 16) = 0.122192E+01
+ PKER_SWETH( 39, 17) = 0.114554E+01
+ PKER_SWETH( 39, 18) = 0.107382E+01
+ PKER_SWETH( 39, 19) = 0.100647E+01
+ PKER_SWETH( 39, 20) = 0.943232E+00
+ PKER_SWETH( 39, 21) = 0.883849E+00
+ PKER_SWETH( 39, 22) = 0.828086E+00
+ PKER_SWETH( 39, 23) = 0.775721E+00
+ PKER_SWETH( 39, 24) = 0.726547E+00
+ PKER_SWETH( 39, 25) = 0.680367E+00
+ PKER_SWETH( 39, 26) = 0.636998E+00
+ PKER_SWETH( 39, 27) = 0.596268E+00
+ PKER_SWETH( 39, 28) = 0.558013E+00
+ PKER_SWETH( 39, 29) = 0.522080E+00
+ PKER_SWETH( 39, 30) = 0.488327E+00
+ PKER_SWETH( 39, 31) = 0.456617E+00
+ PKER_SWETH( 39, 32) = 0.426823E+00
+ PKER_SWETH( 39, 33) = 0.398824E+00
+ PKER_SWETH( 39, 34) = 0.372505E+00
+ PKER_SWETH( 39, 35) = 0.347761E+00
+ PKER_SWETH( 39, 36) = 0.324487E+00
+ PKER_SWETH( 39, 37) = 0.302588E+00
+ PKER_SWETH( 39, 38) = 0.281972E+00
+ PKER_SWETH( 39, 39) = 0.262550E+00
+ PKER_SWETH( 39, 40) = 0.244238E+00
+ PKER_SWETH( 39, 41) = 0.226957E+00
+ PKER_SWETH( 39, 42) = 0.210631E+00
+ PKER_SWETH( 39, 43) = 0.195187E+00
+ PKER_SWETH( 39, 44) = 0.180559E+00
+ PKER_SWETH( 39, 45) = 0.166686E+00
+ PKER_SWETH( 39, 46) = 0.153516E+00
+ PKER_SWETH( 39, 47) = 0.141008E+00
+ PKER_SWETH( 39, 48) = 0.129131E+00
+ PKER_SWETH( 39, 49) = 0.117873E+00
+ PKER_SWETH( 39, 50) = 0.107233E+00
+ PKER_SWETH( 39, 51) = 0.972184E-01
+ PKER_SWETH( 39, 52) = 0.878440E-01
+ PKER_SWETH( 39, 53) = 0.791184E-01
+ PKER_SWETH( 39, 54) = 0.710406E-01
+ PKER_SWETH( 39, 55) = 0.635951E-01
+ PKER_SWETH( 39, 56) = 0.567529E-01
+ PKER_SWETH( 39, 57) = 0.504750E-01
+ PKER_SWETH( 39, 58) = 0.447169E-01
+ PKER_SWETH( 39, 59) = 0.394327E-01
+ PKER_SWETH( 39, 60) = 0.345813E-01
+ PKER_SWETH( 39, 61) = 0.301271E-01
+ PKER_SWETH( 39, 62) = 0.260446E-01
+ PKER_SWETH( 39, 63) = 0.223191E-01
+ PKER_SWETH( 39, 64) = 0.189491E-01
+ PKER_SWETH( 39, 65) = 0.159459E-01
+ PKER_SWETH( 39, 66) = 0.133348E-01
+ PKER_SWETH( 39, 67) = 0.111460E-01
+ PKER_SWETH( 39, 68) = 0.940775E-02
+ PKER_SWETH( 39, 69) = 0.814637E-02
+ PKER_SWETH( 39, 70) = 0.736755E-02
+ PKER_SWETH( 39, 71) = 0.705182E-02
+ PKER_SWETH( 39, 72) = 0.716064E-02
+ PKER_SWETH( 39, 73) = 0.763295E-02
+ PKER_SWETH( 39, 74) = 0.839614E-02
+ PKER_SWETH( 39, 75) = 0.937315E-02
+ PKER_SWETH( 39, 76) = 0.104870E-01
+ PKER_SWETH( 39, 77) = 0.116808E-01
+ PKER_SWETH( 39, 78) = 0.129002E-01
+ PKER_SWETH( 39, 79) = 0.141107E-01
+ PKER_SWETH( 39, 80) = 0.152883E-01
+ PKER_SWETH( 40, 1) = 0.319267E+01
+ PKER_SWETH( 40, 2) = 0.299631E+01
+ PKER_SWETH( 40, 3) = 0.281193E+01
+ PKER_SWETH( 40, 4) = 0.263880E+01
+ PKER_SWETH( 40, 5) = 0.247623E+01
+ PKER_SWETH( 40, 6) = 0.232358E+01
+ PKER_SWETH( 40, 7) = 0.218024E+01
+ PKER_SWETH( 40, 8) = 0.204565E+01
+ PKER_SWETH( 40, 9) = 0.191927E+01
+ PKER_SWETH( 40, 10) = 0.180061E+01
+ PKER_SWETH( 40, 11) = 0.168918E+01
+ PKER_SWETH( 40, 12) = 0.158455E+01
+ PKER_SWETH( 40, 13) = 0.148631E+01
+ PKER_SWETH( 40, 14) = 0.139405E+01
+ PKER_SWETH( 40, 15) = 0.130743E+01
+ PKER_SWETH( 40, 16) = 0.122609E+01
+ PKER_SWETH( 40, 17) = 0.114971E+01
+ PKER_SWETH( 40, 18) = 0.107800E+01
+ PKER_SWETH( 40, 19) = 0.101065E+01
+ PKER_SWETH( 40, 20) = 0.947416E+00
+ PKER_SWETH( 40, 21) = 0.888036E+00
+ PKER_SWETH( 40, 22) = 0.832276E+00
+ PKER_SWETH( 40, 23) = 0.779916E+00
+ PKER_SWETH( 40, 24) = 0.730746E+00
+ PKER_SWETH( 40, 25) = 0.684572E+00
+ PKER_SWETH( 40, 26) = 0.641210E+00
+ PKER_SWETH( 40, 27) = 0.600488E+00
+ PKER_SWETH( 40, 28) = 0.562243E+00
+ PKER_SWETH( 40, 29) = 0.526323E+00
+ PKER_SWETH( 40, 30) = 0.492583E+00
+ PKER_SWETH( 40, 31) = 0.460890E+00
+ PKER_SWETH( 40, 32) = 0.431116E+00
+ PKER_SWETH( 40, 33) = 0.403140E+00
+ PKER_SWETH( 40, 34) = 0.376851E+00
+ PKER_SWETH( 40, 35) = 0.352140E+00
+ PKER_SWETH( 40, 36) = 0.328907E+00
+ PKER_SWETH( 40, 37) = 0.307055E+00
+ PKER_SWETH( 40, 38) = 0.286495E+00
+ PKER_SWETH( 40, 39) = 0.267140E+00
+ PKER_SWETH( 40, 40) = 0.248907E+00
+ PKER_SWETH( 40, 41) = 0.231718E+00
+ PKER_SWETH( 40, 42) = 0.215498E+00
+ PKER_SWETH( 40, 43) = 0.200175E+00
+ PKER_SWETH( 40, 44) = 0.185683E+00
+ PKER_SWETH( 40, 45) = 0.171959E+00
+ PKER_SWETH( 40, 46) = 0.158946E+00
+ PKER_SWETH( 40, 47) = 0.146595E+00
+ PKER_SWETH( 40, 48) = 0.134867E+00
+ PKER_SWETH( 40, 49) = 0.123735E+00
+ PKER_SWETH( 40, 50) = 0.113185E+00
+ PKER_SWETH( 40, 51) = 0.103216E+00
+ PKER_SWETH( 40, 52) = 0.938355E-01
+ PKER_SWETH( 40, 53) = 0.850554E-01
+ PKER_SWETH( 40, 54) = 0.768835E-01
+ PKER_SWETH( 40, 55) = 0.693180E-01
+ PKER_SWETH( 40, 56) = 0.623442E-01
+ PKER_SWETH( 40, 57) = 0.559346E-01
+ PKER_SWETH( 40, 58) = 0.500518E-01
+ PKER_SWETH( 40, 59) = 0.446530E-01
+ PKER_SWETH( 40, 60) = 0.396945E-01
+ PKER_SWETH( 40, 61) = 0.351341E-01
+ PKER_SWETH( 40, 62) = 0.309350E-01
+ PKER_SWETH( 40, 63) = 0.270668E-01
+ PKER_SWETH( 40, 64) = 0.235073E-01
+ PKER_SWETH( 40, 65) = 0.202425E-01
+ PKER_SWETH( 40, 66) = 0.172698E-01
+ PKER_SWETH( 40, 67) = 0.145977E-01
+ PKER_SWETH( 40, 68) = 0.122444E-01
+ PKER_SWETH( 40, 69) = 0.102365E-01
+ PKER_SWETH( 40, 70) = 0.860187E-02
+ PKER_SWETH( 40, 71) = 0.736637E-02
+ PKER_SWETH( 40, 72) = 0.654201E-02
+ PKER_SWETH( 40, 73) = 0.611859E-02
+ PKER_SWETH( 40, 74) = 0.607653E-02
+ PKER_SWETH( 40, 75) = 0.636809E-02
+ PKER_SWETH( 40, 76) = 0.693164E-02
+ PKER_SWETH( 40, 77) = 0.770652E-02
+ PKER_SWETH( 40, 78) = 0.862610E-02
+ PKER_SWETH( 40, 79) = 0.962951E-02
+ PKER_SWETH( 40, 80) = 0.106726E-01
END IF
!
+IF (LHOOK) CALL DR_HOOK('READ_XKER_SWETH',1,ZHOOK_HANDLE)
END SUBROUTINE READ_XKER_SWETH
+END MODULE MODE_READ_XKER_SWETH
diff --git a/src/PHYEX/micro/mode_rrcolss.f90 b/src/PHYEX/micro/mode_rrcolss.f90
index 83249d7f1573cc471ca0bbde3ba033c3e056fa39..abb1b3d59bd001e9ed033a9cb6db89465be5aca8 100644
--- a/src/PHYEX/micro/mode_rrcolss.f90
+++ b/src/PHYEX/micro/mode_rrcolss.f90
@@ -4,55 +4,17 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
- MODULE MODI_RRCOLSS
+ MODULE MODE_RRCOLSS
! ###################
!
-INTERFACE
-!
- SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRRCOLSS, PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE RRCOLSS
-!
-END INTERFACE
-!
- END MODULE MODI_RRCOLSS
-! ########################################################################
+IMPLICIT NONE
+CONTAINS
SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
PDINFTY, PRRCOLSS, PAG, PBS, PAS )
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################################
!
!
@@ -215,6 +177,8 @@ REAL :: ZCST1
!
!* 1.0 Initialization
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('RRCOLSS',0,ZHOOK_HANDLE)
PRRCOLSS(:,:) = 0.0
ZCST1 = (3.0/XPI)/XRHOLW
!
@@ -280,11 +244,19 @@ DO JLBDAS = 1,SIZE(PRRCOLSS(:,:),1)
DO JDR = 1,INR-1
ZDR = ZDDCOLLR * REAL(JDR)
ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
+#if defined(REPRO48) || defined(REPRO55)
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDR**PEXFALLR) &
+#else
* PESR * ABS(PFALLS*ZDS**PEXFALLS * EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) &
+#endif
* GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
END DO
ZCOLLDRMAX = (ZDS+ZDRMAX)**2 * ZDRMAX**PEXMASSR &
+#if defined(REPRO48) || defined(REPRO55)
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDRMAX**PEXFALLR) &
+#else
* PESR * ABS(PFALLS*ZDS**PEXFALLS* EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDRMAX**PEXFALLR) &
+#endif
* GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR)
!
@@ -312,4 +284,6 @@ DO JLBDAS = 1,SIZE(PRRCOLSS(:,:),1)
END DO
END DO
!
+IF (LHOOK) CALL DR_HOOK('RRCOLSS',1,ZHOOK_HANDLE)
END SUBROUTINE RRCOLSS
+END MODULE MODE_RRCOLSS
diff --git a/src/PHYEX/micro/mode_rscolrg.f90 b/src/PHYEX/micro/mode_rscolrg.f90
index 210df03805b8189e969d1712d411b6f7540e07d8..0ec4020b612e94141874617ef55392909a1d060c 100644
--- a/src/PHYEX/micro/mode_rscolrg.f90
+++ b/src/PHYEX/micro/mode_rscolrg.f90
@@ -4,55 +4,17 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
- MODULE MODI_RSCOLRG
+ MODULE MODE_RSCOLRG
! ###################
!
-INTERFACE
-!
- SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRSCOLRG,PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE RSCOLRG
-!
-END INTERFACE
-!
- END MODULE MODI_RSCOLRG
-! ########################################################################
+IMPLICIT NONE
+CONTAINS
SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
PDINFTY, PRSCOLRG,PAG, PBS, PAS )
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################################
!
!
@@ -212,6 +174,8 @@ REAL :: ZCST1
!
!* 1.0 Initialization
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('RSCOLRG',0,ZHOOK_HANDLE)
PRSCOLRG(:,:) = 0.0
ZCST1 = (3.0/XPI)/XRHOLW
!
@@ -274,12 +238,20 @@ DO JLBDAR = 1,SIZE(PRSCOLRG(:,:),1)
ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN
ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
* GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
+#if defined(REPRO48) || defined(REPRO55)
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDR**PEXFALLR)
+#else
* PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDR**PEXFALLR)
+#endif
END DO
IF( ZDRMIN>0.0 ) THEN
ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
* GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
+#if defined(REPRO48) || defined(REPRO55)
+ * PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDRMIN**PEXFALLR)
+#else
* PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDRMIN**PEXFALLR)
+#endif
ELSE
ZCOLLDRMIN = 0.0
END IF
@@ -312,4 +284,6 @@ DO JLBDAR = 1,SIZE(PRSCOLRG(:,:),1)
END DO
END DO
!
+IF (LHOOK) CALL DR_HOOK('RSCOLRG',1,ZHOOK_HANDLE)
END SUBROUTINE RSCOLRG
+END MODULE MODE_RSCOLRG
diff --git a/src/PHYEX/micro/mode_rzcolx.f90 b/src/PHYEX/micro/mode_rzcolx.f90
index de0fc723a1598394e512fafa67b808ff469ad670..c765515d2c9b3dc4b39c0f8a6a8978383bd6dcb9 100644
--- a/src/PHYEX/micro/mode_rzcolx.f90
+++ b/src/PHYEX/micro/mode_rzcolx.f90
@@ -4,58 +4,18 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################
- MODULE MODI_RZCOLX
+ MODULE MODE_RZCOLX
! ##################
!
-INTERFACE
-!
- SUBROUTINE RZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, &
- PEXZ, PEXMASSZ, PFALLX, PEXFALLX, PFALLEXPX, &
- PFALLZ, PEXFALLZ, PFALLEXPZ, &
- PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
- PDINFTY, PRZCOLX )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DX and DZ
-!
-!
-REAL, INTENT(IN) :: PALPHAX ! First shape parameter of the specy X
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUX ! Second shape parameter of the specy X
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAZ ! First shape parameter of the specy Z
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUZ ! Second shape parameter of the specy Z
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PEXZ ! Efficiency of specy X collecting specy Z
-REAL, INTENT(IN) :: PEXMASSZ ! Mass exponent of specy Z
-REAL, INTENT(IN) :: PFALLX ! Fall speed constant of specy X
-REAL, INTENT(IN) :: PEXFALLX ! Fall speed exponent of specy X
-REAL, INTENT(IN) :: PFALLEXPX ! Fall speed exponential constant of specy X
-REAL, INTENT(IN) :: PFALLZ ! Fall speed constant of specy Z
-REAL, INTENT(IN) :: PEXFALLZ ! Fall speed exponent of specy Z
-REAL, INTENT(IN) :: PFALLEXPZ ! Fall speed exponential constant of specy Z
-REAL, INTENT(IN) :: PLBDAXMAX ! Maximun slope of size distribution of specy X
-REAL, INTENT(IN) :: PLBDAZMAX ! Maximun slope of size distribution of specy Z
-REAL, INTENT(IN) :: PLBDAXMIN ! Minimun slope of size distribution of specy X
-REAL, INTENT(IN) :: PLBDAZMIN ! Minimun slope of size distribution of specy Z
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRZCOLX ! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE RZCOLX
-!
-END INTERFACE
-!
- END MODULE MODI_RZCOLX
-! ########################################################################
+IMPLICIT NONE
+CONTAINS
SUBROUTINE RZCOLX( KND, PALPHAX, PNUX, PALPHAZ, PNUZ, &
PEXZ, PEXMASSZ, PFALLX, PEXFALLX, PFALLEXPX, &
PFALLZ, PEXFALLZ, PFALLEXPZ, &
PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
- PDINFTY, PRZCOLX )
+ PDINFTY, PRZCOLX )
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################################
!
!
@@ -91,9 +51,9 @@ END INTERFACE
!! where E_xz is a collection efficiency, g(D) is the generalized Gamma
!! distribution law. The 'infty' diameter is defined according to the
!! current value of the Lbda that is D_x=PDINFTY/Lbda_x or
-!! D_z=PINFTY/Lbda_z.
+!! D_z=PINFTY/Lbda_z.
!! The result is stored in a two-dimensional array.
-!!
+!!
!!** METHOD
!! ------
!! The free parameters of the size distribution function of specy X and Z
@@ -105,7 +65,7 @@ END INTERFACE
!!
!! EXTERNAL
!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
+!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -120,7 +80,7 @@ END INTERFACE
!! ------
!! J.-P. Pinty * Laboratoire d'Aerologie *
!!
-!! MODIFICATIONS
+!! MODIFICATIONS
!! -------------
!! Original 8/11/95
!!
@@ -138,21 +98,21 @@ USE MODI_GENERAL_GAMMA
IMPLICIT NONE
!
!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
+!* 0.1 Declarations of dummy arguments
+! -------------------------------
!
!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DX and DZ
+INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DX and DZ
!
!
-REAL, INTENT(IN) :: PALPHAX ! First shape parameter of the specy X
- ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAX ! First shape parameter of the specy X
+ ! size distribution (generalized gamma law)
REAL, INTENT(IN) :: PNUX ! Second shape parameter of the specy X
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAZ ! First shape parameter of the specy Z
- ! size distribution (generalized gamma law)
+ ! size distribution (generalized gamma law)
+REAL, INTENT(IN) :: PALPHAZ ! First shape parameter of the specy Z
+ ! size distribution (generalized gamma law)
REAL, INTENT(IN) :: PNUZ ! Second shape parameter of the specy Z
- ! size distribution (generalized gamma law)
+ ! size distribution (generalized gamma law)
REAL, INTENT(IN) :: PEXZ ! Efficiency of specy X collecting specy Z
REAL, INTENT(IN) :: PEXMASSZ ! Mass exponent of specy Z
REAL, INTENT(IN) :: PFALLX ! Fall speed constant of specy X
@@ -166,11 +126,11 @@ REAL, INTENT(IN) :: PLBDAZMAX ! Maximun slope of size distribution of specy Z
REAL, INTENT(IN) :: PLBDAXMIN ! Minimun slope of size distribution of specy X
REAL, INTENT(IN) :: PLBDAZMIN ! Minimun slope of size distribution of specy Z
REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
+ ! which the diameter integration is performed
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PRZCOLX ! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
+ ! the mass collection kernel as a
+ ! function of LAMBDAX and LAMBDAZ
!
!
!* 0.2 Declarations of local variables
@@ -191,14 +151,14 @@ REAL :: ZDDX ! Integration step of the diameter of specy X
REAL :: ZDDZ ! Integration step of the diameter of specy Z
REAL :: ZDX ! Current diameter of the particle specy X
REAL :: ZDZ ! Current diameter of the particle specy Z
-REAL :: ZCOLLZ ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of specy Z
+REAL :: ZCOLLZ ! Single integral of the mass weighted fall speed difference
+ ! over the spectrum of specy Z
REAL :: ZCOLLXZ ! Double integral of the mass weighted fall speed difference
- ! over the spectra of specy X and specy Z
-REAL :: ZSCALZ ! Single integral of the scaling factor over
- ! the spectrum of specy Z
+ ! over the spectra of specy X and specy Z
+REAL :: ZSCALZ ! Single integral of the scaling factor over
+ ! the spectrum of specy Z
REAL :: ZSCALXZ ! Double integral of the scaling factor over
- ! the spectra of specy X and specy Z
+ ! the spectra of specy X and specy Z
REAL :: ZFUNC ! Ancillary function
!
!
@@ -213,13 +173,15 @@ REAL :: ZFUNC ! Ancillary function
!
!* 1.1 Compute the growth rate of the slope factors LAMBDA
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('RZCOLX',0,ZHOOK_HANDLE)
ZDLBDAX = EXP( LOG(PLBDAXMAX/PLBDAXMIN)/REAL(SIZE(PRZCOLX(:,:),1)-1) )
ZDLBDAZ = EXP( LOG(PLBDAZMAX/PLBDAZMIN)/REAL(SIZE(PRZCOLX(:,:),2)-1) )
!
!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
!
DO JLBDAX = 1,SIZE(PRZCOLX(:,:),1)
- ZLBDAX = PLBDAXMIN * ZDLBDAX ** (JLBDAX-1)
+ ZLBDAX = PLBDAXMIN * ZDLBDAX ** (JLBDAX-1)
DO JLBDAZ = 1,SIZE(PRZCOLX(:,:),2)
ZLBDAZ = PLBDAZMIN * ZDLBDAZ ** (JLBDAZ-1)
!
@@ -241,20 +203,25 @@ DO JLBDAX = 1,SIZE(PRZCOLX(:,:),1)
ZSCALZ = 0.0
ZCOLLZ = 0.0
DO JDZ = 1,KND-1
- ZDZ = ZDDZ * REAL(JDZ)
+ ZDZ = ZDDZ * REAL(JDZ)
!
!* 1.6 Compute the normalization factor by integration over the
-! dimensional spectrum of specy Z
+! dimensional spectrum of specy Z
!
- ZFUNC = (ZDX+ZDZ)**2 * ZDZ**PEXMASSZ &
- * GENERAL_GAMMA(PALPHAZ,PNUZ,ZLBDAZ,ZDZ)
- ZSCALZ = ZSCALZ + ZFUNC
+ ZFUNC = (ZDX+ZDZ)**2 * ZDZ**PEXMASSZ &
+ * GENERAL_GAMMA(PALPHAZ,PNUZ,ZLBDAZ,ZDZ)
+ ZSCALZ = ZSCALZ + ZFUNC
!
!* 1.7 Compute the scaled fall speed difference by integration over
! the dimensional spectrum of specy Z
!
+#if defined(REPRO48) || defined(REPRO55)
+ ZCOLLZ = ZCOLLZ + ZFUNC &
+ * PEXZ * ABS(PFALLX*ZDX**PEXFALLX-PFALLZ*ZDZ**PEXFALLZ)
+#else
ZCOLLZ = ZCOLLZ + ZFUNC * PEXZ * ABS( PFALLX*ZDX**PEXFALLX * EXP(-(ZDX*PFALLEXPX)**PALPHAX) &
- PFALLZ*ZDZ**PEXFALLZ * EXP(-(ZDZ*PFALLEXPZ)**PALPHAZ))
+#endif
END DO
!
!* 1.8 Compute the normalization factor by integration over the
@@ -275,4 +242,6 @@ DO JLBDAX = 1,SIZE(PRZCOLX(:,:),1)
END DO
END DO
!
+IF (LHOOK) CALL DR_HOOK('RZCOLX',1,ZHOOK_HANDLE)
END SUBROUTINE RZCOLX
+END MODULE MODE_RZCOLX
diff --git a/src/PHYEX/micro/mode_tiwmx.f90 b/src/PHYEX/micro/mode_tiwmx.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dbfbdc712330cd2f959e1bbccd1c0b3f642b9137
--- /dev/null
+++ b/src/PHYEX/micro/mode_tiwmx.f90
@@ -0,0 +1,113 @@
+!@no_insert_drhook
+! ######spl
+ MODULE MODE_TIWMX
+! ###############
+!
+!!**** *MODE_TIWMX* -
+!!
+!! PURPOSE
+!! -------
+! The purpose of this ...
+!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (ha ha)
+!!
+!! AUTHOR
+!! ------
+!! K. I. Ivarsson *SMHI*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/11/14
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+
+REAL, PARAMETER :: XNDEGR = 100.0
+INTEGER, PARAMETER :: NSTART = 10000
+INTEGER, PARAMETER :: NSTOP = 37316
+
+! Saturation tables and derivatives
+REAL :: ESTABW(NSTART:NSTOP)
+REAL :: DESTABW(NSTART:NSTOP)
+REAL :: ESTABI(NSTART:NSTOP)
+REAL :: DESTABI(NSTART:NSTOP)
+
+! Ice crystal- or water droplet tables
+REAL :: A2TAB(NSTART:NSTOP)
+REAL :: BB3TAB(NSTART:NSTOP)
+REAL :: AM3TAB(NSTART:NSTOP)
+REAL :: AF3TAB(NSTART:NSTOP)
+REAL :: A2WTAB(NSTART:NSTOP)
+REAL :: BB3WTAB(NSTART:NSTOP)
+REAL :: REDINTAB(NSTART:NSTOP)
+
+CONTAINS
+
+ REAL FUNCTION ESATW(TT)
+ REAL,INTENT(IN) :: TT
+ ESATW = ESTABW(NINT(XNDEGR*TT))
+ END FUNCTION ESATW
+
+ REAL FUNCTION DESDTW(TT)
+ REAL,INTENT(IN) :: TT
+ DESDTW = DESTABW(NINT(XNDEGR*TT))
+ END FUNCTION
+
+ REAL FUNCTION ESATI(TT)
+ REAL,INTENT(IN) :: TT
+ ESATI = ESTABI(NINT(XNDEGR*TT))
+ END FUNCTION
+
+ REAL FUNCTION DESDTI(TT)
+ REAL,INTENT(IN) :: TT
+ DESDTI = DESTABI(NINT(XNDEGR*TT))
+ END FUNCTION
+
+! Water droplet function:
+ REAL FUNCTION AA2W(TT)
+ REAL,INTENT(IN) :: TT
+ AA2W = A2WTAB(NINT(XNDEGR*TT))
+ END FUNCTION
+
+! Ice crystal function
+ REAL FUNCTION AA2(TT)
+ REAL,INTENT(IN) :: TT
+ AA2 = A2TAB(NINT(XNDEGR*TT))
+ END FUNCTION
+
+! Meyers IN concentration function:
+ REAL FUNCTION AM3(TT)
+ REAL,INTENT(IN) :: TT
+ AM3 = AM3TAB(NINT(XNDEGR*TT))
+ END FUNCTION
+
+! Fletchers IN concentration function:
+ REAL FUNCTION AF3(TT)
+ REAL,INTENT(IN) :: TT
+ AF3 = AF3TAB(NINT(XNDEGR*TT))
+ END FUNCTION
+
+! Ice crystal function
+ REAL FUNCTION BB3(TT)
+ REAL,INTENT(IN) :: TT
+ BB3 = BB3TAB(NINT(XNDEGR*TT))
+ END FUNCTION
+
+! Water droplet function:
+ REAL FUNCTION BB3W(TT)
+ REAL,INTENT(IN) :: TT
+ BB3W = BB3WTAB(NINT(XNDEGR*TT))
+ END FUNCTION
+
+! Function for IN concentration reduction between 0 and -25 C:
+ REAL FUNCTION REDIN(TT)
+ REAL,INTENT(IN) :: TT
+ REDIN = REDINTAB(NINT(XNDEGR*TT))
+ END FUNCTION
+END MODULE MODE_TIWMX
diff --git a/src/PHYEX/micro/mode_tiwmx_fun.f90 b/src/PHYEX/micro/mode_tiwmx_fun.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7a708b85990e271b4aad7bf0296383ff2073623d
--- /dev/null
+++ b/src/PHYEX/micro/mode_tiwmx_fun.f90
@@ -0,0 +1,108 @@
+!@no_insert_drhook
+! ######spl
+ MODULE MODE_TIWMX_FUN
+! ###############
+!
+!!**** *MODD_TIWMX_FUN* -
+!!
+!! PURPOSE
+!! -------
+! The purpose of this ...
+!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (ha ha)
+!!
+!! AUTHOR
+!! ------
+!! K. I. Ivarsson *SMHI*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/11/14
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XALPW,XBETAW,XGAMW,XTT,XALPI,XBETAI,XGAMI,XLSTT,XRV,XLVTT,&
+ &XLSTT,XP00,XCPV,XCI,XCL
+
+IMPLICIT NONE
+
+CONTAINS
+!
+ REAL FUNCTION ESATW(TT)
+ REAL,INTENT(IN) :: TT
+ ESATW = EXP( XALPW - XBETAW/TT - XGAMW*ALOG(TT) )
+ END FUNCTION ESATW
+!
+! pure saturation pressure over ice for tt <0 C,
+! esatw otherwise.
+!
+ REAL FUNCTION ESATI(TT)
+ REAL,INTENT(IN) :: TT
+ ESATI = ( 0.5 + SIGN(0.5,TT-XTT) )*EXP( XALPW - XBETAW/TT - XGAMW*ALOG(TT) ) - &
+ & ( SIGN(0.5,TT-XTT) - 0.5)*EXP( XALPI - XBETAI/TT - XGAMI*ALOG(TT) )
+ END FUNCTION ESATI
+!
+! pure saturation pressure over water
+ REAL FUNCTION DESDTW(TT)
+ REAL,INTENT(IN) :: TT
+ DESDTW = ESATW(TT)*(XBETAW/TT - XGAMW)/TT
+ END FUNCTION DESDTW
+
+ REAL FUNCTION DESDTI(TT)
+ REAL,INTENT(IN) :: TT
+ DESDTI = ( 0.5 + SIGN(0.5,TT-XTT) )*DESDTW(TT) - &
+ & ( SIGN(0.5,TT-XTT) - 0.5)*ESATI(TT)*(XBETAI/TT - XGAMI)/TT
+ END FUNCTION DESDTI
+
+! Ice crystal function:
+ REAL FUNCTION AA2(TT)
+ REAL,INTENT(IN) :: TT
+ AA2 = ( XLSTT + (XCPV-XCI)*(TT-XTT) )**2 / &
+ & (2.38E-2 + 0.0071E-2 *(TT - XTT))/(TT**2*XRV)
+ END FUNCTION AA2
+
+! Water droplet function:
+ REAL FUNCTION AA2W(TT)
+ REAL,INTENT(IN) :: TT
+ AA2W = ( (XLVTT+ (XCPV-XCL)*(TT-XTT))**2)/ &
+ & (2.38E-2 + 0.0071E-2 *(TT - XTT))/(TT**2*XRV)
+ END FUNCTION AA2W
+
+! Ice crystal function:
+ REAL FUNCTION BB3(TT)
+ REAL,INTENT(IN) :: TT
+ BB3 = XRV/(0.211E-4 * (TT/XTT)**1.94 * XP00)*TT/ESATI(TT)
+ END FUNCTION BB3
+
+! Water droplet function:
+ REAL FUNCTION BB3W(TT)
+ REAL,INTENT(IN) :: TT
+ BB3W = XRV/(0.211E-4 * (TT/XTT)**1.94 * XP00)*TT/ESATW(TT)
+ END FUNCTION BB3W
+
+! Meyers IN concentration function:
+ REAL FUNCTION AM3(TT)
+ REAL,INTENT(IN) :: TT
+ AM3 = 1000.*EXP(12.96*(ESATW(TT)/ESATI(TT) -1.) -0.639)
+ END FUNCTION AM3
+
+! Fletchers IN concentration function:
+ REAL FUNCTION AF3(TT)
+ REAL,INTENT(IN) :: TT
+ AF3 = 0.01*EXP(0.6*(XTT-TT))
+ END FUNCTION AF3
+
+! Function for IN concentration reduction between 0 and -20 C:
+ REAL FUNCTION REDIN(TT)
+ REAL,INTENT(IN) :: TT
+ REAL ZZT
+ ZZT = MAX(0., MIN(1.,(XTT - TT)/20.))
+ REDIN = 1.- (1.-ZZT)/(ZZT**3 + (1.-ZZT)**3)**.333
+ END FUNCTION REDIN
+
+END MODULE MODE_TIWMX_FUN
diff --git a/src/PHYEX/micro/mode_tiwmx_tab.f90 b/src/PHYEX/micro/mode_tiwmx_tab.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e8e42bcd6ef2d9082705d9351d42db729ebca2d9
--- /dev/null
+++ b/src/PHYEX/micro/mode_tiwmx_tab.f90
@@ -0,0 +1,109 @@
+MODULE MODE_TIWMX_TAB
+IMPLICIT NONE
+CONTAINS
+FUNCTION TIWMX_TAB(P,T,QR,FICE,QRSN,RS,EPS)
+
+! Purpose: (*)
+! The fuction tiwmx_tab returns the wet bulb temperature, but also the
+! corresponding saturation specific humidity as an output parameter.
+! -------------------------------------------------------------------
+! Computation of wet bulb temperature.
+! TIW is found iteratively. Note that Q is used instead of WV.
+! Converges VERY quickly. EPS is the threshold value for
+! TIW(n)-TIW(n-1) at wich the iteration is interupted. (n is
+! iteration number).
+! Modified in July 1988 by Stefan Gollvik
+! Converted to new fortran standard in Dec. 2006 by Karl-Ivar Ivarsson.
+
+! INTERFACE : the function is intended to be used everywhere.
+! INPUT arguments (arguments d'entree)
+! -----------------------------------------------------
+! P : pressure (Pa)
+! T : temperature (K)
+! QR : mixing ratio humidity (kg/Kg)
+! FICE : fraction of ice (0 to 1)
+! EPS : The value determines the accuracy of the output value. 0.1
+! : is suffient in most cases. Low value means high accuracy but
+! : also high computational cost.
+
+! OUTPUT arguments (arguments d'sortie)
+! -----------------------------------------------------
+! RS : saturation mixing ratio (fice determines if it is over ice or water)
+!
+! QRSN : saturation mixing ratio for the wet bulb temperature.
+! (Kg/Kg)
+! ( the function itself is the wet bulb temperature (K) )
+
+! Work variables :
+! -----------------------------------------------------
+! f : temporary variable , temperature (K)
+! dfdt : temporary variable (K/K)
+! t2 : temperature used in iteration (K)
+! dt : temperature residual (K)
+! dqsdt : d(qsat)/d(T) in iteration (1/K)
+! b : (latent heat)/(heat capacity for dry air) (K)
+! iter : iteration number
+
+! 1. Declarations.
+! ==================================================================
+! 1.1 MODULES USED
+
+ USE MODD_CST, ONLY : XEPSILO, XCPD, XLSTT, XLVTT
+ USE MODE_TIWMX, ONLY : ESATI, ESATW, DESDTI, DESDTW
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE PARKIND1, ONLY : JPRB
+
+ IMPLICIT NONE
+
+! Function name :
+ REAL :: TIWMX_TAB
+
+! Input Arguments
+ REAL, INTENT(IN) :: P,T,QR,FICE,EPS
+
+! Output Arguments
+ REAL, INTENT(OUT) :: QRSN,RS
+
+! Work variables :
+ REAL :: F,DFDT,T2,DT,QSN,DQSDT,B
+ REAL :: ZES,ZDESDT
+ INTEGER :: ITER
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ IF (LHOOK) CALL DR_HOOK('TIWMX_TAB',0,ZHOOK_HANDLE)
+
+ T2 = T
+
+ B = ( XLVTT*(1.-FICE) + FICE*XLSTT )/XCPD
+
+ TIWMX_TAB = T2
+ DO ITER=1,10
+ ZES = ESATI(T2)*FICE + ESATW(T2)*(1.-FICE)
+ ZDESDT= DESDTI(T2)*FICE + DESDTW(T2)*(1.-FICE)
+ IF(ZES >= P*0.61)THEN ! Do not to compute when condensation
+ QRSN = 1. ! not possible and avoid mixing ratio > 1
+ TIWMX_TAB = T2
+ IF (LHOOK) CALL DR_HOOK('TIWMX_TAB',1,ZHOOK_HANDLE)
+ RETURN
+ ELSE
+ QSN = XEPSILO*ZES/(P-ZES)
+ DQSDT = QSN*ZDESDT*( 1.0/ZES + 1.0/(P-ZES) )
+ ENDIF
+ IF ( ITER == 1 ) RS = QSN
+ F = T2 - T + B*(QSN - QR)
+ DFDT = 1. + B*DQSDT
+ DT = -F / DFDT
+ T2 = T2 + DT
+ IF(ABS(DT) <= EPS)THEN
+ TIWMX_TAB = T2
+ QSN = MIN(1.,QSN+DT*DQSDT)
+ QRSN = QSN ! approximation
+ IF (LHOOK) CALL DR_HOOK('TIWMX_TAB',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ ENDDO
+
+ IF (LHOOK) CALL DR_HOOK('TIWMX_TAB',1,ZHOOK_HANDLE)
+
+END FUNCTION TIWMX_TAB
+END MODULE MODE_TIWMX_TAB
diff --git a/src/PHYEX/micro/modi_condensation.f90 b/src/PHYEX/micro/modi_condensation.f90
new file mode 100644
index 0000000000000000000000000000000000000000..812dae784eb9a29e7c860111520c12e6fc82a32c
--- /dev/null
+++ b/src/PHYEX/micro/modi_condensation.f90
@@ -0,0 +1,81 @@
+! ######spl
+ MODULE MODI_CONDENSATION
+! ########################
+!
+INTERFACE
+!
+ SUBROUTINE CONDENSATION(D, CST, ICEP, NEB, TURBN, &
+ &HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ &PPABS, PZZ, PRHODREF, PT, PRV_IN, PRV_OUT, PRC_IN, PRC_OUT, PRI_IN, PRI_OUT, &
+ &PRR, PRS, PRG, PSIGS, LMFCONV, PMFCONV, PCLDFR, PSIGRC, OUSERI, &
+ &OSIGMAS, OCND2, LHGT_QS, &
+ &PICLDFR, PWCLDFR, PSSIO, PSSIU, PIFR, PSIGQSAT, &
+ &PLV, PLS, PCPH, &
+ &PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ &PICE_CLD_WGT)
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(LEN=4), INTENT(IN) :: HCONDENS
+CHARACTER(LEN=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABS ! pressure (Pa)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PT ! grid scale T (K)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRV_IN ! grid scale water vapor mixing ratio (kg/kg) in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRV_OUT! grid scale water vapor mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC_IN ! grid scale r_c mixing ratio (kg/kg) in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRC_OUT! grid scale r_c mixing ratio (kg/kg) in output
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRI_IN ! grid scale r_i (kg/kg) in input
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRI_OUT! grid scale r_i (kg/kg) in output
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRR ! grid scale mixing ration of rain (kg/kg)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+LOGICAL, INTENT(IN) :: LMFCONV ! =SIZE(PMFCONV)!=0
+REAL, DIMENSION(MERGE(D%NIJT,0,LMFCONV),&
+ MERGE(D%NKT,0,LMFCONV)), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
+
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+ ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! or only solid condensate (OUSERI=.FALSE.)
+LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
+ ! or that from turbulence scheme
+LOGICAL, INTENT(IN) :: OCND2 ! logical switch to sparate liquid and ice
+ ! more rigid (DEFALT value : .FALSE.)
+LOGICAL, INTENT(IN) :: LHGT_QS! logical switch for height dependent VQSIGSAT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PICLDFR ! ice cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWCLDFR ! water or mixed-phase cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSSIO ! Super-saturation with respect to ice in the
+ ! supersaturated fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSSIU ! Sub-saturation with respect to ice in the
+ ! subsaturated fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PIFR ! Ratio cloud ice moist part
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+ ! multiplied by PSIGQSAT
+
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
+END SUBROUTINE CONDENSATION
+!
+END INTERFACE
+!
+END MODULE MODI_CONDENSATION
diff --git a/src/PHYEX/micro/modi_ice_adjust.f90 b/src/PHYEX/micro/modi_ice_adjust.f90
new file mode 100644
index 0000000000000000000000000000000000000000..95680b082309ec4a6e00eb196b0028a770c96550
--- /dev/null
+++ b/src/PHYEX/micro/modi_ice_adjust.f90
@@ -0,0 +1,111 @@
+! ######################
+ MODULE MODI_ICE_ADJUST
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE ICE_ADJUST (D, CST, ICEP, NEB, TURBN, BUCONF, KRR, &
+ &HFRAC_ICE, &
+ &HBUNAME, OCND2, LHGT_QS, &
+ &PTSTEP, PSIGQSAT, &
+ &PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,&
+ &PPABST, PZZ, &
+ &PEXN, PCF_MF, PRC_MF, PRI_MF, &
+ &PICLDFR, PWCLDFR, PSSIO, PSSIU, PIFR, &
+ &PRV, PRC, PRVS, PRCS, PTH, PTHS, &
+ &OCOMPUTE_SRC, PSRCS, PCLDFR, &
+ &PRR, PRI, PRIS, PRS, PRG, TBUDGETS, KBUDGETS, &
+ &PICE_CLD_WGT, &
+ &PRH, &
+ &POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ &PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF)
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(LEN=4), INTENT(IN) :: HBUNAME ! Name of the budget
+LOGICAL, INTENT(IN) :: OCND2 ! logical switch to separate liquid
+ ! and ice
+ ! more rigid (DEFAULT value : .FALSE.)
+LOGICAL, INTENT(IN) :: LHGT_QS ! logical switch for height dependent VQSIGSAT
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%LSUBG_COND),&
+ MERGE(D%NKT,0,TURBN%LSUBG_COND)), INTENT(IN) :: PSIGS ! Sigma_s at time t
+LOGICAL, INTENT(IN) :: LMFCONV ! =SIZE(PMFCONV)!=0
+REAL, DIMENSION(MERGE(D%NIJT,0,LMFCONV),&
+ MERGE(D%NKT,0,LMFCONV)), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! height of model layer
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PCF_MF ! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC_MF ! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRI_MF ! Convective Mass Flux ice mixing ratio
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRV ! Water vapor m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC ! Cloud water m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTH ! Theta to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHS ! Theta source
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PICLDFR ! ice cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWCLDFR ! water or mixed-phase cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSSIO ! Super-saturation with respect to ice in the
+ ! supersaturated fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSSIU ! Sub-saturation with respect to ice in the
+ ! subsaturated fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PIFR ! Ratio cloud ice moist part to dry part
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRR ! Rain water m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRI ! Cloud ice m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRS ! Aggregate m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRG ! Graupel m.r. to adjust
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT):: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH ! Hail m.r. to adjust
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+!
+END SUBROUTINE ICE_ADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_ICE_ADJUST
+
diff --git a/src/PHYEX/micro/modi_ini_neb.f90 b/src/PHYEX/micro/modi_ini_neb.f90
new file mode 100644
index 0000000000000000000000000000000000000000..eaa71d814aba5264d69e8de759b00ce5f52d9190
--- /dev/null
+++ b/src/PHYEX/micro/modi_ini_neb.f90
@@ -0,0 +1,16 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_INI_NEB
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE INI_NEB
+END SUBROUTINE INI_NEB
+!
+END INTERFACE
+!
+END MODULE MODI_INI_NEB
diff --git a/src/PHYEX/micro/modi_ini_rain_ice.f90 b/src/PHYEX/micro/modi_ini_rain_ice.f90
new file mode 100644
index 0000000000000000000000000000000000000000..24dd0d68de12ce2b27d5d2ef3f0a9e60f1978fa1
--- /dev/null
+++ b/src/PHYEX/micro/modi_ini_rain_ice.f90
@@ -0,0 +1,23 @@
+! ######spl
+ MODULE MODI_INI_RAIN_ICE
+! ########################
+!
+INTERFACE
+ SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+!
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
+!
+END SUBROUTINE INI_RAIN_ICE
+!
+END INTERFACE
+!
+END MODULE MODI_INI_RAIN_ICE
diff --git a/src/PHYEX/micro/modi_ini_snow.f90 b/src/PHYEX/micro/modi_ini_snow.f90
new file mode 100644
index 0000000000000000000000000000000000000000..788ec7c9a8f216a921b5ddcbba27ab78195188b0
--- /dev/null
+++ b/src/PHYEX/micro/modi_ini_snow.f90
@@ -0,0 +1,15 @@
+! ######spl
+ MODULE MODI_INI_SNOW
+! ########################
+!
+INTERFACE
+ SUBROUTINE INI_SNOW ( KLUOUT )
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+
+!
+END SUBROUTINE INI_SNOW
+!
+END INTERFACE
+!
+END MODULE MODI_INI_SNOW
diff --git a/src/PHYEX/micro/modi_ini_tiwmx.f90 b/src/PHYEX/micro/modi_ini_tiwmx.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9ef7e6409e537b13fe57af01140bc353dddfe029
--- /dev/null
+++ b/src/PHYEX/micro/modi_ini_tiwmx.f90
@@ -0,0 +1,16 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ######spl
+ MODULE MODI_INI_TIWMX
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE INI_TIWMX
+END SUBROUTINE INI_TIWMX
+!
+END INTERFACE
+!
+END MODULE MODI_INI_TIWMX
diff --git a/src/PHYEX/micro/modi_rain_ice.f90 b/src/PHYEX/micro/modi_rain_ice.f90
new file mode 100644
index 0000000000000000000000000000000000000000..44988b26ccd07cc685a414d4c073471c676dc866
--- /dev/null
+++ b/src/PHYEX/micro/modi_rain_ice.f90
@@ -0,0 +1,97 @@
+! ######spl
+ MODULE MODI_RAIN_ICE
+! ####################
+!
+INTERFACE
+ SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ KPROMA, KSIZE, &
+ OCND2, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ PTSTEP, KRR, ODMICRO, PEXN, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC, PINPRR, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS, KBUDGETS, &
+ PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
+!
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Switch for ri->rs Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLI_HCF
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(MERGE(D%NIJT, 0, PARAMI%LDEPOSC)), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+!
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+END SUBROUTINE RAIN_ICE
+END INTERFACE
+END MODULE MODI_RAIN_ICE
diff --git a/src/PHYEX/micro/radtr_satel.f90 b/src/PHYEX/micro/radtr_satel.f90
index ce4f86451ba3abeb5fa293ff5036fccfe8d9138e..5c79550bb3f34b5eb7929616036b6468aa5c01ec 100644
--- a/src/PHYEX/micro/radtr_satel.f90
+++ b/src/PHYEX/micro/radtr_satel.f90
@@ -111,9 +111,14 @@ END MODULE MODI_RADTR_SATEL
USE MODD_CST
USE MODD_PARAMETERS
USE MODD_GRID_n
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM
+USE MODD_NEB, ONLY: NEB
+USE MODD_TURB_n, ONLY: TURBN
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
USE MODD_RAD_TRANSF
USE MODE_ll
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
!
USE MODI_INIT_NBMOD
USE MODI_DETER_ANGLE
@@ -254,10 +259,12 @@ REAL :: ZFLWP, ZFIWP, ZANGCOR, ZRADLP, ZMULTS, ZTMP, ZKI
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! Temperature
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGRC ! s r_c / sig_s^2
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZNCLD ! grid scale cloud fraction
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC ! grid scale r_c mixing ratio (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI ! grid scale r_i (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! grid scale r_v (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_IN, ZRC_OUT ! grid scale r_c mixing ratio (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_IN, ZRI_OUT ! grid scale r_i (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_IN, ZRV_OUT ! grid scale r_v (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
+REAL, DIMENSION(SIZE(PPABST,1),SIZE(PPABST,2)) :: ZSIGQSAT2D, ZDUM
+TYPE(DIMPHYEX_t) :: D
!----------------------------------------------------------------------------
!
!* 1. INITIALIZATION OF CONSTANTS FOR TRANSFERT CODE
@@ -279,6 +286,7 @@ IKU = SIZE(PTHT,3)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = IKU - JPVEXT
+CALL FILL_DIMPHYEX(D, IIU, IJU, IKU)
!
IKSTAE = SIZE(PSTATM,1)
IKUP = IKE-JPVEXT+1
@@ -465,24 +473,38 @@ ZCLDLU = 0.
!
IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
ALLOCATE(ZNCLD(IIU,IJU,IKU))
- ALLOCATE(ZRC(IIU,IJU,IKU))
- ZRC=PRT(:,:,:,2)
- ALLOCATE(ZRI(IIU,IJU,IKU))
- ZRI=0.
- IF( OUSERI ) ZRI=PRT(:,:,:,4)
+ ALLOCATE(ZRC_IN(IIU,IJU,IKU))
+ ALLOCATE(ZRC_OUT(IIU,IJU,IKU))
+ ZRC_IN=PRT(:,:,:,2)
+ ALLOCATE(ZRI_IN(IIU,IJU,IKU))
+ ALLOCATE(ZRI_OUT(IIU,IJU,IKU))
+ ZRI_IN=0.
+ IF( OUSERI ) ZRI_IN=PRT(:,:,:,4)
IF ( .NOT. OSUBG_COND .AND. ORAD_SUBG_COND) THEN
PRINT*,' THE SUBGRID CONDENSATION SCHEME IN DIAGNOSTIC MODE IS ACTIVATED'
ALLOCATE(ZTEMP(IIU,IJU,IKU))
ZTEMP=PTHT*ZEXNT
ALLOCATE(ZSIGRC(IIU,IJU,IKU))
- ALLOCATE(ZRV(IIU,IJU,IKU))
- ZRV=PRT(:,:,:,1)
+ ALLOCATE(ZRV_IN(IIU,IJU,IKU))
+
+ ZRV_IN=PRT(:,:,:,1)
ALLOCATE(ZRHO(IIU,IJU,IKU))
ZRHO=1. !unused
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'T', 'CB02', 'CB',&
- PPABST, PZZ, ZRHO, ZTEMP, ZRV, ZRC, ZRI, PRT(:,:,:,5), PRT(:,:,:,6), PSIGS,&
- PMFCONV, ZNCLD, ZSIGRC, OUSERI, OSIGMAS,PSIGQSAT )
+ ZSIGQSAT2D(:,:)=PSIGQSAT
+ !CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, &
+ ! 'T', 'CB02', 'CB',&
+ ! PPABST, PZZ, ZRHO, ZTEMP, ZRV_IN, ZRV_OUT, ZRC_IN, ZRC_OUT, ZRI_IN, ZRI_OUT, &
+ ! PRT(:,:,:,2), PRT(:,:,:,5), PRT(:,:,:,6), PSIGS, PMFCONV, ZNCLD, &
+ ! ZSIGRC, OUSERI, OSIGMAS, .FALSE., .FALSE., &
+ ! ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, ZSIGQSAT2D )
+ CALL CONDENSATION(D, CST, RAIN_ICE_PARAM, NEB, TURBN, &
+ &'T', 'CB02', 'CB', &
+ &PPABST, PZZ, ZRHO, ZTEMP, ZRV_IN, ZRV_OUT, ZRC_IN, ZRC_OUT, ZRI_IN, ZRI_OUT, &
+ &PRT(:,:,:,2), PRT(:,:,:,5), PRT(:,:,:,6), PSIGS, .FALSE., PMFCONV, ZNCLD, ZSIGRC, .FALSE., &
+ &OSIGMAS, .FALSE., .FALSE., &
+ &ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, ZSIGQSAT2D)
DEALLOCATE(ZTEMP,ZSIGRC)
+ DEALLOCATE(ZRV_OUT)
ELSE
ZNCLD=PCLDFR
END IF
@@ -492,10 +514,10 @@ IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
DO JI=IIB,IIE
IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
IF ( ZVIEW(IIJ) /= XUNDEF .AND. &
- (ZRC(JI,JJ,JK) > 0. .OR. ZRI(JI,JJ,JK) > 0. ) ) THEN
- ZFLWP = ZRC(JI,JJ,JK) / XG /MAX(1.E-10,ZNCLD(JI,JJ,JK)) &
+ (ZRC_OUT(JI,JJ,JK) > 0. .OR. ZRI_OUT(JI,JJ,JK) > 0. ) ) THEN
+ ZFLWP = ZRC_OUT(JI,JJ,JK) / XG /MAX(1.E-10,ZNCLD(JI,JJ,JK)) &
* (PPABST(JI,JJ,JK)-PPABST(JI,JJ,JK+1))
- ZFIWP = ZRI(JI,JJ,JK) / XG /MAX(1.E-10,ZNCLD(JI,JJ,JK)) &
+ ZFIWP = ZRI_OUT(JI,JJ,JK) / XG /MAX(1.E-10,ZNCLD(JI,JJ,JK)) &
* (PPABST(JI,JJ,JK)-PPABST(JI,JJ,JK+1))
ZANGCOR = ZVIEW(IIJ) / 1.66
!!!Parametrization following Ou and Chou, 1995 (Atmos. Res.)
@@ -512,7 +534,7 @@ IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
END DO
END DO
END DO
- DEALLOCATE(ZNCLD,ZRC,ZRI)
+ DEALLOCATE(ZNCLD,ZRC_OUT,ZRI_OUT)
END IF
!
DEALLOCATE(ZEXNT)
diff --git a/src/PHYEX/micro/rain_c2r2_khko.f90 b/src/PHYEX/micro/rain_c2r2_khko.f90
index 3ccba06544041b4516ebab044175223dee4ac36d..5708c0d4c4742afee013137bff42bc0fc1d51c48 100644
--- a/src/PHYEX/micro/rain_c2r2_khko.f90
+++ b/src/PHYEX/micro/rain_c2r2_khko.f90
@@ -13,7 +13,7 @@ INTERFACE
PZZ, PRHODJ, &
PRHODREF, PEXNREF, &
PPABST, PTHT, PRVT, PRCT, &
- PRRT, PTHM, PRCM, PPABSTT, &
+ PRRT, PTHM, PRCM, PPABSM, &
PW_NU,PDTHRAD, PTHS, PRVS, PRCS, PRRS, &
PCNT, PCCT, PCRT, PCNS, PCCS, PCRS, &
PINPRC, PINPRR, PINPRR3D, PEVAP3D,PAEROT, &
@@ -48,7 +48,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
@@ -87,7 +87,7 @@ END MODULE MODI_RAIN_C2R2_KHKO
KMI, TPFILE, PZZ, PRHODJ, &
PRHODREF, PEXNREF, &
PPABST, PTHT, PRVT, PRCT, &
- PRRT, PTHM, PRCM, PPABSTT, &
+ PRRT, PTHM, PRCM, PPABSM, &
PW_NU,PDTHRAD, PTHS, PRVS, PRCS, PRRS, &
PCNT, PCCT, PCRT, PCNS, PCCS, PCRS, &
PINPRC, PINPRR, PINPRR3D, PEVAP3D,PAEROT, &
@@ -274,7 +274,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
@@ -622,7 +622,7 @@ ZZW1LOG(:,:,:)= 0. ! supersaturation
ZTDT(:,:,:) = 0.
ZDRC(:,:,:) = 0.
IF (OACTIT) THEN
- ZTM(:,:,:) = PTHM(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
! Modif M.Mazoyer
@@ -946,7 +946,7 @@ ZZW1LOG(:,:,:)= 0. ! supersaturation
ZTDT(:,:,:) = 0.
ZDRC(:,:,:) = 0.
IF (OACTIT) THEN
- ZTM(:,:,:) = PTHM(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
diff --git a/src/PHYEX/micro/rain_ice.f90 b/src/PHYEX/micro/rain_ice.f90
index 373bd2379cbcf2f919d59ac07cf98a28f0971cbf..aa9b05d272540471381ce91dd65f468fb73b6be2 100644
--- a/src/PHYEX/micro/rain_ice.f90
+++ b/src/PHYEX/micro/rain_ice.f90
@@ -4,104 +4,18 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODI_RAIN_ICE_RED
-! ########################
-!
-INTERFACE
- SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
- OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
- OWARM, KKA, KKU, KKL, &
- PTSTEP, KRR, ODMICRO, PEXN, &
- PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
- PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
-!
-!
-INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
- ! Kind of Subgrid autoconversion method
-CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Switch for ri->rs Subgrid autoconversion
- ! Kind of Subgrid autoconversion method
-LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
- ! form by warm processes
- ! (Kessler scheme)
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-!
-END SUBROUTINE RAIN_ICE_RED
-END INTERFACE
-END MODULE MODI_RAIN_ICE_RED
-! ######spl
- SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
- OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
- OWARM,KKA,KKU,KKL,&
+ SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ KPROMA, KSIZE, &
+ OCND2,HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
+ PINPRC, PINPRR, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS, KBUDGETS, &
+ PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
! ######################################################################
!
@@ -257,6 +171,7 @@ END MODULE MODI_RAIN_ICE_RED
! P. Wautelet 17/01/2020: move Quicksort to tools.f90
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
+!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!-----------------------------------------------------------------
!
@@ -266,146 +181,176 @@ END MODULE MODI_RAIN_ICE_RED
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-use modd_budget, only: lbu_enable, &
- lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
- tbudgets
-USE MODD_CST, ONLY: XCI,XCL,XCPD,XCPV,XLSTT,XLVTT,XTT
-USE MODD_PARAMETERS, ONLY: JPVEXT,XUNDEF
-USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPOSC,LFEEDBACKT,LSEDIM_AFTER, &
- NMAXITER,XMRSTEP,XTSTEP_TS,XVDEPOSC,LSNOW_T
-USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN,XLBDAS_MIN,XLBDAS_MAX,XTRANS_MP_GAMMAS,XLBS,XLBEXS
-USE MODD_VAR_ll, ONLY: IP
-
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
-USE MODE_ll
-USE MODE_MSG
-use mode_tools, only: Countjv
-
-USE MODI_ICE4_NUCLEATION_WRAPPER
-USE MODI_ICE4_RAINFR_VERT
-USE MODI_ICE4_SEDIMENTATION_STAT
-USE MODI_ICE4_SEDIMENTATION_SPLIT
-USE MODI_ICE4_TENDENCIES
-
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
+ & ITH, & ! Potential temperature
+ & IRV, & ! Water vapor
+ & IRC, & ! Cloud water
+ & IRR, & ! Rain water
+ & IRI, & ! Pristine ice
+ & IRS, & ! Snow/aggregate
+ & IRG, & ! Graupel
+ & IRH ! Hail
+
+USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+
+USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
+USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
+USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
+USE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM, ONLY: ICE4_SEDIMENTATION_SPLIT_MOMENTUM
+USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
+USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
!
-INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
+LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
-LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
- ! form by warm processes
- ! (Kessler scheme)
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(KIT,KJT,KKT),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PHLI_HCF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(MERGE(D%NIJT, 0, PARAMI%LDEPOSC)), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
!
!* 0.2 Declarations of local variables :
!
-REAL, DIMENSION(SIZE(PRST,1),SIZE(PRST,2),SIZE(PRST,3)) :: ZLBDAS ! Modif !lbda parameter snow
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+INTEGER :: JIJ, JK
+INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE
+INTEGER :: ISTIJ, ISTK
+!
+!Arrays for nucleation call outisde of ODMICRO points
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZW ! work array
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZT ! Temperature
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ & ZZ_RVHENI ! heterogeneous nucleation
+REAL, DIMENSION(MERGE(D%NIJT, 0, BUCONF%LBU_ENABLE), &
+ &MERGE(D%NKT, 0, BUCONF%LBU_ENABLE)) :: ZW1, ZW2, ZW3, ZW4, ZW5, ZW6 !Work arrays
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_LVFACT, ZZ_LSFACT, ZZ_DIFF
+!
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRCT ! Cloud water m.r. source at t
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRRT ! Rain water m.r. source at t
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRIT ! Pristine ice m.r. source at t
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRST ! Snow/aggregate m.r. source at t
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRGT ! Graupel m.r. source at t
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRHT ! Hail m.r. source at t
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZCITOUT ! Output value for CIT
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZLBDAS ! Modif !lbda parameter snow
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB, IKTB !
-INTEGER :: IKE, IKTE !
+!Diagnostics
+REAL, DIMENSION(D%NIJT) :: ZINPRI ! Pristine ice instant precip
!
-INTEGER :: JI, JJ, JK
+LOGICAL :: GEXT_TEND
+LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
+INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
+REAL :: ZW0D
+REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
+REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
+REAL :: ZTIME_THRESHOLD ! Time to reach threshold
+!For total tendencies computation
+REAL, DIMENSION(D%NIJT,D%NKT,0:7) :: ZWR
+!
+!Output packed total mixing ratio change (for budgets only)
+REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
+ & ZTOT_RCHONI, & ! Homogeneous nucleation
+ & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
+ & ZTOT_RVDEPS, & ! Deposition on r_s,
+ & ZTOT_RIAGGS, & ! Aggregation on r_s
+ & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
+ & ZTOT_RVDEPG, & ! Deposition on r_g
+ & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
+ & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
+ & ZTOT_RREVAV, & ! Evaporation of r_r
+ & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
+ & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
+ & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
+ & ZTOT_RHMLTR, & ! Melting of the hailstones
+ & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
+ & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
+ & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
+ & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
+ & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
+ & ZTOT_RWETGH, & ! Conversion of graupel into hail
+ & ZTOT_RGMLTR, & ! Melting of the graupel
+ & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
+ & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
+ & ZTOT_RDRYHG ! Conversion of hailstone into graupel
!
!For packing
INTEGER :: IMICRO ! Case r_x>0 locations
-INTEGER, DIMENSION(KSIZE) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-!Arrays for nucleation call outisde of LDMICRO points
-REAL, DIMENSION(KIT, KJT, KKT) :: ZW ! work array
-REAL, DIMENSION(KIT, KJT, KKT) :: ZT ! Temperature
-REAL, DIMENSION(KIT, KJT, KKT) :: &
- & ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
- & ZZ_RVHENI ! heterogeneous nucleation
-real, dimension(:,:,:), allocatable :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
-real, dimension(:,:,:), allocatable :: zz_diff
-REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT
-!
-!Diagnostics
-REAL, DIMENSION(KIT, KJT, KKT) :: &
- & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
- & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
- & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
- & ZHLC_LRC3D,& ! HLCLOUDS cloud water content in low water content
- & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
- & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
- & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
- & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
-
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
-!
-!Packed variables
-REAL, DIMENSION(KSIZE) :: ZRVT, & ! Water vapor m.r. at t
- & ZRCT, & ! Cloud water m.r. at t
- & ZRRT, & ! Rain water m.r. at t
- & ZRIT, & ! Pristine ice m.r. at t
- & ZRST, & ! Snow/aggregate m.r. at t
- & ZRGT, & ! Graupel m.r. at t
- & ZRHT, & ! Hail m.r. at t
+INTEGER :: JL, JV
+REAL, DIMENSION(KPROMA) :: ZTIME ! Current integration time (starts with 0 and ends with PTSTEP)
+REAL, DIMENSION(KPROMA) :: &
+ & ZMAXTIME, & ! Time on which we can apply the current tendencies
+ & ZTIME_LASTCALL, & ! Integration time when last tendecies call has been done
+ & ZSSI, &
& ZCIT, & ! Pristine ice conc. at t
- & ZTHT, & ! Potential temperature
& ZRHODREF, & ! RHO Dry REFerence
& ZZT, & ! Temperature
& ZPRES, & ! Pressure
@@ -423,11 +368,11 @@ REAL, DIMENSION(KSIZE) :: ZRVT, & ! Water vapor m.r. at t
& ZHLI_HCF, &
& ZHLI_LCF, &
& ZHLI_HRI, &
- & ZHLI_LRI, &
- & ZFRAC
+ & ZHLI_LRI
+LOGICAL, DIMENSION(KPROMA) :: LLCOMPUTE ! .TRUE. or points where we must compute tendencies,
!
!Output packed tendencies (for budgets only)
-REAL, DIMENSION(KSIZE) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+REAL, DIMENSION(KPROMA) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
& ZRCHONI, & ! Homogeneous nucleation
& ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
& ZRVDEPS, & ! Deposition on r_s,
@@ -454,147 +399,102 @@ REAL, DIMENSION(KSIZE) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio
& ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
& ZRDRYHG ! Conversion of hailstone into graupel
!
-!Output packed total mixing ratio change (for budgets only)
-REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
- & ZTOT_RCHONI, & ! Homogeneous nucleation
- & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
- & ZTOT_RVDEPS, & ! Deposition on r_s,
- & ZTOT_RIAGGS, & ! Aggregation on r_s
- & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
- & ZTOT_RVDEPG, & ! Deposition on r_g
- & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
- & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
- & ZTOT_RREVAV, & ! Evaporation of r_r
- & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
- & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
- & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
- & ZTOT_RHMLTR, & ! Melting of the hailstones
- & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
- & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
- & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
- & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
- & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
- & ZTOT_RWETGH, & ! Conversion of graupel into hail
- & ZTOT_RGMLTR, & ! Melting of the graupel
- & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
- & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
- & ZTOT_RDRYHG ! Conversion of hailstone into graupel
+!For mixing-ratio-splitting
+LOGICAL :: LLCPZ0RT
+REAL :: ZTIME_THRESHOLD1D(KPROMA) ! Time to reach threshold
+REAL, DIMENSION(KPROMA, KRR) :: Z0RT ! Mixing-ratios at the beginig of the current loop
!
-!For time- or mixing-ratio- splitting
-REAL, DIMENSION(KSIZE) :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
- & Z0RCT, & ! Cloud water m.r. at the beginig of the current loop
- & Z0RRT, & ! Rain water m.r. at the beginig of the current loop
- & Z0RIT, & ! Pristine ice m.r. at the beginig of the current loop
- & Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
- & Z0RGT, & ! Graupel m.r. at the beginig of the current loop
- & Z0RHT, & ! Hail m.r. at the beginig of the current loop
- & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
- & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH
-!
-!To take into acount external tendencies inside the splitting
-REAL, DIMENSION(KSIZE) :: ZEXT_RV, & ! External tendencie for rv
- & ZEXT_RC, & ! External tendencie for rc
- & ZEXT_RR, & ! External tendencie for rr
- & ZEXT_RI, & ! External tendencie for ri
- & ZEXT_RS, & ! External tendencie for rs
- & ZEXT_RG, & ! External tendencie for rg
- & ZEXT_RH, & ! External tendencie for rh
- & ZEXT_TH, & ! External tendencie for th
- & ZEXT_WW ! Working array
-LOGICAL :: GEXT_TEND
+REAL, DIMENSION(KPROMA,0:7) :: &
+ & ZVART, & !Packed variables
+ & ZEXTPK, & !To take into acount external tendencies inside the splitting
+ & ZA, ZB
!
-INTEGER, DIMENSION(KSIZE) :: IITER ! Number of iterations done (with real tendencies computation)
-INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-REAL, DIMENSION(KSIZE) :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
- & ZMAXTIME, & ! Time on which we can apply the current tendencies
- & ZTIME_THRESHOLD, & ! Time to reach threshold
- & ZTIME_LASTCALL ! Integration time when last tendecies call has been done
-REAL, DIMENSION(KSIZE) :: ZW1D
-REAL, DIMENSION(KSIZE) :: ZCOMPUTE ! 1. for points where we must compute tendencies, 0. elsewhere
-LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
-REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
-REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
-REAL, DIMENSION(KSIZE, 8) :: ZRS_TEND
-REAL, DIMENSION(KSIZE, 8) :: ZRG_TEND
-REAL, DIMENSION(KSIZE, 10) :: ZRH_TEND
-REAL, DIMENSION(KSIZE) :: ZSSI
+REAL, DIMENSION(KPROMA, 8) :: ZRS_TEND, ZRG_TEND
+REAL, DIMENSION(KPROMA,10) :: ZRH_TEND
+
+INTEGER, DIMENSION(KPROMA) :: &
+ & I1,I2, & ! Used to replace the COUNT and PACK intrinsics on variables
+ & IITER ! Number of iterations done (with real tendencies computation)
+INTEGER, DIMENSION(KSIZE) :: I1TOT, I2TOT ! Used to replace the COUNT and PACK intrinsics
!
-!For total tendencies computation
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
- &ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS
+REAL, DIMENSION(KPROMA) :: ZSUM2, ZMAXB
+REAL :: ZDEVIDE, ZX, ZRICE
+!
+INTEGER :: IC, JMICRO
+LOGICAL :: LLSIGMA_RC, LL_ANY_ITER, LL_AUCV_ADJU
+!
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZW3D
+LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLW3D
!
!-------------------------------------------------------------------------------
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HIN', pths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HIN', prvs(:, :, :) * prhodj(:, :, :) )
-end if
+IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
+!
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IIJB=D%NIJB
+IIJE=D%NIJE
!-------------------------------------------------------------------------------
!
+IF(OCND2) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'OCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION')
+END IF
+IF(KPROMA /= KSIZE) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'For now, KPROMA must be equal to KSIZE, see code for explanation')
+ ! Microphyscs was optimized by introducing chunks of KPROMA size
+ ! Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphisical species are present
+ ! We cannot rebuild the entire 3D arrays in the subroutine, so we cannot call ice4_rainfr_vert in it
+ ! A solution would be to suppress optimisation in this case by setting KPROMA=KSIZE in rain_ice
+ ! Another solution would be to compute column by column?
+ ! Another one would be to cut tendencies in 3 parts: before rainfr_vert, rainfr_vert, after rainfr_vert
+ENDIF
+!
!* 1. COMPUTE THE LOOP BOUNDS
! -----------------------
!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=KKA+JPVEXT*KKL
-IKE=KKU-JPVEXT*KKL
-IKTB=1+JPVEXT
-IKTE=KKT-JPVEXT
-!
ZINV_TSTEP=1./PTSTEP
GEXT_TEND=.TRUE.
!
! LSFACT and LVFACT without exner
-IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
- ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
- ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
- ENDDO
- ENDDO
- ENDDO
-ELSE
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
- ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
- ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
- ENDDO
- ENDDO
+DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ IF (KRR==7) THEN
+ ZRICE=PRIT(JIJ,JK)+PRST(JIJ,JK)+PRGT(JIJ,JK)+PRHT(JIJ,JK)
+ ELSE
+ ZRICE=PRIT(JIJ,JK)+PRST(JIJ,JK)+PRGT(JIJ,JK)
+ ENDIF
+ ZDEVIDE = CST%XCPD + CST%XCPV*PRVT(JIJ,JK) + CST%XCL*(PRCT(JIJ,JK)+PRRT(JIJ,JK)) + CST%XCI*ZRICE
+ ZT(JIJ,JK) = PTHT(JIJ,JK) * PEXN(JIJ,JK)
+ ZZ_LSFACT(JIJ,JK)=(CST%XLSTT+(CST%XCPV-CST%XCI)*(ZT(JIJ,JK)-CST%XTT)) / ZDEVIDE
+ ZZ_LVFACT(JIJ,JK)=(CST%XLVTT+(CST%XCPV-CST%XCL)*(ZT(JIJ,JK)-CST%XTT)) / ZDEVIDE
ENDDO
-ENDIF
-
+ENDDO
+!
!Compute lambda_snow parameter
!ZT en KELVIN
-ZLBDAS(:,:,:)=1000.
-DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- IF (LSNOW_T) THEN
- IF (PRST(JI,JJ,JK)>XRTMIN(5)) THEN
- IF(ZT(JI,JJ,JK)>263.15) THEN
- ZLBDAS(JI,JJ,JK) = MAX(MIN(XLBDAS_MAX, 10**(14.554-0.0423*ZT(JI,JJ,JK))),XLBDAS_MIN)*XTRANS_MP_GAMMAS
+DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZLBDAS(JIJ,JK)=1000.
+ END DO
+END DO
+DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ IF (PARAMI%LSNOW_T) THEN
+ IF (PRST(JIJ,JK)>ICED%XRTMIN(5)) THEN
+ IF(ZT(JIJ,JK)>CST%XTT-10.0) THEN
+ ZLBDAS(JIJ,JK) = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*ZT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
ELSE
- ZLBDAS(JI,JJ,JK) = MAX(MIN(XLBDAS_MAX, 10**(6.226-0.0106*ZT(JI,JJ,JK))),XLBDAS_MIN)*XTRANS_MP_GAMMAS
+ ZLBDAS(JIJ,JK) = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226-0.0106*ZT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
END IF
END IF
+#if defined(REPRO48) || defined(REPRO55)
+#else
ELSE
- IF (PRST(JI,JJ,JK).GT.XRTMIN(5)) THEN
- ZLBDAS(JI,JJ,JK) = MAX(MIN(XLBDAS_MAX,XLBS*(PRHODREF(JI,JJ,JK)*PRST(JI,JJ,JK))**XLBEXS),XLBDAS_MIN)
+ IF (PRST(JIJ,JK).GT.ICED%XRTMIN(5)) THEN
+ ZLBDAS(JIJ,JK) = MAX(MIN(ICED%XLBDAS_MAX,ICED%XLBS*(PRHODREF(JIJ,JK)*PRST(JIJ,JK))**ICED%XLBEXS),ICED%XLBDAS_MIN)
END IF
+#endif
END IF
- END DO
END DO
END DO
!
@@ -603,292 +503,391 @@ END DO
!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
-IF(.NOT. LSEDIM_AFTER) THEN
+IF(.NOT. PARAMI%LSEDIM_AFTER) THEN
!
!* 2.1 sedimentation
!
- if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
-
- !Init only if not osedic (to prevent crash with double init)
- !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
- ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
- if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
- call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
-
- IF(HSEDIM=='STAT') THEN
- !SR: It *seems* that we must have two separate calls for ifort
+ IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
+
+ IF(PARAMI%CSEDIM=='STAT') THEN
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
+ ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
+ ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
+ ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
+ ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
+ ZRHT(JIJ,JK)=PRHS(JIJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
+ &PTSTEP, KRR, PARAMI%LSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- &ZLBDAS, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &ZLBDAS, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
+ &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
+ ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
+ ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
+ ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
+ ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
+ &PTSTEP, KRR, PARAMI%LSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- &ZLBDAS, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &ZLBDAS, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+ PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
- ELSEIF(HSEDIM=='SPLI') THEN
- !SR: It *seems* that we must have two separate calls for ifort
+ ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
+ &PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
+ &PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+ PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
!We correct negativities with conservation
!SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
! It is initialized with the m.r. at T and is modified by two tendencies:
! sedimentation tendency and an external tendency which represents all other
! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a specie at a given sub-timestep. From
+ ! are negative, sedimentation can remove a species at a given sub-timestep. From
! this point sedimentation stops for the remaining sub-timesteps but the other tendency
! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a specie, instead we apply
+ ! We could prevent the algorithm to not consume too much a species, instead we apply
! a correction here.
- CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
+ CALL CORRECT_NEGATIVITIES(D, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
- ELSEIF(HSEDIM=='NONE') THEN
+ ELSEIF(PARAMI%CSEDIM=='NONE') THEN
ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for PARAMI%CSEDIM='//PARAMI%CSEDIM)
END IF
+
+
+
+
+
+
+!!!!! ajouter momentum
+
+
+
+
+
+
+
+
+
+
+
+
+
+
!
!* 2.2 budget storage
!
- if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
-
- !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
- !(a warning is printed in ini_budget in that case)
- if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
- call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
ENDIF
!
+
+DO JK = IKTB,IKTE
+ !Backup of T variables
+ ZWR(:,JK,IRV)=PRVT(:,JK)
+ ZWR(:,JK,IRC)=PRCT(:,JK)
+ ZWR(:,JK,IRR)=PRRT(:,JK)
+ ZWR(:,JK,IRI)=PRIT(:,JK)
+ ZWR(:,JK,IRS)=PRST(:,JK)
+ ZWR(:,JK,IRG)=PRGT(:,JK)
+ IF (KRR==7) THEN
+ ZWR(:,JK,IRH)=PRHT(:,JK)
+ ELSE
+ ZWR(:,JK,IRH)=0.
+ ENDIF
+
+ !Preset for output 3D variables
+ IF(PARAMI%LWARM) THEN
+ PEVAP3D(:,JK)=0.
+ ENDIF
+ PRAINFR(:,JK)=0.
+#ifdef REPRO55
+ ZCITOUT(:,JK)=PCIT(:,JK)
+#else
+ ZCITOUT(:,JK)=0. !We want 0 outside of IMICRO points
+#endif
+ENDDO
+
+IF(BUCONF%LBU_ENABLE) THEN
+ ZTOT_RVHENI(:)=0.
+ ZTOT_RCHONI(:)=0.
+ ZTOT_RRHONG(:)=0.
+ ZTOT_RVDEPS(:)=0.
+ ZTOT_RIAGGS(:)=0.
+ ZTOT_RIAUTS(:)=0.
+ ZTOT_RVDEPG(:)=0.
+ ZTOT_RCAUTR(:)=0.
+ ZTOT_RCACCR(:)=0.
+ ZTOT_RREVAV(:)=0.
+ ZTOT_RCRIMSS(:)=0.
+ ZTOT_RCRIMSG(:)=0.
+ ZTOT_RSRIMCG(:)=0.
+ ZTOT_RIMLTC(:)=0.
+ ZTOT_RCBERI(:)=0.
+ ZTOT_RHMLTR(:)=0.
+ ZTOT_RSMLTG(:)=0.
+ ZTOT_RCMLTSR(:)=0.
+ ZTOT_RRACCSS(:)=0.
+ ZTOT_RRACCSG(:)=0.
+ ZTOT_RSACCRG(:)=0.
+ ZTOT_RICFRRG(:)=0.
+ ZTOT_RRCFRIG(:)=0.
+ ZTOT_RICFRR(:)=0.
+ ZTOT_RCWETG(:)=0.
+ ZTOT_RIWETG(:)=0.
+ ZTOT_RRWETG(:)=0.
+ ZTOT_RSWETG(:)=0.
+ ZTOT_RCDRYG(:)=0.
+ ZTOT_RIDRYG(:)=0.
+ ZTOT_RRDRYG(:)=0.
+ ZTOT_RSDRYG(:)=0.
+ ZTOT_RWETGH(:)=0.
+ ZTOT_RGMLTR(:)=0.
+ ZTOT_RCWETH(:)=0.
+ ZTOT_RIWETH(:)=0.
+ ZTOT_RSWETH(:)=0.
+ ZTOT_RGWETH(:)=0.
+ ZTOT_RRWETH(:)=0.
+ ZTOT_RCDRYH(:)=0.
+ ZTOT_RIDRYH(:)=0.
+ ZTOT_RSDRYH(:)=0.
+ ZTOT_RRDRYH(:)=0.
+ ZTOT_RGDRYH(:)=0.
+ ZTOT_RDRYHG(:)=0.
+ENDIF
+
!-------------------------------------------------------------------------------
-!
-!* 3. PACKING
-! --------
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
-IMICRO=0
-IF(KSIZE/=0) IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
-!Packing
-IF(IMICRO>0) THEN
- DO JL=1, IMICRO
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXN(JL) = PEXN(I1(JL),I2(JL),I3(JL))
- ZHLC_HCF(JL) = PHLC_HCF(I1(JL),I2(JL),I3(JL))
- ZHLC_HRC(JL) = PHLC_HRC(I1(JL),I2(JL),I3(JL))
- ZHLC_LRC(JL) = ZRCT(JL) - ZHLC_HRC(JL)
- ZHLI_HCF(JL) = PHLI_HCF(I1(JL),I2(JL),I3(JL))
- ZHLI_HRI(JL) = PHLI_HRI(I1(JL),I2(JL),I3(JL))
- ZHLI_LRI(JL) = ZRIT(JL) - ZHLI_HRI(JL)
- IF(ZRCT(JL)>0.) THEN
- ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
- ELSE
- ZHLC_LCF(JL)=0.
+IF (KSIZE /= COUNT(ODMICRO(IIJB:IIJE,IKTB:IKTE))) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'RAIN_ICE : KSIZE /= COUNT(ODMICRO)')
+ENDIF
+
+IF (KSIZE > 0) THEN
+
+ !Maximum number of iterations
+ !We only count real iterations (those for which we *compute* tendencies)
+ INB_ITER_MAX=PARAMI%NMAXITER
+ IF(PARAMI%XTSTEP_TS/=0.)THEN
+ INB_ITER_MAX=MAX(1, INT(PTSTEP/PARAMI%XTSTEP_TS)) !At least the number of iterations needed for the time-splitting
+ ZTSTEP=PTSTEP/INB_ITER_MAX
+ INB_ITER_MAX=MAX(PARAMI%NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
+ ENDIF
+
+!===============================================================================================================
+! Cache-blocking loop :
+
+ LLSIGMA_RC=(HSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM')
+ LL_AUCV_ADJU=(HSUBG_AUCV_RC=='ADJU' .OR. HSUBG_AUCV_RI=='ADJU')
+
+ ! starting indexes :
+ IC=0
+ ISTK=IKTB
+ ISTIJ=IIJB
+
+ DO JMICRO=1,KSIZE,KPROMA
+
+ IMICRO=MIN(KPROMA,KSIZE-JMICRO+1)
+!
+!* 3. PACKING
+! --------
+
+ ! Setup packing parameters
+ OUTER_LOOP: DO JK = ISTK, IKTE
+ IF (ANY(ODMICRO(:,JK))) THEN
+ DO JIJ = ISTIJ, IIJE
+ IF (ODMICRO(JIJ,JK)) THEN
+ IC=IC+1
+ ! Initialization of variables in packed format :
+ ZVART(IC, ITH)=PTHT(JIJ, JK)
+ ZVART(IC, IRV)=PRVT(JIJ, JK)
+ ZVART(IC, IRC)=PRCT(JIJ, JK)
+ ZVART(IC, IRR)=PRRT(JIJ, JK)
+ ZVART(IC, IRI)=PRIT(JIJ, JK)
+ ZVART(IC, IRS)=PRST(JIJ, JK)
+ ZVART(IC, IRG)=PRGT(JIJ, JK)
+ IF (KRR==7) THEN
+ ZVART(IC, IRH)=PRHT(JIJ, JK)
+ ENDIF
+ IF (GEXT_TEND) THEN
+ !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
+ ZEXTPK(IC, ITH)=PTHS(JIJ, JK)
+ ZEXTPK(IC, IRV)=PRVS(JIJ, JK)
+ ZEXTPK(IC, IRC)=PRCS(JIJ, JK)
+ ZEXTPK(IC, IRR)=PRRS(JIJ, JK)
+ ZEXTPK(IC, IRI)=PRIS(JIJ, JK)
+ ZEXTPK(IC, IRS)=PRSS(JIJ, JK)
+ ZEXTPK(IC, IRG)=PRGS(JIJ, JK)
+ IF (KRR==7) THEN
+ ZEXTPK(IC, IRH)=PRHS(JIJ, JK)
+ ENDIF
+ ENDIF
+ ZCIT (IC)=PCIT (JIJ, JK)
+ ZCF (IC)=PCLDFR (JIJ, JK)
+ ZRHODREF (IC)=PRHODREF(JIJ, JK)
+ ZPRES (IC)=PPABST (JIJ, JK)
+ ZEXN (IC)=PEXN (JIJ, JK)
+ IF(LLSIGMA_RC) THEN
+ ZSIGMA_RC(IC)=PSIGS (JIJ, JK)
+ ENDIF
+ IF (LL_AUCV_ADJU) THEN
+ ZHLC_HCF(IC) = PHLC_HCF(JIJ, JK)
+ ZHLC_HRC(IC) = PHLC_HRC(JIJ, JK)
+ ZHLI_HCF(IC) = PHLI_HCF(JIJ, JK)
+ ZHLI_HRI(IC) = PHLI_HRI(JIJ, JK)
+ ENDIF
+ ! Save indices for later usages:
+ I1(IC) = JIJ
+ I2(IC) = JK
+ I1TOT(JMICRO+IC-1)=JIJ
+ I2TOT(JMICRO+IC-1)=JK
+ IF (IC==IMICRO) THEN
+ ! the end of the chunk has been reached, then reset the starting index :
+ ISTIJ=JIJ+1
+ IF (ISTIJ <= IIJE) THEN
+ ISTK=JK
+ ELSE
+ ! end of line, restart from 1 and increment upper loop
+ ISTK=JK+1
+ IF (ISTK > IKTE) THEN
+ ! end of line, restart from 1
+ ISTK=IKTB
+ ENDIF
+ ENDIF
+ IC=0
+ EXIT OUTER_LOOP
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ! restart inner loop on JIJ :
+ ISTIJ=IIJB
+ ENDDO OUTER_LOOP
+
+ IF (GEXT_TEND) THEN
+ DO JV=0, KRR
+ DO JL=1, IMICRO
+ ZEXTPK(JL, JV)=ZEXTPK(JL, JV)-ZVART(JL, JV)*ZINV_TSTEP
+ ENDDO
+ ENDDO
ENDIF
- IF(ZRIT(JL)>0.) THEN
- ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
- ELSE
- ZHLI_LCF(JL)=0.
+ IF (LLSIGMA_RC) THEN
+ DO JL=1, IMICRO
+ ZSIGMA_RC(JL)=ZSIGMA_RC(JL)*2.
+ ENDDO
ENDIF
- ENDDO
- IF(GEXT_TEND) THEN
- DO JL=1, IMICRO
- ZEXT_RV(JL) = PRVS(I1(JL),I2(JL),I3(JL)) - ZRVT(JL)*ZINV_TSTEP
- ZEXT_RC(JL) = PRCS(I1(JL),I2(JL),I3(JL)) - ZRCT(JL)*ZINV_TSTEP
- ZEXT_RR(JL) = PRRS(I1(JL),I2(JL),I3(JL)) - ZRRT(JL)*ZINV_TSTEP
- ZEXT_RI(JL) = PRIS(I1(JL),I2(JL),I3(JL)) - ZRIT(JL)*ZINV_TSTEP
- ZEXT_RS(JL) = PRSS(I1(JL),I2(JL),I3(JL)) - ZRST(JL)*ZINV_TSTEP
- ZEXT_RG(JL) = PRGS(I1(JL),I2(JL),I3(JL)) - ZRGT(JL)*ZINV_TSTEP
- ZEXT_TH(JL) = PTHS(I1(JL),I2(JL),I3(JL)) - ZTHT(JL)*ZINV_TSTEP
- !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
- ENDDO
- ENDIF
- IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') THEN
- DO JL=1, IMICRO
- ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL))*2.
- ENDDO
- ENDIF
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
- ENDDO
- IF(GEXT_TEND) THEN
+ IF (LL_AUCV_ADJU) THEN
DO JL=1, IMICRO
- ZEXT_RH(JL) = PRHS(I1(JL),I2(JL),I3(JL)) - ZRHT(JL)*ZINV_TSTEP
+ ZHLC_LRC(JL) = ZVART(JL, IRC) - ZHLC_HRC(JL)
+ ZHLI_LRI(JL) = ZVART(JL, IRI) - ZHLI_HRI(JL)
+ IF(ZVART(JL, IRC)>0.) THEN
+ ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
+ ELSE
+ ZHLC_LCF(JL)=0.
+ ENDIF
+ IF(ZVART(JL, IRI)>0.) THEN
+ ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
+ ELSE
+ ZHLI_LCF(JL)=0.
+ ENDIF
ENDDO
ENDIF
- ELSE
- ZRHT(:)=0.
- IF(GEXT_TEND) ZEXT_RH(:)=0.
- ENDIF
- IF(LBU_ENABLE) THEN
- ZTOT_RVHENI(:)=0.
- ZTOT_RCHONI(:)=0.
- ZTOT_RRHONG(:)=0.
- ZTOT_RVDEPS(:)=0.
- ZTOT_RIAGGS(:)=0.
- ZTOT_RIAUTS(:)=0.
- ZTOT_RVDEPG(:)=0.
- ZTOT_RCAUTR(:)=0.
- ZTOT_RCACCR(:)=0.
- ZTOT_RREVAV(:)=0.
- ZTOT_RCRIMSS(:)=0.
- ZTOT_RCRIMSG(:)=0.
- ZTOT_RSRIMCG(:)=0.
- ZTOT_RIMLTC(:)=0.
- ZTOT_RCBERI(:)=0.
- ZTOT_RHMLTR(:)=0.
- ZTOT_RSMLTG(:)=0.
- ZTOT_RCMLTSR(:)=0.
- ZTOT_RRACCSS(:)=0.
- ZTOT_RRACCSG(:)=0.
- ZTOT_RSACCRG(:)=0.
- ZTOT_RICFRRG(:)=0.
- ZTOT_RRCFRIG(:)=0.
- ZTOT_RICFRR(:)=0.
- ZTOT_RCWETG(:)=0.
- ZTOT_RIWETG(:)=0.
- ZTOT_RRWETG(:)=0.
- ZTOT_RSWETG(:)=0.
- ZTOT_RCDRYG(:)=0.
- ZTOT_RIDRYG(:)=0.
- ZTOT_RRDRYG(:)=0.
- ZTOT_RSDRYG(:)=0.
- ZTOT_RWETGH(:)=0.
- ZTOT_RGMLTR(:)=0.
- ZTOT_RCWETH(:)=0.
- ZTOT_RIWETH(:)=0.
- ZTOT_RSWETH(:)=0.
- ZTOT_RGWETH(:)=0.
- ZTOT_RRWETH(:)=0.
- ZTOT_RCDRYH(:)=0.
- ZTOT_RIDRYH(:)=0.
- ZTOT_RSDRYH(:)=0.
- ZTOT_RRDRYH(:)=0.
- ZTOT_RGDRYH(:)=0.
- ZTOT_RDRYHG(:)=0.
- ENDIF
-ENDIF
+
!-------------------------------------------------------------------------------
!
!* 4. LOOP
! ----
!
-!Maximum number of iterations
-!We only count real iterations (those for which we *compute* tendencies)
-INB_ITER_MAX=NMAXITER
-IF(XTSTEP_TS/=0.)THEN
- INB_ITER_MAX=MAX(1, INT(PTSTEP/XTSTEP_TS)) !At least the number of iterations needed for the time-splitting
- ZTSTEP=PTSTEP/INB_ITER_MAX
- INB_ITER_MAX=MAX(NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
-ENDIF
-IITER(:)=0
-ZTIME(:)=0. ! Current integration time (all points may have a different integration time)
-DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
- IF(XMRSTEP/=0.) THEN
- ! In this case we need to remember the mixing ratios used to compute the tendencies
- ! because when mixing ratio has evolved more than a threshold, we must re-compute tendecies
- DO JL=1, IMICRO
- Z0RVT(JL)=ZRVT(JL)
- Z0RCT(JL)=ZRCT(JL)
- Z0RRT(JL)=ZRRT(JL)
- Z0RIT(JL)=ZRIT(JL)
- Z0RST(JL)=ZRST(JL)
- Z0RGT(JL)=ZRGT(JL)
- Z0RHT(JL)=ZRHT(JL)
- ENDDO
- ENDIF
- IF(XTSTEP_TS/=0.) THEN
- ! In this case we need to remember the time when tendencies were computed
- ! because when time has evolved more than a limit, we must re-compute tendecies
- ZTIME_LASTCALL(:)=ZTIME(:)
- ENDIF
- ZCOMPUTE(:)=MAX(0., -SIGN(1., ZTIME(:)-PTSTEP)) ! Compuation (1.) only for points for which integration time has not reached the timestep
- LSOFT=.FALSE. ! We *really* compute the tendencies
- IITER(:)=IITER(:)+INT(ZCOMPUTE(:))
- DO WHILE(SUM(ZCOMPUTE(:))>0.) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZZT(JL) = ZTHT(JL) * ZEXN(JL)
- ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
- ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
- ENDDO
- ELSE
+ IITER(1:IMICRO)=0
+ ZTIME(1:IMICRO)=0. ! Current integration time (all points may have a different integration time)
+
+ DO WHILE(ANY(ZTIME(1:IMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
+
+ IF(PARAMI%XTSTEP_TS/=0.) THEN
+ ! In this case we need to remember the time when tendencies were computed
+ ! because when time has evolved more than a limit, we must re-compute tendencies
+ ZTIME_LASTCALL(1:IMICRO)=ZTIME(1:IMICRO)
+ ENDIF
DO JL=1, IMICRO
- ZZT(JL) = ZTHT(JL) * ZEXN(JL)
- ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
- ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ IF (ZTIME(JL) < PTSTEP) THEN
+ LLCOMPUTE(JL)=.TRUE. ! Computation (.TRUE.) only for points for which integration time has not reached the timestep
+ IITER(JL)=IITER(JL)+1
+ ELSE
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
ENDDO
- ENDIF
- !
- !*** 4.1 Tendecies computation
- !
- ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
- &KRR, LSOFT, ZCOMPUTE, &
- &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, CSUBG_PR_PDF, &
- &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, I3, &
- &ZPRES, ZCF, ZSIGMA_RC,&
+ LL_ANY_ITER=ANY(IITER(1:IMICRO) < INB_ITER_MAX)
+ LLCPZ0RT=.TRUE.
+ LSOFT=.FALSE. ! We *really* compute the tendencies
+
+ DO WHILE(ANY(LLCOMPUTE(1:IMICRO))) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
+!$OMP SIMD
+ DO JL=1, IMICRO
+ ZSUM2(JL)=SUM(ZVART(JL,IRI:KRR))
+ ENDDO
+ DO JL=1, IMICRO
+ ZDEVIDE=(CST%XCPD + CST%XCPV*ZVART(JL, IRV) + CST%XCL*(ZVART(JL, IRC)+ZVART(JL, IRR)) + CST%XCI*ZSUM2(JL)) * ZEXN(JL)
+ ZZT(JL) = ZVART(JL, ITH) * ZEXN(JL)
+ ZLSFACT(JL)=(CST%XLSTT+(CST%XCPV-CST%XCI)*(ZZT(JL)-CST%XTT)) / ZDEVIDE
+ ZLVFACT(JL)=(CST%XLVTT+(CST%XCPV-CST%XCL)*(ZZT(JL)-CST%XTT)) / ZDEVIDE
+ ENDDO
+ !
+ !*** 4.1 Tendencies computation
+ !
+ ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
+ CALL ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ &KPROMA, IMICRO, &
+ &KRR, LSOFT, LLCOMPUTE, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, &
+ &ZPRES, ZCF, ZSIGMA_RC, &
&ZCIT, &
- &ZZT, ZTHT, &
- &ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
+ &ZZT, ZVART, &
&ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
&ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, &
&ZRCAUTR, ZRCACCR, ZRREVAV, &
@@ -899,1014 +898,929 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
&ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, ZRDRYHG, ZRHMLTR, &
&ZRCBERI, &
&ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
- &ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
- &ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
+ &ZA, ZB, &
&ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
&ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, PRAINFR)
- ! External tendencies
- IF(GEXT_TEND) THEN
- DO JL=1, IMICRO
- ZA_TH(JL) = ZA_TH(JL) + ZEXT_TH(JL)
- ZA_RV(JL) = ZA_RV(JL) + ZEXT_RV(JL)
- ZA_RC(JL) = ZA_RC(JL) + ZEXT_RC(JL)
- ZA_RR(JL) = ZA_RR(JL) + ZEXT_RR(JL)
- ZA_RI(JL) = ZA_RI(JL) + ZEXT_RI(JL)
- ZA_RS(JL) = ZA_RS(JL) + ZEXT_RS(JL)
- ZA_RG(JL) = ZA_RG(JL) + ZEXT_RG(JL)
- ZA_RH(JL) = ZA_RH(JL) + ZEXT_RH(JL)
- ENDDO
- ENDIF
- !
- !*** 4.2 Integration time
- !
- ! If we can, we will use these tendencies until the end of the timestep
- ZMAXTIME(:)=ZCOMPUTE(:) * (PTSTEP-ZTIME(:)) ! Remaining time until the end of the timestep
-
- !We need to adjust tendencies when temperature reaches 0
- IF(LFEEDBACKT) THEN
- DO JL=1, IMICRO
- !Is ZB_TH enough to change temperature sign?
- ZW1D(JL)=(ZTHT(JL) - XTT/ZEXN(JL)) * (ZTHT(JL) + ZB_TH(JL) - XTT/ZEXN(JL))
- ZMAXTIME(JL)=ZMAXTIME(JL)*MAX(0., SIGN(1., ZW1D(JL)))
- !Can ZA_TH make temperature change of sign?
- ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ABS(ZA_TH(JL)))) ! WHERE(ABS(ZA_TH(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1. - ZW1D(JL))*(-1.) + &
- ZW1D(JL) * &
- (XTT/ZEXN(JL) - ZB_TH(JL) - ZTHT(JL))/ &
- SIGN(MAX(ABS(ZA_TH(JL)), 1.E-20), ZA_TH(JL))
- ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ZTIME_THRESHOLD(JL))) ! WHERE(ZTIME_THRESHOLD(:)>1.E-20)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- ZW1D(JL) * MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ENDDO
- ENDIF
- !We need to adjust tendencies when a specy disappears
- !When a species is missing, only the external tendencies can be negative (and we must keep track of it)
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., ZA_RV(JL)+1.E-20)) * & ! WHERE(ZA_RV(:)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(1)-ZRVT(JL))) ! WHERE(ZRVT(:)>XRTMIN(1))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RV(JL)+ZRVT(JL))/MIN(ZA_RV(JL), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA_RC(JL)+1.E-20)) * & ! WHERE(ZA_RC(:)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(2)-ZRCT(JL))) ! WHERE(ZRCT(:)>XRTMIN(2))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RC(JL)+ZRCT(JL))/MIN(ZA_RC(JL), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA_RR(JL)+1.E-20)) * & ! WHERE(ZA_RR(:)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(3)-ZRRT(JL))) ! WHERE(ZRRT(:)>XRTMIN(3))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RR(JL)+ZRRT(JL))/MIN(ZA_RR(JL), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA_RI(JL)+1.E-20)) * & ! WHERE(ZI_RV(:)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(4)-ZRIT(JL))) ! WHERE(ZRIT(:)>XRTMIN(4))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RI(JL)+ZRIT(JL))/MIN(ZA_RI(JL), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA_RS(JL)+1.E-20)) * & ! WHERE(ZA_RS(:)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(5)-ZRST(JL))) ! WHERE(ZRST(:)>XRTMIN(5))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RS(JL)+ZRST(JL))/MIN(ZA_RS(JL), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA_RG(JL)+1.E-20)) * & ! WHERE(ZA_RG(:)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) ! WHERE(ZRGT(:)>XRTMIN(6))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RG(JL)+ZRGT(JL))/MIN(ZA_RG(JL), -1.E-20))
- ENDDO
-
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., ZA_RH(JL)+1.E-20)) * & ! WHERE(ZA_RH(:)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(7)-ZRHT(JL))) ! WHERE(ZRHT(:)>XRTMIN(7))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RH(JL)+ZRHT(JL))/MIN(ZA_RH(JL), -1.E-20))
- ENDDO
- ENDIF
+ ! External tendencies
+ IF(GEXT_TEND) THEN
+ DO JV=0, KRR
+ DO JL=1, IMICRO
+ ZA(JL, JV) = ZA(JL, JV) + ZEXTPK(JL, JV)
+ ENDDO
+ ENDDO
+ ENDIF
+ !
+ !*** 4.2 Integration time
+ !
+ ! If we can, we shall use these tendencies until the end of the timestep
+ DO JL=1, IMICRO
+ IF(LLCOMPUTE(JL)) THEN
+ ZMAXTIME(JL)=(PTSTEP-ZTIME(JL)) ! Remaining time until the end of the timestep
+ ELSE
+ ZMAXTIME(JL)=0.
+ ENDIF
+ ENDDO
- !We stop when the end of the timestep is reached
- ZCOMPUTE(:)=ZCOMPUTE(:) * MAX(0., -SIGN(1., ZTIME(:)+ZMAXTIME(:)-PTSTEP))
+ !We need to adjust tendencies when temperature reaches 0
+ IF(PARAMI%LFEEDBACKT) THEN
+ DO JL=1, IMICRO
+ !Is ZB(:, ITH) enough to change temperature sign?
+ ZX=CST%XTT/ZEXN(JL)
+ IF ((ZVART(JL, ITH) - ZX) * (ZVART(JL, ITH) + ZB(JL, ITH) - ZX) < 0.) THEN
+ ZMAXTIME(JL)=0.
+ ENDIF
+ !Can ZA(:, ITH) make temperature change of sign?
+ IF (ABS(ZA(JL,ITH)) > 1.E-20 ) THEN
+ ZTIME_THRESHOLD=(ZX - ZB(JL, ITH) - ZVART(JL, ITH))/ZA(JL, ITH)
+ IF (ZTIME_THRESHOLD > 0.) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+
+ !We need to adjust tendencies when a species disappears
+ !When a species is missing, only the external tendencies can be negative (and we must keep track of it)
+ DO JV=1, KRR
+ DO JL=1, IMICRO
+ IF (ZA(JL, JV) < -1.E-20 .AND. ZVART(JL, JV) > ICED%XRTMIN(JV)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), -(ZB(JL, JV)+ZVART(JL, JV))/ZA(JL, JV))
+ ENDIF
+ ENDDO
+ ENDDO
- !We must recompute tendencies when the end of the sub-timestep is reached
- IF(XTSTEP_TS/=0.) THEN
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., ZTIME_LASTCALL(JL)+ZTSTEP-ZTIME(JL)-ZMAXTIME(JL))) ! WHERE(ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * (ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP)
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
- ENDDO
- ENDIF
+ !We stop when the end of the timestep is reached
+ DO JL=1, IMICRO
+ IF (ZTIME(JL)+ZMAXTIME(JL) >= PTSTEP) THEN
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ !We must recompute tendencies when the end of the sub-timestep is reached
+ IF (PARAMI%XTSTEP_TS/=0.) THEN
+ DO JL=1, IMICRO
+ IF ((IITER(JL) < INB_ITER_MAX) .AND. (ZTIME(JL)+ZMAXTIME(JL) > ZTIME_LASTCALL(JL)+ZTSTEP)) THEN
+ ZMAXTIME(JL)=ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ ENDIF
+
+ !We must recompute tendencies when the maximum allowed change is reached
+ !When a species is missing, only the external tendencies can be active and we do not want to recompute
+ !the microphysical tendencies when external tendencies are negative (results won't change because species was already missing)
+ IF (PARAMI%XMRSTEP/=0.) THEN
+ IF (LL_ANY_ITER) THEN
+ ! In this case we need to remember the initial mixing ratios used to compute the tendencies
+ ! because when mixing ratio has evolved more than a threshold, we must re-compute tendencies
+ ! Thus, at first iteration (ie when LLCPZ0RT=.TRUE.) we copy ZVART into Z0RT
+ DO JV=1,KRR
+ IF (LLCPZ0RT) Z0RT(1:IMICRO, JV)=ZVART(1:IMICRO, JV)
+ DO JL=1, IMICRO
+ IF (IITER(JL)<INB_ITER_MAX .AND. ABS(ZA(JL,JV))>1.E-20) THEN
+ ZTIME_THRESHOLD1D(JL)=(SIGN(1., ZA(JL, JV))*PARAMI%XMRSTEP+ &
+ &Z0RT(JL, JV)-ZVART(JL, JV)-ZB(JL, JV))/ZA(JL, JV)
+ ELSE
+ ZTIME_THRESHOLD1D(JL)=-1.
+ ENDIF
+ ENDDO
+ DO JL=1, IMICRO
+ IF (ZTIME_THRESHOLD1D(JL)>=0 .AND. ZTIME_THRESHOLD1D(JL)<ZMAXTIME(JL) .AND. &
+ &(ZVART(JL, JV)>ICED%XRTMIN(JV) .OR. ZA(JL, JV)>0.)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD1D(JL))
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ ENDDO
+ LLCPZ0RT=.FALSE.
+!$OMP SIMD
+ DO JL=1,IMICRO
+ ZMAXB(JL)=MAXVAL(ABS(ZB(JL,1:KRR)))
+ ENDDO
+ DO JL=1, IMICRO
+ IF (IITER(JL)<INB_ITER_MAX .AND. ZMAXB(JL)>PARAMI%XMRSTEP) THEN
+ ZMAXTIME(JL)=0.
+ LLCOMPUTE(JL)=.FALSE.
+ ENDIF
+ ENDDO
+ ENDIF ! LL_ANY_ITER
+ ENDIF ! XMRSTEP/=0.
+ !
+ !*** 4.3 New values of variables for next iteration
+ !
+ DO JV=0, KRR
+ DO JL=1, IMICRO
+ ZVART(JL, JV)=ZVART(JL, JV)+ZA(JL, JV)*ZMAXTIME(JL)+ZB(JL, JV)
+ ENDDO
+ ENDDO
+ DO JL=1, IMICRO
+#ifdef REPRO55
+ ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZVART(JL,IRI)))
+#else
+ IF (ZVART(JL,IRI)<=0.) ZCIT(JL) = 0.
+#endif
+ ZTIME(JL)=ZTIME(JL)+ZMAXTIME(JL)
+ ENDDO
- !We must recompute tendencies when the maximum allowed change is reached
- !When a specy is missing, only the external tendencies can be active and we do not want to recompute
- !the microphysical tendencies when external tendencies are negative (results won't change because specy was already missing)
- IF(XMRSTEP/=0.) THEN
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RV(JL)))) ! WHERE(ABS(ZA_RV(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RV(JL))*XMRSTEP+Z0RVT(JL)-ZRVT(JL)-ZB_RV(JL))/ &
- &SIGN(MAX(ABS(ZA_RV(JL)), 1.E-20), ZA_RV(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRVT(JL))) + & !WHERE(ZRVT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RV(JL)))) !WHERE(ZA_RV(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RC(JL)))) ! WHERE(ABS(ZA_RC(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RC(JL))*XMRSTEP+Z0RCT(JL)-ZRCT(JL)-ZB_RC(JL))/ &
- &SIGN(MAX(ABS(ZA_RC(JL)), 1.E-20), ZA_RC(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRCT(JL))) + & !WHERE(ZRCT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RC(JL)))) !WHERE(ZA_RC(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RR(JL)))) ! WHERE(ABS(ZA_RR(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RR(JL))*XMRSTEP+Z0RRT(JL)-ZRRT(JL)-ZB_RR(JL))/ &
- &SIGN(MAX(ABS(ZA_RR(JL)), 1.E-20), ZA_RR(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRRT(JL))) + & !WHERE(ZRRT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RR(JL)))) !WHERE(ZA_RR(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RI(JL)))) ! WHERE(ABS(ZA_RI(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RI(JL))*XMRSTEP+Z0RIT(JL)-ZRIT(JL)-ZB_RI(JL))/ &
- &SIGN(MAX(ABS(ZA_RI(JL)), 1.E-20), ZA_RI(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRIT(JL))) + & !WHERE(ZRIT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RI(JL)))) !WHERE(ZA_RI(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RS(JL)))) ! WHERE(ABS(ZA_RS(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RS(JL))*XMRSTEP+Z0RST(JL)-ZRST(JL)-ZB_RS(JL))/ &
- &SIGN(MAX(ABS(ZA_RS(JL)), 1.E-20), ZA_RS(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRST(JL))) + & !WHERE(ZRST(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RS(JL)))) !WHERE(ZA_RS(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RG(JL)))) ! WHERE(ABS(ZA_RG(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RG(JL))*XMRSTEP+Z0RGT(JL)-ZRGT(JL)-ZB_RG(JL))/ &
- &SIGN(MAX(ABS(ZA_RG(JL)), 1.E-20), ZA_RG(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) + & !WHERE(ZRGT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RG(JL)))) !WHERE(ZA_RG(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ !
+ !*** 4.4 Mixing ratio change due to each process
+ !
+ IF(BUCONF%LBU_ENABLE) THEN
+ DO JL=1, IMICRO
+ ZTOT_RVHENI (JMICRO+JL-1)=ZTOT_RVHENI (JMICRO+JL-1)+ZRVHENI_MR(JL)
+ ZTOT_RCHONI (JMICRO+JL-1)=ZTOT_RCHONI (JMICRO+JL-1)+ZRCHONI (JL)*ZMAXTIME(JL)
+ ZTOT_RRHONG (JMICRO+JL-1)=ZTOT_RRHONG (JMICRO+JL-1)+ZRRHONG_MR(JL)
+ ZTOT_RVDEPS (JMICRO+JL-1)=ZTOT_RVDEPS (JMICRO+JL-1)+ZRVDEPS (JL)*ZMAXTIME(JL)
+ ZTOT_RIAGGS (JMICRO+JL-1)=ZTOT_RIAGGS (JMICRO+JL-1)+ZRIAGGS (JL)*ZMAXTIME(JL)
+ ZTOT_RIAUTS (JMICRO+JL-1)=ZTOT_RIAUTS (JMICRO+JL-1)+ZRIAUTS (JL)*ZMAXTIME(JL)
+ ZTOT_RVDEPG (JMICRO+JL-1)=ZTOT_RVDEPG (JMICRO+JL-1)+ZRVDEPG (JL)*ZMAXTIME(JL)
+ ZTOT_RCAUTR (JMICRO+JL-1)=ZTOT_RCAUTR (JMICRO+JL-1)+ZRCAUTR (JL)*ZMAXTIME(JL)
+ ZTOT_RCACCR (JMICRO+JL-1)=ZTOT_RCACCR (JMICRO+JL-1)+ZRCACCR (JL)*ZMAXTIME(JL)
+ ZTOT_RREVAV (JMICRO+JL-1)=ZTOT_RREVAV (JMICRO+JL-1)+ZRREVAV (JL)*ZMAXTIME(JL)
+ ZTOT_RCRIMSS(JMICRO+JL-1)=ZTOT_RCRIMSS(JMICRO+JL-1)+ZRCRIMSS (JL)*ZMAXTIME(JL)
+ ZTOT_RCRIMSG(JMICRO+JL-1)=ZTOT_RCRIMSG(JMICRO+JL-1)+ZRCRIMSG (JL)*ZMAXTIME(JL)
+ ZTOT_RSRIMCG(JMICRO+JL-1)=ZTOT_RSRIMCG(JMICRO+JL-1)+ZRSRIMCG (JL)*ZMAXTIME(JL)+ZRSRIMCG_MR(JL)
+ ZTOT_RRACCSS(JMICRO+JL-1)=ZTOT_RRACCSS(JMICRO+JL-1)+ZRRACCSS (JL)*ZMAXTIME(JL)
+ ZTOT_RRACCSG(JMICRO+JL-1)=ZTOT_RRACCSG(JMICRO+JL-1)+ZRRACCSG (JL)*ZMAXTIME(JL)
+ ZTOT_RSACCRG(JMICRO+JL-1)=ZTOT_RSACCRG(JMICRO+JL-1)+ZRSACCRG (JL)*ZMAXTIME(JL)
+ ZTOT_RSMLTG (JMICRO+JL-1)=ZTOT_RSMLTG (JMICRO+JL-1)+ZRSMLTG (JL)*ZMAXTIME(JL)
+ ZTOT_RCMLTSR(JMICRO+JL-1)=ZTOT_RCMLTSR(JMICRO+JL-1)+ZRCMLTSR (JL)*ZMAXTIME(JL)
+ ZTOT_RICFRRG(JMICRO+JL-1)=ZTOT_RICFRRG(JMICRO+JL-1)+ZRICFRRG (JL)*ZMAXTIME(JL)
+ ZTOT_RRCFRIG(JMICRO+JL-1)=ZTOT_RRCFRIG(JMICRO+JL-1)+ZRRCFRIG (JL)*ZMAXTIME(JL)
+ ZTOT_RICFRR (JMICRO+JL-1)=ZTOT_RICFRR (JMICRO+JL-1)+ZRICFRR (JL)*ZMAXTIME(JL)
+ ZTOT_RCWETG (JMICRO+JL-1)=ZTOT_RCWETG (JMICRO+JL-1)+ZRCWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RIWETG (JMICRO+JL-1)=ZTOT_RIWETG (JMICRO+JL-1)+ZRIWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RRWETG (JMICRO+JL-1)=ZTOT_RRWETG (JMICRO+JL-1)+ZRRWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RSWETG (JMICRO+JL-1)=ZTOT_RSWETG (JMICRO+JL-1)+ZRSWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RWETGH (JMICRO+JL-1)=ZTOT_RWETGH (JMICRO+JL-1)+ZRWETGH (JL)*ZMAXTIME(JL)+ZRWETGH_MR(JL)
+ ZTOT_RCDRYG (JMICRO+JL-1)=ZTOT_RCDRYG (JMICRO+JL-1)+ZRCDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RIDRYG (JMICRO+JL-1)=ZTOT_RIDRYG (JMICRO+JL-1)+ZRIDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RRDRYG (JMICRO+JL-1)=ZTOT_RRDRYG (JMICRO+JL-1)+ZRRDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RSDRYG (JMICRO+JL-1)=ZTOT_RSDRYG (JMICRO+JL-1)+ZRSDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RGMLTR (JMICRO+JL-1)=ZTOT_RGMLTR (JMICRO+JL-1)+ZRGMLTR (JL)*ZMAXTIME(JL)
+ ZTOT_RCWETH (JMICRO+JL-1)=ZTOT_RCWETH (JMICRO+JL-1)+ZRCWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RIWETH (JMICRO+JL-1)=ZTOT_RIWETH (JMICRO+JL-1)+ZRIWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RSWETH (JMICRO+JL-1)=ZTOT_RSWETH (JMICRO+JL-1)+ZRSWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RGWETH (JMICRO+JL-1)=ZTOT_RGWETH (JMICRO+JL-1)+ZRGWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RRWETH (JMICRO+JL-1)=ZTOT_RRWETH (JMICRO+JL-1)+ZRRWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RCDRYH (JMICRO+JL-1)=ZTOT_RCDRYH (JMICRO+JL-1)+ZRCDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RIDRYH (JMICRO+JL-1)=ZTOT_RIDRYH (JMICRO+JL-1)+ZRIDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RSDRYH (JMICRO+JL-1)=ZTOT_RSDRYH (JMICRO+JL-1)+ZRSDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RRDRYH (JMICRO+JL-1)=ZTOT_RRDRYH (JMICRO+JL-1)+ZRRDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RGDRYH (JMICRO+JL-1)=ZTOT_RGDRYH (JMICRO+JL-1)+ZRGDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RDRYHG (JMICRO+JL-1)=ZTOT_RDRYHG (JMICRO+JL-1)+ZRDRYHG (JL)*ZMAXTIME(JL)
+ ZTOT_RHMLTR (JMICRO+JL-1)=ZTOT_RHMLTR (JMICRO+JL-1)+ZRHMLTR (JL)*ZMAXTIME(JL)
+ ZTOT_RIMLTC (JMICRO+JL-1)=ZTOT_RIMLTC (JMICRO+JL-1)+ZRIMLTC_MR(JL)
+ ZTOT_RCBERI (JMICRO+JL-1)=ZTOT_RCBERI (JMICRO+JL-1)+ZRCBERI (JL)*ZMAXTIME(JL)
+ ENDDO
+ ENDIF
+ !
+ !*** 4.5 Next loop
+ !
+ LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
ENDDO
+ ENDDO
- IF(KRR==7) THEN
+ IF(GEXT_TEND) THEN
+ !Z..T variables contain the external tendency, we substract it
+ DO JV=0, KRR
DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RH(JL)))) ! WHERE(ABS(ZA_RH(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RH(JL))*XMRSTEP+Z0RHT(JL)-ZRHT(JL)-ZB_RH(JL))/ &
- &SIGN(MAX(ABS(ZA_RH(JL)), 1.E-20), ZA_RH(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRHT(JL))) + & !WHERE(ZRHT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RH(JL)))) !WHERE(ZA_RH(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ZVART(JL, JV) = ZVART(JL, JV) - ZEXTPK(JL, JV) * PTSTEP
ENDDO
- ENDIF
-
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(ABS(ZB_RV(JL)), ABS(ZB_RC(JL)), ABS(ZB_RR(JL)), ABS(ZB_RI(JL)), &
- &ABS(ZB_RS(JL)), ABS(ZB_RG(JL)), ABS(ZB_RH(JL)))
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & !WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., XMRSTEP-ZW1D(JL))) !WHERE(ZW1D(:)>XMRSTEP)
- ZMAXTIME(JL)=(1.-ZW1D(JL))*ZMAXTIME(JL)
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
ENDDO
ENDIF
- !
- !*** 4.3 New values of variables for next iteration
- !
- DO JL=1, IMICRO
- ZTHT(JL)=ZTHT(JL)+ZA_TH(JL)*ZMAXTIME(JL)+ZB_TH(JL)
- ZRVT(JL)=ZRVT(JL)+ZA_RV(JL)*ZMAXTIME(JL)+ZB_RV(JL)
- ZRCT(JL)=ZRCT(JL)+ZA_RC(JL)*ZMAXTIME(JL)+ZB_RC(JL)
- ZRRT(JL)=ZRRT(JL)+ZA_RR(JL)*ZMAXTIME(JL)+ZB_RR(JL)
- ZRIT(JL)=ZRIT(JL)+ZA_RI(JL)*ZMAXTIME(JL)+ZB_RI(JL)
- ZRST(JL)=ZRST(JL)+ZA_RS(JL)*ZMAXTIME(JL)+ZB_RS(JL)
- ZRGT(JL)=ZRGT(JL)+ZA_RG(JL)*ZMAXTIME(JL)+ZB_RG(JL)
- ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZRIT(JL))) ! WHERE(ZRIT(:)==0.) ZCIT(:) = 0.
- ENDDO
- IF(KRR==7) ZRHT(:)=ZRHT(:)+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
- !
- !*** 4.4 Mixing ratio change due to each process
- !
- IF(LBU_ENABLE) THEN
- ZTOT_RVHENI(:)= ZTOT_RVHENI(:) +ZRVHENI_MR(:)
- ZTOT_RCHONI(:)= ZTOT_RCHONI(:) +ZRCHONI(:) *ZMAXTIME(:)
- ZTOT_RRHONG(:)= ZTOT_RRHONG(:) +ZRRHONG_MR(:)
- ZTOT_RVDEPS(:)= ZTOT_RVDEPS(:) +ZRVDEPS(:) *ZMAXTIME(:)
- ZTOT_RIAGGS(:)= ZTOT_RIAGGS(:) +ZRIAGGS(:) *ZMAXTIME(:)
- ZTOT_RIAUTS(:)= ZTOT_RIAUTS(:) +ZRIAUTS(:) *ZMAXTIME(:)
- ZTOT_RVDEPG(:)= ZTOT_RVDEPG(:) +ZRVDEPG(:) *ZMAXTIME(:)
- ZTOT_RCAUTR(:)= ZTOT_RCAUTR(:) +ZRCAUTR(:) *ZMAXTIME(:)
- ZTOT_RCACCR(:)= ZTOT_RCACCR(:) +ZRCACCR(:) *ZMAXTIME(:)
- ZTOT_RREVAV(:)= ZTOT_RREVAV(:) +ZRREVAV(:) *ZMAXTIME(:)
- ZTOT_RCRIMSS(:)=ZTOT_RCRIMSS(:)+ZRCRIMSS(:)*ZMAXTIME(:)
- ZTOT_RCRIMSG(:)=ZTOT_RCRIMSG(:)+ZRCRIMSG(:)*ZMAXTIME(:)
- ZTOT_RSRIMCG(:)=ZTOT_RSRIMCG(:)+ZRSRIMCG(:)*ZMAXTIME(:)+ZRSRIMCG_MR(:)
- ZTOT_RRACCSS(:)=ZTOT_RRACCSS(:)+ZRRACCSS(:)*ZMAXTIME(:)
- ZTOT_RRACCSG(:)=ZTOT_RRACCSG(:)+ZRRACCSG(:)*ZMAXTIME(:)
- ZTOT_RSACCRG(:)=ZTOT_RSACCRG(:)+ZRSACCRG(:)*ZMAXTIME(:)
- ZTOT_RSMLTG(:)= ZTOT_RSMLTG(:) +ZRSMLTG(:) *ZMAXTIME(:)
- ZTOT_RCMLTSR(:)=ZTOT_RCMLTSR(:)+ZRCMLTSR(:) *ZMAXTIME(:)
- ZTOT_RICFRRG(:)=ZTOT_RICFRRG(:)+ZRICFRRG(:)*ZMAXTIME(:)
- ZTOT_RRCFRIG(:)=ZTOT_RRCFRIG(:)+ZRRCFRIG(:)*ZMAXTIME(:)
- ZTOT_RICFRR(:)= ZTOT_RICFRR(:) +ZRICFRR(:) *ZMAXTIME(:)
- ZTOT_RCWETG(:)= ZTOT_RCWETG(:) +ZRCWETG(:) *ZMAXTIME(:)
- ZTOT_RIWETG(:)= ZTOT_RIWETG(:) +ZRIWETG(:) *ZMAXTIME(:)
- ZTOT_RRWETG(:)= ZTOT_RRWETG(:) +ZRRWETG(:) *ZMAXTIME(:)
- ZTOT_RSWETG(:)= ZTOT_RSWETG(:) +ZRSWETG(:) *ZMAXTIME(:)
- ZTOT_RWETGH(:)= ZTOT_RWETGH(:) +ZRWETGH(:) *ZMAXTIME(:)+ZRWETGH_MR(:)
- ZTOT_RCDRYG(:)= ZTOT_RCDRYG(:) +ZRCDRYG(:) *ZMAXTIME(:)
- ZTOT_RIDRYG(:)= ZTOT_RIDRYG(:) +ZRIDRYG(:) *ZMAXTIME(:)
- ZTOT_RRDRYG(:)= ZTOT_RRDRYG(:) +ZRRDRYG(:) *ZMAXTIME(:)
- ZTOT_RSDRYG(:)= ZTOT_RSDRYG(:) +ZRSDRYG(:) *ZMAXTIME(:)
- ZTOT_RGMLTR(:)= ZTOT_RGMLTR(:) +ZRGMLTR(:) *ZMAXTIME(:)
- ZTOT_RCWETH(:)= ZTOT_RCWETH(:) +ZRCWETH(:) *ZMAXTIME(:)
- ZTOT_RIWETH(:)= ZTOT_RIWETH(:) +ZRIWETH(:) *ZMAXTIME(:)
- ZTOT_RSWETH(:)= ZTOT_RSWETH(:) +ZRSWETH(:) *ZMAXTIME(:)
- ZTOT_RGWETH(:)= ZTOT_RGWETH(:) +ZRGWETH(:) *ZMAXTIME(:)
- ZTOT_RRWETH(:)= ZTOT_RRWETH(:) +ZRRWETH(:) *ZMAXTIME(:)
- ZTOT_RCDRYH(:)= ZTOT_RCDRYH(:) +ZRCDRYH(:) *ZMAXTIME(:)
- ZTOT_RIDRYH(:)= ZTOT_RIDRYH(:) +ZRIDRYH(:) *ZMAXTIME(:)
- ZTOT_RSDRYH(:)= ZTOT_RSDRYH(:) +ZRSDRYH(:) *ZMAXTIME(:)
- ZTOT_RRDRYH(:)= ZTOT_RRDRYH(:) +ZRRDRYH(:) *ZMAXTIME(:)
- ZTOT_RGDRYH(:)= ZTOT_RGDRYH(:) +ZRGDRYH(:) *ZMAXTIME(:)
- ZTOT_RDRYHG(:)= ZTOT_RDRYHG(:) +ZRDRYHG(:) *ZMAXTIME(:)
- ZTOT_RHMLTR(:)= ZTOT_RHMLTR(:) +ZRHMLTR(:) *ZMAXTIME(:)
- ZTOT_RIMLTC(:)= ZTOT_RIMLTC(:) +ZRIMLTC_MR(:)
- ZTOT_RCBERI(:)= ZTOT_RCBERI(:) +ZRCBERI(:) *ZMAXTIME(:)
- ENDIF
- !
- !*** 4.5 Next loop
- !
- LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
- ZTIME(:)=ZTIME(:)+ZMAXTIME(:)
- ENDDO
-ENDDO
+
!-------------------------------------------------------------------------------
!
!* 5. UNPACKING DIAGNOSTICS
! ---------------------
!
-IF(IMICRO>0) THEN
- ZHLC_HCF3D(:,:,:)=0.
- ZHLC_LCF3D(:,:,:)=0.
- ZHLC_HRC3D(:,:,:)=0.
- ZHLC_LRC3D(:,:,:)=0.
- ZHLI_HCF3D(:,:,:)=0.
- ZHLI_LCF3D(:,:,:)=0.
- ZHLI_HRI3D(:,:,:)=0.
- ZHLI_LRI3D(:,:,:)=0.
- DO JL=1,IMICRO
- ZHLC_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HCF(JL)
- ZHLC_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LCF(JL)
- ZHLC_HRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HRC(JL)
- ZHLC_LRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LRC(JL)
- ZHLI_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LCF(JL)
- ZHLI_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HCF(JL)
- ZHLI_HRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HRI(JL)
- ZHLI_LRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LRI(JL)
- PCIT(I1(JL), I2(JL), I3(JL)) = ZCIT(JL)
- END DO
-ELSE
- PRAINFR(:,:,:)=0.
- ZHLC_HCF3D(:,:,:)=0.
- ZHLC_LCF3D(:,:,:)=0.
- ZHLC_HRC3D(:,:,:)=0.
- ZHLC_LRC3D(:,:,:)=0.
- ZHLI_HCF3D(:,:,:)=0.
- ZHLI_LCF3D(:,:,:)=0.
- ZHLI_HRI3D(:,:,:)=0.
- ZHLI_LRI3D(:,:,:)=0.
- PCIT(:,:,:) = 0.
-ENDIF
-IF(OWARM) THEN
- PEVAP3D(:,:,:) = 0.
- DO JL=1,IMICRO
- PEVAP3D(I1(JL), I2(JL), I3(JL)) = ZRREVAV(JL)
- END DO
-ENDIF
-!
+ DO JL=1, IMICRO
+ ZCITOUT (I1(JL),I2(JL))=ZCIT (JL)
+ IF(PARAMI%LWARM) THEN
+ PEVAP3D(I1(JL),I2(JL))=ZRREVAV(JL)
+ ENDIF
+ ZWR(I1(JL),I2(JL),IRV)=ZVART(JL, IRV)
+ ZWR(I1(JL),I2(JL),IRC)=ZVART(JL, IRC)
+ ZWR(I1(JL),I2(JL),IRR)=ZVART(JL, IRR)
+ ZWR(I1(JL),I2(JL),IRI)=ZVART(JL, IRI)
+ ZWR(I1(JL),I2(JL),IRS)=ZVART(JL, IRS)
+ ZWR(I1(JL),I2(JL),IRG)=ZVART(JL, IRG)
+ IF (KRR==7) THEN
+ ZWR(I1(JL),I2(JL),IRH)=ZVART(JL, IRH)
+ ENDIF
+ ENDDO
+
+ ENDDO ! JMICRO
+ENDIF ! KSIZE > 0
+PCIT(:,:)=ZCITOUT(:,:)
+
+!==========================================================================================================
+
+
!
!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
-CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
- PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT/PEXN, ZT, &
- PRVT, &
- PCIT, ZZ_RVHENI_MR)
-DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
- ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
- ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
- PRIS(JI,JJ,JK)=PRIS(JI,JJ,JK)+ZZ_RVHENI(JI,JJ,JK)
- PRVS(JI,JJ,JK)=PRVS(JI,JJ,JK)-ZZ_RVHENI(JI,JJ,JK)
- PTHS(JI,JJ,JK)=PTHS(JI,JJ,JK) + ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
- ENDDO
+LLW3D(:,:)=.FALSE.
+DO JK=IKTB,IKTE
+ DO JIJ=IIJB,IIJE
+ IF (.NOT. ODMICRO(JIJ, JK)) THEN
+ LLW3D(JIJ, JK)=.TRUE.
+ ZW3D(JIJ, JK)=ZZ_LSFACT(JIJ, JK)/PEXN(JIJ, JK)
+ ELSE
+ LLW3D(JIJ, JK)=.FALSE.
+ ENDIF
ENDDO
ENDDO
+CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, D%NIJT*D%NKT, LLW3D(:,:), &
+ PTHT(:, :), PPABST(:, :), PRHODREF(:, :), &
+ PEXN(:, :), ZW3D(:, :), ZT(:, :), &
+ PRVT(:, :), &
+ PCIT(:, :), ZZ_RVHENI_MR(:, :))
!
-if ( lbu_enable ) then
- !Note: there is an other contribution for HIN later
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HIN', pths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HIN', prvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIN', zz_rvheni(:, :, :) * prhodj(:, :, :) )
-end if
!-------------------------------------------------------------------------------
!
-!* 7. UNPACKING AND TOTAL TENDENCIES
-! ------------------------------
+!* 7. TOTAL TENDENCIES
+! ----------------
!
!
!*** 7.1 total tendencies limited by available species
!
-! ZW_??S variables will contain the new S variables values
-!
-IF(GEXT_TEND) THEN
- !Z..T variables contain the exeternal tendency, we substract it
- DO JL=1, IMICRO
- ZRVT(JL) = ZRVT(JL) - ZEXT_RV(JL) * PTSTEP
- ZRCT(JL) = ZRCT(JL) - ZEXT_RC(JL) * PTSTEP
- ZRRT(JL) = ZRRT(JL) - ZEXT_RR(JL) * PTSTEP
- ZRIT(JL) = ZRIT(JL) - ZEXT_RI(JL) * PTSTEP
- ZRST(JL) = ZRST(JL) - ZEXT_RS(JL) * PTSTEP
- ZRGT(JL) = ZRGT(JL) - ZEXT_RG(JL) * PTSTEP
- ZTHT(JL) = ZTHT(JL) - ZEXT_TH(JL) * PTSTEP
+DO JK = IKTB, IKTE
+ DO CONCURRENT (JIJ=IIJB:IIJE)
+ !LV/LS
+ ZZ_LSFACT(JIJ,JK)=ZZ_LSFACT(JIJ,JK)/PEXNREF(JIJ,JK)
+ ZZ_LVFACT(JIJ,JK)=ZZ_LVFACT(JIJ,JK)/PEXNREF(JIJ,JK)
+
+ !Tendency dure to nucleation on non ODMICRO points
+ ZZ_RVHENI(JIJ,JK) = MIN(PRVS(JIJ,JK), ZZ_RVHENI_MR(JIJ,JK)/PTSTEP)
+
+ !Hydrometeor tendencies is the difference between old state and new state (can be negative)
+ ZWR(JIJ,JK,IRV)=(ZWR(JIJ,JK,IRV)-PRVT(JIJ,JK))*ZINV_TSTEP
+ ZWR(JIJ,JK,IRC)=(ZWR(JIJ,JK,IRC)-PRCT(JIJ,JK))*ZINV_TSTEP
+ ZWR(JIJ,JK,IRR)=(ZWR(JIJ,JK,IRR)-PRRT(JIJ,JK))*ZINV_TSTEP
+ ZWR(JIJ,JK,IRI)=(ZWR(JIJ,JK,IRI)-PRIT(JIJ,JK))*ZINV_TSTEP
+ ZWR(JIJ,JK,IRS)=(ZWR(JIJ,JK,IRS)-PRST(JIJ,JK))*ZINV_TSTEP
+ ZWR(JIJ,JK,IRG)=(ZWR(JIJ,JK,IRG)-PRGT(JIJ,JK))*ZINV_TSTEP
+ IF(KRR==7) THEN
+ ZWR(JIJ,JK,IRH)=(ZWR(JIJ,JK,IRH)-PRHT(JIJ,JK))*ZINV_TSTEP
+ ENDIF
+
+ !Theta tendency computed from hydrometeors tendencies
+ ZWR(JIJ,JK, ITH) = (ZWR(JIJ,JK,IRC)+ZWR(JIJ,JK,IRR))*ZZ_LVFACT(JIJ,JK)+ &
+ & (ZWR(JIJ,JK,IRI)+ZWR(JIJ,JK,IRS)+ZWR(JIJ,JK,IRG)+ &
+ & ZWR(JIJ,JK,IRH))*ZZ_LSFACT(JIJ,JK)
+
+ !We apply these tendencies to the S variables
+ !including the nucleation part
+ PTHS(JIJ,JK) = PTHS(JIJ,JK) + ZWR(JIJ,JK,ITH)+ZZ_RVHENI(JIJ,JK)*ZZ_LSFACT(JIJ,JK)
+ PRVS(JIJ,JK) = PRVS(JIJ,JK) + ZWR(JIJ,JK,IRV)-ZZ_RVHENI(JIJ,JK)
+ PRCS(JIJ,JK) = PRCS(JIJ,JK) + ZWR(JIJ,JK,IRC)
+ PRRS(JIJ,JK) = PRRS(JIJ,JK) + ZWR(JIJ,JK,IRR)
+ PRIS(JIJ,JK) = PRIS(JIJ,JK) + ZWR(JIJ,JK,IRI)+ZZ_RVHENI(JIJ,JK)
+ PRSS(JIJ,JK) = PRSS(JIJ,JK) + ZWR(JIJ,JK,IRS)
+ PRGS(JIJ,JK) = PRGS(JIJ,JK) + ZWR(JIJ,JK,IRG)
+ IF (KRR==7) THEN
+ PRHS(JIJ,JK) = PRHS(JIJ,JK) + ZWR(JIJ,JK,IRH)
+ ENDIF
ENDDO
- IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
-ENDIF
-!Tendencies computed from difference between old state and new state (can be negative)
- ZW_RVS(:,:,:) = 0.
- ZW_RCS(:,:,:) = 0.
- ZW_RRS(:,:,:) = 0.
- ZW_RIS(:,:,:) = 0.
- ZW_RSS(:,:,:) = 0.
- ZW_RGS(:,:,:) = 0.
- ZW_RHS(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW_RVS(I1(JL), I2(JL), I3(JL)) = ( ZRVT(JL) - PRVT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RCS(I1(JL), I2(JL), I3(JL)) = ( ZRCT(JL) - PRCT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RRS(I1(JL), I2(JL), I3(JL)) = ( ZRRT(JL) - PRRT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RIS(I1(JL), I2(JL), I3(JL)) = ( ZRIT(JL) - PRIT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RSS(I1(JL), I2(JL), I3(JL)) = ( ZRST(JL) - PRST(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RGS(I1(JL), I2(JL), I3(JL)) = ( ZRGT(JL) - PRGT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- END DO
- IF(KRR==7) THEN
- DO JL=1,IMICRO
- ZW_RHS(I1(JL), I2(JL), I3(JL)) = ( ZRHT(JL) - PRHT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- END DO
-END IF
-ZW_THS(:,:,:) = (ZW_RCS(:,:,:)+ZW_RRS(:,:,:) )*ZZ_LVFACT(:,:,:) + &
- & (ZW_RIS(:,:,:)+ZW_RSS(:,:,:)+ZW_RGS(:,:,:)+ZW_RHS(:,:,:))*ZZ_LSFACT(:,:,:)
-!We apply these tendencies to the S variables
-ZW_RVS(:,:,:) = PRVS(:,:,:) + ZW_RVS(:,:,:)
-ZW_RCS(:,:,:) = PRCS(:,:,:) + ZW_RCS(:,:,:)
-ZW_RRS(:,:,:) = PRRS(:,:,:) + ZW_RRS(:,:,:)
-ZW_RIS(:,:,:) = PRIS(:,:,:) + ZW_RIS(:,:,:)
-ZW_RSS(:,:,:) = PRSS(:,:,:) + ZW_RSS(:,:,:)
-ZW_RGS(:,:,:) = PRGS(:,:,:) + ZW_RGS(:,:,:)
-IF(KRR==7) ZW_RHS(:,:,:) = PRHS(:,:,:) + ZW_RHS(:,:,:)
-ZW_THS(:,:,:) = PTHS(:,:,:) + ZW_THS(:,:,:)
-
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CORR', zw_ths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CORR', zw_rvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zw_rcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zw_rrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zw_ris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zw_rss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CORR', zw_rgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'CORR', zw_rhs(:, :, :) * prhodj(:, :, :) )
-end if
+ENDDO
-!We correct negativities with conservation
-CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
- &ZW_RIS, ZW_RSS, ZW_RGS, &
- &ZW_THS, ZZ_LVFACT, ZZ_LSFACT, ZW_RHS)
-
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CORR', zw_ths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CORR', zw_rvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zw_rcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zw_rrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zw_ris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zw_rss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CORR', zw_rgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'CORR', zw_rhs(:, :, :) * prhodj(:, :, :) )
-end if
!
!*** 7.2 LBU_ENABLE case
!
-IF(LBU_ENABLE) THEN
- allocate( zw1( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- allocate( zw2( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- allocate( zw3( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- allocate( zw4( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- if ( krr == 7 ) then
- allocate( zw5( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- allocate( zw6( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- end if
-
- if ( lbudget_th ) then
- allocate( zz_diff( size( zz_lsfact, 1 ), size( zz_lsfact, 2 ), size( zz_lsfact, 3 ) ) )
- zz_diff(:, :, :) = zz_lsfact(:, :, :) - zz_lvfact(:, :, :)
- end if
-
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
- END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIN', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIN', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIN', zw(:, :, :) * prhodj(:, :, :) )
+IF(BUCONF%LBU_ENABLE) THEN
+ IF (BUCONF%LBUDGET_TH) THEN
+ ZZ_DIFF(:,:)=0.
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ ZZ_DIFF(JIJ, JK) = ZZ_LSFACT(JIJ, JK) - ZZ_LVFACT(JIJ, JK)
+ ENDDO
+ ENDDO
+ END IF
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
+ END DO
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ ZW(JIJ,JK)=ZW(JIJ,JK)+ZZ_RVHENI(JIJ,JK)
+ ENDDO
+ ENDDO
+#ifdef REPRO48
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ZW(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', -ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HENU', ZW(:, :) *PRHODJ(:, :))
+#else
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIN', ZW(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIN', -ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIN', ZW(:, :) *PRHODJ(:, :))
+#endif
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HON', ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HON', -ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HON', ZW(:, :) *PRHODJ(:, :))
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'SFR', ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'SFR', -ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'SFR', ZW(:, :) *PRHODJ(:, :))
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPS', ZW(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPS', -ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DEPS', ZW(:, :) *PRHODJ(:, :))
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
END DO
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AGGS', -ZW(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AGGS', ZW(:, :)*PRHODJ(:, :))
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
END DO
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'AUTS', -ZW(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AUTS', ZW(:, :)*PRHODJ(:, :))
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', zw(:, :, :) * prhodj(:, :, :) )
-
- IF(OWARM) THEN
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DEPG', ZW(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'DEPG', -ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DEPG', ZW(:, :) *PRHODJ(:, :))
+
+ IF(PARAMI%LWARM) THEN
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'AUTO', -ZW(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'AUTO', ZW(:, :)*PRHODJ(:, :))
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'ACCR', -ZW(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACCR', ZW(:, :)*PRHODJ(:, :))
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', -zw(:, :, :) * zz_lvfact(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', -zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'REVA', -ZW(:, :)*ZZ_LVFACT(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'REVA', ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'REVA', -ZW(:, :) *PRHODJ(:, :))
ENDIF
- ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
END DO
- ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
END DO
- ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
-
- ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'RIM', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', (-ZW1(:, :)-ZW2(:, :))*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ( ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ( ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
+
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
END DO
- ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
END DO
- ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
-
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'ACC', (ZW1(:, :)+ZW2(:, :) )*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', (-ZW1(:, :)-ZW2(:, :))*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ( ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ( ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
+
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CMEL', -ZW(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CMEL', ZW(:, :)*PRHODJ(:, :))
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CMEL', -ZW(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CMEL', ZW(:, :)*PRHODJ(:, :))
- ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
END DO
- ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
END DO
- ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', zw2(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ( -zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ( -zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( zw1(:, :, :) + zw2(:, :, :) ) * prhodj(:, :, :) )
-
- ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'CFRZ', ZW2(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CFRZ', (-ZW2(:, :)+ZW3(:, :))*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'CFRZ', (-ZW1(:, :)-ZW3(:, :))*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CFRZ', ( ZW1(:, :)+ZW2(:, :))*PRHODJ(:, :))
+
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
END DO
- ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
END DO
- ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
END DO
- ZW4(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
+ ZW4(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', -zw1(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', -zw2(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', -zw3(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', -zw4(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) &
- + zw3(:, :, :) + zw4(:, :, :) ) &
- * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETG', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETG', -ZW1(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETG', -ZW2(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETG', -ZW3(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETG', -ZW4(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETG', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ZW4(:, :)) &
+ & *PRHODJ(:, :))
IF(KRR==7) THEN
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GHCV', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'GHCV', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GHCV', -ZW(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'GHCV', ZW(:, :)*PRHODJ(:, :))
END IF
- ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
END DO
- ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
END DO
- ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
END DO
- ZW4(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
+ ZW4(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', -zw1(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', -zw2(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', -zw3(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', -zw4(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) &
- + zw3(:, :, :) + zw4(:, :, :) ) &
- * prhodj(:, :, :) )
-
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYG', (ZW1(:, :)+ZW2(:, :) )*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYG', -ZW1(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYG', -ZW2(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYG', -ZW3(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYG', -ZW4(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYG', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ZW4(:, :)) &
+ & *PRHODJ(:, :))
+
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'GMLT', -ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'GMLT', ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'GMLT', -ZW(:, :) *PRHODJ(:, :))
IF(KRR==7) THEN
- ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
END DO
- ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
END DO
- ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
END DO
- ZW4(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
+ ZW4(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
END DO
- ZW5(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ ZW5(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW5(I1TOT(JL), I2TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETH', -zw1(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETH', -zw2(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETH', -zw3(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETH', -zw4(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETH', -zw5(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
- + zw4(:, :, :) + zw5(:, :, : ) ) &
- * prhodj(:, :, :) )
-
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'WETH', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETH', -ZW1(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETH', -ZW2(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'WETH', -ZW3(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETH', -ZW4(:, :) *PRHODJ(:, :))
+#ifdef REPRO48
+#else
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'WETH', -ZW5(:, :) *PRHODJ(:, :))
+#endif
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'WETH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ &
+ &ZW4(:, :)+ZW5(:, : )) *PRHODJ(:, :))
+
+#if defined(REPRO48) || defined(REPRO55)
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'HGCV', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HGCV', zw(:, :, :) * prhodj(:, :, :) )
-
- ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
+#endif
+#ifdef REPRO48
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', (-ZW5(:, :)-ZW(:, :))*PRHODJ(:, :))
+#endif
+#ifdef REPRO55
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW(:, :)*PRHODJ(:, :))
+#endif
+#if defined(REPRO48) || defined(REPRO55)
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW(:, :)*PRHODJ(:, :))
+#endif
+
+ ZW1(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
END DO
- ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
+ ZW2(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
END DO
- ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
+ ZW3(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
END DO
- ZW4(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
+ ZW4(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
END DO
- ZW5(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
+ ZW5(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW5(I1TOT(JL), I2TOT(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
END DO
- ZW6(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW6(I1(JL), I2(JL), I3(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
+ ZW6(:,:) = 0.
+#if defined(REPRO48) || defined(REPRO55)
+ !ZW6 must be removed when REPRO* will be suppressed
+ DO JL=1, KSIZE
+ ZW6(I1TOT(JL), I2TOT(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYH', -zw1(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYH', -zw2(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYH', -zw3(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYH', -zw4(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYH', ( -zw5(:, :, :) + zw6(:, :, : ) ) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
- + zw4(:, :, :) + zw5(:, :, : )- zw6(:, :, :) ) &
- * prhodj(:, :, :) )
-
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
+#endif
+ IF (BUCONF%LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'DRYH', (ZW1(:, :)+ZW2(:, :))*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYH', -ZW1(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYH', -ZW2(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'DRYH', -ZW3(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DRYH', -ZW4(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYH', (-ZW5(:, :)+ZW6(:, :)) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'DRYH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ &
+ &ZW4(:, :)+ZW5(:, :)-ZW6(:, :)) &
+ & *PRHODJ(:, :))
+
+#if defined(REPRO48) || defined(REPRO55)
+#else
+ !When REPRO48 will be suppressed, ZW6 must be removed
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
+ END DO
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW(:, :)*PRHODJ(:, :))
+#endif
+
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', -zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HMLT', -ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HMLT', ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HMLT', -ZW(:, :) *PRHODJ(:, :))
ENDIF
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'IMLT', -ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'IMLT', ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'IMLT', -ZW(:, :) *PRHODJ(:, :))
- ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
+ ZW(:,:) = 0.
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', zw(:, :, :) * prhodj(:, :, :) )
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'BERFI', ZW(:, :)*ZZ_DIFF(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'BERFI', -ZW(:, :) *PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'BERFI', ZW(:, :) *PRHODJ(:, :))
- deallocate( zw1, zw2, zw3, zw4 )
- if ( krr == 7 ) deallocate( zw5, zw6 )
- if ( lbudget_th ) deallocate( zz_diff )
ENDIF
!
!*** 7.3 Final tendencies
!
-DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- PRVS(JI,JJ,JK) = ZW_RVS(JI,JJ,JK)
- PRCS(JI,JJ,JK) = ZW_RCS(JI,JJ,JK)
- PRRS(JI,JJ,JK) = ZW_RRS(JI,JJ,JK)
- PRIS(JI,JJ,JK) = ZW_RIS(JI,JJ,JK)
- PRSS(JI,JJ,JK) = ZW_RSS(JI,JJ,JK)
- PRGS(JI,JJ,JK) = ZW_RGS(JI,JJ,JK)
- PTHS(JI,JJ,JK) = ZW_THS(JI,JJ,JK)
- ENDDO
- ENDDO
-ENDDO
-IF (KRR==7) PRHS(:,:,:) = ZW_RHS(:,:,:)
+IF (BUCONF%LBU_ENABLE) THEN
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'CORR', PRSS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'CORR', PRIS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'CORR', PRSS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :)*PRHODJ(:, :))
+END IF
+
+!NOTE:
+! This call cannot be moved before the preeceding budget calls because,
+! with AROME, the BUDGET_STORE_INIT does nothing. The equivalent is done only
+! once before the physics call and copies of the S variables evolve automatically
+! internally to the budget (DDH) machinery at each BUDGET_STORE_ADD and
+! BUDGET_STORE_END calls. Thus, the difference between the DDH internal version
+! of the S variables and the S variables used in the folowing BUDGET_STORE_END
+! call must only be due to the correction of negativities.
+!
+!We correct negativities with conservation
+CALL CORRECT_NEGATIVITIES(D, KRR, PRVS, PRCS, PRRS, &
+ &PRIS, PRSS, PRGS, &
+ &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+
+IF (BUCONF%LBU_ENABLE) THEN
+ IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'CORR', PRRS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'CORR', PRIS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'CORR', PRSS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :)*PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :)*PRHODJ(:, :))
+END IF
!
!-------------------------------------------------------------------------------
!
!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
-IF(LSEDIM_AFTER) THEN
+IF(PARAMI%LSEDIM_AFTER) THEN
!
!* 8.1 sedimentation
!
- if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
-
- !Init only if not osedic (to prevent crash with double init)
- !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
- ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
- if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
- call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
-
- IF(HSEDIM=='STAT') THEN
- !SR: It *seems* that we must have two separate calls for ifort
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
+
+ IF(PARAMI%CSEDIM=='STAT') THEN
+ IF (KRR==7) THEN
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
+ ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
+ ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
+ ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
+ ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
+ ZRHT(JIJ,JK)=PRHS(JIJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
+ &PTSTEP, KRR, PARAMI%LSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- &ZLBDAS, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &ZLBDAS, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
+ &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ,&
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP
+ ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP
+ ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP
+ ZRST(JIJ,JK)=PRSS(JIJ,JK)*PTSTEP
+ ZRGT(JIJ,JK)=PRGS(JIJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ CALL ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, &
+ &PTSTEP, KRR, PARAMI%LSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- &ZLBDAS, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &ZLBDAS, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+ PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
- ELSEIF(HSEDIM=='SPLI') THEN
+ ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
+ &PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
+ &PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+ PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
!We correct negativities with conservation
!SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
! It is initialized with the m.r. at T and is modified by two tendencies:
! sedimentation tendency and an external tendency which represents all other
! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a specie at a given sub-timestep. From
+ ! are negative, sedimentation can remove a species at a given sub-timestep. From
! this point sedimentation stops for the remaining sub-timesteps but the other tendency
! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a specie, instead we apply
+ ! We could prevent the algorithm to not consume too much a species, instead we apply
! a correction here.
- CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
+ CALL CORRECT_NEGATIVITIES(D, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for PARAMI%CSEDIM='//PARAMI%CSEDIM)
END IF
!
!* 8.2 budget storage
!
- if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
-
- !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
- !(a warning is printed in ini_budget in that case)
- if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
- call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
-
- !sedimentation of rain fraction
+ IF (BUCONF%LBUDGET_RC .AND. PARAMI%LSEDIC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RR) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
+ IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
+
+ !"sedimentation" of rain fraction
IF (PRESENT(PRHS)) THEN
- CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
- &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP, PRHS(:,:,:)*PTSTEP)
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, PRRS(:,:)*PTSTEP, &
+ &PRSS(:,:)*PTSTEP, PRGS(:,:)*PTSTEP, PRHS(:,:)*PTSTEP)
ELSE
- CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
- &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, PRRS(:,:)*PTSTEP, &
+ &PRSS(:,:)*PTSTEP, PRGS(:,:)*PTSTEP)
ENDIF
ENDIF
!
+!-------------------------------------------------------------------------------
+!
+!* 9. COMPUTE THE FOG DEPOSITION TERM
+! -------------------------------------
+!
+IF (PARAMI%LDEPOSC) THEN !cloud water deposition on vegetation
+ IF (BUCONF%LBU_ENABLE .AND. BUCONF%LBUDGET_RC) &
+ & CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'DEPO', PRCS(:, :)*PRHODJ(:, :))
+
+ PINDEP(:)=0.
+!DEC$ IVDEP
+ DO JIJ = IIJB, IIJE
+ PINDEP(JIJ) = PARAMI%XVDEPOSC * PRCT(JIJ, IKB) * PRHODREF(JIJ, IKB) / CST%XRHOLW
+ PRCS(JIJ, IKB) = PRCS(JIJ, IKB) - PARAMI%XVDEPOSC * PRCT(JIJ, IKB) / PDZZ(JIJ, IKB)
+ PINPRC(JIJ) = PINPRC(JIJ) + PINDEP(JIJ)
+ ENDDO
+
+ IF (BUCONF%LBU_ENABLE .AND. BUCONF%LBUDGET_RC) &
+ & CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'DEPO', PRCS(:, :)*PRHODJ(:, :))
+ENDIF
+
+IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 1, ZHOOK_HANDLE)
!
CONTAINS
!
- SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &
+ SUBROUTINE CORRECT_NEGATIVITIES(D, KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
&PTH, PLVFACT, PLSFACT, PRH)
!
IMPLICIT NONE
!
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KRR
- REAL, DIMENSION(KIT, KJT, KKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
- REAL, DIMENSION(KIT, KJT, KKT), INTENT(IN) :: PLVFACT, PLSFACT
- REAL, DIMENSION(KIT, KJT, KKT), OPTIONAL, INTENT(INOUT) :: PRH
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ INTEGER, INTENT(IN) :: KRR
+ REAL, DIMENSION(D%NIJT, D%NKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
+ REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLVFACT, PLSFACT
+ REAL, DIMENSION(D%NIJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PRH
!
- REAL, DIMENSION(KIT, KJT, KKT) :: ZW
- INTEGER :: JI, JJ, JK
+ REAL :: ZW
+ INTEGER :: JIJ, JK
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
+ IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE)
!
!We correct negativities with conservation
- ! 1) deal with negative values for mixing ratio, except for vapor
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW(JI,JJ,JK) =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
- PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
- PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ ! 1) deal with negative values for mixing ratio, except for vapor
+ ZW =PRC(JIJ,JK)-MAX(PRC(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
+ PRC(JIJ,JK)=PRC(JIJ,JK)-ZW
+
+ ZW =PRR(JIJ,JK)-MAX(PRR(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
+ PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
+
+ ZW =PRI(JIJ,JK)-MAX(PRI(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ PRI(JIJ,JK)=PRI(JIJ,JK)-ZW
+
+ ZW =PRS(JIJ,JK)-MAX(PRS(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ PRS(JIJ,JK)=PRS(JIJ,JK)-ZW
+
+ ZW =PRG(JIJ,JK)-MAX(PRG(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ PRG(JIJ,JK)=PRG(JIJ,JK)-ZW
- IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW(JI,JJ,JK) =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
- ENDIF
+ IF(KRR==7) THEN
+ ZW =PRH(JIJ,JK)-MAX(PRH(JIJ,JK), 0.)
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ PRH(JIJ,JK)=PRH(JIJ,JK)-ZW
+ ENDIF
- ! 2) deal with negative vapor mixing ratio
-
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ! for rc and ri, we keep ice fraction constant
- ZW(JI,JJ,JK)=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
- &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)* &
- &(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
- PRC(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRC(JI,JJ,JK)
- PRI(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRI(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRR(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRS(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRG(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
+ ! 2) deal with negative vapor mixing ratio
+
+ ! for rc and ri, we keep ice fraction constant
+ ZW=MIN(1., MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.) / &
+ &MAX(PRC(JIJ,JK)+PRI(JIJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW* &
+ &(PRC(JIJ,JK)*PLVFACT(JIJ,JK)+PRI(JIJ,JK)*PLSFACT(JIJ,JK))
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW*(PRC(JIJ,JK)+PRI(JIJ,JK))
+ PRC(JIJ,JK)=(1.-ZW)*PRC(JIJ,JK)
+ PRI(JIJ,JK)=(1.-ZW)*PRI(JIJ,JK)
+
+ ZW=MIN(MAX(PRR(JIJ,JK), 0.), &
+ &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rr to convert into rv
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
+
+ ZW=MIN(MAX(PRS(JIJ,JK), 0.), &
+ &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rs to convert into rv
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PRS(JIJ,JK)=PRS(JIJ,JK)-ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+
+ ZW=MIN(MAX(PRG(JIJ,JK), 0.), &
+ &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rg to convert into rv
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PRG(JIJ,JK)=PRG(JIJ,JK)-ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
- IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW(JI,JJ,JK)=MIN(MAX(PRH(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- ENDDO
- ENDDO
+ IF(KRR==7) THEN
+ ZW=MIN(MAX(PRH(JIJ,JK), 0.), &
+ &MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rh to convert into rv
+ PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
+ PRH(JIJ,JK)=PRH(JIJ,JK)-ZW
+ PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
+ ENDIF
ENDDO
- ENDIF
+ ENDDO
!
+ IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 1, ZHOOK_HANDLE)
!
END SUBROUTINE CORRECT_NEGATIVITIES
-
!
-END SUBROUTINE RAIN_ICE_RED
+END SUBROUTINE RAIN_ICE
diff --git a/src/PHYEX/micro/rain_ice_fast_rg.f90 b/src/PHYEX/micro/rain_ice_fast_rg.f90
index b8a7b480ae57a727adeaa3e04888ea61a9db5586..4d4c4ec292ad965e5bb42e6c1806239eea8b7b14 100644
--- a/src/PHYEX/micro/rain_ice_fast_rg.f90
+++ b/src/PHYEX/micro/rain_ice_fast_rg.f90
@@ -204,8 +204,13 @@ REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
JL = I1(JJ)
ZZW1(JL,3) = MIN( PRSS(JL),XFSDRYG*ZVEC3(JJ) & ! RSDRYG
* EXP( XCOLEXSG*(PZT(JL)-XTT) ) &
+#if defined(REPRO48) || defined(REPRO55)
+ *( ZVECLBDAS(JJ)**(XCXS-XBS) )*( ZVECLBDAG(JJ)**XCXG ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+#else
*PRST(JL)*( ZVECLBDAG(JJ)**XCXG ) &
*( PRHODREF(JL)**(-XCEXVT) ) &
+#endif
*( XLBSDRYG1/( ZVECLBDAG(JJ)**2 ) + &
XLBSDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAS(JJ) ) + &
XLBSDRYG3/( ZVECLBDAS(JJ)**2) ) )
diff --git a/src/PHYEX/micro/rain_ice_fast_rh.f90 b/src/PHYEX/micro/rain_ice_fast_rh.f90
index 58446c16979afbc514d69da50796323a870f3e33..b86db34ae9e8ebca3d6940162d5fa624fd3092c3 100644
--- a/src/PHYEX/micro/rain_ice_fast_rh.f90
+++ b/src/PHYEX/micro/rain_ice_fast_rh.f90
@@ -186,8 +186,13 @@ REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
DO JJ = 1, IGWET
JL = I1W(JJ)
ZZW1(JL,3) = MIN( PRSS(JL),XFSWETH*ZVEC3(JJ) & ! RSWETH
+#if defined(REPRO48) || defined(REPRO55)
+ *( ZVECLBDAS(JJ)**(XCXS-XBS) )*( ZVECLBDAH(JJ)**XCXH ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+#else
*PRST(JL)*( ZVECLBDAH(JJ)**XCXH ) &
*( PRHODREF(JL)**(-XCEXVT) ) &
+#endif
*( XLBSWETH1/( ZVECLBDAH(JJ)**2 ) + &
XLBSWETH2/( ZVECLBDAH(JJ) * ZVECLBDAS(JJ) ) + &
XLBSWETH3/( ZVECLBDAS(JJ)**2) ) )
diff --git a/src/PHYEX/micro/rain_ice_fast_rs.f90 b/src/PHYEX/micro/rain_ice_fast_rs.f90
index 2acc9b0e0101635f8baebf80e9e2fa5dea82aad3..8b7dbdc3db20aeb3788386e4ef089d9aec04f1a9 100644
--- a/src/PHYEX/micro/rain_ice_fast_rs.f90
+++ b/src/PHYEX/micro/rain_ice_fast_rs.f90
@@ -136,9 +136,15 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
DO JJ = 1, IGRIM
JL = I1(JJ)
ZZW1(JJ) = MIN( PRCS(JL), &
+#if defined(REPRO48) || defined(REPRO55)
+ XCRIMSS * ZVEC1(JJ) * PRCT(JL) & ! RCRIMSS
+ * ZVECLBDAS(JJ)**XEXCRIMSS &
+ * PRHODREF(JL)**(-XCEXVT) )
+#else
XCRIMSS * ZVEC1(JJ) * PRCT(JL) * PRST(JL) & ! RCRIMSS
* ZVECLBDAS(JJ)**(XBS+XEXCRIMSS) &
* PRHODREF(JL)**(-XCEXVT+1) )
+#endif
PRCS(JL) = PRCS(JL) - ZZW1(JJ)
PRSS(JL) = PRSS(JL) + ZZW1(JJ)
PTHS(JL) = PTHS(JL) + ZZW1(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RCRIMSS))
@@ -157,12 +163,21 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
JL = I1(JJ)
IF ( PRSS(JL) > 0.0 ) THEN
ZZW2(JJ) = MIN( PRCS(JL), &
+#if defined(REPRO48) || defined(REPRO55)
+ XCRIMSG * PRCT(JL) & ! RCRIMSG
+ * ZVECLBDAS(JJ)**XEXCRIMSG &
+ * PRHODREF(JL)**(-XCEXVT) &
+ - ZZW1(JJ) )
+ ZZW3(JJ) = MIN( PRSS(JL), &
+ XSRIMCG * ZVECLBDAS(JJ)**XEXSRIMCG & ! RSRIMCG
+#else
XCRIMSG * PRCT(JL) *PRST(JL) & ! RCRIMSG
* ZVECLBDAS(JJ)**(XBS+XEXCRIMSG) &
* PRHODREF(JL)**(-XCEXVT+1) &
- ZZW1(JJ) )
ZZW3(JJ) = MIN( PRSS(JL), &
PRST(JL) * PRHODREF(JL) * XSRIMCG * ZVECLBDAS(JJ)**(XBS+XEXSRIMCG) & ! RSRIMCG
+#endif
* (1.0 - ZVEC1(JJ) )/(PTSTEP*PRHODREF(JL)) )
PRCS(JL) = PRCS(JL) - ZZW2(JJ)
PRSS(JL) = PRSS(JL) - ZZW3(JJ)
@@ -260,7 +275,11 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
DO JJ = 1, IGACC
JL = I1(JJ)
ZZW2(JJ) = & !! coef of RRACCS
+#if defined(REPRO48) || defined(REPRO55)
+ XFRACCSS*( ZVECLBDAS(JJ)**XCXS )*( PRHODREF(JL)**(-XCEXVT-1.) ) &
+#else
XFRACCSS*( PRST(JL)*ZVECLBDAS(JJ)**XBS )*( PRHODREF(JL)**(-XCEXVT) ) &
+#endif
*( XLBRACCS1/((ZVECLBDAS(JJ)**2) ) + &
XLBRACCS2/( ZVECLBDAS(JJ) * ZVECLBDAR(JJ) ) + &
XLBRACCS3/( (ZVECLBDAR(JJ)**2)) )/ZVECLBDAR(JJ)**4
@@ -306,7 +325,11 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
ZZW2(JJ) = MAX( MIN( PRRS(JL),ZZW2(JJ)-ZZW4(JJ) ),0.0 ) ! RRACCSG
IF ( ZZW2(JJ) > 0.0 ) THEN
ZZW3(JJ) = MIN( PRSS(JL),XFSACCRG*ZVEC3(JJ)* & ! RSACCRG
+#if defined(REPRO48) || defined(REPRO55)
+ ( ZVECLBDAS(JJ)**(XCXS-XBS) )*( PRHODREF(JL)**(-XCEXVT-1.) ) &
+#else
PRST(JL)*( PRHODREF(JL)**(-XCEXVT) ) &
+#endif
*( XLBSACCR1/((ZVECLBDAR(JJ)**2) ) + &
XLBSACCR2/( ZVECLBDAR(JJ) * ZVECLBDAS(JJ) ) + &
XLBSACCR3/( (ZVECLBDAS(JJ)**2)) )/ZVECLBDAR(JJ) )
@@ -353,9 +376,15 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
!
! compute RSMLT
!
+#if defined(REPRO48) || defined(REPRO55)
+ ZZW(:) = MIN( PRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) ) / &
+#else
ZZW(:) = MIN( PRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * PRST(:) * PRHODREF(:) * &
( X0DEPS* PLBDAS(:)**(XBS+XEX0DEPS) + &
X1DEPS*PCJ(:)*PLBDAS(:)**(XBS+XEX1DEPS) ) ) / &
+#endif
( PRHODREF(:)*XLMTT ) ) )
!
! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
diff --git a/src/PHYEX/micro/rain_ice_old.f90 b/src/PHYEX/micro/rain_ice_old.f90
index d736f5a9cc920751da778ad291aa4ad4898d93aa..6645e796b47be4aee5b48ea208e72ec8f09bbfa3 100644
--- a/src/PHYEX/micro/rain_ice_old.f90
+++ b/src/PHYEX/micro/rain_ice_old.f90
@@ -4,11 +4,11 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODI_RAIN_ICE
+ MODULE MODI_RAIN_ICE_OLD
! ####################
!
INTERFACE
- SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
+ SUBROUTINE RAIN_ICE_OLD (D, OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
KSPLITR, PTSTEP, KRR, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
@@ -17,7 +17,9 @@ INTERFACE
PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Switch for rc->rr Subgrid autoconversion
@@ -77,11 +79,11 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
-END SUBROUTINE RAIN_ICE
+END SUBROUTINE RAIN_ICE_OLD
END INTERFACE
-END MODULE MODI_RAIN_ICE
+END MODULE MODI_RAIN_ICE_OLD
! ######spl
- SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
+ SUBROUTINE RAIN_ICE_OLD (D, OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
KSPLITR, PTSTEP, KRR, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
@@ -139,7 +141,7 @@ END MODULE MODI_RAIN_ICE
!! REFERENCE
!! ---------
!!
-!! Book1 and Book2 of documentation ( routine RAIN_ICE )
+!! Book1 and Book2 of documentation ( routine RAIN_ICE_OLD )
!!
!! AUTHOR
!! ------
@@ -229,8 +231,9 @@ use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
use MODD_LES, only: LLES_CALL
use MODD_PARAMETERS, only: JPVEXT
use MODD_PARAM_ICE, only: CSUBG_PR_PDF, LDEPOSC
-use MODD_RAIN_ICE_DESCR, only: XLBEXR, XLBR, XRTMIN
+use MODD_RAIN_ICE_DESCR, only: RAIN_ICE_DESCR, XLBEXR, XLBR, XRTMIN
use MODD_RAIN_ICE_PARAM, only: XCRIAUTC
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
use MODE_MSG
use MODE_RAIN_ICE_FAST_RG, only: RAIN_ICE_FAST_RG
@@ -245,7 +248,8 @@ use MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
use mode_tools, only: Countjv
use mode_tools_ll, only: GET_INDICE_ll
-USE MODI_ICE4_RAINFR_VERT
+USE MODE_ICE4_RAINFR_VERT
+!
IMPLICIT NONE
!
@@ -253,6 +257,7 @@ IMPLICIT NONE
!
!
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Switch for rc->rr Subgrid autoconversion
@@ -738,12 +743,12 @@ IF( IMICRO >= 0 ) THEN
ELSE
!wrong CSUBG_PR_PDF case
WRITE(*,*) 'wrong CSUBG_PR_PDF case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_OLD','')
ENDIF
ELSE
!wrong HSUBG_AUCV case
WRITE(*,*)'wrong HSUBG_AUCV case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_OLD','')
ENDIF
!Diagnostic of precipitation fraction
@@ -751,7 +756,7 @@ IF( IMICRO >= 0 ) THEN
DO JL=1,IMICRO
PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
END DO
- CALL ICE4_RAINFR_VERT( IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:), &
+ CALL ICE4_RAINFR_VERT(D, RAIN_ICE_DESCR, PRAINFR, PRRT(:,:,:), &
RESHAPE( SOURCE = [ ( 0., JL = 1, SIZE( PRSS ) ) ], SHAPE = SHAPE( PRSS ) ), &
RESHAPE( SOURCE = [ ( 0., JL = 1, SIZE( PRGS ) ) ], SHAPE = SHAPE( PRGS ) ) )
DO JL=1,IMICRO
@@ -934,12 +939,12 @@ ELSEIF (HSEDIM == 'SPLI') THEN
KRR,OSEDIC,LDEPOSC,PINPRC,PINDEP,PINPRR,PINPRS,PINPRG,PDZZ,PRHODREF,PPABST,PTHT,PRHODJ,&
PINPRR3D,PRCS,PRCT,PRRS,PRRT,PRIS,PRIT,PRSS,PRST,PRGS,PRGT,PSEA,PTOWN,PINPRH,PRHS,PRHT,PFPR)
ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM )
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_OLD', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!sedimentation of rain fraction
-CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+CALL ICE4_RAINFR_VERT(D, RAIN_ICE_DESCR, PRAINFR, PRRS(:,:,:)*PTSTEP, &
PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE RAIN_ICE
+END SUBROUTINE RAIN_ICE_OLD
diff --git a/src/PHYEX/micro/rain_ice_slow.f90 b/src/PHYEX/micro/rain_ice_slow.f90
index 6df8c726f4766e4ce747c8f9dffccee910497e60..10120d3cd5ecc0a3b2991c720c2c13869d5874d9 100644
--- a/src/PHYEX/micro/rain_ice_slow.f90
+++ b/src/PHYEX/micro/rain_ice_slow.f90
@@ -147,7 +147,11 @@ real, dimension(size(plsfact)) :: zz_diff
END WHERE
ZZW(:) = 0.0
WHERE ( (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0) )
+#if defined(REPRO48) || defined(REPRO55)
+ ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+#else
ZZW(:) = ( PRST(:) * PLBDAS(:)**XBS * PSSI(:)/PAI(:) ) * &
+#endif
( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
ZZW(:) = MIN( PRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
- MIN( PRSS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
@@ -169,8 +173,13 @@ real, dimension(size(plsfact)) :: zz_diff
WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. (PRIS(:)>0.0) )
ZZW(:) = MIN( PRIS(:),XFIAGGS * EXP( XCOLEXIS*(PZT(:)-XTT) ) &
* PRIT(:) &
+#if defined(REPRO48) || defined(REPRO55)
+ * PLBDAS(:)**XEXIAGGS &
+ * PRHODREF(:)**(-XCEXVT) )
+#else
* PRST(:) * PLBDAS(:)**(XBS+XEXIAGGS) &
* PRHODREF(:)**(-XCEXVT+1) )
+#endif
PRSS(:) = PRSS(:) + ZZW(:)
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
diff --git a/src/PHYEX/turb/ini_cturb.f90 b/src/PHYEX/turb/ini_cturb.f90
index ffe97a66684a46723380e1b3b03f9066c0099113..ea3f0c70d937df63992fde48dba3347e5f6b5fd4 100644
--- a/src/PHYEX/turb/ini_cturb.f90
+++ b/src/PHYEX/turb/ini_cturb.f90
@@ -73,8 +73,17 @@ END MODULE MODI_INI_CTURB
USE MODD_CST
USE MODD_CTURB
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
IMPLICIT NONE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('INI_CTURB',0,ZHOOK_HANDLE)
+!
+CALL CTURB_ASSOCIATE()
+!
! ---------------------------------------------------------------------------
!
! 1. SETTING THE NUMERICAL VALUES
@@ -85,7 +94,6 @@ IMPLICIT NONE
!XCED is now replaced by XCEDIS
!XCED = 0.70
!XCED = 0.84
-!
! Redelsperger-Sommeria (1981) = 0.70
! Schmidt-Schumann (1989) = 0.845
! Cheng-Canuto-Howard (2002) = 0.845
@@ -251,4 +259,5 @@ XSBL_O_BL = 0.05 ! SBL height / BL height ratio
XFTOP_O_FSURF = 0.05 ! Fraction of surface (heat or momentum) flux used to define top of BL
!
!
+IF (LHOOK) CALL DR_HOOK('INI_CTURB',1,ZHOOK_HANDLE)
END SUBROUTINE INI_CTURB
diff --git a/src/PHYEX/turb/les_mean_subgrid_phy.f90 b/src/PHYEX/turb/les_mean_subgrid_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..88a7d2c7260c6756fca71fcaabaebfbaa19b0f34
--- /dev/null
+++ b/src/PHYEX/turb/les_mean_subgrid_phy.f90
@@ -0,0 +1,136 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 les 2006/08/30 18:41:10
+!-----------------------------------------------------------------
+! #####################
+MODULE MODI_LES_MEAN_SUBGRID_PHY
+! #####################
+!
+INTERFACE LES_MEAN_SUBGRID_PHY
+!
+
+SUBROUTINE LES_MEAN_SUBGRID_3D_PHY(D, TLES, PA, PA_MEAN, OSUM)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_LES, ONLY: TLES_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(TLES_t), INTENT(IN) :: TLES
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA
+!
+REAL, DIMENSION(D%NKLES,TLES%NLES_CURRENT_TCOUNT,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
+!
+LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
+!
+END SUBROUTINE LES_MEAN_SUBGRID_3D_PHY
+!
+SUBROUTINE LES_MEAN_SUBGRID_SURF_PHY(D, TLES, PA, PA_MEAN, OSUM)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_LES, ONLY: TLES_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(TLES_t), INTENT(IN) :: TLES
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PA
+!
+REAL, DIMENSION(TLES%NLES_CURRENT_TCOUNT), INTENT(INOUT) :: PA_MEAN
+!
+LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
+!
+END SUBROUTINE LES_MEAN_SUBGRID_SURF_PHY
+!
+END INTERFACE LES_MEAN_SUBGRID_PHY
+!
+END MODULE MODI_LES_MEAN_SUBGRID_PHY
+!
+! ##############################################
+ SUBROUTINE LES_MEAN_SUBGRID_3D_PHY(D, TLES,PA, PA_MEAN, OSUM)
+! ##############################################
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_LES, ONLY: TLES_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(TLES_t), INTENT(IN) :: TLES
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA
+REAL, DIMENSION(D%NKLES,TLES%NLES_CURRENT_TCOUNT,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
+LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
+!
+CALL LES_MEAN_SUBGRID_unpack3D(D,TLES, PA, PA_MEAN, OSUM)
+!
+END SUBROUTINE LES_MEAN_SUBGRID_3D_PHY
+!
+! ##############################################
+ SUBROUTINE LES_MEAN_SUBGRID_SURF_PHY(D, TLES,PA, PA_MEAN, OSUM)
+! ##############################################
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_LES, ONLY: TLES_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(TLES_t), INTENT(IN) :: TLES
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PA
+REAL, DIMENSION(TLES%NLES_CURRENT_TCOUNT), INTENT(INOUT) :: PA_MEAN
+LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
+!
+CALL LES_MEAN_SUBGRID_unpackSURF(D, TLES, PA, PA_MEAN, OSUM)
+!
+END SUBROUTINE LES_MEAN_SUBGRID_SURF_PHY
+!
+! ##############################################
+ SUBROUTINE LES_MEAN_SUBGRID_unpack3D(D, TLES,PA, PA_MEAN, OSUM)
+! ##############################################
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_LES, ONLY: TLES_t
+USE MODI_LES_MEAN_SUBGRID
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(TLES_t), INTENT(IN) :: TLES
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PA
+REAL, DIMENSION(D%NKLES,TLES%NLES_CURRENT_TCOUNT,D%NLESMASK), INTENT(INOUT) :: PA_MEAN
+LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
+!
+CALL LES_MEAN_SUBGRID_3D(PA, PA_MEAN, OSUM)
+!
+END SUBROUTINE LES_MEAN_SUBGRID_unpack3D
+!
+! ##############################################
+ SUBROUTINE LES_MEAN_SUBGRID_unpackSURF(D, TLES,PA, PA_MEAN, OSUM)
+! ##############################################
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_LES, ONLY: TLES_t
+USE MODI_LES_MEAN_SUBGRID
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(TLES_t), INTENT(IN) :: TLES
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PA
+REAL, DIMENSION(TLES%NLES_CURRENT_TCOUNT), INTENT(INOUT) :: PA_MEAN
+LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
+!
+CALL LES_MEAN_SUBGRID_SURF(PA, PA_MEAN, OSUM)
+!
+END SUBROUTINE LES_MEAN_SUBGRID_unpackSURF
diff --git a/src/PHYEX/turb/modd_cturb.f90 b/src/PHYEX/turb/modd_cturb.f90
index db23e955b7e52ad14c9d4d5d555fb24895d8fbd9..10b21c7580b75424c1eca936247d1f46ff4c7635 100644
--- a/src/PHYEX/turb/modd_cturb.f90
+++ b/src/PHYEX/turb/modd_cturb.f90
@@ -2,12 +2,6 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/05/23 10:10:13
-!-----------------------------------------------------------------
! #######################
MODULE MODD_CTURB
! #######################
@@ -39,53 +33,146 @@
!! Nov 06, 2002 (V. Masson) add XALPSBL and XASBL
!! May 06 Remove EPS
!! Jan 2019 (Q. Rodier) Remove XASBL
+!! Jan 2022 (Q. Rodier) introduction of a strucuture
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
IMPLICIT NONE
+TYPE CSTURB_t
!
-REAL,SAVE :: XCMFS ! constant for the momentum flux due to shear
-REAL,SAVE :: XCMFB ! constant for the momentum flux due to buoyancy
-REAL,SAVE :: XCSHF ! constant for the sensible heat flux
-REAL,SAVE :: XCHF ! constant for the humidity flux
-REAL,SAVE :: XCTV ! constant for the temperature variance
-REAL,SAVE :: XCHV ! constant for the humidity variance
-REAL,SAVE :: XCHT1 ! first ct. for the humidity-temperature correlation
-REAL,SAVE :: XCHT2 ! second ct. for the humidity-temperature correlation
+REAL :: XCMFS ! constant for the momentum flux due to shear
+REAL :: XCMFB ! constant for the momentum flux due to buoyancy
+REAL :: XCSHF ! constant for the sensible heat flux
+REAL :: XCHF ! constant for the humidity flux
+REAL :: XCTV ! constant for the temperature variance
+REAL :: XCHV ! constant for the humidity variance
+REAL :: XCHT1 ! first ct. for the humidity-temperature correlation
+REAL :: XCHT2 ! second ct. for the humidity-temperature correlation
!
-REAL,SAVE :: XCPR1 ! first ct. for the turbulent Prandtl numbers
-REAL,SAVE :: XCPR2 ! second ct. for the turbulent Prandtl numbers
-REAL,SAVE :: XCPR3 ! third ct. for the turbulent Prandtl numbers
-REAL,SAVE :: XCPR4 ! fourth ct. for the turbulent Prandtl numbers
-REAL,SAVE :: XCPR5 ! fifth ct. for the turbulent Prandtl numbers
+REAL :: XCPR1 ! first ct. for the turbulent Prandtl numbers
+REAL :: XCPR2 ! second ct. for the turbulent Prandtl numbers
+REAL :: XCPR3 ! third ct. for the turbulent Prandtl numbers
+REAL :: XCPR4 ! fourth ct. for the turbulent Prandtl numbers
+REAL :: XCPR5 ! fifth ct. for the turbulent Prandtl numbers
!
-REAL,SAVE :: XCET ! constant into the transport term of the TKE eq.
-REAL,SAVE :: XCED ! constant into the dissipation term of the TKE eq.
+REAL :: XCET ! constant into the transport term of the TKE eq.
+REAL :: XCED ! constant into the dissipation term of the TKE eq.
!
-REAL,SAVE :: XCDP ! ct. for the production term in the dissipation eq.
-REAL,SAVE :: XCDD ! ct. for the destruction term in the dissipation eq.
-REAL,SAVE :: XCDT ! ct. for the transport term in the dissipation eq.
+REAL :: XCDP ! ct. for the production term in the dissipation eq.
+REAL :: XCDD ! ct. for the destruction term in the dissipation eq.
+REAL :: XCDT ! ct. for the transport term in the dissipation eq.
!
-REAL,SAVE :: XTKEMIN ! mimimum value for the TKE
-REAL,SAVE :: XRM17 ! Rodier et al 2017 constant in shear term for mixing length
+REAL :: XTKEMIN ! mimimum value for the TKE
+REAL :: XRM17 ! Rodier et al 2017 constant in shear term for mixing length
!
-REAL,SAVE :: XLINI ! initial value for BL mixing length
-REAL,SAVE :: XLINF ! to prevent division by zero in the BL algorithm
+REAL :: XLINI ! initial value for BL mixing length
+REAL :: XLINF ! to prevent division by zero in the BL algorithm
!
-REAL,SAVE :: XALPSBL ! constant linking TKE and friction velocity in the SBL
+REAL :: XALPSBL ! constant linking TKE and friction velocity in the SBL
!
-REAL,SAVE :: XCEP ! Constant for wind pressure-correlations
-REAL,SAVE :: XA0 ! Constant a0 for wind pressure-correlations
-REAL,SAVE :: XA2 ! Constant a2 for wind pressure-correlations
-REAL,SAVE :: XA3 ! Constant a3 for wind pressure-correlations
-REAL,SAVE :: XA5 ! Constant a5 for temperature pressure-correlations
-REAL,SAVE :: XCTD ! Constant for temperature and vapor dissipation
-REAL,SAVE :: XCTP ! Constant for temperature and vapor pressure-correlations
+REAL :: XCEP ! Constant for wind pressure-correlations
+REAL :: XA0 ! Constant a0 for wind pressure-correlations
+REAL :: XA2 ! Constant a2 for wind pressure-correlations
+REAL :: XA3 ! Constant a3 for wind pressure-correlations
+REAL :: XA5 ! Constant a5 for temperature pressure-correlations
+REAL :: XCTD ! Constant for temperature and vapor dissipation
+REAL :: XCTP ! Constant for temperature and vapor pressure-correlations
!
-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
+REAL :: XPHI_LIM ! Threshold value for Phi3 and Psi3
+REAL :: XSBL_O_BL ! SBL height / BL height ratio
+REAL :: XFTOP_O_FSURF! Fraction of surface (heat or momentum) flux used to define top of BL
!
+END TYPE CSTURB_t
+!
+TYPE(CSTURB_t), TARGET, SAVE :: CSTURB
+!
+REAL,POINTER :: XCMFS => NULL()
+REAL,POINTER :: XCMFB => NULL()
+REAL,POINTER :: XCSHF => NULL()
+REAL,POINTER :: XCHF => NULL()
+REAL,POINTER :: XCTV => NULL()
+REAL,POINTER :: XCHV => NULL()
+REAL,POINTER :: XCHT1 => NULL()
+REAL,POINTER :: XCHT2 => NULL()
+!
+REAL,POINTER :: XCPR1 => NULL()
+REAL,POINTER :: XCPR2 => NULL()
+REAL,POINTER :: XCPR3 => NULL()
+REAL,POINTER :: XCPR4 => NULL()
+REAL,POINTER :: XCPR5 => NULL()
+!
+REAL,POINTER :: XCET => NULL()
+REAL,POINTER :: XCED => NULL()
+!
+REAL,POINTER :: XCDP => NULL()
+REAL,POINTER :: XCDD => NULL()
+REAL,POINTER :: XCDT => NULL()
+!
+REAL,POINTER :: XTKEMIN => NULL()
+REAL,POINTER :: XRM17 => NULL()
+!
+REAL,POINTER :: XLINI => NULL()
+REAL,POINTER :: XLINF => NULL()
+!
+REAL,POINTER :: XALPSBL => NULL()
+!
+REAL,POINTER :: XCEP => NULL()
+REAL,POINTER :: XA0 => NULL()
+REAL,POINTER :: XA2 => NULL()
+REAL,POINTER :: XA3 => NULL()
+REAL,POINTER :: XA5 => NULL()
+REAL,POINTER :: XCTD => NULL()
+REAL,POINTER :: XCTP => NULL()
+!
+REAL,POINTER :: XPHI_LIM => NULL()
+REAL,POINTER :: XSBL_O_BL => NULL()
+REAL,POINTER :: XFTOP_O_FSURF => NULL()
+
+CONTAINS
+SUBROUTINE CTURB_ASSOCIATE()
+IMPLICIT NONE
+ XCMFS=>CSTURB%XCMFS
+ XCMFB=>CSTURB%XCMFB
+ XCSHF=>CSTURB%XCSHF
+ XCHF=>CSTURB%XCHF
+ XCTV=>CSTURB%XCTV
+ XCHV=>CSTURB%XCHV
+ XCHT1=>CSTURB%XCHT1
+ XCHT2=>CSTURB%XCHT2
+ !
+ XCPR1=>CSTURB%XCPR1
+ XCPR2=>CSTURB%XCPR2
+ XCPR3=>CSTURB%XCPR3
+ XCPR4=>CSTURB%XCPR4
+ XCPR5=>CSTURB%XCPR5
+ !
+ XCET=>CSTURB%XCET
+ XCED=>CSTURB%XCED
+ !
+ XCDP=>CSTURB%XCDP
+ XCDD=>CSTURB%XCDD
+ XCDT=>CSTURB%XCDT
+ !
+ XTKEMIN=>CSTURB%XTKEMIN
+ XRM17=>CSTURB%XRM17
+ !
+ XLINI=>CSTURB%XLINI
+ XLINF=>CSTURB%XLINF
+ !
+ XALPSBL=>CSTURB%XALPSBL
+ !
+ XCEP=>CSTURB%XCEP
+ XA0=>CSTURB%XA0
+ XA2=>CSTURB%XA2
+ XA3=>CSTURB%XA3
+ XA5=>CSTURB%XA5
+ XCTD=>CSTURB%XCTD
+ XCTP=>CSTURB%XCTP
+ !
+ XPHI_LIM=>CSTURB%XPHI_LIM
+ XSBL_O_BL=>CSTURB%XSBL_O_BL
+ XFTOP_O_FSURF=>CSTURB%XFTOP_O_FSURF
+END SUBROUTINE CTURB_ASSOCIATE
END MODULE MODD_CTURB
diff --git a/src/PHYEX/turb/modd_diag_in_run.f90 b/src/PHYEX/turb/modd_diag_in_run.f90
index b7bba80d0c045a7787cf64d952de4b44c6a2961f..6f9829570ec8a9f75685491317b5adc86b18e623 100644
--- a/src/PHYEX/turb/modd_diag_in_run.f90
+++ b/src/PHYEX/turb/modd_diag_in_run.f90
@@ -3,11 +3,6 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/10/24 10:07:40
-!-----------------------------------------------------------------
MODULE MODD_DIAG_IN_RUN
! Modifications
!! 02/2018 Q.Libois ECRAD
diff --git a/src/PHYEX/turb/modd_param_mfshalln.f90 b/src/PHYEX/turb/modd_param_mfshalln.f90
index 54912a086cf1566008d7822440755107d40d4d50..72a5644bf955b2cf90266ebeed7b161564f081bc 100644
--- a/src/PHYEX/turb/modd_param_mfshalln.f90
+++ b/src/PHYEX/turb/modd_param_mfshalln.f90
@@ -13,7 +13,7 @@
!! PURPOSE
!! -------
!! The purpose of this declarative module is to declare the
-! variables that may be set by namelist for the mass flux scheme
+!! variables that may be set by namelist for the mass flux scheme
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
@@ -29,7 +29,7 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 01/02/07
+!! Original 01/02/07
!! 10/16 R.Honnert Update with AROME
!! 01/2019 R.Honnert add parameters for the reduction of mass-flux surface closure with resolution
!-------------------------------------------------------------------------------
@@ -40,7 +40,7 @@
USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
-TYPE PARAM_MFSHALL_t
+TYPE PARAM_MFSHALL_t
REAL :: XIMPL_MF ! degre of implicitness
@@ -74,27 +74,27 @@ REAL :: XALPHA_MF ! coefficient for cloudy fraction
REAL :: XSIGMA_MF ! coefficient for sigma computation
REAL :: XFRAC_UP_MAX! maximum Updraft fraction
!
-! Tuning variables for RHCJ10 updraft :
-REAL :: XA1
+! Parameter for Rio et al (2010) formulation for entrainment and detrainment (RHCJ10)
+REAL :: XA1
REAL :: XB
-REAL :: XC
+REAL :: XC
REAL :: XBETA1
+!
! Parameters for closure assumption of Hourdin et al 2002
REAL :: XR ! Aspect ratio of updraft
!
! Grey Zone
-
LOGICAL :: LGZ ! Grey Zone Surface Closure
REAL :: XGZ ! Tuning of the surface initialisation
!
! Thermodynamic parameter
-
REAL :: XLAMBDA_MF ! Lambda to compute ThetaS1 from ThetaL
END TYPE PARAM_MFSHALL_t
TYPE(PARAM_MFSHALL_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: PARAM_MFSHALL_MODEL
+TYPE(PARAM_MFSHALL_t), POINTER, SAVE :: PARAM_MFSHALLN => NULL()
REAL , POINTER :: XIMPL_MF=>NULL()
CHARACTER (LEN=4), POINTER :: CMF_UPDRAFT=>NULL()
@@ -132,6 +132,8 @@ CONTAINS
SUBROUTINE PARAM_MFSHALL_GOTO_MODEL(KFROM, KTO)
INTEGER, INTENT(IN) :: KFROM, KTO
!
+PARAM_MFSHALLN => PARAM_MFSHALL_MODEL(KTO)
+!
! Save current state for allocated arrays
!
! Current model is set to model KTO
diff --git a/src/PHYEX/turb/modd_turbn.f90 b/src/PHYEX/turb/modd_turbn.f90
index 8c35fd9d4be7bd61167ee2e6aba4a4fb40e521a5..defaab643b41917ccd50e45c98c533aee266b3bf 100644
--- a/src/PHYEX/turb/modd_turbn.f90
+++ b/src/PHYEX/turb/modd_turbn.f90
@@ -73,6 +73,8 @@ TYPE TURB_t
LOGICAL :: LSIGMAS ! Switch for using Sigma_s from turbulence scheme
LOGICAL :: LSIG_CONV ! Switch for computing Sigma_s due to convection
!
+ LOGICAL :: LHARAT
+ LOGICAL :: LSTATNW ! SWITCH LSTATNW
LOGICAL :: LRMC01 ! Switch for computing separate mixing
! ! and dissipative length in the SBL
! ! according to Redelsperger, Mahe &
@@ -99,7 +101,7 @@ TYPE TURB_t
REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL() ! O-A interface flux for v
REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL() ! O-A interface flux for theta
REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL() ! O-A interface flux for vapor
- LOGICAL :: LHGRAD ! logical switch for the computation of the Leornard Terms
+ LOGICAL :: LLEONARD ! logical switch for the computation of the Leornard Terms
REAL :: XCOEFHGRADTHL ! coeff applied to thl contribution
REAL :: XCOEFHGRADRM ! coeff applied to mixing ratio contribution
REAL :: XALTHGRAD ! altitude from which to apply the Leonard terms
@@ -110,7 +112,7 @@ TYPE TURB_t
END TYPE TURB_t
TYPE(TURB_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: TURB_MODEL
-
+TYPE(TURB_t), POINTER, SAVE :: TURBN => NULL()
REAL, POINTER :: XIMPL=>NULL()
REAL, POINTER :: XKEMIN=>NULL()
REAL, POINTER :: XCEDIS=>NULL()
@@ -123,6 +125,8 @@ LOGICAL, POINTER :: LSUBG_COND=>NULL()
LOGICAL, POINTER :: LSIGMAS=>NULL()
LOGICAL, POINTER :: LSIG_CONV=>NULL()
LOGICAL, POINTER :: LRMC01=>NULL()
+LOGICAL, POINTER :: LHARAT=>NULL()
+LOGICAL, POINTER :: LSTATNW=>NULL()
CHARACTER(LEN=4),POINTER :: CTOM=>NULL()
CHARACTER(LEN=4),POINTER :: CSUBG_AUCV=>NULL()
CHARACTER(LEN=80),POINTER :: CSUBG_AUCV_RI=>NULL()
@@ -142,7 +146,7 @@ REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL()
-LOGICAL, POINTER :: LHGRAD=>NULL()
+LOGICAL, POINTER :: LLEONARD=>NULL()
REAL, POINTER :: XCOEFHGRADTHL=>NULL()
REAL, POINTER :: XCOEFHGRADRM=>NULL()
REAL, POINTER :: XALTHGRAD=>NULL()
@@ -153,6 +157,8 @@ CONTAINS
SUBROUTINE TURB_GOTO_MODEL(KFROM, KTO)
INTEGER, INTENT(IN) :: KFROM, KTO
!
+TURBN => TURB_MODEL(KTO)
+!
! Save current state for allocated arrays
!
!TURB_MODEL(KFROM)%XBL_DEPTH=>XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
@@ -176,6 +182,8 @@ XCADAP=>TURB_MODEL(KTO)%XCADAP
CTURBLEN=>TURB_MODEL(KTO)%CTURBLEN
CTURBDIM=>TURB_MODEL(KTO)%CTURBDIM
LTURB_FLX=>TURB_MODEL(KTO)%LTURB_FLX
+LHARAT=>TURB_MODEL(KTO)%LHARAT
+LSTATNW=>TURB_MODEL(KTO)%LSTATNW
LTURB_DIAG=>TURB_MODEL(KTO)%LTURB_DIAG
LSUBG_COND=>TURB_MODEL(KTO)%LSUBG_COND
LSIGMAS=>TURB_MODEL(KTO)%LSIGMAS
@@ -200,7 +208,7 @@ XSSUFL_C=>TURB_MODEL(KTO)%XSSUFL_C
XSSVFL_C=>TURB_MODEL(KTO)%XSSVFL_C
XSSTFL_C=>TURB_MODEL(KTO)%XSSTFL_C
XSSRFL_C=>TURB_MODEL(KTO)%XSSRFL_C
-LHGRAD=>TURB_MODEL(KTO)%LHGRAD
+LLEONARD=>TURB_MODEL(KTO)%LLEONARD
XCOEFHGRADTHL=>TURB_MODEL(KTO)%XCOEFHGRADTHL
XCOEFHGRADRM=>TURB_MODEL(KTO)%XCOEFHGRADRM
XALTHGRAD=>TURB_MODEL(KTO)%XALTHGRAD
diff --git a/src/PHYEX/turb/mode_bl89.f90 b/src/PHYEX/turb/mode_bl89.f90
index 8d9fe3e369828bca9115ce04c6ea4b01cfb18570..8291ef9a6f90dcbcfc0cb455f7a70865324c9839 100644
--- a/src/PHYEX/turb/mode_bl89.f90
+++ b/src/PHYEX/turb/mode_bl89.f90
@@ -1,37 +1,18 @@
-!MNH_LIC Copyright 1997-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ################
- MODULE MODI_BL89
-! ################
-INTERFACE
- SUBROUTINE BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM)
-!
-INTEGER, INTENT(IN) :: KKA
-INTEGER, INTENT(IN) :: KKU
-INTEGER, INTENT(IN) :: KKL
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-INTEGER, INTENT(IN) :: KRR
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSHEAR
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
-
-END SUBROUTINE BL89
-END INTERFACE
-END MODULE MODI_BL89
-!
-! #########################################################
- SUBROUTINE BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM)
+MODULE MODE_BL89
+IMPLICIT NONE
+CONTAINS
+! ######spl
+ SUBROUTINE BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM,OOCEAN,HPROGRAM)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #########################################################
!
!!**** *BL89* -
-!!
+!!
!! PURPOSE
!! -------
!! This routine computes the mixing length from Bougeault-Lacarrere 89
@@ -54,7 +35,7 @@ END MODULE MODI_BL89
!!
!! AUTHOR
!! ------
-!!
+!!
!! J. Cuxart INM and Meteo-France
!!
!! MODIFICATIONS
@@ -64,7 +45,7 @@ END MODULE MODI_BL89
!! 06/01/98 (V. Masson and P. Jabouille) optimization
!! 15/03/99 (V. Masson) new lup ldown averaging
!! 21/02/01 (P. Jabouille) improve vectorization
-!! 2012-02 (Y. Seity) add possibility to run with
+!! 2012-02 (Y. Seity) add possibility to run with
!! reversed vertical levels
!! Philippe 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q
!! 01/2019 (Q. Rodier) support for RM17 mixing length
@@ -75,12 +56,11 @@ END MODULE MODI_BL89
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
-USE MODD_PARAMETERS
-use modd_precision, only: MNHREAL
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_PRECISION, ONLY: MNHREAL
!
!
IMPLICIT NONE
@@ -88,49 +68,47 @@ IMPLICIT NONE
!* 0.1 Declaration 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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN),TARGET :: PZZ
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN),TARGET :: PDZZ
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN),TARGET :: PTHVREF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN),TARGET :: PTHLM ! conservative pot. temp.
INTEGER, INTENT(IN) :: KRR
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! water var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSHEAR
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM ! Mixing length
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN),TARGET :: PRM ! water var.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN),TARGET :: PTKEM ! TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN),TARGET :: PSHEAR
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),TARGET :: PLM ! Mixing length
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! CPROGRAM is the program currently running (modd_conf)
! thermodynamical variables PTHLM=Theta at the begining
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: IKB,IKE
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IKT,IKB,IKA,IKU
-REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZVPT ! Virtual Potential Temp at half levels
-REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZDELTVPT
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZVPT ! Virtual Potential Temp at half levels
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZDELTVPT
! Increment of Virtual Potential Temp between two following levels
-REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZHLVPT
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZHLVPT
! Virtual Potential Temp at half levels
-REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2)) :: ZLWORK,ZINTE
+REAL, DIMENSION(D%NIJT) :: ZLWORK,ZINTE
! ! downwards then upwards vertical displacement,
! ! residual internal energy,
! ! residual potential energy
-REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZZZ,ZDZZ, &
- ZG_O_THVREF, &
- ZTHM,ZTKEM,ZLM, &
- ZLMDN,ZSHEAR, &
- ZSQRT_TKE
! ! input and output arrays packed according one horizontal coord.
-REAL, DIMENSION(SIZE(PRM,1)*SIZE(PRM,2),SIZE(PRM,3),SIZE(PRM,4)) :: ZRM
! ! input array packed according one horizontal coord.
-REAL, DIMENSION(SIZE(PRM,1)*SIZE(PRM,2),SIZE(PRM,3)) :: ZSUM ! to replace SUM function
-!
-INTEGER :: IIU,IJU
-INTEGER :: J1D ! horizontal loop counter
-INTEGER :: JK,JKK,J3RD ! loop counters
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZSUM ! to replace SUM function
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZG_O_THVREF
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZSQRT_TKE
+REAL, DIMENSION(D%NIJT,D%NKT) :: PLMDN
+!
+INTEGER :: IIJB, IIJE
+INTEGER :: IKTB, IKTE, IKE,IKL
+INTEGER :: JIJ ! horizontal loop counter
+INTEGER :: JK,JKK ! loop counters
INTEGER :: JRR ! moist loop counter
REAL :: ZRVORD ! Rv/Rd
REAL :: ZPOTE,ZLWORK1,ZLWORK2
@@ -138,55 +116,50 @@ REAL :: ZTEST,ZTEST0,ZTESTM ! test for vectorization
REAL :: Z2SQRT2,ZUSRBL89,ZBL89EXP
!-------------------------------------------------------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('BL89',0,ZHOOK_HANDLE)
Z2SQRT2=2.*SQRT(2.)
-IIU=SIZE(PTKEM,1)
-IJU=SIZE(PTKEM,2)
-!
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-
-IKTB = JPVEXT_TURB + 1
-IKT = SIZE(PTKEM,3)
-IKTE = IKT-JPVEXT_TURB
-ZRVORD = XRV / XRD
!
+ZRVORD = CST%XRV / CST%XRD
+!
+IIJB=D%NIJB
+IIJE=D%NIJE
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKT=D%NKT
+IKB=D%NKB
+IKE=D%NKE
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
!-------------------------------------------------------------------------------
!
!* 1. pack the horizontal dimensions into one
! ---------------------------------------
!
-IF (CPROGRAM=='AROME ') THEN
- DO JK=1,IKT
- ZZZ (:,JK) = PZZ (:,1,JK)
- ZDZZ (:,JK) = PDZZ (:,1,JK)
- ZTHM (:,JK) = PTHLM (:,1,JK)
- ZTKEM (:,JK) = PTKEM (:,1,JK)
- ZG_O_THVREF(:,JK) = XG/PTHVREF(:,1,JK)
- END DO
+! Pointer remapping instead of RESHAPE (contiguous memory)
+! 2D array => 3D array
+!
+IF (OOCEAN) THEN
DO JK=1,IKT
- DO JRR=1,KRR
- ZRM (:,JK,JRR) = PRM (:,1,JK,JRR)
+ DO JIJ=IIJB,IIJE
+ ZG_O_THVREF(JIJ,JK) = CST%XG * CST%XALPHAOC
END DO
END DO
-ELSE
+ELSE !Atmosphere case
DO JK=1,IKT
- ZZZ (:,JK) = RESHAPE(PZZ (:,:,JK),(/ IIU*IJU /) )
- ZDZZ (:,JK) = RESHAPE(PDZZ (:,:,JK),(/ IIU*IJU /) )
- ZTHM (:,JK) = RESHAPE(PTHLM (:,:,JK),(/ IIU*IJU /) )
- ZSHEAR (:,JK) = RESHAPE(PSHEAR (:,:,JK),(/ IIU*IJU /) )
- ZTKEM (:,JK) = RESHAPE(PTKEM (:,:,JK),(/ IIU*IJU /) )
- ZG_O_THVREF(:,JK) = RESHAPE(XG/PTHVREF(:,:,JK),(/ IIU*IJU /) )
- IF (LOCEAN) ZG_O_THVREF(:,JK) = XG * XALPHAOC
- DO JRR=1,KRR
- ZRM (:,JK,JRR) = RESHAPE(PRM (:,:,JK,JRR),(/ IIU*IJU /) )
+ DO JIJ=IIJB,IIJE
+ ZG_O_THVREF(JIJ,JK) = CST%XG / PTHVREF(JIJ,JK)
END DO
END DO
END IF
!
-ZSQRT_TKE = SQRT(ZTKEM)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZSQRT_TKE(IIJB:IIJE,1:IKT) = SQRT(PTKEM(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-!ZBL89EXP is defined here because (and not in ini_cturb) because XCED is defined in read_exseg (depending on BL89/RM17)
-ZBL89EXP = LOG(16.)/(4.*LOG(XKARMAN)+LOG(XCED)-3.*LOG(XCMFS))
+!ZBL89EXP is defined here because (and not in ini_cturb) because CSTURB%XCED is defined in read_exseg (depending on BL89/RM17)
+ZBL89EXP = LOG(16.)/(4.*LOG(CST%XKARMAN)+LOG(CSTURB%XCED)-3.*LOG(CSTURB%XCMFS))
ZUSRBL89 = 1./ZBL89EXP
!-------------------------------------------------------------------------------
!
@@ -194,14 +167,18 @@ ZUSRBL89 = 1./ZBL89EXP
! -----------------------------------------------
!
IF(KRR /= 0) THEN
- ZSUM(:,:) = 0.
+ ZSUM(IIJB:IIJE,1:IKT) = 0.
DO JRR=1,KRR
- ZSUM(:,:) = ZSUM(:,:)+ZRM(:,:,JRR)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZSUM(IIJB:IIJE,1:IKT) = ZSUM(IIJB:IIJE,1:IKT)+PRM(IIJB:IIJE,1:IKT,JRR)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDDO
- ZVPT(:,1:)=ZTHM(:,:) * ( 1. + ZRVORD*ZRM(:,:,1) ) &
- / ( 1. + ZSUM(:,:) )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZVPT(IIJB:IIJE,1:IKT)=PTHLM(IIJB:IIJE,1:IKT) * ( 1. + ZRVORD*PRM(IIJB:IIJE,1:IKT,1) ) &
+ / ( 1. + ZSUM(IIJB:IIJE,1:IKT) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- ZVPT(:,1:)=ZTHM(:,:)
+ ZVPT(IIJB:IIJE,1:IKT)=PTHLM(IIJB:IIJE,1:IKT)
END IF
!
!!!!!!!!!!!!
@@ -214,72 +191,72 @@ END IF
!We do not call directly this routine for numerical performance reasons
!but algorithm must remain the same.
!!!!!!!!!!!!
-
-ZDELTVPT(:,IKTB:IKTE)=ZVPT(:,IKTB:IKTE)-ZVPT(:,IKTB-KKL:IKTE-KKL)
-ZDELTVPT(:,KKU)=ZVPT(:,KKU)-ZVPT(:,KKU-KKL)
-ZDELTVPT(:,KKA)=0.
-WHERE (ABS(ZDELTVPT(:,:))<XLINF)
- ZDELTVPT(:,:)=XLINF
-END WHERE
-!
-ZHLVPT(:,IKTB:IKTE)= 0.5 * ( ZVPT(:,IKTB:IKTE)+ZVPT(:,IKTB-KKL:IKTE-KKL) )
-ZHLVPT(:,KKU)= 0.5 * ( ZVPT(:,KKU)+ZVPT(:,KKU-KKL) )
-ZHLVPT(:,KKA) = ZVPT(:,KKA)
+!
+DO JK=IKTB,IKTE
+ DO JIJ=IIJB,IIJE
+ ZDELTVPT(JIJ,JK) = ZVPT(JIJ,JK) - ZVPT(JIJ,JK-IKL)
+ ZHLVPT(JIJ,JK) = 0.5 * ( ZVPT(JIJ,JK) + ZVPT(JIJ,JK-IKL) )
+ END DO
+END DO
+!
+DO JIJ=IIJB,IIJE
+ ZDELTVPT(JIJ,IKU) = ZVPT(JIJ,IKU) - ZVPT(JIJ,IKU-IKL)
+ ZDELTVPT(JIJ,IKA) = 0.
+ ZHLVPT(JIJ,IKU) = 0.5 * ( ZVPT(JIJ,IKU) + ZVPT(JIJ,IKU-IKL) )
+ ZHLVPT(JIJ,IKA) = ZVPT(JIJ,IKA)
+END DO
+!
+DO JK=1,IKT
+ DO JIJ=IIJB,IIJE
+ IF(ABS(ZDELTVPT(JIJ,JK))<CSTURB%XLINF) THEN
+ ZDELTVPT(JIJ,JK)=CSTURB%XLINF
+ END IF
+ END DO
+END DO
+!
!-------------------------------------------------------------------------------
!
!* 3. loop on model levels
! --------------------
+!
DO JK=IKTB,IKTE
!
!-------------------------------------------------------------------------------
!
-!
-
!* 4. mixing length for a downwards displacement
! ------------------------------------------
- ZINTE(:)=ZTKEM(:,JK)
+ ZINTE(IIJB:IIJE)=PTKEM(IIJB:IIJE,JK)
ZLWORK=0.
ZTESTM=1.
- DO JKK=JK,IKB,-KKL
+ DO JKK=JK,IKB,-IKL
IF(ZTESTM > 0.) THEN
ZTESTM=0.
- DO J1D=1,IIU*IJU
-
- ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
-
+ DO JIJ=IIJB,IIJE
+ ZTEST0=0.5+SIGN(0.5,ZINTE(JIJ))
!--------- SHEAR + STABILITY -----------
ZPOTE = ZTEST0* &
- (-ZG_O_THVREF(J1D,JK)*(ZHLVPT(J1D,JKK)-ZVPT(J1D,JK)) &
- + XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
- )*ZDZZ(J1D,JKK)
+ (-ZG_O_THVREF(JIJ,JK)*(ZHLVPT(JIJ,JKK)-ZVPT(JIJ,JK)) &
+ + CSTURB%XRM17*PSHEAR(JIJ,JKK)*ZSQRT_TKE(JIJ,JK) &
+ )*PDZZ(JIJ,JKK)
- ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE)
+ ZTEST =0.5+SIGN(0.5,ZINTE(JIJ)-ZPOTE)
ZTESTM=ZTESTM+ZTEST0
- ZLWORK1=ZDZZ(J1D,JKK)
-
- !-------- ORIGINAL -------------
-! ZLWORK2= ( + ZG_O_THVREF(J1D,JK) * &
-! ( ZVPT(J1D,JKK) - ZVPT(J1D,JK) ) &
-! + SQRT (ABS( &
-! ( ZG_O_THVREF(J1D,JK) * (ZVPT(J1D,JKK) - ZVPT(J1D,JK)) )**2 &
-! + 2. * ZINTE(J1D) * ZG_O_THVREF(J1D,JK) &
-! * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK) ))) / &
-! ( ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK))
-
+ ZLWORK1=PDZZ(JIJ,JKK)
!--------- SHEAR + STABILITY -----------
- ZLWORK2 = (ZG_O_THVREF(J1D,JK) *(ZVPT(J1D,JKK) - ZVPT(J1D,JK)) &
- -XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
- + sqrt(abs( (XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
- + ( -ZG_O_THVREF(J1D,JK) * (ZVPT(J1D,JKK) - ZVPT(J1D,JK)) ))**2.0 + &
- 2. * ZINTE(J1D) * &
- (ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK)/ ZDZZ(J1D,JKK))))) / &
- (ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK))
-
-
- ZLWORK(J1D)=ZLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1+(1-ZTEST)*ZLWORK2)
- ZINTE(J1D) = ZINTE(J1D) - ZPOTE
-
+ ZLWORK2 = (ZG_O_THVREF(JIJ,JK) *(ZVPT(JIJ,JKK) - ZVPT(JIJ,JK)) &
+ -CSTURB%XRM17*PSHEAR(JIJ,JKK)*ZSQRT_TKE(JIJ,JK) &
+ + sqrt(abs( (CSTURB%XRM17*PSHEAR(JIJ,JKK)*ZSQRT_TKE(JIJ,JK) &
+ + ( -ZG_O_THVREF(JIJ,JK) * (ZVPT(JIJ,JKK) - ZVPT(JIJ,JK)) ))**2.0 + &
+ 2. * ZINTE(JIJ) * &
+#ifdef REPRO48
+ ZG_O_THVREF(JIJ,JK) * ZDELTVPT(JIJ,JKK)/ PDZZ(JIJ,JKK)))) / &
+#else
+ (ZG_O_THVREF(JIJ,JK) * ZDELTVPT(JIJ,JKK)/ PDZZ(JIJ,JKK))))) / &
+#endif
+ (ZG_O_THVREF(JIJ,JK) * ZDELTVPT(JIJ,JKK) / PDZZ(JIJ,JKK))
+ ZLWORK(JIJ)=ZLWORK(JIJ)+ZTEST0*(ZTEST*ZLWORK1+(1-ZTEST)*ZLWORK2)
+ ZINTE(JIJ) = ZINTE(JIJ) - ZPOTE
END DO
ENDIF
END DO
@@ -288,62 +265,48 @@ DO JK=IKTB,IKTE
!* 5. intermediate storage of the final mixing length
! -----------------------------------------------
!
- ZLMDN(:,JK)=MIN(ZLWORK(:),0.5*(ZZZ(:,JK)+ZZZ(:,JK+KKL))-ZZZ(:,IKB))
+ DO JIJ=IIJB,IIJE
+ PLMDN(JIJ,JK)=MIN(ZLWORK(JIJ),0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+IKL))-PZZ(JIJ,IKB))
+ END DO
!
!-------------------------------------------------------------------------------
!
!* 6. mixing length for an upwards displacement
! -----------------------------------------
!
- ZINTE(:)=ZTKEM(:,JK)
- ZLWORK=0.
+ ZINTE(IIJB:IIJE)=PTKEM(IIJB:IIJE,JK)
+ ZLWORK(IIJB:IIJE)=0.
ZTESTM=1.
!
- DO JKK=JK+KKL,IKE,KKL
+ DO JKK=JK+IKL,IKE,IKL
IF(ZTESTM > 0.) THEN
ZTESTM=0.
- DO J1D=1,IIU*IJU
- ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
-
- !-------- ORIGINAL -------------
- !ZPOTE = ZTEST0*ZG_O_THVREF(J1D,JK) * &
- ! (ZHLVPT(J1D,JKK) - ZVPT(J1D,JK) ) *ZDZZ(J1D,JKK)
-
+ DO JIJ=IIJB,IIJE
+ ZTEST0=0.5+SIGN(0.5,ZINTE(JIJ))
!--------- SHEAR + STABILITY -----------
ZPOTE = ZTEST0* &
- (ZG_O_THVREF(J1D,JK)*(ZHLVPT(J1D,JKK)-ZVPT(J1D,JK)) &
- +XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
- )*ZDZZ(J1D,JKK)
-
- ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE)
+ (ZG_O_THVREF(JIJ,JK)*(ZHLVPT(JIJ,JKK)-ZVPT(JIJ,JK)) &
+ +CSTURB%XRM17*PSHEAR(JIJ,JKK)*ZSQRT_TKE(JIJ,JK) &
+ )*PDZZ(JIJ,JKK)
+ ZTEST =0.5+SIGN(0.5,ZINTE(JIJ)-ZPOTE)
ZTESTM=ZTESTM+ZTEST0
- ZLWORK1=ZDZZ(J1D,JKK)
-
- !-------- ORIGINAL -------------
- ! ZLWORK2= ( - ZG_O_THVREF(J1D,JK) * &
- ! ( ZVPT(J1D,JKK-KKL) - ZVPT(J1D,JK) ) &
- ! + SQRT (ABS( &
- ! ( ZG_O_THVREF(J1D,JK) * (ZVPT(J1D,JKK-KKL) - ZVPT(J1D,JK)) )**2 &
- ! + 2. * ZINTE(J1D) * ZG_O_THVREF(J1D,JK) &
- ! * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK) )) ) / &
- ! ( ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK) )
-
+ ZLWORK1=PDZZ(JIJ,JKK)
!--------- SHEAR + STABILITY -----------
- ZLWORK2= ( - ZG_O_THVREF(J1D,JK) *(ZVPT(J1D,JKK-KKL) - ZVPT(J1D,JK) ) &
- - XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
+ ZLWORK2= ( - ZG_O_THVREF(JIJ,JK) *(ZVPT(JIJ,JKK-IKL) - ZVPT(JIJ,JK) ) &
+ - CSTURB%XRM17*PSHEAR(JIJ,JKK)*ZSQRT_TKE(JIJ,JK) &
+ SQRT (ABS( &
- (XRM17*ZSHEAR(J1D,JKK)*ZSQRT_TKE(J1D,JK) &
- + ( ZG_O_THVREF(J1D,JK) * (ZVPT(J1D,JKK-KKL) - ZVPT(J1D,JK))) )**2 &
- + 2. * ZINTE(J1D) * &
- ( ZG_O_THVREF(J1D,JK)* ZDELTVPT(J1D,JKK)/ZDZZ(J1D,JKK))))) / &
- (ZG_O_THVREF(J1D,JK) * ZDELTVPT(J1D,JKK) / ZDZZ(J1D,JKK))
-
-
-
-
- ZLWORK(J1D)=ZLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1+(1-ZTEST)*ZLWORK2)
- ZINTE(J1D) = ZINTE(J1D) - ZPOTE
- END DO
+ (CSTURB%XRM17*PSHEAR(JIJ,JKK)*ZSQRT_TKE(JIJ,JK) &
+ + ( ZG_O_THVREF(JIJ,JK) * (ZVPT(JIJ,JKK-IKL) - ZVPT(JIJ,JK))) )**2 &
+ + 2. * ZINTE(JIJ) * &
+#ifdef REPRO48
+ ZG_O_THVREF(JIJ,JK)* ZDELTVPT(JIJ,JKK)/PDZZ(JIJ,JKK)))) / &
+#else
+ (ZG_O_THVREF(JIJ,JK)* ZDELTVPT(JIJ,JKK)/PDZZ(JIJ,JKK))))) / &
+#endif
+ (ZG_O_THVREF(JIJ,JK) * ZDELTVPT(JIJ,JKK) / PDZZ(JIJ,JKK))
+ ZLWORK(JIJ)=ZLWORK(JIJ)+ZTEST0*(ZTEST*ZLWORK1+(1-ZTEST)*ZLWORK2)
+ ZINTE(JIJ) = ZINTE(JIJ) - ZPOTE
+ END DO
ENDIF
END DO
!
@@ -351,18 +314,22 @@ DO JK=IKTB,IKTE
!
!* 7. final mixing length
!
- DO J1D=1,IIU*IJU
- ZLWORK1=MAX(ZLMDN(J1D,JK),1.E-10_MNHREAL)
- ZLWORK2=MAX(ZLWORK(J1D),1.E-10_MNHREAL)
+ DO JIJ=IIJB,IIJE
+ ZLWORK1=MAX(PLMDN(JIJ,JK),1.E-10_MNHREAL)
+ ZLWORK2=MAX(ZLWORK(JIJ),1.E-10_MNHREAL)
ZPOTE = ZLWORK1 / ZLWORK2
+#ifdef REPRO48
+ ZLWORK2=1.d0 + ZPOTE**(2./3.)
+ PLM(JIJ,JK) = Z2SQRT2*ZLWORK1/(ZLWORK2*SQRT(ZLWORK2))
+#else
ZLWORK2=1.d0 + ZPOTE**ZBL89EXP
- ZLM(J1D,JK) = ZLWORK1*(2./ZLWORK2)**ZUSRBL89
- END DO
+ PLM(JIJ,JK) = ZLWORK1*(2./ZLWORK2)**ZUSRBL89
+#endif
+ PLM(JIJ,JK)=MAX(PLM(JIJ,JK),CSTURB%XLINI)
+ END DO
-ZLM(:,JK)=MAX(ZLM(:,JK),XLINI)
-!
-!
+!-------------------------------------------------------------------------------
!* 8. end of the loop on the vertical levels
! --------------------------------------
!
@@ -373,24 +340,17 @@ END DO
!* 9. boundaries
! ----------
!
-ZLM(:,KKA)=ZLM(:,IKB)
-ZLM(:,IKE)=ZLM(:,IKE-KKL)
-ZLM(:,KKU)=ZLM(:,IKE-KKL)
+PLM(IIJB:IIJE,IKA)=PLM(IIJB:IIJE,IKB)
+PLM(IIJB:IIJE,IKE)=PLM(IIJB:IIJE,IKE-IKL)
+PLM(IIJB:IIJE,IKU)=PLM(IIJB:IIJE,IKE-IKL)
!
!-------------------------------------------------------------------------------
!
!* 10. retrieve output array in model coordinates
! ------------------------------------------
+! Not needed anymore because of the use of Pointer remapping (see 1.)
+! PLM (3D array) is the target of PLM (2D array) in a contiguous way
!
-IF (CPROGRAM=='AROME ') THEN
- DO JK=1,IKT
- PLM (:,1,JK) = ZLM (:,JK)
- END DO
-ELSE
- DO JK=1,IKT
- PLM (:,:,JK) = RESHAPE(ZLM (:,JK), (/ IIU,IJU /) )
- END DO
-END IF
-
-!
+IF (LHOOK) CALL DR_HOOK('BL89',1,ZHOOK_HANDLE)
END SUBROUTINE BL89
+END MODULE MODE_BL89
diff --git a/src/PHYEX/turb/mode_bl_depth_diag.f90 b/src/PHYEX/turb/mode_bl_depth_diag.f90
index 2e7fb121cdda00386511bb0254c18249bec192bb..2e817e7cc1924ad6cf1032be9a0b60ef6a162b4c 100644
--- a/src/PHYEX/turb/mode_bl_depth_diag.f90
+++ b/src/PHYEX/turb/mode_bl_depth_diag.f90
@@ -1,80 +1,19 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ################
- MODULE MODI_BL_DEPTH_DIAG
-! ################
+MODULE MODE_BL_DEPTH_DIAG
!
INTERFACE BL_DEPTH_DIAG
-!
-!
- FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
-!
-END FUNCTION BL_DEPTH_DIAG_3D
-!
-!
- FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, INTENT(IN) :: PSURF ! surface flux
-REAL, INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL :: BL_DEPTH_DIAG_1D
-!
-END FUNCTION BL_DEPTH_DIAG_1D
-!
-END INTERFACE
-!
-END MODULE MODI_BL_DEPTH_DIAG
-!
-!-------------------------------------------------------------------------------
-!
-! ################
- MODULE MODI_BL_DEPTH_DIAG_3D
-! ################
-!
-!
-INTERFACE
-!
-!
- FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
-!
-END FUNCTION BL_DEPTH_DIAG_3D
-!
-!
+ MODULE PROCEDURE BL_DEPTH_DIAG_3D
+ MODULE PROCEDURE BL_DEPTH_DIAG_1D
END INTERFACE
!
-END MODULE MODI_BL_DEPTH_DIAG_3D
+CONTAINS
!
-!-------------------------------------------------------------------------------
-!
-FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
+SUBROUTINE BL_DEPTH_DIAG_3D(D,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF,BL_DEPTH_DIAG3D)
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
!
!!**** *SBL_DEPTH* - computes SBL depth
@@ -112,89 +51,97 @@ FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
!
!* 0.1 declarations of arguments
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
IMPLICIT NONE
!
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSURF ! surface flux
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PZS ! orography
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLUX ! flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: BL_DEPTH_DIAG3D
!
!
! 0.2 declaration of local variables
!
-INTEGER :: JI,JJ,JK ! loop counters
-INTEGER :: IKL ! +1 : MesoNH levels -1: Arome
+INTEGER :: JIJ,JK ! loop counters
+INTEGER :: IKB,IKE,IIJB,IIJE,IKL
REAL :: ZFLX ! flux at top of BL
!
!----------------------------------------------------------------------------
!
-IF (KKB < KKE) THEN
- IKL=1
-ELSE
- IKL=-1
-ENDIF
-
-BL_DEPTH_DIAG_3D(:,:) = 0.
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_3D',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IKL=D%NKL
+IIJE=D%NIJE
+IIJB=D%NIJB
+!
+BL_DEPTH_DIAG3D(:) = 0.
!
-DO JJ=1,SIZE(PSURF,2)
- DO JI=1,SIZE(PSURF,1)
- IF (PSURF(JI,JJ)==0.) CYCLE
- DO JK=KKB,KKE,IKL
- IF (PZZ(JI,JJ,JK-IKL)<=PZS(JI,JJ)) CYCLE
- ZFLX = PSURF(JI,JJ) * PFTOP_O_FSURF
- IF ( (PFLUX(JI,JJ,JK)-ZFLX)*(PFLUX(JI,JJ,JK-IKL)-ZFLX) <= 0. ) THEN
- BL_DEPTH_DIAG_3D(JI,JJ) = (PZZ (JI,JJ,JK-IKL) - PZS(JI,JJ)) &
- + (PZZ (JI,JJ,JK) - PZZ (JI,JJ,JK-IKL)) &
- * (ZFLX - PFLUX(JI,JJ,JK-IKL) ) &
- / (PFLUX(JI,JJ,JK) - PFLUX(JI,JJ,JK-IKL) )
+DO JIJ=IIJB,IIJE
+ IF (PSURF(JIJ)==0.) CYCLE
+ DO JK=IKB,IKE,IKL
+ IF (PZZ(JIJ,JK-IKL)<=PZS(JIJ)) CYCLE
+ ZFLX = PSURF(JIJ) * PFTOP_O_FSURF
+ IF ( (PFLUX(JIJ,JK)-ZFLX)*(PFLUX(JIJ,JK-IKL)-ZFLX) <= 0. ) THEN
+ BL_DEPTH_DIAG3D(JIJ) = (PZZ (JIJ,JK-IKL) - PZS(JIJ)) &
+ + (PZZ (JIJ,JK) - PZZ (JIJ,JK-IKL)) &
+ * (ZFLX - PFLUX(JIJ,JK-IKL) ) &
+ / (PFLUX(JIJ,JK) - PFLUX(JIJ,JK-IKL) )
EXIT
END IF
END DO
- END DO
END DO
!
-BL_DEPTH_DIAG_3D(:,:) = BL_DEPTH_DIAG_3D(:,:) / (1. - PFTOP_O_FSURF)
-!
-END FUNCTION BL_DEPTH_DIAG_3D
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+BL_DEPTH_DIAG3D(IIJB:IIJE) = BL_DEPTH_DIAG3D(IIJB:IIJE) / (1. - PFTOP_O_FSURF)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
+IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_3D',1,ZHOOK_HANDLE)
+END SUBROUTINE BL_DEPTH_DIAG_3D
!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
+SUBROUTINE BL_DEPTH_DIAG_1D(D,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF,BL_DEPTH_DIAG1D)
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
-FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
-USE MODI_BL_DEPTH_DIAG_3D
IMPLICIT NONE
!
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, INTENT(IN) :: PSURF ! surface flux
REAL, INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, DIMENSION(D%NKT), INTENT(IN) :: PFLUX ! flux
+REAL, DIMENSION(D%NKT), INTENT(IN) :: PZZ ! altitude of flux points
REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL :: BL_DEPTH_DIAG_1D
+REAL, INTENT(OUT) :: BL_DEPTH_DIAG1D
!
REAL, DIMENSION(1,1) :: ZSURF
REAL, DIMENSION(1,1) :: ZZS
-REAL, DIMENSION(1,1,SIZE(PFLUX)) :: ZFLUX
-REAL, DIMENSION(1,1,SIZE(PZZ)) :: ZZZ
+REAL, DIMENSION(1,1,D%NKT) :: ZFLUX
+REAL, DIMENSION(1,1,D%NKT) :: ZZZ
REAL, DIMENSION(1,1) :: ZBL_DEPTH_DIAG
!
+INTEGER :: IKT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_1D',0,ZHOOK_HANDLE)
+IKT=D%NKT
ZSURF = PSURF
ZZS = PZS
-ZFLUX(1,1,:) = PFLUX(:)
-ZZZ (1,1,:) = PZZ (:)
+ZFLUX(1,1,1:IKT) = PFLUX(1:IKT)
+ZZZ (1,1,1:IKT) = PZZ (1:IKT)
!
-ZBL_DEPTH_DIAG = BL_DEPTH_DIAG_3D(KKB,KKE,ZSURF,ZZS,ZFLUX,ZZZ,PFTOP_O_FSURF)
+CALL BL_DEPTH_DIAG_3D(D,ZSURF,ZZS,ZFLUX,ZZZ,PFTOP_O_FSURF,ZBL_DEPTH_DIAG)
!
-BL_DEPTH_DIAG_1D = ZBL_DEPTH_DIAG(1,1)
+BL_DEPTH_DIAG1D = ZBL_DEPTH_DIAG(1,1)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION BL_DEPTH_DIAG_1D
+IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_1D',1,ZHOOK_HANDLE)
+END SUBROUTINE BL_DEPTH_DIAG_1D
+END MODULE MODE_BL_DEPTH_DIAG
diff --git a/src/PHYEX/turb/mode_coefj.f90 b/src/PHYEX/turb/mode_coefj.f90
index 4c52e37f2b7ca5290b71503c038694405f5137b4..239b3f63c3c5a3c774fd10014840d4e42bc9a17e 100644
--- a/src/PHYEX/turb/mode_coefj.f90
+++ b/src/PHYEX/turb/mode_coefj.f90
@@ -9,31 +9,9 @@
! MASDEV4_7 turb 2006/05/18 13:07:25
!-----------------------------------------------------------------
!################
-MODULE MODI_COEFJ
-!################
-!
-INTERFACE
-!
- FUNCTION COEFJ(PTHL,PEXNREF,PFRAC_ICE) RESULT(PCOEFJ)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL ! Temperature variable
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Exner function of the
-! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFRAC_ICE
- ! Fraction of ri in the
- ! non-precipating
- ! "rc+ri" condensate
-!
-REAL,DIMENSION(SIZE(PTHL,1),SIZE(PTHL,2),SIZE(PTHL,3)):: PCOEFJ ! result
-!
-END FUNCTION COEFJ
-!
-END INTERFACE
-!
-END MODULE MODI_COEFJ
-!
-!
-!
+MODULE MODE_COEFJ
+IMPLICIT NONE
+CONTAINS
! #######################################################
FUNCTION COEFJ(PTHL,PEXNREF,PFRAC_ICE) RESULT(PCOEFJ)
! #######################################################
@@ -154,3 +132,4 @@ END IF
!---------------------------------------------------------------------------
!
END FUNCTION COEFJ
+END MODULE MODE_COEFJ
diff --git a/src/PHYEX/turb/mode_compute_bl89_ml.f90 b/src/PHYEX/turb/mode_compute_bl89_ml.f90
index b2df24bd9b4d00d0e37550e347af3dcef9fc3abf..36008959d5bba861c545aa3313ef83e96e0557f6 100644
--- a/src/PHYEX/turb/mode_compute_bl89_ml.f90
+++ b/src/PHYEX/turb/mode_compute_bl89_ml.f90
@@ -1,46 +1,12 @@
-!MNH_LIC Copyright 2006-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_COMPUTE_BL89_ML
-! ###########################
-
-INTERFACE
-
-! ###################################################################
- SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, &
- PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PSHEAR,PLWORK)
-! ###################################################################
-
-!* 1.1 Declaration of Arguments
-
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
-REAL, DIMENSION(:), INTENT(IN) :: PTKEM_DEP ! TKE to consume
-REAL, DIMENSION(:), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
-REAL, DIMENSION(:,:), INTENT(IN) :: PVPT ! ThetaV on mass levels
-INTEGER, INTENT(IN) :: KK ! index of departure level
-LOGICAL, INTENT(IN) :: OUPORDN ! switch to compute upward (true) or
- ! downward (false) mixing length
-LOGICAL, INTENT(IN) :: OFLUX ! Computation must be done from flux level
-REAL, DIMENSION(:), INTENT(OUT) :: PLWORK ! Resulting mixing length
-REAL, DIMENSION(:,:), INTENT(IN) :: PSHEAR ! vertical wind shear for RM17 mixing length
-
-END SUBROUTINE COMPUTE_BL89_ML
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_BL89_ML
+MODULE MODE_COMPUTE_BL89_ML
+IMPLICIT NONE
+CONTAINS
! ######spl
- SUBROUTINE COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ2D, &
+ SUBROUTINE COMPUTE_BL89_ML(D, CST, CSTURB,PDZZ2D, &
PTKEM_DEP,PG_O_THVREF,PVPT,KK,OUPORDN,OFLUX,PSHEAR,PLWORK)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ###################################################################
!!
!! COMPUTE_BL89_ML routine to:
@@ -75,66 +41,80 @@ END MODULE MODI_COMPUTE_BL89_ML
!but algorithm must remain the same.
!!!!!!!!!!!!
!
-USE MODD_CTURB
-USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
!
-use mode_msg
+USE MODE_MSG
!
-USE MODI_SHUMAN_MF
+USE MODI_SHUMAN_MF, ONLY: DZM_MF, MZM_MF
!
IMPLICIT NONE
!
! 0.1 arguments
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
-REAL, DIMENSION(:), INTENT(IN) :: PTKEM_DEP ! TKE to consume
-REAL, DIMENSION(:), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
-REAL, DIMENSION(:,:), INTENT(IN) :: PVPT ! ThetaV on mass levels
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ2D ! height difference between two mass levels
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PTKEM_DEP ! TKE to consume
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PG_O_THVREF ! g/ThetaVRef at the departure point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVPT ! ThetaV on mass levels
INTEGER, INTENT(IN) :: KK ! index of departure level
LOGICAL, INTENT(IN) :: OUPORDN ! switch to compute upward (true) or
! downward (false) mixing length
LOGICAL, INTENT(IN) :: OFLUX ! Computation must be done from flux level
-REAL, DIMENSION(:), INTENT(OUT) :: PLWORK ! Resulting mixing length
-REAL, DIMENSION(:,:), INTENT(IN) :: PSHEAR ! vertical wind shear for RM17 mixing length
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PLWORK ! Resulting mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSHEAR ! vertical wind shear for RM17 mixing length
! 0.2 Local variable
!
-REAL, DIMENSION(SIZE(PVPT,1)) :: ZLWORK1,ZLWORK2 ! Temporary mixing length
-REAL, DIMENSION(SIZE(PVPT,1)) :: ZINTE,ZPOTE ! TKE and potential energy
+REAL, DIMENSION(D%NIJT) :: ZLWORK1,ZLWORK2 ! Temporary mixing length
+REAL, DIMENSION(D%NIJT) :: ZINTE,ZPOTE ! TKE and potential energy
! between 2 levels
-REAL, DIMENSION(SIZE(PVPT,1)) :: ZVPT_DEP ! Thetav on departure point
+REAL, DIMENSION(D%NIJT) :: ZVPT_DEP ! Thetav on departure point
!
-REAL, DIMENSION(SIZE(PVPT,1),SIZE(PVPT,2)) :: ZDELTVPT,ZHLVPT
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZDELTVPT,ZHLVPT
!Virtual Potential Temp at Half level and DeltaThv between
!2 mass levels
-INTEGER :: IIJU !Internal Domain
INTEGER :: J1D !horizontal loop counter
INTEGER :: JKK !loop counters
+INTEGER :: JIJ, JK
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT,IKB,IKA,IKE,IKL
REAL :: ZTEST,ZTEST0,ZTESTM !test for vectorization
!-------------------------------------------------------------------------------------
!
!* 1. INITIALISATION
! --------------
-IIJU=SIZE(PVPT,1)
-!
-ZDELTVPT(:,:)=DZM_MF(KKA,KKU,KKL,PVPT(:,:))
-ZDELTVPT(:,KKA)=0.
-WHERE (ABS(ZDELTVPT(:,:))<XLINF)
- ZDELTVPT(:,:)=XLINF
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('COMPUTE_BL89_ML',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKB=D%NKB
+IKA=D%NKA
+IKE=D%NKE
+IKL=D%NKL
+!
+CALL DZM_MF(D, PVPT(:,:), ZDELTVPT(:,:))
+ZDELTVPT(IIJB:IIJE,IKA)=0.
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE (ABS(ZDELTVPT(IIJB:IIJE,1:IKT))<CSTURB%XLINF)
+ ZDELTVPT(IIJB:IIJE,1:IKT)=CSTURB%XLINF
END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!
-ZHLVPT(:,:)=MZM_MF(KKA,KKU,KKL,PVPT(:,:))
+CALL MZM_MF(D, PVPT(:,:), ZHLVPT(:,:))
!
!We consider that gradient between mass levels KKB and KKB+KKL is the same as
!the gradient between flux level KKB and mass level KKB
-ZDELTVPT(:,KKB)=PDZZ2D(:,KKB)*ZDELTVPT(:,KKB+KKL)/PDZZ2D(:,KKB+KKL)
-ZHLVPT(:,KKB)=PVPT(:,KKB)-ZDELTVPT(:,KKB)*0.5
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZDELTVPT(IIJB:IIJE,IKB)=PDZZ2D(IIJB:IIJE,IKB)*ZDELTVPT(IIJB:IIJE,IKB+IKL)/PDZZ2D(IIJB:IIJE,IKB+IKL)
+ZHLVPT(IIJB:IIJE,IKB)=PVPT(IIJB:IIJE,IKB)-ZDELTVPT(IIJB:IIJE,IKB)*0.5
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!
!
@@ -143,65 +123,71 @@ ZHLVPT(:,KKB)=PVPT(:,KKB)-ZDELTVPT(:,KKB)*0.5
!
IF (OUPORDN.EQV..TRUE.) THEN
- ZINTE(:)=PTKEM_DEP(:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZINTE(IIJB:IIJE)=PTKEM_DEP(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
PLWORK=0.
ZTESTM=1.
IF(OFLUX)THEN
- ZVPT_DEP(:)=ZHLVPT(:,KK) ! departure point is on flux level
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZVPT_DEP(IIJB:IIJE)=ZHLVPT(IIJB:IIJE,KK) ! departure point is on flux level
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!We must compute what happens between flux level KK and mass level KK
- DO J1D=1,IIJU
+ DO J1D=IIJB,IIJE
ZTEST0=0.5+SIGN(0.5,ZINTE(J1D)) ! test if there's energy to consume
! Energy consumed if parcel cross the entire layer
ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
(0.5*(ZHLVPT(J1D,KK)+ PVPT(J1D,KK)) - ZVPT_DEP(J1D)) + &
- XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D)))) * &
+ CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D)))) * &
PDZZ2D(J1D,KK)*0.5
! Test if it rests some energy to consume
ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
! Length travelled by parcel if it rests energy to consume
ZLWORK1(J1D)=PDZZ2D(J1D,KK)*0.5
! Lenght travelled by parcel to nullify energy
- ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
+ ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
( ZHLVPT(J1D,KK) - ZVPT_DEP(J1D) ) &
- - XRM17*PSHEAR(J1D,KK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ - CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D))) &
+ SQRT (ABS( &
- (XRM17*PSHEAR(J1D,KK)*sqrt(abs(PTKEM_DEP(J1D))) + &
+ (CSTURB%XRM17*PSHEAR(J1D,KK)*SQRT(ABS(PTKEM_DEP(J1D))) + &
PG_O_THVREF(J1D) * (ZHLVPT(J1D,KK) - ZVPT_DEP(J1D)) )**2 &
+ 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
* ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )) ) / &
- ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )
- ! Effective length travelled by parcel
+ ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,KK) / PDZZ2D(J1D,KK) )
+ ! Effective length travelled by parcel
PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
(1-ZTEST)*ZLWORK2(J1D))
! Rest of energy to consume
ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
ENDDO
ELSE
- ZVPT_DEP(:)=PVPT(:,KK) ! departure point is on mass level
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZVPT_DEP(IIJB:IIJE)=PVPT(IIJB:IIJE,KK) ! departure point is on mass level
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDIF
- DO JKK=KK+KKL,KKE,KKL
+ DO JKK=KK+IKL,IKE,IKL
IF(ZTESTM > 0.) THEN
ZTESTM=0
- DO J1D=1,IIJU
+ DO J1D=IIJB,IIJE
ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
ZPOTE(J1D) = ZTEST0*(PG_O_THVREF(J1D) * &
(ZHLVPT(J1D,JKK) - ZVPT_DEP(J1D)) &
- + XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
+ + CSTURB%XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
ZTESTM=ZTESTM+ZTEST0
ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
!ZLWORK2 jump of the last reached level
ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * &
- ( PVPT(J1D,JKK-KKL) - ZVPT_DEP(J1D) ) &
- - XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ ( PVPT(J1D,JKK-IKL) - ZVPT_DEP(J1D) ) &
+ - CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ SQRT (ABS( &
- (XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + &
- PG_O_THVREF(J1D) * (PVPT(J1D,JKK-KKL) - ZVPT_DEP(J1D)) )**2 &
+ (CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + &
+ PG_O_THVREF(J1D) * (PVPT(J1D,JKK-IKL) - ZVPT_DEP(J1D)) )**2 &
+ 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
* ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
-!
+ !
PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
(1-ZTEST)*ZLWORK2(J1D))
ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
@@ -215,31 +201,33 @@ ENDIF
!
IF (OUPORDN.EQV..FALSE.) THEN
- IF(OFLUX) call Print_msg(NVERB_FATAL,'GEN','COMPUTE_BL89_ML','OFLUX option not coded for downward mixing length')
- ZINTE(:)=PTKEM_DEP(:)
+ IF(OFLUX) CALL PRINT_MSG(NVERB_FATAL,'GEN','COMPUTE_BL89_ML','OFLUX option not coded for downward mixing length')
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZINTE(IIJB:IIJE)=PTKEM_DEP(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
PLWORK=0.
ZTESTM=1.
- DO JKK=KK,KKB,-KKL
+ DO JKK=KK,IKB,-IKL
IF(ZTESTM > 0.) THEN
ZTESTM=0
- DO J1D=1,IIJU
+ DO J1D=IIJB,IIJE
ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
ZPOTE(J1D) = ZTEST0*(-PG_O_THVREF(J1D) * &
(ZHLVPT(J1D,JKK) - PVPT(J1D,KK)) &
- + XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
+ + CSTURB%XRM17*PSHEAR(J1D,JKK)*SQRT(ABS(PTKEM_DEP(J1D))))* PDZZ2D(J1D,JKK)
ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
ZTESTM=ZTESTM+ZTEST0
ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
- ZLWORK2(J1D)= ( + PG_O_THVREF(J1D) * &
+ ZLWORK2(J1D)= ( + PG_O_THVREF(J1D) * &
( PVPT(J1D,JKK) - PVPT(J1D,KK) ) &
- -XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ -CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) &
+ SQRT (ABS( &
- (XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) - &
+ (CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) - &
PG_O_THVREF(J1D) * (PVPT(J1D,JKK) - PVPT(J1D,KK)) )**2 &
+ 2. * ZINTE(J1D) * PG_O_THVREF(J1D) &
* ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / &
( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )
-!
+ !
PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+ &
(1-ZTEST)*ZLWORK2(J1D))
ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
@@ -247,5 +235,7 @@ IF (OUPORDN.EQV..FALSE.) THEN
ENDIF
END DO
ENDIF
-
+
+IF (LHOOK) CALL DR_HOOK('COMPUTE_BL89_ML',1,ZHOOK_HANDLE)
END SUBROUTINE COMPUTE_BL89_ML
+END MODULE MODE_COMPUTE_BL89_ML
diff --git a/src/PHYEX/turb/mode_compute_function_thermo_mf.f90 b/src/PHYEX/turb/mode_compute_function_thermo_mf.f90
index ae9499c7008d5bd965ba30482a71e048d98c6f78..fdb54d89b93374cc3fb1e4e25bd5fc3eb3c23060 100644
--- a/src/PHYEX/turb/mode_compute_function_thermo_mf.f90
+++ b/src/PHYEX/turb/mode_compute_function_thermo_mf.f90
@@ -1,55 +1,27 @@
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ######spl
- MODULE MODI_COMPUTE_FUNCTION_THERMO_MF
+ MODULE MODE_COMPUTE_FUNCTION_THERMO_MF
! ######################################
!
-INTERFACE
-
-! #################################################################
- SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
- PTH, PR, PEXN, PFRAC_ICE, PPABS, &
- PT, PAMOIST,PATHETA )
-! #################################################################
-
-!* 1.1 Declaration of Arguments
-!
-
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
-REAL, DIMENSION(:,:) , INTENT(IN) :: PFRAC_ICE ! ice fraction
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PAMOIST,PATHETA
-!
-END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_FUNCTION_THERMO_MF
-! ######spl
- SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE COMPUTE_FUNCTION_THERMO_MF(D, CST, KRR,KRRL,KRRI,OSTATNW, &
PTH, PR, PEXN, PFRAC_ICE, PPABS, &
PT,PAMOIST,PATHETA )
! #################################################################
!
!!
-!!**** *COMPUTE_FUNCTION_THERMO_MF* -
+!!**** *COMPUTE_FUNCTION_THERMO_MF* -
!!
!! PURPOSE
!! -------
!!
!!** METHOD
!! ------
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -63,7 +35,7 @@ END MODULE MODI_COMPUTE_FUNCTION_THERMO_MF
!!
!! AUTHOR
!! ------
-!!
+!!
!! JP Pinty *LA*
!!
!! MODIFICATIONS
@@ -72,39 +44,46 @@ END MODULE MODI_COMPUTE_FUNCTION_THERMO_MF
!! Externalisation of computations done in TURB and MF_TURB (Malardel and Pergaud, fev. 2007)
!! Optimization : V.Masson, 09/2010
!! S. Riette Sept 2011 : remove of unused PL?OCPEXN, use of received ice fraction
+!! Wim de Rooy June 2019: update statistical cloud scheme
!!
!! --------------------------------------------------------------------------
-!
+!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+LOGICAL, INTENT(IN) :: OSTATNW ! cloud scheme inclues convect. covar. contrib
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
-REAL, DIMENSION(:,:) , INTENT(IN) :: PFRAC_ICE ! ice fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(D%NIJT,D%NKT) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
+REAL, DIMENSION(D%NIJT,D%NKT) , INTENT(IN) :: PFRAC_ICE ! ice fraction
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PT ! temperature
-REAL, DIMENSION(:,:), INTENT(OUT) :: PAMOIST,PATHETA
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA
!
!-------------------------------------------------------------------------------
-!
+!
!* 0.2 Declarations of local variables
!
REAL :: ZEPS ! XMV / XMD
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: &
- ZCP, & ! Cp
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
+ ZCP, & ! Cp
ZE, & ! Saturation mixing ratio
ZDEDT, & ! Saturation mixing ratio derivative
ZAMOIST_W, & ! Coefficients for s = f (Thetal,Rnp)
@@ -113,126 +92,164 @@ REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: &
ZATHETA_I, & !
ZLVOCP,ZLSOCP
-INTEGER :: JRR
+INTEGER :: JRR, JIJ, JK
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKTB,IKTE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_FUNCTION_THERMO_MF',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKTB=D%NKTB
+IKTE=D%NKTE
!
- ZEPS = XMV / XMD
+ ZEPS = CST%XMV / CST%XMD
!
!* Cph
!
-ZCP=XCPD
+ZCP=CST%XCPD
-IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + XCPV * PR(:,:,1)
+IF (KRR > 0) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ ZCP(IIJB:IIJE,IKTB:IKTE) = ZCP(IIJB:IIJE,IKTB:IKTE) + CST%XCPV * PR(IIJB:IIJE,IKTB:IKTE,1)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ENDIF
-DO JRR = 2,1+KRRL ! loop on the liquid components
- ZCP(:,:) = ZCP(:,:) + XCL * PR(:,:,JRR)
+DO JRR = 2,1+KRRL ! loop on the liquid components
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ ZCP(IIJB:IIJE,IKTB:IKTE) = ZCP(IIJB:IIJE,IKTB:IKTE) + CST%XCL * PR(IIJB:IIJE,IKTB:IKTE,JRR)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
END DO
-DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
- ZCP(:,:) = ZCP(:,:) + XCI * PR(:,:,JRR)
+DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ ZCP(IIJB:IIJE,IKTB:IKTE) = ZCP(IIJB:IIJE,IKTB:IKTE) + CST%XCI * PR(IIJB:IIJE,IKTB:IKTE,JRR)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+
END DO
!* Temperature
!
-PT(:,:) = PTH(:,:) * PEXN(:,:)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+PT(IIJB:IIJE,IKTB:IKTE) = PTH(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
!
!
!! Liquid water
!
-IF ( KRRL >= 1 ) THEN
-!
-!* Lv/Cph
-!
- ZLVOCP(:,:) = (XLVTT + (XCPV-XCL) * (PT(:,:)-XTT) ) / ZCP(:,:)
-!
-!* Saturation vapor pressure with respect to water
-!
- ZE(:,:) = EXP( XALPW - XBETAW/PT(:,:) - XGAMW*ALOG( PT(:,:) ) )
-!
-!* Saturation mixing ratio with respect to water
-!
- ZE(:,:) = ZE(:,:) * ZEPS / ( PPABS(:,:) - ZE(:,:) )
-!
-!* Compute the saturation mixing ratio derivative (rvs')
-!
- ZDEDT(:,:) = ( XBETAW / PT(:,:) - XGAMW ) / PT(:,:) &
- * ZE(:,:) * ( 1. + ZE(:,:) / ZEPS )
-!
-!* Compute Amoist
-!
- ZAMOIST_W(:,:)= 0.5 / ( 1.0 + ZDEDT(:,:) * ZLVOCP(:,:) )
-!
-!* Compute Atheta
-!
- ZATHETA_W(:,:)= ZAMOIST_W(:,:) * PEXN(:,:) * &
- ( ( ZE(:,:) - PR(:,:,1) ) * ZLVOCP(:,:) / &
- ( 1. + ZDEDT(:,:) * ZLVOCP(:,:) ) * &
- ( &
- ZE(:,:) * (1. + ZE(:,:)/ZEPS) &
- * ( -2.*XBETAW/PT(:,:) + XGAMW ) / PT(:,:)**2 &
- +ZDEDT(:,:) * (1. + 2. * ZE(:,:)/ZEPS) &
- * ( XBETAW/PT(:,:) - XGAMW ) / PT(:,:) &
- ) &
- - ZDEDT(:,:) &
- )
-
-!
-!! Solid water
-!
- IF ( KRRI >= 1 ) THEN
-
-!
-!* Ls/Cph
-!
- ZLSOCP(:,:) = (XLSTT + (XCPV-XCI) * (PT(:,:)-XTT) ) / ZCP(:,:)
-!
-!* Saturation vapor pressure with respect to ice
-!
- ZE(:,:) = EXP( XALPI - XBETAI/PT(:,:) - XGAMI*ALOG( PT(:,:) ) )
-!
-!* Saturation mixing ratio with respect to ice
-!
- ZE(:,:) = ZE(:,:) * ZEPS / ( PPABS(:,:) - ZE(:,:) )
-!
-!* Compute the saturation mixing ratio derivative (rvs')
-!
- ZDEDT(:,:) = ( XBETAI / PT(:,:) - XGAMI ) / PT(:,:) &
- * ZE(:,:) * ( 1. + ZE(:,:) / ZEPS )
-!
-!* Compute Amoist
-!
- ZAMOIST_I(:,:)= 0.5 / ( 1.0 + ZDEDT(:,:) * ZLSOCP(:,:) )
-!
-!* Compute Atheta
-!
- ZATHETA_I(:,:)= ZAMOIST_I(:,:) * PEXN(:,:) * &
- ( ( ZE(:,:) - PR(:,:,1) ) * ZLSOCP(:,:) / &
- ( 1. + ZDEDT(:,:) * ZLSOCP(:,:) ) * &
+IF ( KRRL >= 1 ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ !
+ !* Lv/Cph
+ !
+ ZLVOCP(IIJB:IIJE,IKTB:IKTE) = (CST%XLVTT + (CST%XCPV-CST%XCL) * (PT(IIJB:IIJE,IKTB:IKTE)-CST%XTT) ) / &
+ & ZCP(IIJB:IIJE,IKTB:IKTE)
+ !
+ !* Saturation vapor pressure with respect to water
+ !
+ ZE(IIJB:IIJE,IKTB:IKTE) = EXP(CST%XALPW - CST%XBETAW/PT(IIJB:IIJE,IKTB:IKTE) - &
+ &CST%XGAMW*ALOG( PT(IIJB:IIJE,IKTB:IKTE) ) )
+ !
+ !* Saturation mixing ratio with respect to water
+ !
+ ZE(IIJB:IIJE,IKTB:IKTE) = ZE(IIJB:IIJE,IKTB:IKTE) * ZEPS / &
+ & ( PPABS(IIJB:IIJE,IKTB:IKTE) - ZE(IIJB:IIJE,IKTB:IKTE) )
+ !
+ !* Compute the saturation mixing ratio derivative (rvs')
+ !
+ ZDEDT(IIJB:IIJE,IKTB:IKTE) = (CST%XBETAW/PT(IIJB:IIJE,IKTB:IKTE) - CST%XGAMW) / PT(IIJB:IIJE,IKTB:IKTE)&
+ * ZE(IIJB:IIJE,IKTB:IKTE) * ( 1. + ZE(IIJB:IIJE,IKTB:IKTE) / ZEPS )
+ !
+ !* Compute Amoist and Atheta
+ !
+ IF (OSTATNW) THEN
+ ZAMOIST_W(IIJB:IIJE,IKTB:IKTE)= 1.0/( 1.0 + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLVOCP(IIJB:IIJE,IKTB:IKTE))
+ ZATHETA_W(IIJB:IIJE,IKTB:IKTE)= ZAMOIST_W(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) &
+ * ZDEDT(IIJB:IIJE,IKTB:IKTE)
+ ELSE
+ ZAMOIST_W(IIJB:IIJE,IKTB:IKTE)= 0.5/( 1.0 + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLVOCP(IIJB:IIJE,IKTB:IKTE) )
+ ZATHETA_W(IIJB:IIJE,IKTB:IKTE)= ZAMOIST_W(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) * &
+ ( ( ZE(IIJB:IIJE,IKTB:IKTE) - PR(IIJB:IIJE,IKTB:IKTE,1) ) * ZLVOCP(IIJB:IIJE,IKTB:IKTE) / &
+ ( 1. + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLVOCP(IIJB:IIJE,IKTB:IKTE) ) * &
+ ( &
+ ZE(IIJB:IIJE,IKTB:IKTE) * (1. + ZE(IIJB:IIJE,IKTB:IKTE)/ZEPS) &
+ * ( -2.*CST%XBETAW/PT(IIJB:IIJE,IKTB:IKTE) + CST%XGAMW ) / PT(IIJB:IIJE,IKTB:IKTE)**2&
+ +ZDEDT(IIJB:IIJE,IKTB:IKTE) * (1. + 2. * ZE(IIJB:IIJE,IKTB:IKTE)/ZEPS) &
+ * ( CST%XBETAW/PT(IIJB:IIJE,IKTB:IKTE) - CST%XGAMW ) / PT(IIJB:IIJE,IKTB:IKTE) &
+ ) &
+ - ZDEDT(IIJB:IIJE,IKTB:IKTE) &
+ )
+ END IF
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ !
+ !! Solid water
+ !
+ IF ( KRRI >= 1 ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ !
+ !* Ls/Cph
+ !
+ ZLSOCP(IIJB:IIJE,IKTB:IKTE) = (CST%XLSTT + (CST%XCPV-CST%XCI) * (PT(IIJB:IIJE,IKTB:IKTE)-CST%XTT) ) / &
+ & ZCP(IIJB:IIJE,IKTB:IKTE)
+ !
+ !* Saturation vapor pressure with respect to ice
+ !
+ ZE(IIJB:IIJE,IKTB:IKTE) = EXP(CST%XALPI - CST%XBETAI/PT(IIJB:IIJE,IKTB:IKTE) - &
+ &CST%XGAMI*ALOG( PT(IIJB:IIJE,IKTB:IKTE) ) )
+ !
+ !* Saturation mixing ratio with respect to ice
+ !
+ ZE(IIJB:IIJE,IKTB:IKTE) = ZE(IIJB:IIJE,IKTB:IKTE) * ZEPS / &
+ & ( PPABS(IIJB:IIJE,IKTB:IKTE) - ZE(IIJB:IIJE,IKTB:IKTE) )
+ !
+ !* Compute the saturation mixing ratio derivative (rvs')
+ !
+ ZDEDT(IIJB:IIJE,IKTB:IKTE) = (CST%XBETAI/PT(IIJB:IIJE,IKTB:IKTE)-CST%XGAMI) /PT(IIJB:IIJE,IKTB:IKTE)&
+ * ZE(IIJB:IIJE,IKTB:IKTE) * ( 1. + ZE(IIJB:IIJE,IKTB:IKTE) / ZEPS )
+ !
+ !* Compute Amoist and Atheta
+ !
+ IF (OSTATNW) THEN
+ ZAMOIST_I(IIJB:IIJE,IKTB:IKTE)= 1.0/( 1.0 + ZDEDT(IIJB:IIJE,IKTB:IKTE) *ZLVOCP(IIJB:IIJE,IKTB:IKTE))
+ ZATHETA_I(IIJB:IIJE,IKTB:IKTE)= ZAMOIST_I(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) &
+ * ZDEDT(IIJB:IIJE,IKTB:IKTE)
+ ELSE
+ ZAMOIST_I(IIJB:IIJE,IKTB:IKTE)= 0.5/(1.0 + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLSOCP(IIJB:IIJE,IKTB:IKTE))
+ ZATHETA_I(IIJB:IIJE,IKTB:IKTE)= ZAMOIST_I(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) * &
+ ( ( ZE(IIJB:IIJE,IKTB:IKTE) - PR(IIJB:IIJE,IKTB:IKTE,1) ) * ZLSOCP(IIJB:IIJE,IKTB:IKTE) / &
+ ( 1. + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLSOCP(IIJB:IIJE,IKTB:IKTE) ) * &
( &
- ZE(:,:) * (1. + ZE(:,:)/ZEPS) &
- * ( -2.*XBETAI/PT(:,:) + XGAMI ) / PT(:,:)**2 &
- +ZDEDT(:,:) * (1. + 2. * ZE(:,:)/ZEPS) &
- * ( XBETAI/PT(:,:) - XGAMI ) / PT(:,:) &
+ ZE(IIJB:IIJE,IKTB:IKTE) * (1. + ZE(IIJB:IIJE,IKTB:IKTE)/ZEPS) &
+ * ( -2.*CST%XBETAI/PT(IIJB:IIJE,IKTB:IKTE) + CST%XGAMI ) / PT(IIJB:IIJE,IKTB:IKTE)**2 &
+ +ZDEDT(IIJB:IIJE,IKTB:IKTE) * (1. + 2. * ZE(IIJB:IIJE,IKTB:IKTE)/ZEPS) &
+ * ( CST%XBETAI/PT(IIJB:IIJE,IKTB:IKTE) - CST%XGAMI ) / PT(IIJB:IIJE,IKTB:IKTE) &
) &
- - ZDEDT(:,:) &
+ - ZDEDT(IIJB:IIJE,IKTB:IKTE) &
)
+ END IF
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
ELSE
- ZAMOIST_I(:,:)=0.
- ZATHETA_I(:,:)=0.
+ ZAMOIST_I(IIJB:IIJE,IKTB:IKTE)=0.
+ ZATHETA_I(IIJB:IIJE,IKTB:IKTE)=0.
ENDIF
- PAMOIST(:,:) = (1.0-PFRAC_ICE(:,:))*ZAMOIST_W(:,:) &
- +PFRAC_ICE(:,:) *ZAMOIST_I(:,:)
- PATHETA(:,:) = (1.0-PFRAC_ICE(:,:))*ZATHETA_W(:,:) &
- +PFRAC_ICE(:,:) *ZATHETA_I(:,:)
-
-!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ PAMOIST(IIJB:IIJE,IKTB:IKTE) = (1.0-PFRAC_ICE(IIJB:IIJE,IKTB:IKTE))*ZAMOIST_W(IIJB:IIJE,IKTB:IKTE) &
+ +PFRAC_ICE(IIJB:IIJE,IKTB:IKTE) *ZAMOIST_I(IIJB:IIJE,IKTB:IKTE)
+ PATHETA(IIJB:IIJE,IKTB:IKTE) = (1.0-PFRAC_ICE(IIJB:IIJE,IKTB:IKTE))*ZATHETA_W(IIJB:IIJE,IKTB:IKTE) &
+ +PFRAC_ICE(IIJB:IIJE,IKTB:IKTE) *ZATHETA_I(IIJB:IIJE,IKTB:IKTE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+ !
ELSE
- PAMOIST(:,:) = 0.
- PATHETA(:,:) = 0.
+ PAMOIST(IIJB:IIJE,IKTB:IKTE) = 0.
+ PATHETA(IIJB:IIJE,IKTB:IKTE) = 0.
ENDIF
+IF (LHOOK) CALL DR_HOOK('COMPUTE_FUNCTION_THERMO_MF',1,ZHOOK_HANDLE)
END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF
+!
+END MODULE MODE_COMPUTE_FUNCTION_THERMO_MF
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud.f90 b/src/PHYEX/turb/mode_compute_mf_cloud.f90
index 23f94bce58fd8595d043f8050b86189873745c78..c1ee0cfd6d86aca723cc05f4b4f8d73582ef19df 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud.f90
@@ -4,62 +4,17 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODI_COMPUTE_MF_CLOUD
+ MODULE MODE_COMPUTE_MF_CLOUD
! ############################
!
-INTERFACE
-! #################################################################
- SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD,&
- PFRAC_ICE, &
- PRC_UP,PRI_UP,PEMF, &
- PTHL_UP, PRT_UP, PFRAC_UP, &
- PTHV_UP, PFRAC_ICE_UP, PRSAT_UP, &
- PEXNM, PTHLM, PRTM, PTHM, PTHVM, PRM, &
- PDZZ, PZZ, KKLCL, &
- PPABSM, PRHODREF, &
- PRC_MF, PRI_MF, PCF_MF, PSIGMF, PDEPTH )
-! #################################################################
-!!
-!
-!* 1.1 Declaration of Arguments
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP ! updraft thetaV
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PRSAT_UP ! Rsat in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! exner function
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
-INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM, PRHODREF ! environement
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content and
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! cloud fraction for MF scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
-REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
-
-END SUBROUTINE COMPUTE_MF_CLOUD
-
-END INTERFACE
+IMPLICIT NONE
+CONTAINS
!
-END MODULE MODI_COMPUTE_MF_CLOUD
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD(KKA,KKB,KKE,KKU,KKL,KRR,KRRL,KRRI,HMF_CLOUD, &
+ SUBROUTINE COMPUTE_MF_CLOUD(D, CST, CSTURB, PARAMMF, OSTATNW, &
+ KRR, KRRL, KRRI, &
PFRAC_ICE, &
- PRC_UP,PRI_UP,PEMF, &
+ PRC_UP,PRI_UP,PEMF, &
PTHL_UP, PRT_UP, PFRAC_UP, &
PTHV_UP, PFRAC_ICE_UP, PRSAT_UP, &
PEXNM, PTHLM, PRTM, PTHM, PTHVM, PRM, &
@@ -106,12 +61,19 @@ END MODULE MODI_COMPUTE_MF_CLOUD
!* 0. DECLARATIONS
! ------------
!
-use mode_msg
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+!
+USE MODE_MSG
!
-USE MODI_COMPUTE_MF_CLOUD_BIGAUS
-USE MODI_COMPUTE_MF_CLOUD_DIRECT
-USE MODI_COMPUTE_MF_CLOUD_STAT
+USE MODE_COMPUTE_MF_CLOUD_DIRECT, ONLY: COMPUTE_MF_CLOUD_DIRECT
+USE MODE_COMPUTE_MF_CLOUD_STAT, ONLY: COMPUTE_MF_CLOUD_STAT
+USE MODE_COMPUTE_MF_CLOUD_BIGAUS, ONLY: COMPUTE_MF_CLOUD_BIGAUS
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
IMPLICIT NONE
@@ -119,78 +81,82 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud scheme
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP ! updraft thetaV
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PRSAT_UP ! Rsat in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! exner function
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
-INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM, PRHODREF ! environement
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
-REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
-
+LOGICAL, INTENT(IN) :: OSTATNW ! cloud scheme inclues convect. covar. contrib
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC_UP,PRI_UP,PEMF! updraft characteritics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHV_UP ! updraft thetaV
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRSAT_UP ! Rsat in updraft
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNM ! exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM, PTHVM ! theta and thetaV
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ, PZZ
+INTEGER, DIMENSION(D%NIJT), INTENT(IN) :: KKLCL ! index of updraft condensation level
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM, PRHODREF ! environement
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDEPTH ! Deepness of cloud
!
! 1.2 Declaration of local variables
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------
! 1. INITIALISATION
!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD',0,ZHOOK_HANDLE)
!
! 2.1 Internal domain
-
PRC_MF = 0.
PRI_MF = 0.
PCF_MF = 0.
PSIGMF = 0.
-IF (HMF_CLOUD == 'DIRE') THEN
+IF (PARAMMF%CMF_CLOUD == 'DIRE') THEN
!Direct cloud scheme
- CALL COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, &
+ CALL COMPUTE_MF_CLOUD_DIRECT(D, PARAMMF, &
&KKLCL(:), PFRAC_UP(:,:), PRC_UP(:,:), PRI_UP(:,:),&
&PRC_MF(:,:), PRI_MF(:,:), PCF_MF(:,:))
!
-ELSEIF (HMF_CLOUD == 'STAT') THEN
+ELSEIF (PARAMMF%CMF_CLOUD == 'STAT') THEN
!Statistical scheme using the PDF proposed by Bougeault (81, 82) and
!Bechtold et al (95).
- CALL COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,&
+ CALL COMPUTE_MF_CLOUD_STAT(D, CST, CSTURB, PARAMMF, &
+ &KRR, KRRL, KRRI, OSTATNW, &
&PFRAC_ICE,&
&PTHLM, PRTM, PPABSM, PRM,&
&PDZZ, PTHM, PEXNM,&
&PEMF, PTHL_UP, PRT_UP,&
&PSIGMF)
-ELSEIF (HMF_CLOUD == 'BIGA') THEN
+ELSEIF (PARAMMF%CMF_CLOUD == 'BIGA') THEN
!Statistical scheme using the bi-gaussian PDF proposed by E. Perraud.
- CALL COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ CALL COMPUTE_MF_CLOUD_BIGAUS(D, CST, PARAMMF,&
&PEMF, PDEPTH,&
&PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
&PRTM, PTHM, PTHVM,&
&PDZZ, PZZ, PRHODREF,&
&PRC_MF, PRI_MF, PCF_MF)
!
-ELSEIF (HMF_CLOUD == 'NONE') THEN
+ELSEIF (PARAMMF%CMF_CLOUD == 'NONE') THEN
! No CONVECTIVE CLOUD SCHEME
! Nothing to do: PRC_MF, PRI_MF, PCF_MF, PSIGMF are already filled with zero
ELSE
- call Print_msg(NVERB_FATAL,'GEN','COMPUTE_MF_CLOUD','Shallow convection cloud scheme not valid: HMF_CLOUD='//TRIM(HMF_CLOUD))
+ CALL PRINT_MSG(NVERB_FATAL, &
+'GEN','COMPUTE_MF_CLOUD','Shallow convection cloud scheme not valid: PARAMMF%CMF_CLOUD='//TRIM(PARAMMF%CMF_CLOUD))
ENDIF
+IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD',1,ZHOOK_HANDLE)
+
END SUBROUTINE COMPUTE_MF_CLOUD
+END MODULE MODE_COMPUTE_MF_CLOUD
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud_bigaus.f90 b/src/PHYEX/turb/mode_compute_mf_cloud_bigaus.f90
index b080f9923a6aff7ef04af89ddcaba2d4a6ca6405..a34c6e46f1d6db259eda3aa9062aeac8b481be3f 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud_bigaus.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud_bigaus.f90
@@ -4,44 +4,12 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
+ MODULE MODE_COMPUTE_MF_CLOUD_BIGAUS
! ###################################
!
-INTERFACE
-! #################################################################
- SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
- PEMF, PDEPTH,&
- PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
- PRTM, PTHM, PTHVM,&
- PDZZ, PZZ, PRHODREF,&
- PRC_MF, PRI_MF, PCF_MF)
-! #################################################################
-!!
-!
-!* 1.1 Declaration of Arguments
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
-REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
-
-END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
-! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(D, CST, PARAMMF,&
PEMF, PDEPTH,&
PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
PRTM, PTHM, PTHVM,&
@@ -89,50 +57,61 @@ END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAM_MFSHALL_n, ONLY : XALPHA_MF, XSIGMA_MF
-USE MODD_CST, ONLY : XPI, XG
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
!
-USE MODI_SHUMAN_MF
-USE MODI_GAMMA_INC
-!
-USE MODE_THERMO
+USE MODI_SHUMAN_MF, ONLY: MZF_MF, GZ_M_W_MF
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declaration of Arguments
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
-REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ, PZZ
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMF ! updraft characteritics
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM, PRTM, PTHVM ! env. var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ, PZZ
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
!
!* 0.1 Declaration of local variables
!
!
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZGRAD_Z_RT, & !
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZGRAD_Z_RT, & !
& ZALPHA_UP_M, & ! Variables used to compute variance
& ZSIGMF ! and sqrt(variance)
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZOMEGA_UP_M !
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW1 ! working array
-INTEGER :: JK ! vertical loop control
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZEMF_M, ZTHV_UP_M, & !
+REAL, DIMENSION(D%NIJT) :: ZOMEGA_UP_M !
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZW1 ! working array
+INTEGER :: JIJ, JK ! loop control
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZEMF_M, ZTHV_UP_M, & !
& ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points
& ZFRAC_ICE_UP_M !
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOND ! condensate
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration
-
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZCOND ! condensate
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZA, ZGAM ! used for integration
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT,IKB,IKA,IKU,IKE,IKL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKB=D%NKB
+IKA=D%NKA
+IKU=D%NKU
+IKE=D%NKE
+IKL=D%NKL
+!
!Computation is done on mass points
!----------------------------------------------------------------------------
!
@@ -141,69 +120,86 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration
!
!
!Vertical gradient of RT, result on mass points
-ZW1(:,:)=GZ_M_W_MF(KKA,KKU,KKL, PRTM(:,:), PDZZ(:,:))
-ZGRAD_Z_RT(:,:)=MZF_MF(KKA,KKU,KKL, ZW1(:,:))
+CALL GZ_M_W_MF(D, PRTM(:,:), PDZZ(:,:), ZW1(:,:))
+CALL MZF_MF(D, ZW1(:,:), ZGRAD_Z_RT(:,:))
!Interpolation on mass points
-ZTHV_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PTHV_UP(:,:))
-ZRSAT_UP_M(:,:)= MZF_MF(KKA,KKU,KKL, PRSAT_UP(:,:))
-ZRT_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRT_UP(:,:))
-ZEMF_M(:,:) = MZF_MF(KKA,KKU,KKL, PEMF(:,:))
-ZFRAC_ICE_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PFRAC_ICE_UP(:,:))
+CALL MZF_MF(D, PTHV_UP(:,:), ZTHV_UP_M(:,:))
+CALL MZF_MF(D, PRSAT_UP(:,:), ZRSAT_UP_M(:,:))
+CALL MZF_MF(D, PRT_UP(:,:), ZRT_UP_M(:,:))
+CALL MZF_MF(D, PEMF(:,:), ZEMF_M(:,:))
+CALL MZF_MF(D, PFRAC_ICE_UP(:,:), ZFRAC_ICE_UP_M(:,:))
!computation of omega star up
ZOMEGA_UP_M(:)=0.
-DO JK=KKB,KKE,KKL
+DO JK=IKB,IKE-IKL,IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
!Vertical integration over the entire column but only buoyant points are used
- !ZOMEGA_UP_M(:)=ZOMEGA_UP_M(:) + &
- ! ZEMF_M(:,JK) * &
- ! MAX(0.,(ZTHV_UP_M(:,JK)-PTHVM(:,JK))) * &
- ! (PZZ(:,JK+KKL)-PZZ(:,JK)) / &
- ! (PTHM(:,JK) * PRHODREF(:,JK))
+ !ZOMEGA_UP_M(IIJB:IIJE)=ZOMEGA_UP_M(IIJB:IIJE) + &
+ ! ZEMF_M(IIJB:IIJE,JK) * &
+ ! MAX(0.,(ZTHV_UP_M(IIJB:IIJE,JK)-PTHVM(IIJB:IIJE,JK))) * &
+ ! (PZZ(IIJB:IIJE,JK+KKL)-PZZ(IIJB:IIJE,JK)) / &
+ ! (PTHM(IIJB:IIJE,JK) * PRHODREF(IIJB:IIJE,JK))
!Vertical integration over the entire column
- ZOMEGA_UP_M(:)=ZOMEGA_UP_M(:) + &
- ZEMF_M(:,JK) * &
- (ZTHV_UP_M(:,JK)-PTHVM(:,JK)) * &
- (PZZ(:,JK+KKL)-PZZ(:,JK)) / &
- (PTHM(:,JK) * PRHODREF(:,JK))
+ ZOMEGA_UP_M(IIJB:IIJE)=ZOMEGA_UP_M(IIJB:IIJE) + &
+ ZEMF_M(IIJB:IIJE,JK) * &
+ (ZTHV_UP_M(IIJB:IIJE,JK)-PTHVM(IIJB:IIJE,JK)) * &
+ (PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK)) / &
+ (PTHM(IIJB:IIJE,JK) * PRHODREF(IIJB:IIJE,JK))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDDO
-ZOMEGA_UP_M(:)=MAX(ZOMEGA_UP_M(:), 1.E-20)
-ZOMEGA_UP_M(:)=(XG*ZOMEGA_UP_M(:))**(1./3.)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZOMEGA_UP_M(IIJB:IIJE)=MAX(ZOMEGA_UP_M(IIJB:IIJE), 1.E-20)
+ZOMEGA_UP_M(IIJB:IIJE)=(CST%XG*ZOMEGA_UP_M(IIJB:IIJE))**(1./3.)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!computation of alpha up
-DO JK=KKA,KKU,KKL
- ZALPHA_UP_M(:,JK)=ZEMF_M(:,JK)/(XALPHA_MF*PRHODREF(:,JK)*ZOMEGA_UP_M(:))
+DO JK=IKA,IKU,IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZALPHA_UP_M(IIJB:IIJE,JK)=ZEMF_M(IIJB:IIJE,JK)/(PARAMMF%XALPHA_MF*PRHODREF(IIJB:IIJE,JK)*ZOMEGA_UP_M(IIJB:IIJE))
+ ZALPHA_UP_M(IIJB:IIJE,JK)=MAX(0., MIN(ZALPHA_UP_M(IIJB:IIJE,JK), 1.))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDDO
-ZALPHA_UP_M(:,:)=MAX(0., MIN(ZALPHA_UP_M(:,:), 1.))
!computation of sigma of the distribution
-DO JK=KKA,KKU,KKL
- ZSIGMF(:,JK)=ZEMF_M(:,JK) * &
- (ZRT_UP_M(:,JK) - PRTM(:,JK)) * &
- PDEPTH(:) * ZGRAD_Z_RT(:,JK) / &
- (XSIGMA_MF * ZOMEGA_UP_M(:) * PRHODREF(:,JK))
+DO JK=IKA,IKU,IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSIGMF(IIJB:IIJE,JK)=ZEMF_M(IIJB:IIJE,JK) * &
+ (ZRT_UP_M(IIJB:IIJE,JK) - PRTM(IIJB:IIJE,JK)) * &
+ PDEPTH(IIJB:IIJE) * ZGRAD_Z_RT(IIJB:IIJE,JK) / &
+ (PARAMMF%XSIGMA_MF * ZOMEGA_UP_M(IIJB:IIJE) * PRHODREF(IIJB:IIJE,JK))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDDO
-ZSIGMF(:,:)=SQRT(MAX(ABS(ZSIGMF(:,:)), 1.E-40))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZSIGMF(IIJB:IIJE,1:IKT)=SQRT(MAX(ABS(ZSIGMF(IIJB:IIJE,1:IKT)), 1.E-40))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!* 2. PDF integration
! ------------------------------------------------
!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!The mean of the distribution is ZRT_UP
!Computation of ZA and ZGAM (=efrc(ZA)) coefficient
-ZA(:,:)=(ZRSAT_UP_M(:,:)-ZRT_UP_M(:,:))/(sqrt(2.)*ZSIGMF(:,:))
+ZA(IIJB:IIJE,1:IKT)=(ZRSAT_UP_M(IIJB:IIJE,1:IKT)-ZRT_UP_M(IIJB:IIJE,1:IKT))/&
+ &(sqrt(2.)*ZSIGMF(IIJB:IIJE,1:IKT))
!Approximation of erf function
-ZGAM(:,:)=1-SIGN(1., ZA(:,:))*SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
+ZGAM(IIJB:IIJE,1:IKT)=1-SIGN(1., ZA(IIJB:IIJE,1:IKT))*SQRT(1-EXP(-4*ZA(IIJB:IIJE,1:IKT)**2/CST%XPI))
!computation of cloud fraction
-PCF_MF(:,:)=MAX( 0., MIN(1.,0.5*ZGAM(:,:) * ZALPHA_UP_M(:,:)))
+PCF_MF(IIJB:IIJE,1:IKT)=MAX( 0., MIN(1.,0.5*ZGAM(IIJB:IIJE,1:IKT) * ZALPHA_UP_M(IIJB:IIJE,1:IKT)))
!computation of condensate, then PRC and PRI
-ZCOND(:,:)=(EXP(-ZA(:,:)**2)-ZA(:,:)*SQRT(XPI)*ZGAM(:,:))*ZSIGMF(:,:)/SQRT(2.*XPI) * ZALPHA_UP_M(:,:)
-ZCOND(:,:)=MAX(ZCOND(:,:), 0.) !due to approximation of ZGAM value, ZCOND could be slightly negative
-PRC_MF(:,:)=(1.-ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:)
-PRI_MF(:,:)=( ZFRAC_ICE_UP_M(:,:)) * ZCOND(:,:)
-
+ZCOND(IIJB:IIJE,1:IKT)=(EXP(-ZA(IIJB:IIJE,1:IKT)**2)-&
+ &ZA(IIJB:IIJE,1:IKT)*SQRT(CST%XPI)*ZGAM(IIJB:IIJE,1:IKT))* &
+ &ZSIGMF(IIJB:IIJE,1:IKT)/SQRT(2.*CST%XPI) * ZALPHA_UP_M(IIJB:IIJE,1:IKT)
+ZCOND(IIJB:IIJE,1:IKT)=MAX(ZCOND(IIJB:IIJE,1:IKT), 0.) !due to approximation of ZGAM value, ZCOND could be slightly negative
+PRC_MF(IIJB:IIJE,1:IKT)=(1.-ZFRAC_ICE_UP_M(IIJB:IIJE,1:IKT)) * ZCOND(IIJB:IIJE,1:IKT)
+PRI_MF(IIJB:IIJE,1:IKT)=( ZFRAC_ICE_UP_M(IIJB:IIJE,1:IKT)) * ZCOND(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',1,ZHOOK_HANDLE)
END SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS
+END MODULE MODE_COMPUTE_MF_CLOUD_BIGAUS
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud_direct.f90 b/src/PHYEX/turb/mode_compute_mf_cloud_direct.f90
index c1c1b6220f77c571fad9b291f4d1863f76203239..2323b77f523cf7d886bc038730eabe17d0052916 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud_direct.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud_direct.f90
@@ -3,34 +3,12 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ######spl
- MODULE MODI_COMPUTE_MF_CLOUD_DIRECT
+ MODULE MODE_COMPUTE_MF_CLOUD_DIRECT
! ###################################
!
-INTERFACE
-! #################################################################
- SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, &
- &KKLCL, PFRAC_UP, PRC_UP, PRI_UP,&
- &PRC_MF, PRI_MF, PCF_MF)
-! #################################################################
-!!
-!
-!* 1.1 Declaration of Arguments
-!
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content (INPUT=environment, OUTPUT=conv. cloud)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
-
-END SUBROUTINE COMPUTE_MF_CLOUD_DIRECT
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_MF_CLOUD_DIRECT
-! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(KKE, KKL, &
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE COMPUTE_MF_CLOUD_DIRECT(D, PARAMMF, &
&KKLCL, PFRAC_UP, PRC_UP, PRI_UP,&
&PRC_MF, PRI_MF, PCF_MF)
! #################################################################
@@ -69,31 +47,43 @@ END MODULE MODI_COMPUTE_MF_CLOUD_DIRECT
!! -------------
!! Original 25 Aug 2011
!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette Apr 2013: computation begins one level lower (to be able to have a cloud
+!! on mass level just below the first saturated flux level)
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAM_MFSHALL_n, ONLY : XKCF_MF
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAM_MFSHALL_n, ONLY : PARAM_MFSHALL_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declaration of Arguments
!
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL ! index of updraft condensation level
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
-REAL, DIMENSION(:,:), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+INTEGER, DIMENSION(D%NIJT), INTENT(IN) :: KKLCL ! index of updraft condensation level
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_UP ! Updraft Fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRC_UP,PRI_UP ! updraft characteritics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRC_MF, PRI_MF ! cloud content
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud fraction for MF scheme
!
!* 0.1 Declaration of local variables
!
-INTEGER :: JI,JK
+INTEGER :: JI,JK, JK0, IKB,IKE,IKL,IIJB,IIJE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Initialisation
!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_DIRECT',0,ZHOOK_HANDLE)
!
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
+IIJB=D%NIJB
+IIJE=D%NIJE
!* 1. COMPUTATION OF SUBGRID CLOUD
! ----------------------------
@@ -104,16 +94,25 @@ PRC_MF(:,:)=0.
PRI_MF(:,:)=0.
PCF_MF(:,:)=0.
-DO JI=1,SIZE(PCF_MF,1)
- DO JK=KKLCL(JI),KKE-KKL,KKL
- PCF_MF(JI,JK ) = MAX( 0., MIN(1.,XKCF_MF *0.5* ( &
- & PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+KKL) ) ))
- PRC_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRC_UP(JI,JK) &
- + PFRAC_UP(JI,JK+KKL)*PRC_UP(JI,JK+KKL) )
- PRI_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRI_UP(JI,JK) &
- + PFRAC_UP(JI,JK+KKL)*PRI_UP(JI,JK+KKL) )
+DO JI=IIJB,IIJE
+#ifdef REPRO48
+ JK0=KKLCL(JI)-IKL ! first mass level with cloud
+ JK0=MAX(JK0, MIN(IKB,IKE)) !protection if KKL=1
+ JK0=MIN(JK0, MAX(IKB,IKE)) !protection if KKL=-1
+ DO JK=JK0,IKE-IKL,IKL
+#else
+ DO JK=KKLCL(JI),IKE-IKL,IKL
+#endif
+ PCF_MF(JI,JK ) = MAX( 0., MIN(1.,PARAMMF%XKCF_MF *0.5* ( &
+ & PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+IKL) ) ))
+ PRC_MF(JI,JK) = 0.5* PARAMMF%XKCF_MF * ( PFRAC_UP(JI,JK)*PRC_UP(JI,JK) &
+ + PFRAC_UP(JI,JK+IKL)*PRC_UP(JI,JK+IKL) )
+ PRI_MF(JI,JK) = 0.5* PARAMMF%XKCF_MF * ( PFRAC_UP(JI,JK)*PRI_UP(JI,JK) &
+ + PFRAC_UP(JI,JK+IKL)*PRI_UP(JI,JK+IKL) )
END DO
END DO
+IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_DIRECT',1,ZHOOK_HANDLE)
END SUBROUTINE COMPUTE_MF_CLOUD_DIRECT
+END MODULE MODE_COMPUTE_MF_CLOUD_DIRECT
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud_stat.f90 b/src/PHYEX/turb/mode_compute_mf_cloud_stat.f90
index c3c78d4677e2624ff759e6a50da959d81f8fe251..3c562015e63667859aa1862c251baf0493e0e948 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud_stat.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud_stat.f90
@@ -3,49 +3,14 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ######spl
- MODULE MODI_COMPUTE_MF_CLOUD_STAT
+ MODULE MODE_COMPUTE_MF_CLOUD_STAT
! ############################
!
-INTERFACE
-! #################################################################
- SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,&
- &PFRAC_ICE,&
- &PTHLM, PRTM, PPABSM, PRM,&
- &PDZZ, PTHM, PEXNM,&
- &PEMF, PTHL_UP, PRT_UP,&
- &PSIGMF)
-! #################################################################
-!!
-!
-!* 1.1 Declaration of Arguments
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! environement
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
-
-
-END SUBROUTINE COMPUTE_MF_CLOUD_STAT
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_MF_CLOUD_STAT
+IMPLICIT NONE
+CONTAINS
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD_STAT(KKA, KKB, KKE, KKU, KKL, KRR, KRRL, KRRI,&
+ SUBROUTINE COMPUTE_MF_CLOUD_STAT(D, CST, CSTURB, PARAMMF, &
+ &KRR, KRRL, KRRI, OSTATNW, &
&PFRAC_ICE,&
&PTHLM, PRTM, PPABSM, PRM,&
&PDZZ, PTHM, PEXNM, &
@@ -84,49 +49,66 @@ END MODULE MODI_COMPUTE_MF_CLOUD_STAT
!! -------------
!! Original 25 Aug 2011
!! S. Riette Jan 2012: support for both order of vertical levels
+!! Wim de Rooy June 2019: update statistical cloud scheme (now including
+!! covariance term for MF contribution)
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAM_MFSHALL_n, ONLY : XTAUSIGMF
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_CTURB, ONLY: CSTURB_t
+
!
-USE MODI_SHUMAN_MF
-USE MODI_COMPUTE_FUNCTION_THERMO_MF
+USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
+USE MODE_COMPUTE_FUNCTION_THERMO_MF, ONLY: COMPUTE_FUNCTION_THERMO_MF
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!* 0.1 Declaration of Arguments
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+LOGICAL, INTENT(IN) :: OSTATNW ! cloud scheme inclues convect. covar. contrib
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! environement
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_ICE ! liquid/ice fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM, PRTM ! cons. var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM ! environement
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMF ! updraft characteritics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHL_UP, PRT_UP ! rc,w,Mass Flux,Thetal,rt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSIGMF ! SQRT(variance) for statistical cloud scheme
!
!* 0.1 Declaration of local variables
!
!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZFLXZ
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZT
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZAMOIST, ZATHETA
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZFLXZ,ZFLXZ2,ZFLXZ3
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZT
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZAMOIST, ZATHETA
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK,ZWK2
+INTEGER :: JIJ, JK
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 initialisation
!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_STAT',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
!
!----------------------------------------------------------------------------
!
@@ -135,7 +117,7 @@ REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZAMOIST, ZATHETA
! ------------------------------------------------
!
! Thermodynamics functions
-CALL COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
+CALL COMPUTE_FUNCTION_THERMO_MF( D, CST, KRR,KRRL,KRRI,OSTATNW, &
PTHM,PRM,PEXNM,PFRAC_ICE,PPABSM, &
ZT,ZAMOIST,ZATHETA )
!
@@ -145,14 +127,30 @@ IF (KRRL > 0) THEN
!
!
- ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:))) * &
- GZ_M_W_MF(KKA,KKU,KKL,PTHLM(:,:),PDZZ(:,:))
-!
-! Avoid negative values
- ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:))
+ CALL MZM_MF(D, PTHLM(:,:), ZFLXZ(:,:))
+ CALL GZ_M_W_MF(D, PTHLM(:,:), PDZZ(:,:), ZWK(:,:))
+ IF (OSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = -2 * CSTURB%XCTV* PARAMMF%XTAUSIGMF * PEMF(IIJB:IIJE,1:IKT)* &
+ & (PTHL_UP(IIJB:IIJE,1:IKT)-ZFLXZ(IIJB:IIJE,1:IKT)) * ZWK(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = -2 * PARAMMF%XTAUSIGMF * PEMF(IIJB:IIJE,1:IKT)* &
+ & (PTHL_UP(IIJB:IIJE,1:IKT)-ZFLXZ(IIJB:IIJE,1:IKT)) * ZWK(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ !
+ ! Avoid negative values
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = MAX(0.,ZFLXZ(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PSIGMF(:,:) = MZF_MF(KKA,KKU,KKL,ZFLXZ(:,:)) * ZATHETA(:,:)**2
+ CALL MZF_MF(D, ZFLXZ(:,:), PSIGMF(:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PSIGMF(IIJB:IIJE,1:IKT) = PSIGMF(IIJB:IIJE,1:IKT) * ZATHETA(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
@@ -161,21 +159,58 @@ IF (KRRL > 0) THEN
!
!
!
- ZFLXZ(:,:) = -2 * XTAUSIGMF * PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,PRTM(:,:))) * &
- GZ_M_W_MF(KKA,KKU,KKL,PRTM(:,:),PDZZ(:,:))
-!
-! Avoid negative values
- ZFLXZ(:,:) = MAX(0.,ZFLXZ(:,:))
-!
+ CALL MZM_MF(D, PRTM(:,:), ZFLXZ2(:,:))
+ CALL GZ_M_W_MF(D, PRTM(:,:), PDZZ(:,:), ZWK2(:,:))
+ IF (OSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ2(IIJB:IIJE,1:IKT) = -2 * CSTURB%XCTV * PARAMMF%XTAUSIGMF * PEMF(IIJB:IIJE,1:IKT)* &
+ & (PRT_UP(IIJB:IIJE,1:IKT)-ZFLXZ2(IIJB:IIJE,1:IKT)) * ZWK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ2(IIJB:IIJE,1:IKT) = -2 * PARAMMF%XTAUSIGMF * PEMF(IIJB:IIJE,1:IKT)* &
+ & (PRT_UP(IIJB:IIJE,1:IKT)-ZFLXZ2(IIJB:IIJE,1:IKT)) * ZWK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ !
+ ! Avoid negative values
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ2(IIJB:IIJE,1:IKT) = MAX(0.,ZFLXZ2(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PSIGMF(:,:) = PSIGMF(:,:) + ZAMOIST(:,:) **2 * MZF_MF(KKA,KKU,KKL,ZFLXZ(:,:))
+ CALL MZF_MF(D, ZFLXZ2(:,:), ZWK2(:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PSIGMF(IIJB:IIJE,1:IKT) = PSIGMF(IIJB:IIJE,1:IKT) + ZAMOIST(IIJB:IIJE,1:IKT) **2 *ZWK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ IF (OSTATNW) THEN
+ !wc Now including convection covariance contribution in case of OSTATNW=TRUE
+ !
+ ! 1.2.2 contribution from <Rnp Thl>
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ3(IIJB:IIJE,1:IKT) = - CSTURB%XCTV * PARAMMF%XTAUSIGMF * &
+ (PEMF(IIJB:IIJE,1:IKT)*(PRT_UP(IIJB:IIJE,1:IKT)-ZFLXZ2(IIJB:IIJE,1:IKT)) * &
+ ZWK(IIJB:IIJE,1:IKT) + &
+ PEMF(IIJB:IIJE,1:IKT)*(PTHL_UP(IIJB:IIJE,1:IKT)-ZFLXZ(IIJB:IIJE,1:IKT)) * &
+ ZWK2(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_MF(D, ZFLXZ3, ZFLXZ)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PSIGMF(IIJB:IIJE,1:IKT) = PSIGMF(IIJB:IIJE,1:IKT) - &
+ MIN(0.,2.*ZAMOIST(IIJB:IIJE,1:IKT)*ZATHETA(IIJB:IIJE,1:IKT)*&
+ &ZFLXZ(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
!
! 1.3 Vertical part of Sigma_s
!
- PSIGMF(:,:) = SQRT( MAX (PSIGMF(:,:) , 0.) )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PSIGMF(IIJB:IIJE,1:IKT) = SQRT( MAX (PSIGMF(IIJB:IIJE,1:IKT) , 0.) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
PSIGMF(:,:) = 0.
END IF
!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_STAT',1,ZHOOK_HANDLE)
!
END SUBROUTINE COMPUTE_MF_CLOUD_STAT
+END MODULE MODE_COMPUTE_MF_CLOUD_STAT
diff --git a/src/PHYEX/turb/mode_compute_updraft.f90 b/src/PHYEX/turb/mode_compute_updraft.f90
index 69985ecdb2976aa04462ab124cddfe561f38bffe..5e9389b857af9b3b61dec13310470696b4287d21 100644
--- a/src/PHYEX/turb/mode_compute_updraft.f90
+++ b/src/PHYEX/turb/mode_compute_updraft.f90
@@ -4,87 +4,14 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODI_COMPUTE_UPDRAFT
+ MODULE MODE_COMPUTE_UPDRAFT
! ###########################
!
-INTERFACE
-!
-! #################################################################
- SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV, &
- PPABSM,PRHODREF,PUM,PVM,PTKEM, &
- PTHM,PRVM,PTHLM,PRTM, &
- PSVM,PTHL_UP,PRT_UP, &
- PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
- PW_UP,PU_UP, PV_UP, PSV_UP, &
- PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
- PEMF,PDETR,PENTR, &
- PBUO_INTEG,KKLCL,KKETL,KKCTL, &
- PDEPTH)
-! #################################################################
-!
-!* 1.1 Declaration of Arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
-
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
-! normal surface fluxes of theta,rv,(u,v) parallel to the orography
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
- PRI_UP,PTHV_UP,& ! updraft ri, THv
- PW_UP,PFRAC_UP,& ! updraft w, fraction
- PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
- PRSAT_UP ! Rsat
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
- ! entrainment, detrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
-
-
-END SUBROUTINE COMPUTE_UPDRAFT
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_UPDRAFT
-! ######spl
- SUBROUTINE COMPUTE_UPDRAFT(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE COMPUTE_UPDRAFT(D,CST,NEB,PARAMMF,TURBN,CSTURB, &
+ KSV, HFRAC_ICE, &
+ OENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
@@ -96,7 +23,7 @@ END MODULE MODI_COMPUTE_UPDRAFT
PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
PEMF,PDETR,PENTR, &
PBUO_INTEG,KKLCL,KKETL,KKCTL, &
- PDEPTH )
+ PDEPTH, PDX, PDY )
! #################################################################
!!
@@ -134,22 +61,25 @@ END MODULE MODI_COMPUTE_UPDRAFT
!! R.Honnert Oct 2016 : Add ZSURF and Update with AROME
!! Q.Rodier 01/2019 : support RM17 mixing length
!! R.Honnert 01/2019 : add LGZ (reduction of the mass-flux surface closure with the resolution)
+!! S. Riette 06/2022: compute_entr_detr is inlined
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_PARAM_MFSHALL_n
-USE MODD_TURB_n, ONLY : CTURBLEN
-
-USE MODI_COMPUTE_ENTR_DETR
-USE MODI_TH_R_FROM_THL_RT_1D
-USE MODI_SHUMAN_MF
-
-USE MODI_COMPUTE_BL89_ML
-USE MODD_GRID_n, ONLY : XDXHAT, XDYHAT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_CTURB, ONLY: CSTURB_t
+!
+USE MODI_SHUMAN_MF, ONLY: MZM_MF, MZF_MF, GZ_M_W_MF
+USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
IMPLICIT NONE
@@ -157,59 +87,61 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+INTEGER, INTENT(IN) :: KSV
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metrics coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV
! normal surface fluxes of theta,rv,(u,v) parallel to the orography
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at t-dt
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-dt
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
PRI_UP,PTHV_UP,& ! updraft ri, THv
PW_UP,PFRAC_UP,& ! updraft w, fraction
PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
PRSAT_UP ! Rsat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(D%NIJT), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+REAL, INTENT(IN) :: PDX, PDY
! 1.2 Declaration of local variables
!
!
! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZTHM_F,ZRVM_F ! Theta,rv of
! updraft environnement
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZRTM_F, ZTHLM_F, ZTKEM_F,& ! rt, thetal,TKE,pressure,
ZUM_F,ZVM_F,ZRHO_F, & ! density,momentum
ZPRES_F,ZTHVM_F,ZTHVM, & ! interpolated at the flux point
@@ -218,47 +150,99 @@ REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
ZBUO_INTEG_DRY, ZBUO_INTEG_CLD,&! Integrated Buoyancy
ZENTR_CLD,ZDETR_CLD ! wet entrainment and detrainment
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT,KSV) :: &
ZSVM_F ! scalar variables
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZTH_UP, & ! updraft THETA
ZRC_MIX, ZRI_MIX ! guess of Rc and Ri for KF mixture
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZCOEF ! diminution coefficient for too high clouds
-REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+REAL, DIMENSION(D%NIJT) :: ZWTHVSURF ! Surface w'thetav'
REAL :: ZRDORV ! RD/RV
REAL :: ZRVORD ! RV/RD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD
+REAL, DIMENSION(D%NIJT) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground
-INTEGER :: ISV ! Number of scalar variables
-INTEGER :: JK,JI,JSV ! loop counters
+INTEGER :: JK,JIJ,JSV ! loop counters
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+LOGICAL, DIMENSION(D%NIJT) :: GTEST,GTESTLCL,GTESTETL
! Test if the ascent continue, if LCL or ETL is reached
LOGICAL :: GLMIX
! To choose upward or downward mixing length
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
-LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+LOGICAL, DIMENSION(D%NIJT) :: GWORK1
+LOGICAL, DIMENSION(D%NIJT,D%NKT) :: GWORK2
-INTEGER :: ITEST,JLOOP
+INTEGER :: ITEST
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI,&
+REAL, DIMENSION(D%NIJT) :: ZRC_UP, ZRI_UP, ZRV_UP,&
+ ZRSATW, ZRSATI,&
ZPART_DRY
REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
REAL :: ZTMAX,ZRMAX ! control value
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZSURF
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+REAL, DIMENSION(D%NIJT) :: ZSURF
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+!
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK
+REAL, DIMENSION(D%NIJT,16) :: ZBUF
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+! 1.3 Declaration of additional local variables for compute_entr_detr
+!
+! Variables for cloudy part
+REAL, DIMENSION(D%NIJT) :: ZKIC, ZKIC_F2 ! fraction of env. mass in the muxtures
+REAL, DIMENSION(D%NIJT) :: ZEPSI,ZDELTA ! factor entrainment detrainment
+REAL :: ZEPSI_CLOUD ! factor entrainment detrainment
+REAL :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr.
+REAL, DIMENSION(D%NIJT) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures
+REAL, DIMENSION(D%NIJT) :: ZTHMIX ! Theta and Thetav of mixtures
+REAL, DIMENSION(D%NIJT) :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures
+REAL, DIMENSION(D%NIJT) :: ZTHVMIX, ZTHVMIX_F2 ! Theta and Thetav of mixtures
+REAL, DIMENSION(D%NIJT) :: ZTHV_UP_F2 ! thv_up at flux point kk+kkl
+REAL, DIMENSION(D%NIJT) :: ZRSATW_ED, ZRSATI_ED ! working arrays (mixing ratio at saturation)
+REAL, DIMENSION(D%NIJT) :: ZTHV ! theta V of environment at the bottom of cloudy part
+REAL :: ZKIC_INIT !Initial value of ZKIC
+REAL :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part
+
+! Variables for dry part
+REAL :: ZFOESW, ZFOESI ! saturating vapor pressure
+REAL :: ZDRSATODP ! d.Rsat/dP
+REAL :: ZT ! Temperature
+REAL :: ZWK0D ! Work array
+
+! Variables for dry and cloudy parts
+REAL, DIMENSION(D%NIJT) :: ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk
+ ZCOEFF_PLUS_HALF ! Variation of Thv between mass points kk and kk+kkl
+REAL, DIMENSION(D%NIJT) :: ZPRE ! pressure at the bottom of the cloudy part
+REAL, DIMENSION(D%NIJT) :: ZG_O_THVREF_ED
+REAL, DIMENSION(D%NIJT) :: ZFRAC_ICE ! fraction of ice
+REAL, DIMENSION(D%NIJT) :: ZDZ_STOP,& ! Exact Height of the LCL above flux level KK
+ ZTHV_MINUS_HALF,& ! Thv at flux point(kk)
+ ZTHV_PLUS_HALF ! Thv at flux point(kk+kkl)
+REAL :: ZDZ ! Delta Z used in computations
+INTEGER :: JKLIM
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT,IKB,IKE,IKL
+!
+IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
+!
! Thresholds for the perturbation of
! theta_l and r_t at the first level of the updraft
ZTMAX=2.0
@@ -268,21 +252,19 @@ ZRMAX=1.E-3
! INITIALISATION
! Initialisation of the constants
-ZRDORV = XRD / XRV !=0.622
-ZRVORD = (XRV / XRD)
+ZRDORV = CST%XRD / CST%XRV !=0.622
+ZRVORD = (CST%XRV / CST%XRD)
ZDEPTH_MAX1=3000. ! clouds with depth inferior to this value are keeped untouched
ZDEPTH_MAX2=4000. ! clouds with depth superior to this value are suppressed
! Local variables, internal domain
-!number of scalar variables
-ISV=SIZE(PSVM,3)
IF (OENTR_DETR) THEN
! Initialisation of intersesting Level :LCL,ETL,CTL
- KKLCL(:)=KKE
- KKETL(:)=KKE
- KKCTL(:)=KKE
+ KKLCL(:)=IKE
+ KKETL(:)=IKE
+ KKCTL(:)=IKE
!
! Initialisation
@@ -304,7 +286,9 @@ IF (OENTR_DETR) THEN
PBUO_INTEG=0.
PFRAC_ICE_UP(:,:)=0.
- PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRSAT_UP(IIJB:IIJE,1:IKT)=PRVM(IIJB:IIJE,1:IKT) ! should be initialised correctly but is (normaly) not used
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!cloud/dry air mixture cloud content
ZRC_MIX = 0.
@@ -314,103 +298,139 @@ END IF
! Initialisation of environment variables at t-dt
! variables at flux level
-ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
-ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:))
-ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:))
-ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:))
-ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:))
+CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
+CALL MZM_MF(D, PRTM(:,:), ZRTM_F (:,:))
+CALL MZM_MF(D, PUM(:,:), ZUM_F (:,:))
+CALL MZM_MF(D, PVM(:,:), ZVM_F (:,:))
+CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:))
-DO JSV=1,ISV
+DO JSV=1,KSV
IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
- ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV))
+ CALL MZM_MF(D, PSVM(:,:,JSV), ZSVM_F(:,:,JSV))
END DO
!
! Initialisation of updraft characteristics
-PTHL_UP(:,:)=ZTHLM_F(:,:)
-PRT_UP(:,:)=ZRTM_F(:,:)
-PU_UP(:,:)=ZUM_F(:,:)
-PV_UP(:,:)=ZVM_F(:,:)
-PSV_UP(:,:,:)=ZSVM_F(:,:,:)
-
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PTHL_UP(IIJB:IIJE,1:IKT)=ZTHLM_F(IIJB:IIJE,1:IKT)
+PRT_UP(IIJB:IIJE,1:IKT)=ZRTM_F(IIJB:IIJE,1:IKT)
+PU_UP(IIJB:IIJE,1:IKT)=ZUM_F(IIJB:IIJE,1:IKT)
+PV_UP(IIJB:IIJE,1:IKT)=ZVM_F(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV)
+PSV_UP(IIJB:IIJE,1:IKT,:)=ZSVM_F(IIJB:IIJE,1:IKT,:)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV)
! Computation or initialisation of updraft characteristics at the KKB level
! thetal_up,rt_up,thetaV_up, w2,Buoyancy term and mass flux (PEMF)
-
-PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PTHL_UP(IIJB:IIJE,IKB)= ZTHLM_F(IIJB:IIJE,IKB)+ &
+ & MAX(0.,MIN(ZTMAX,(PSFTH(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))* PARAMMF%XALP_PERT))
+PRT_UP(IIJB:IIJE,IKB) = ZRTM_F(IIJB:IIJE,IKB)+ &
+ & MAX(0.,MIN(ZRMAX,(PSFRV(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))* PARAMMF%XALP_PERT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
IF (OENTR_DETR) THEN
- ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
- ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
- ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:))
- ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:))
+ CALL MZM_MF(D, PTHM (:,:), ZTHM_F (:,:))
+ CALL MZM_MF(D, PPABSM(:,:), ZPRES_F(:,:))
+ CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F (:,:))
+ CALL MZM_MF(D, PRVM(:,:), ZRVM_F (:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! thetav at mass and flux levels
- ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
- ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+ ZTHVM_F(IIJB:IIJE,1:IKT)=ZTHM_F(IIJB:IIJE,1:IKT)* &
+ &((1.+ZRVORD*ZRVM_F(IIJB:IIJE,1:IKT))/(1.+ZRTM_F(IIJB:IIJE,1:IKT)))
+ ZTHVM(IIJB:IIJE,1:IKT)=PTHM(IIJB:IIJE,1:IKT)* &
+ &((1.+ZRVORD*PRVM(IIJB:IIJE,1:IKT))/(1.+PRTM(IIJB:IIJE,1:IKT)))
- PTHV_UP(:,:)=ZTHVM_F(:,:)
+ PTHV_UP(IIJB:IIJE,1:IKT)=ZTHVM_F(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZW_UP2(:,:)=0.
- ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
-
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZW_UP2(IIJB:IIJE,IKB) = MAX(0.0001,(2./3.)*ZTKEM_F(IIJB:IIJE,IKB))
! Computation of non conservative variable for the KKB level of the updraft
! (all or nothing ajustement)
- PRC_UP(:,KKB)=0.
- PRI_UP(:,KKB)=0.
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
- PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
-
+ PRC_UP(:,IKB)=0.
+ PRI_UP(:,IKB)=0.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,IKB),ZPRES_F(:,IKB), &
+ PTHL_UP(:,IKB),PRT_UP(:,IKB),ZTH_UP(:,IKB), &
+ PRV_UP(:,IKB),PRC_UP(:,IKB),PRI_UP(:,IKB),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., &
+ PBUF=ZBUF(:,:), KB=D%NIJB, KE=D%NIJE)
+
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
! compute updraft thevav and buoyancy term at KKB level
- PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
+ PTHV_UP(IIJB:IIJE,IKB) = ZTH_UP(IIJB:IIJE,IKB)*&
+ & ((1+ZRVORD*PRV_UP(IIJB:IIJE,IKB))/(1+PRT_UP(IIJB:IIJE,IKB)))
! compute mean rsat in updraft
- PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
-
+ PRSAT_UP(IIJB:IIJE,IKB) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,IKB)) + &
+ & ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
! Closure assumption for mass flux at KKB level
!
- ZG_O_THVREF=XG/ZTHVM_F
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZG_O_THVREF(IIJB:IIJE,1:IKT)=CST%XG/ZTHVM_F(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! compute L_up
GLMIX=.TRUE.
- ZTKEM_F(:,KKB)=0.
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZTKEM_F(IIJB:IIJE,IKB)=0.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- IF(CTURBLEN=='RM17') THEN
- ZDUDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PUM,PDZZ))
- ZDVDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PVM,PDZZ))
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+ IF(TURBN%CTURBLEN=='RM17') THEN
+ CALL GZ_M_W_MF(D, PUM, PDZZ, ZWK)
+ CALL MZF_MF(D, ZWK, ZDUDZ)
+ CALL GZ_M_W_MF(D, PVM, PDZZ, ZWK)
+ CALL MZF_MF(D, ZWK, ZDVDZ)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)**2 + ZDVDZ(IIJB:IIJE,1:IKT)**2)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
ZSHEAR = 0. !no shear in bl89 mixing length
END IF
- !
- CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.FALSE.,ZSHEAR,ZLUP)
- ZLUP(:)=MAX(ZLUP(:),1.E-10)
+ !
+#ifdef REPRO48
+ CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,IKB),&
+ &ZG_O_THVREF(:,IKB),ZTHVM,IKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
+#else
+ CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,IKB),&
+ &ZG_O_THVREF(:,IKB),ZTHVM,IKB,GLMIX,.FALSE.,ZSHEAR,ZLUP)
+#endif
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ ZLUP(IIJB:IIJE)=MAX(ZLUP(IIJB:IIJE),1.E-10)
! Compute Buoyancy flux at the ground
- ZWTHVSURF(:) = (ZTHVM_F(:,KKB)/ZTHM_F(:,KKB))*PSFTH(:)+ &
- (0.61*ZTHM_F(:,KKB))*PSFRV(:)
+ ZWTHVSURF(IIJB:IIJE) = (ZTHVM_F(IIJB:IIJE,IKB)/ZTHM_F(IIJB:IIJE,IKB))*PSFTH(IIJB:IIJE)+ &
+ (0.61*ZTHM_F(IIJB:IIJE,IKB))*PSFRV(IIJB:IIJE)
! Mass flux at KKB level (updraft triggered if PSFTH>0.)
- IF (LGZ) THEN
- ZSURF(:)=TANH(XGZ*SQRT(XDXHAT(1)*XDYHAT(1))/ZLUP)
+ IF (PARAMMF%LGZ) THEN
+ IF(PDX==0. .OR. PDY==0.) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'COMPUTE_UPDRAFT', 'PDX or PDY is NULL with option LGZ!')
+ ENDIF
+ ZSURF(IIJB:IIJE)=TANH(PARAMMF%XGZ*SQRT(PDX*PDY)/ZLUP(IIJB:IIJE))
ELSE
- ZSURF(:)=1.
+ ZSURF(IIJB:IIJE)=1.
END IF
- WHERE (ZWTHVSURF(:)>0.)
- PEMF(:,KKB) = XCMF * ZSURF(:) * ZRHO_F(:,KKB) * &
- ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.)
- PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX)
- ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2
- GTEST(:)=.TRUE.
+ WHERE (ZWTHVSURF(IIJB:IIJE)>0.)
+ PEMF(IIJB:IIJE,IKB) = PARAMMF%XCMF * ZSURF(IIJB:IIJE) * ZRHO_F(IIJB:IIJE,IKB) * &
+ ((ZG_O_THVREF(IIJB:IIJE,IKB))*ZWTHVSURF(IIJB:IIJE)*ZLUP(IIJB:IIJE))**(1./3.)
+ PFRAC_UP(IIJB:IIJE,IKB)=MIN(PEMF(IIJB:IIJE,IKB)/(SQRT(ZW_UP2(IIJB:IIJE,IKB))*ZRHO_F(IIJB:IIJE,IKB)), &
+ &PARAMMF%XFRAC_UP_MAX)
+ ZW_UP2(IIJB:IIJE,IKB)=(PEMF(IIJB:IIJE,IKB)/(PFRAC_UP(IIJB:IIJE,IKB)*ZRHO_F(IIJB:IIJE,IKB)))**2
+ GTEST(IIJB:IIJE)=.TRUE.
ELSEWHERE
- PEMF(:,KKB) =0.
- GTEST(:)=.FALSE.
+ PEMF(IIJB:IIJE,IKB) =0.
+ GTEST(IIJB:IIJE)=.FALSE.
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ELSE
- GTEST(:)=PEMF(:,KKB+KKL)>0.
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ GTEST(IIJB:IIJE)=PEMF(IIJB:IIJE,IKB+IKL)>0.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
!--------------------------------------------------------------------------
@@ -425,31 +445,35 @@ GTESTLCL(:)=.FALSE.
GTESTETL(:)=.FALSE.
! Loop on vertical level
-DO JK=KKB,KKE-KKL,KKL
-! IF the updraft top is reached for all column, stop the loop on levels
- ITEST=COUNT(GTEST)
- IF (ITEST==0) CYCLE
+DO JK=IKB,IKE-IKL,IKL
-! Computation of entrainment and detrainment with KF90
-! parameterization in clouds and LR01 in subcloud layer
+ ! IF the updraft top is reached for all column, stop the loop on levels
+ ITEST=COUNT(GTEST(IIJB:IIJE))
+ IF (ITEST==0) CYCLE
+ ! Computation of entrainment and detrainment with KF90
+ ! parameterization in clouds and LR01 in subcloud layer
-! to find the LCL (check if JK is LCL or not)
- WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
- KKLCL(:) = JK
- GTESTLCL(:)=.TRUE.
+ ! to find the LCL (check if JK is LCL or not)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE ((PRC_UP(IIJB:IIJE,JK)+PRI_UP(IIJB:IIJE,JK)>0.).AND.(.NOT.(GTESTLCL(IIJB:IIJE))))
+ KKLCL(IIJB:IIJE) = JK
+ GTESTLCL(IIJB:IIJE)=.TRUE.
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
-! COMPUTE PENTR and PDETR at mass level JK
+ ! COMPUTE PENTR and PDETR at mass level JK
IF (OENTR_DETR) THEN
- IF(JK/=KKB) THEN
- ZRC_MIX(:,JK) = ZRC_MIX(:,JK-KKL) ! guess of Rc of mixture
- ZRI_MIX(:,JK) = ZRI_MIX(:,JK-KKL) ! guess of Ri of mixture
+ IF(JK/=IKB) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZRC_MIX(IIJB:IIJE,JK) = ZRC_MIX(IIJB:IIJE,JK-IKL) ! guess of Rc of mixture
+ ZRI_MIX(IIJB:IIJE,JK) = ZRI_MIX(IIJB:IIJE,JK-IKL) ! guess of Ri of mixture
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDIF
- CALL COMPUTE_ENTR_DETR(JK,KKB,KKE,KKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
- PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+KKL),&
+ CALL COMPUTE_ENTR_DETR(D, CST, NEB, PARAMMF, JK,IKB,IKE,IKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
+ PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+IKL),&
PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), &
PTHLM(:,:),PRTM(:,:),ZW_UP2(:,:),ZTH_UP(:,JK), &
PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), &
@@ -458,190 +482,643 @@ DO JK=KKB,KKE-KKL,KKL
PENTR(:,JK),PDETR(:,JK),ZENTR_CLD(:,JK),ZDETR_CLD(:,JK),&
ZBUO_INTEG_DRY(:,JK), ZBUO_INTEG_CLD(:,JK), &
ZPART_DRY(:) )
- PBUO_INTEG(:,JK)=ZBUO_INTEG_DRY(:,JK)+ZBUO_INTEG_CLD(:,JK)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ PBUO_INTEG(IIJB:IIJE,JK)=ZBUO_INTEG_DRY(IIJB:IIJE,JK)+ZBUO_INTEG_CLD(IIJB:IIJE,JK)
- IF (JK==KKB) THEN
- PDETR(:,JK)=0.
- ZDETR_CLD(:,JK)=0.
+ IF (JK==IKB) THEN
+ PDETR(IIJB:IIJE,JK)=0.
+ ZDETR_CLD(IIJB:IIJE,JK)=0.
ENDIF
-! Computation of updraft characteristics at level JK+KKL
- WHERE(GTEST)
- ZMIX1(:)=0.5*(PZZ(:,JK+KKL)-PZZ(:,JK))*(PENTR(:,JK)-PDETR(:,JK))
- PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(2*ZMIX1(:))
+ ! Computation of updraft characteristics at level JK+KKL
+ WHERE(GTEST(IIJB:IIJE))
+ ZMIX1(IIJB:IIJE)=0.5*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ &(PENTR(IIJB:IIJE,JK)-PDETR(IIJB:IIJE,JK))
+ PEMF(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK)*EXP(2*ZMIX1(IIJB:IIJE))
ENDWHERE
- ELSE
- GTEST(:) = (PEMF(:,JK+KKL)>0.)
- END IF
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+ ELSE !OENTR_DETR
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ GTEST(IIJB:IIJE) = (PEMF(IIJB:IIJE,JK+IKL)>0.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END IF !OENTR_DETR
-
-! stop the updraft if MF becomes negative
- WHERE (GTEST.AND.(PEMF(:,JK+KKL)<=0.))
- PEMF(:,JK+KKL)=0.
- KKCTL(:) = JK+KKL
- GTEST(:)=.FALSE.
- PFRAC_ICE_UP(:,JK+KKL)=PFRAC_ICE_UP(:,JK)
- PRSAT_UP(:,JK+KKL)=PRSAT_UP(:,JK)
+ ! stop the updraft if MF becomes negative
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (GTEST(IIJB:IIJE).AND.(PEMF(IIJB:IIJE,JK+IKL)<=0.))
+ PEMF(IIJB:IIJE,JK+IKL)=0.
+ KKCTL(IIJB:IIJE) = JK+IKL
+ GTEST(IIJB:IIJE)=.FALSE.
+ PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)=PFRAC_ICE_UP(IIJB:IIJE,JK)
+ PRSAT_UP(IIJB:IIJE,JK+IKL)=PRSAT_UP(IIJB:IIJE,JK)
ENDWHERE
-
-
-! If the updraft did not stop, compute cons updraft characteritics at jk+KKL
-! WHERE(GTEST)
- DO JLOOP=1,SIZE(GTEST)
- IF (GTEST(JLOOP) ) THEN
- ZMIX2(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*PENTR(JLOOP,JK) !&
- ZMIX3_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZDETR_CLD(JLOOP,JK) !&
- ZMIX2_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZENTR_CLD(JLOOP,JK)
-
- !PTHL_UP(JLOOP,JK+KKL)=(PTHL_UP(JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*ZMIX2(JLOOP)) &
- ! /(1.+0.5*ZMIX2(JLOOP))
- !PRT_UP(JLOOP,JK+KKL) =(PRT_UP (JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*ZMIX2(JLOOP)) &
- ! /(1.+0.5*ZMIX2(JLOOP))
-
- PTHL_UP(JLOOP,JK+KKL)=PTHL_UP(JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
- PRT_UP(JLOOP,JK+KKL) =PRT_UP (JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
-
- END IF
- END DO
-! ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+
+ ! If the updraft did not stop, compute cons updraft characteritics at jk+KKL
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ ZMIX2(JIJ) = (PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*PENTR(JIJ,JK) !&
+ ZMIX3_CLD(JIJ) = (PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*(1.-ZPART_DRY(JIJ))*ZDETR_CLD(JIJ,JK) !&
+ ZMIX2_CLD(JIJ) = (PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*(1.-ZPART_DRY(JIJ))*ZENTR_CLD(JIJ,JK)
+#ifdef REPRO48
+ PTHL_UP(JIJ,JK+IKL)=(PTHL_UP(JIJ,JK)*(1.-0.5*ZMIX2(JIJ)) + PTHLM(JIJ,JK)*ZMIX2(JIJ)) &
+ /(1.+0.5*ZMIX2(JIJ))
+ PRT_UP(JIJ,JK+IKL) =(PRT_UP (JIJ,JK)*(1.-0.5*ZMIX2(JIJ)) + PRTM(JIJ,JK)*ZMIX2(JIJ)) &
+ /(1.+0.5*ZMIX2(JIJ))
+#else
+ PTHL_UP(JIJ,JK+IKL)=PTHL_UP(JIJ,JK)*EXP(-ZMIX2(JIJ)) + PTHLM(JIJ,JK)*(1-EXP(-ZMIX2(JIJ)))
+ PRT_UP(JIJ,JK+IKL) =PRT_UP (JIJ,JK)*EXP(-ZMIX2(JIJ)) + PRTM(JIJ,JK)*(1-EXP(-ZMIX2(JIJ)))
+#endif
+ ENDIF
+ ENDDO
-
- IF(OMIXUV) THEN
- IF(JK/=KKB) THEN
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
- (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
- (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
+ IF(PARAMMF%LMIXUV) THEN
+ IF(JK/=IKB) THEN
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(GTEST(IIJB:IIJE))
+ PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ ((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+&
+ (PUM(IIJB:IIJE,JK)-PUM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) &
+ /(1+0.5*ZMIX2(IIJB:IIJE))
+ PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ ((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+&
+ (PVM(IIJB:IIJE,JK)-PVM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) &
+ /(1+0.5*ZMIX2(IIJB:IIJE))
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ELSE
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(GTEST(IIJB:IIJE))
+ PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ ((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) &
+ /(1+0.5*ZMIX2(IIJB:IIJE))
+ PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ ((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) &
+ /(1+0.5*ZMIX2(IIJB:IIJE))
ENDWHERE
-
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ENDIF
- ENDIF
- DO JSV=1,ISV
- IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
- WHERE(GTEST)
- PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
- PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
- ENDWHERE
+ ENDIF !PARAMMF%LMIXUV
+ DO JSV=1,KSV
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(GTEST(IIJB:IIJE))
+ PSV_UP(IIJB:IIJE,JK+IKL,JSV) = (PSV_UP(IIJB:IIJE,JK,JSV)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ PSVM(IIJB:IIJE,JK,JSV)*ZMIX2(IIJB:IIJE)) /(1+0.5*ZMIX2(IIJB:IIJE))
+ ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
- IF (OENTR_DETR) THEN
-
-! Compute non cons. var. at level JK+KKL
- ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
- ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
- PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
- WHERE(GTEST)
- PRC_UP(:,JK+KKL)=ZRC_UP(:)
- PRV_UP(:,JK+KKL)=ZRV_UP(:)
- PRI_UP(:,JK+KKL)=ZRI_UP(:)
- PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
- ENDWHERE
-
+ IF (OENTR_DETR) THEN
-! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
- WHERE(GTEST)
- PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
- WHERE (ZBUO_INTEG_DRY(:,JK)>0.)
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*(XABUO-XBENTR*XENTR_DRY)* ZBUO_INTEG_DRY(:,JK)
- ELSEWHERE
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK) + 2.*XABUO* ZBUO_INTEG_DRY(:,JK)
+ ! Compute non cons. var. at level JK+KKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZRC_UP(IIJB:IIJE)=PRC_UP(IIJB:IIJE,JK) ! guess = level just below
+ ZRI_UP(IIJB:IIJE)=PRI_UP(IIJB:IIJE,JK) ! guess = level just below
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+IKL),ZPRES_F(:,JK+IKL), &
+ PTHL_UP(:,JK+IKL),PRT_UP(:,JK+IKL),ZTH_UP(:,JK+IKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., &
+ PBUF=ZBUF(:,:), KB=D%NIJB, KE=D%NIJE)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(GTEST(IIJB:IIJE))
+ PRC_UP(IIJB:IIJE,JK+IKL)=ZRC_UP(IIJB:IIJE)
+ PRV_UP(IIJB:IIJE,JK+IKL)=ZRV_UP(IIJB:IIJE)
+ PRI_UP(IIJB:IIJE,JK+IKL)=ZRI_UP(IIJB:IIJE)
+ PRSAT_UP(IIJB:IIJE,JK+IKL) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)) + &
+ & ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)
ENDWHERE
- ZW_UP2(:,JK+KKL) = ZW_UP2(:,JK+KKL)*(1.-(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))&
- /(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:))) &
- +2.*(XABUO)*ZBUO_INTEG_CLD(:,JK)/(1.+(XBDETR*ZMIX3_CLD(:)+XBENTR*ZMIX2_CLD(:)))
- ENDWHERE
+ ! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
+ WHERE(GTEST(IIJB:IIJE))
+ PTHV_UP(IIJB:IIJE,JK+IKL) = ZTH_UP(IIJB:IIJE,JK+IKL)* &
+ & ((1+ZRVORD*PRV_UP(IIJB:IIJE,JK+IKL))/(1+PRT_UP(IIJB:IIJE,JK+IKL)))
+ WHERE (ZBUO_INTEG_DRY(IIJB:IIJE,JK)>0.)
+ ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK) + 2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)* &
+ &ZBUO_INTEG_DRY(IIJB:IIJE,JK)
+ ELSEWHERE
+ ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(IIJB:IIJE,JK)
+ ENDWHERE
+ ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK+IKL)*(1.-(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+ &
+ &PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE)))&
+ /(1.+(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE))) &
+ +2.*(PARAMMF%XABUO)*ZBUO_INTEG_CLD(IIJB:IIJE,JK)/ &
+ &(1.+(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE)))
+ ENDWHERE
-! Test if the updraft has reach the ETL
- GTESTETL(:)=.FALSE.
- WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
- KKETL(:) = JK+KKL
- GTESTETL(:)=.TRUE.
- ENDWHERE
+ ! Test if the updraft has reach the ETL
+ WHERE (GTEST(IIJB:IIJE).AND.(PBUO_INTEG(IIJB:IIJE,JK)<=0.))
+ KKETL(IIJB:IIJE) = JK+IKL
+ GTESTETL(IIJB:IIJE)=.TRUE.
+ ELSEWHERE
+ GTESTETL(IIJB:IIJE)=.FALSE.
+ ENDWHERE
-! Test is we have reached the top of the updraft
- WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=0.).OR.(PEMF(:,JK+KKL)<=0.)))
- ZW_UP2(:,JK+KKL)=0.
- PEMF(:,JK+KKL)=0.
- GTEST(:)=.FALSE.
- PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL)
- PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL)
- PRC_UP(:,JK+KKL)=0.
- PRI_UP(:,JK+KKL)=0.
- PRV_UP(:,JK+KKL)=0.
- PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL)
- PFRAC_UP(:,JK+KKL)=0.
- KKCTL(:)=JK+KKL
- ENDWHERE
+ ! Test is we have reached the top of the updraft
+ WHERE (GTEST(IIJB:IIJE).AND.((ZW_UP2(IIJB:IIJE,JK+IKL)<=0.).OR.(PEMF(IIJB:IIJE,JK+IKL)<=0.)))
+ ZW_UP2(IIJB:IIJE,JK+IKL)=0.
+ PEMF(IIJB:IIJE,JK+IKL)=0.
+ GTEST(IIJB:IIJE)=.FALSE.
+ PTHL_UP(IIJB:IIJE,JK+IKL)=ZTHLM_F(IIJB:IIJE,JK+IKL)
+ PRT_UP(IIJB:IIJE,JK+IKL)=ZRTM_F(IIJB:IIJE,JK+IKL)
+ PRC_UP(IIJB:IIJE,JK+IKL)=0.
+ PRI_UP(IIJB:IIJE,JK+IKL)=0.
+ PRV_UP(IIJB:IIJE,JK+IKL)=0.
+ PTHV_UP(IIJB:IIJE,JK+IKL)=ZTHVM_F(IIJB:IIJE,JK+IKL)
+ PFRAC_UP(IIJB:IIJE,JK+IKL)=0.
+ KKCTL(IIJB:IIJE)=JK+IKL
+ ENDWHERE
-! compute frac_up at JK+KKL
- WHERE (GTEST)
- PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
- ENDWHERE
-
-! Updraft fraction must be smaller than XFRAC_UP_MAX
- WHERE (GTEST)
- PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
- ENDWHERE
-
+ ! compute frac_up at JK+KKL
+ WHERE (GTEST(IIJB:IIJE))
+ PFRAC_UP(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK+IKL)/&
+ &(SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))*ZRHO_F(IIJB:IIJE,JK+IKL))
+ ENDWHERE
-! When cloudy and non-buoyant, updraft fraction must decrease
-
- WHERE ((GTEST.AND.GTESTETL).AND.GTESTLCL)
- PFRAC_UP(:,JK+KKL)=MIN(PFRAC_UP(:,JK+KKL),PFRAC_UP(:,JK))
- ENDWHERE
+ ! Updraft fraction must be smaller than XFRAC_UP_MAX
+ WHERE (GTEST(IIJB:IIJE))
+ PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(IIJB:IIJE,JK+IKL))
+ ENDWHERE
-! Mass flux is updated with the new updraft fraction
-
- IF (OENTR_DETR) PEMF(:,JK+KKL)=PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL)
+ ! When cloudy and non-buoyant, updraft fraction must decrease
+ WHERE ((GTEST(IIJB:IIJE).AND.GTESTETL(IIJB:IIJE)).AND.GTESTLCL(IIJB:IIJE))
+ PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PFRAC_UP(IIJB:IIJE,JK+IKL),PFRAC_UP(IIJB:IIJE,JK))
+ ENDWHERE
- END IF
+ ! Mass flux is updated with the new updraft fraction
+ IF (OENTR_DETR) PEMF(IIJB:IIJE,JK+IKL)=PFRAC_UP(IIJB:IIJE,JK+IKL)*SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))* &
+ &ZRHO_F(IIJB:IIJE,JK+IKL)
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+ END IF !OENTR_DETR
ENDDO
IF(OENTR_DETR) THEN
- PW_UP(:,:)=SQRT(ZW_UP2(:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PW_UP(IIJB:IIJE,1:IKT)=SQRT(ZW_UP2(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PEMF(:,KKB) =0.
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PEMF(IIJB:IIJE,IKB) =0.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
-! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
-! To do this, mass flux is multiplied by a coefficient decreasing linearly
-! from 1 (for clouds of ZDEPTH_MAX1 m of depth) to 0 (for clouds of ZDEPTH_MAX2 m of depth).
-! This way, all MF fluxes are diminished by this amount.
-! Diagnosed cloud fraction is also multiplied by the same coefficient.
-!
- DO JI=1,SIZE(PTHM,1)
- PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
+ ! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
+ ! To do this, mass flux is multiplied by a coefficient decreasing linearly
+ ! from 1 (for clouds of ZDEPTH_MAX1 m of depth) to 0 (for clouds of ZDEPTH_MAX2 m of depth).
+ ! This way, all MF fluxes are diminished by this amount.
+ ! Diagnosed cloud fraction is also multiplied by the same coefficient.
+ !
+ DO JIJ=IIJB,IIJE
+ PDEPTH(JIJ) = MAX(0., PZZ(JIJ,KKCTL(JIJ)) - PZZ(JIJ,KKLCL(JIJ)) )
END DO
- GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
- GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=MAX(KKU,KKA) )
- ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=SIZE(ZCOEF,2))
- ZCOEF=MIN(MAX(ZCOEF,0.),1.)
- WHERE (GWORK2)
- PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
- PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ GWORK1(IIJB:IIJE)= (GTESTLCL(IIJB:IIJE) .AND. (PDEPTH(IIJB:IIJE) > ZDEPTH_MAX1) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ DO JK=1,IKT
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ GWORK2(IIJB:IIJE,JK) = GWORK1(IIJB:IIJE)
+ ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ZCOEF(IIJB:IIJE,JK)=MIN(MAX(ZCOEF(IIJB:IIJE,JK),0.),1.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ ENDDO
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE (GWORK2(IIJB:IIJE,1:IKT))
+ PEMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT) * ZCOEF(IIJB:IIJE,1:IKT)
+ PFRAC_UP(IIJB:IIJE,1:IKT) = PFRAC_UP(IIJB:IIJE,1:IKT) * ZCOEF(IIJB:IIJE,1:IKT)
ENDWHERE
-ENDIF
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ENDIF
+
+IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',1,ZHOOK_HANDLE)
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
+ SUBROUTINE COMPUTE_ENTR_DETR(D, CST, NEB, PARAMMF,&
+ KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
+ HFRAC_ICE,PFRAC_ICE,PRHODREF,&
+ PPRE_MINUS_HALF,&
+ PPRE_PLUS_HALF,PZZ,PDZZ,&
+ PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,&
+ PTHL_UP,PRT_UP,PLUP,&
+ PRC_UP,PRI_UP,PTHV_UP,&
+ PRSAT_UP,PRC_MIX,PRI_MIX, &
+ PENTR,PDETR,PENTR_CLD,PDETR_CLD,&
+ PBUO_INTEG_DRY,PBUO_INTEG_CLD,&
+ PPART_DRY)
+! #############################################################
+
+!!
+!!***COMPUTE_ENTR_DETR* - calculates caracteristics of the updraft or downdraft
+!! using model of the EDMF scheme
+!!
+!! PURPOSE
+!! -------
+!!**** The purpose of this routine is to compute entrainement and
+!! detrainement at one level of the updraft
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of Meso-NH documentation (chapter Convection)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.Pergaud : 2009
+!!
+!! MODIFICATIONS
+!! -------------
+!! Y.Seity (06/2010) Bug correction
+!! V.Masson (09/2010) Optimization
+!! S. Riette april 2011 : ice added, protection against zero divide by Yves Bouteloup
+!! protection against too big ZPART_DRY, interface modified
+!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette & J. Escobar (11/2013) : remove div by 0 on real*4 case
+!! P.Marguinaud Jun 2012: fix uninitialized variable
+!! P.Marguinaud Nov 2012: fix gfortran bug
+!! S. Riette Apr 2013: bugs correction, rewriting (for optimisation) and
+!! improvement of continuity at the condensation level
+!! S. Riette Nov 2013: protection against zero divide for min value of dry PDETR
+!! R.Honnert Oct 2016 : Update with AROME
+! P. Wautelet 08/02/2019: bugfix: compute ZEPSI_CLOUD only once and only when it is needed
+!! R. El Khatib 29-Apr-2019 portability fix : compiler may get confused by embricked WHERE statements
+!! eventually breaking tests with NaN initializations at compile time.
+!! Replace by IF conditions and traditional DO loops can only improve the performance.
+! P. Wautelet 10/02/2021: bugfix: initialized PPART_DRY everywhere
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+!
+IMPLICIT NONE
+!
+!
+!* 1.1 Declaration of Arguments
+!
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+!
+INTEGER, INTENT(IN) :: KK
+INTEGER, INTENT(IN) :: KKB ! near ground physical index
+INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
+INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL,DIMENSION(D%NIJT), INTENT(IN) :: OTEST ! test to see if updraft is running
+LOGICAL,DIMENSION(D%NIJT), INTENT(IN) :: OTESTLCL !test of condensation
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! frac_ice can be compute using
+ ! Temperature (T) or prescribed
+ ! (Y)
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PFRAC_ICE ! fraction of ice
+!
+! prognostic variables at t- deltat
+!
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PRHODREF !rhodref
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PPRE_MINUS_HALF ! Pressure at flux level KK
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PPRE_PLUS_HALF ! Pressure at flux level KK+KKL
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! metrics coefficient
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVM ! ThetaV environment
+
+!
+! thermodynamical variables which are transformed in conservative var.
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM ! Thetal
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRTM ! total mixing ratio
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PW_UP2 ! Vertical velocity^2
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PTH_UP,PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PLUP ! LUP compute from the ground
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PRC_UP,PRI_UP ! Updraft cloud content
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PTHV_UP ! Thetav of updraft
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PRSAT_UP ! Mixing ratio at saturation in updraft
+REAL, DIMENSION(D%NIJT), INTENT(INOUT) :: PRC_MIX, PRI_MIX ! Mixture cloud content
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PENTR ! Mass flux entrainment of the updraft
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PDETR ! Mass flux detrainment of the updraft
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PENTR_CLD ! Mass flux entrainment of the updraft in cloudy part
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PDETR_CLD ! Mass flux detrainment of the updraft in cloudy part
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PBUO_INTEG_DRY, PBUO_INTEG_CLD! Integral Buoyancy
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PPART_DRY ! ratio of dry part at the transition level
+!
+!
+! 1.2 Declaration of local variables
+!
+! Local array declaration must be put in the compute_updraft subroutine
+! For simplicity all local variables (including scalars) are moved in the compute_updraft subroutine
+!
+
+!----------------------------------------------------------------------------------
+
+! 1.3 Initialisation
+! ------------------
+
+ZCOEFFMF_CLOUD=PARAMMF%XENTR_MF * CST%XG / PARAMMF%XCRAD_MF
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZG_O_THVREF_ED(IIJB:IIJE)=CST%XG/PTHVM(IIJB:IIJE,KK)
+
+ZFRAC_ICE(IIJB:IIJE)=PFRAC_ICE(IIJB:IIJE) ! to not modify fraction of ice
+
+ZPRE(IIJB:IIJE)=PPRE_MINUS_HALF(IIJB:IIJE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+
+! 1.4 Estimation of PPART_DRY
+DO JIJ=IIJB,IIJE
+ IF(OTEST(JIJ) .AND. OTESTLCL(JIJ)) THEN
+ !No dry part when condensation level is reached
+ PPART_DRY(JIJ)=0.
+ ZDZ_STOP(JIJ)=0.
+ ZPRE(JIJ)=PPRE_MINUS_HALF(JIJ)
+ ELSE IF (OTEST(JIJ) .AND. .NOT. OTESTLCL(JIJ)) THEN
+ !Temperature at flux level KK
+ ZT=PTH_UP(JIJ)*(PPRE_MINUS_HALF(JIJ)/CST%XP00) ** (CST%XRD/CST%XCPD)
+ !Saturating vapor pressure at flux level KK
+ ZFOESW = MIN(EXP( CST%XALPW - CST%XBETAW/ZT - CST%XGAMW*LOG(ZT) ), 0.99*PPRE_MINUS_HALF(JIJ))
+ ZFOESI = MIN(EXP( CST%XALPI - CST%XBETAI/ZT - CST%XGAMI*LOG(ZT) ), 0.99*PPRE_MINUS_HALF(JIJ))
+ !Computation of d.Rsat / dP (partial derivations with respect to P and T
+ !and use of T=Theta*(P/P0)**(R/Cp) to transform dT into dP with theta_up
+ !constant at the vertical)
+ ZDRSATODP=(CST%XBETAW/ZT-CST%XGAMW)*(1-ZFRAC_ICE(JIJ))+(CST%XBETAI/ZT-CST%XGAMI)*ZFRAC_ICE(JIJ)
+ ZDRSATODP=((CST%XRD/CST%XCPD)*ZDRSATODP-1.)*PRSAT_UP(JIJ)/ &
+ &(PPRE_MINUS_HALF(JIJ)-(ZFOESW*(1-ZFRAC_ICE(JIJ)) + ZFOESI*ZFRAC_ICE(JIJ)))
+ !Use of d.Rsat / dP and pressure at flux level KK to find pressure (ZPRE)
+ !where Rsat is equal to PRT_UP
+ ZPRE(JIJ)=PPRE_MINUS_HALF(JIJ)+(PRT_UP(JIJ)-PRSAT_UP(JIJ))/ZDRSATODP
+ !Fraction of dry part (computed with pressure and used with heights, no
+ !impact found when using log function here and for pressure on flux levels
+ !computation)
+ PPART_DRY(JIJ)=MAX(0., MIN(1., (PPRE_MINUS_HALF(JIJ)-ZPRE(JIJ))/(PPRE_MINUS_HALF(JIJ)-PPRE_PLUS_HALF(JIJ))))
+ !Height above flux level KK of the cloudy part
+ ZDZ_STOP(JIJ) = (PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))*PPART_DRY(JIJ)
+ ELSE
+ PPART_DRY(JIJ)=0. ! value does not matter, here
+ END IF
+END DO
+
+! 1.5 Gradient and flux values of thetav
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+IF(KK/=KKB)THEN
+ ZCOEFF_MINUS_HALF(IIJB:IIJE)=((PTHVM(IIJB:IIJE,KK)-PTHVM(IIJB:IIJE,KK-KKL))/PDZZ(IIJB:IIJE,KK))
+ ZTHV_MINUS_HALF(IIJB:IIJE) = PTHVM(IIJB:IIJE,KK) - &
+ & ZCOEFF_MINUS_HALF(IIJB:IIJE)*0.5*(PZZ(IIJB:IIJE,KK+KKL)-PZZ(IIJB:IIJE,KK))
+ELSE
+ ZCOEFF_MINUS_HALF(IIJB:IIJE)=0.
+ ZTHV_MINUS_HALF(IIJB:IIJE) = PTHVM(IIJB:IIJE,KK)
+ENDIF
+ZCOEFF_PLUS_HALF(IIJB:IIJE) = ((PTHVM(IIJB:IIJE,KK+KKL)-PTHVM(IIJB:IIJE,KK))/PDZZ(IIJB:IIJE,KK+KKL))
+ZTHV_PLUS_HALF(IIJB:IIJE) = PTHVM(IIJB:IIJE,KK) + &
+ & ZCOEFF_PLUS_HALF(IIJB:IIJE)*0.5*(PZZ(IIJB:IIJE,KK+KKL)-PZZ(IIJB:IIJE,KK))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+
+! 2 Dry part computation:
+! Integral buoyancy and computation of PENTR and PDETR for dry part
+! --------------------------------------------------------------------
+
+DO JIJ=IIJB,IIJE
+ IF (OTEST(JIJ) .AND. PPART_DRY(JIJ)>0.) THEN
+ !Buoyancy computation in two parts to use change of gradient of theta v of environment
+ !Between flux level KK and min(mass level, bottom of cloudy part)
+ ZDZ=MIN(ZDZ_STOP(JIJ),(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))*0.5)
+ PBUO_INTEG_DRY(JIJ) = ZG_O_THVREF_ED(JIJ)*ZDZ*&
+ (0.5 * ( - ZCOEFF_MINUS_HALF(JIJ))*ZDZ &
+ - ZTHV_MINUS_HALF(JIJ) + PTHV_UP(JIJ) )
+
+ !Between mass flux KK and bottom of cloudy part (if above mass flux)
+ ZDZ=MAX(0., ZDZ_STOP(JIJ)-(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))*0.5)
+ PBUO_INTEG_DRY(JIJ) = PBUO_INTEG_DRY(JIJ) + ZG_O_THVREF_ED(JIJ)*ZDZ*&
+ (0.5 * ( - ZCOEFF_PLUS_HALF(JIJ))*ZDZ &
+ - PTHVM(JIJ,KK) + PTHV_UP(JIJ) )
+
+ !Entr//Detr. computation
+ IF (PBUO_INTEG_DRY(JIJ)>=0.) THEN
+ PENTR(JIJ) = 0.5/(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)*&
+ LOG(1.+ (2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)/PW_UP2(JIJ,KK))* &
+ PBUO_INTEG_DRY(JIJ))
+ PDETR(JIJ) = 0.
+ ELSE
+ PENTR(JIJ) = 0.
+ PDETR(JIJ) = 0.5/(PARAMMF%XABUO)*&
+ LOG(1.+ (2.*(PARAMMF%XABUO)/PW_UP2(JIJ,KK))* &
+ (-PBUO_INTEG_DRY(JIJ)))
+ ENDIF
+ PENTR(JIJ) = PARAMMF%XENTR_DRY*PENTR(JIJ)/(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))
+ PDETR(JIJ) = PARAMMF%XDETR_DRY*PDETR(JIJ)/(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))
+ !Minimum value of detrainment
+ ZWK0D=PLUP(JIJ)-0.5*(PZZ(JIJ,KK)+PZZ(JIJ,KK+KKL))
+ ZWK0D=SIGN(MAX(1., ABS(ZWK0D)), ZWK0D) ! ZWK0D must not be zero
+ PDETR(JIJ) = MAX(PPART_DRY(JIJ)*PARAMMF%XDETR_LUP/ZWK0D, PDETR(JIJ))
+ ELSE
+ !No dry part, condensation reached (OTESTLCL)
+ PBUO_INTEG_DRY(JIJ) = 0.
+ PENTR(JIJ)=0.
+ PDETR(JIJ)=0.
+ ENDIF
+ENDDO
+
+! 3 Wet part computation
+! -----------------------
+
+! 3.1 Integral buoyancy for cloudy part
+
+! Compute theta_v of updraft at flux level KK+KKL
+!MIX variables are used to avoid declaring new variables
+!but we are dealing with updraft and not mixture
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZRCMIX(IIJB:IIJE)=PRC_UP(IIJB:IIJE)
+ZRIMIX(IIJB:IIJE)=PRI_UP(IIJB:IIJE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,&
+ PPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
+ ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
+ ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZTHV_UP_F2(IIJB:IIJE) = ZTHMIX(IIJB:IIJE)*(1.+ZRVORD*ZRVMIX(IIJB:IIJE))/(1.+PRT_UP(IIJB:IIJE))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+
+! Integral buoyancy for cloudy part
+DO JIJ=IIJB,IIJE
+ IF(OTEST(JIJ) .AND. PPART_DRY(JIJ)<1.) THEN
+ !Gradient of Theta V updraft over the cloudy part, assuming that thetaV updraft don't change
+ !between flux level KK and bottom of cloudy part
+ ZCOTHVU=(ZTHV_UP_F2(JIJ)-PTHV_UP(JIJ))/((PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))*(1-PPART_DRY(JIJ)))
+
+ !Computation in two parts to use change of gradient of theta v of environment
+ !Between bottom of cloudy part (if under mass level) and mass level KK
+ ZDZ=MAX(0., 0.5*(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))-ZDZ_STOP(JIJ))
+ PBUO_INTEG_CLD(JIJ) = ZG_O_THVREF_ED(JIJ)*ZDZ*&
+ (0.5*( ZCOTHVU - ZCOEFF_MINUS_HALF(JIJ))*ZDZ &
+ - (PTHVM(JIJ,KK)-ZDZ*ZCOEFF_MINUS_HALF(JIJ)) + PTHV_UP(JIJ) )
+
+ !Between max(mass level, bottom of cloudy part) and flux level KK+KKL
+ ZDZ=(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))-MAX(ZDZ_STOP(JIJ),0.5*(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK)))
+ PBUO_INTEG_CLD(JIJ) = PBUO_INTEG_CLD(JIJ)+ZG_O_THVREF_ED(JIJ)*ZDZ*&
+ (0.5*( ZCOTHVU - ZCOEFF_PLUS_HALF(JIJ))*ZDZ&
+ - (PTHVM(JIJ,KK)+(0.5*((PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK)))-ZDZ)*ZCOEFF_PLUS_HALF(JIJ)) +&
+ PTHV_UP(JIJ) )
+
+ ELSE
+ !No cloudy part
+ PBUO_INTEG_CLD(JIJ)=0.
+ END IF
+END DO
+
+! 3.2 Critical mixed fraction for KK+KKL flux level (ZKIC_F2) and
+! for bottom of cloudy part (ZKIC), then a mean for the cloudy part
+! (put also in ZKIC)
+!
+! computation by estimating unknown
+! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
+! We determine the zero crossing of the linear curve
+! evaluating the derivative using ZMIXF=0.1
+
+ZKIC_INIT=0.1 ! starting value for critical mixed fraction for CLoudy Part
+
+! Compute thetaV of environment at the bottom of cloudy part
+! and cons then non cons. var. of mixture at the bottom of cloudy part
+
+! JKLIM computed to avoid KKL(KK-KKL) being < KKL*KKB
+JKLIM=KKL*MAX(KKL*(KK-KKL),KKL*KKB)
+DO JIJ=IIJB,IIJE
+ IF(OTEST(JIJ) .AND. PPART_DRY(JIJ)>0.5) THEN
+ ZDZ=ZDZ_STOP(JIJ)-0.5*(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))
+ ZTHV(JIJ)= PTHVM(JIJ,KK)+ZCOEFF_PLUS_HALF(JIJ)*ZDZ
+ ZMIXTHL(JIJ) = ZKIC_INIT * &
+ (PTHLM(JIJ,KK)+ZDZ*(PTHLM(JIJ,KK+KKL)-PTHLM(JIJ,KK))/PDZZ(JIJ,KK+KKL)) + &
+ (1. - ZKIC_INIT)*PTHL_UP(JIJ)
+ ZMIXRT(JIJ) = ZKIC_INIT * &
+ (PRTM(JIJ,KK)+ZDZ*(PRTM(JIJ,KK+KKL)-PRTM(JIJ,KK))/PDZZ(JIJ,KK+KKL)) + &
+ (1. - ZKIC_INIT)*PRT_UP(JIJ)
+ ELSEIF(OTEST(JIJ)) THEN
+ ZDZ=0.5*(PZZ(JIJ,KK+KKL)-PZZ(JIJ,KK))-ZDZ_STOP(JIJ)
+ ZTHV(JIJ)= PTHVM(JIJ,KK)-ZCOEFF_MINUS_HALF(JIJ)*ZDZ
+ ZMIXTHL(JIJ) = ZKIC_INIT * &
+ (PTHLM(JIJ,KK)-ZDZ*(PTHLM(JIJ,KK)-PTHLM(JIJ,JKLIM))/PDZZ(JIJ,KK)) + &
+ (1. - ZKIC_INIT)*PTHL_UP(JIJ)
+ ZMIXRT(JIJ) = ZKIC_INIT * &
+ (PRTM(JIJ,KK)-ZDZ*(PRTM(JIJ,KK)-PRTM(JIJ,JKLIM))/PDZZ(JIJ,KK)) + &
+ (1. - ZKIC_INIT)*PRT_UP(JIJ)
+ ELSE
+#ifdef REPRO55
+ ZMIXTHL(JIJ) = 0.1
+#else
+ ZMIXTHL(JIJ) = 300.
+#endif
+ ZMIXRT(JIJ) = 0.1
+ ENDIF
+ENDDO
+CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,&
+ ZPRE,ZMIXTHL,ZMIXRT,&
+ ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
+ ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZTHVMIX(IIJB:IIJE) = ZTHMIX(IIJB:IIJE)*(1.+ZRVORD*ZRVMIX(IIJB:IIJE))/(1.+ZMIXRT(IIJB:IIJE))
+
+! Compute cons then non cons. var. of mixture at the flux level KK+KKL with initial ZKIC
+ZMIXTHL(IIJB:IIJE) = ZKIC_INIT * 0.5*(PTHLM(IIJB:IIJE,KK)+PTHLM(IIJB:IIJE,KK+KKL))+&
+ & (1. - ZKIC_INIT)*PTHL_UP(IIJB:IIJE)
+ZMIXRT(IIJB:IIJE) = ZKIC_INIT * 0.5*(PRTM(IIJB:IIJE,KK)+PRTM(IIJB:IIJE,KK+KKL))+&
+ & (1. - ZKIC_INIT)*PRT_UP(IIJB:IIJE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,&
+ PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
+ ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
+ ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZTHVMIX_F2(IIJB:IIJE) = ZTHMIX(IIJB:IIJE)*(1.+ZRVORD*ZRVMIX(IIJB:IIJE))/(1.+ZMIXRT(IIJB:IIJE))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+
+!Computation of mean ZKIC over the cloudy part
+DO JIJ=IIJB,IIJE
+ IF (OTEST(JIJ)) THEN
+ ! Compute ZKIC at the bottom of cloudy part
+ ! Thetav_up at bottom is equal to Thetav_up at flux level KK
+ IF (ABS(PTHV_UP(JIJ)-ZTHVMIX(JIJ))<1.E-10) THEN
+ ZKIC(JIJ)=1.
+ ELSE
+ ZKIC(JIJ) = MAX(0.,PTHV_UP(JIJ)-ZTHV(JIJ))*ZKIC_INIT / &
+ (PTHV_UP(JIJ)-ZTHVMIX(JIJ))
+ END IF
+ ! Compute ZKIC_F2 at flux level KK+KKL
+ IF (ABS(ZTHV_UP_F2(JIJ)-ZTHVMIX_F2(JIJ))<1.E-10) THEN
+ ZKIC_F2(JIJ)=1.
+ ELSE
+ ZKIC_F2(JIJ) = MAX(0.,ZTHV_UP_F2(JIJ)-ZTHV_PLUS_HALF(JIJ))*ZKIC_INIT / &
+ (ZTHV_UP_F2(JIJ)-ZTHVMIX_F2(JIJ))
+ END IF
+ !Mean ZKIC over the cloudy part
+ ZKIC(JIJ)=MAX(MIN(0.5*(ZKIC(JIJ)+ZKIC_F2(JIJ)),1.),0.)
+ END IF
+END DO
+
+! 3.3 Integration of PDF
+! According to Kain and Fritsch (1990), we replace delta Mt
+! in eq. (7) and (8) using eq. (5). Here we compute the ratio
+! of integrals without computing delta Me
+
+!Constant PDF
+!For this PDF, eq. (5) is delta Me=0.5*delta Mt
+DO JIJ=IIJB,IIJE
+ IF(OTEST(JIJ)) THEN
+ ZEPSI(JIJ) = ZKIC(JIJ)**2. !integration multiplied by 2
+ ZDELTA(JIJ) = (1.-ZKIC(JIJ))**2. !idem
+ ENDIF
+ENDDO
+
+!Triangular PDF
+!Calculus must be verified before activating this part, but in this state,
+!results on ARM case are almost identical
+!For this PDF, eq. (5) is also delta Me=0.5*delta Mt
+!WHERE(OTEST(IIJB:IIJE))
+! !Integration multiplied by 2
+! WHERE(ZKIC<0.5)
+! ZEPSI(IIJB:IIJE)=8.*ZKIC(IIJB:IIJE)**3/3.
+! ZDELTA(IIJB:IIJE)=1.-4.*ZKIC(IIJB:IIJE)**2+8.*ZKIC(IIJB:IIJE)**3/3.
+! ELSEWHERE
+! ZEPSI(IIJB:IIJE)=5./3.-4*ZKIC(IIJB:IIJE)**2+8.*ZKIC(IIJB:IIJE)**3/3.
+! ZDELTA(IIJB:IIJE)=8.*(1.-ZKIC(IIJB:IIJE))**3/3.
+! ENDWHERE
+!ENDWHERE
+
+! 3.4 Computation of PENTR and PDETR
+DO JIJ=IIJB,IIJE
+ IF(OTEST(JIJ)) THEN
+ ZEPSI_CLOUD=MIN(ZDELTA(JIJ), ZEPSI(JIJ))
+ PENTR_CLD(JIJ) = (1.-PPART_DRY(JIJ))*ZCOEFFMF_CLOUD*PRHODREF(JIJ)*ZEPSI_CLOUD
+ PDETR_CLD(JIJ) = (1.-PPART_DRY(JIJ))*ZCOEFFMF_CLOUD*PRHODREF(JIJ)*ZDELTA(JIJ)
+ PENTR(JIJ) = PENTR(JIJ)+PENTR_CLD(JIJ)
+ PDETR(JIJ) = PDETR(JIJ)+PDETR_CLD(JIJ)
+ ELSE
+ PENTR_CLD(JIJ) = 0.
+ PDETR_CLD(JIJ) = 0.
+ ENDIF
+ENDDO
+
+END SUBROUTINE COMPUTE_ENTR_DETR
END SUBROUTINE COMPUTE_UPDRAFT
+END MODULE MODE_COMPUTE_UPDRAFT
+
diff --git a/src/PHYEX/turb/mode_compute_updraft_raha.f90 b/src/PHYEX/turb/mode_compute_updraft_raha.f90
index 1cf8c32b22ea103beb7c41b2f79a11e7abb549d6..042afa8ffb717fd0f20f8cca318a6d38c9b49054 100644
--- a/src/PHYEX/turb/mode_compute_updraft_raha.f90
+++ b/src/PHYEX/turb/mode_compute_updraft_raha.f90
@@ -4,88 +4,13 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODI_COMPUTE_UPDRAFT_RAHA
+ MODULE MODE_COMPUTE_UPDRAFT_RAHA
! ###########################
!
-INTERFACE
-!
-! #################################################################
- SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV, &
- PPABSM,PRHODREF,PUM,PVM, PTKEM, &
- PEXNM,PTHM,PRVM,PTHLM,PRTM, &
- PSVM,PTHL_UP,PRT_UP, &
- PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
- PW_UP,PU_UP, PV_UP, PSV_UP, &
- PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
- PEMF,PDETR,PENTR, &
- PBUO_INTEG,KKLCL,KKETL,KKCTL, &
- PDEPTH )
-! #################################################################
-!
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
-
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
-! normal surface fluxes of theta,rv,(u,v) parallel to the orography
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
-REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
-REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
- ! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
-
-
-END SUBROUTINE COMPUTE_UPDRAFT_RAHA
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_UPDRAFT_RAHA
-!
-! ######spl
- SUBROUTINE COMPUTE_UPDRAFT_RAHA(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE COMPUTE_UPDRAFT_RAHA(D, CST, NEB, PARAMMF, &
+ KSV, HFRAC_ICE, OENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
@@ -133,12 +58,15 @@ END MODULE MODI_COMPUTE_UPDRAFT_RAHA
!
!* 0. DECLARATIONS
! ------------
-
-USE MODD_CST
-USE MODD_PARAM_MFSHALL_n
-
-USE MODI_TH_R_FROM_THL_RT_1D
-USE MODI_SHUMAN_MF
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+!
+USE MODI_SHUMAN_MF, ONLY: MZM_MF
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
IMPLICIT NONE
@@ -146,122 +74,131 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+INTEGER, INTENT(IN) :: KSV
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metrics coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV
! normal surface fluxes of theta,rv,(u,v) parallel to the orography
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
-REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
-REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at t-dt
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRI_UP,PTHV_UP ! updraft ri, THv
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(D%NIJT), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PDEPTH ! Deepness of cloud
! 1.2 Declaration of local variables
!
!
! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F,ZRCM_F ! Theta,rv of
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHM_F,ZRVM_F,ZRCM_F ! Theta,rv of
! updraft environnement
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZG_O_THVREF ! g*ThetaV ref
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZW_UP2 ! w**2 of the updraft
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables
+REAL, DIMENSION(D%NIJT,D%NKT,KSV) :: ZSVM_F ! scalar variables
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZTH_UP ! updraft THETA
+REAL, DIMENSION(D%NIJT) :: ZT_UP ! updraft T
+REAL, DIMENSION(D%NIJT) :: ZLVOCPEXN ! updraft L
+REAL, DIMENSION(D%NIJT) :: ZCP ! updraft cp
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZBUO ! Buoyancy
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHS_UP,ZTHSM
+
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZCOEF ! diminution coefficient for too high clouds
-REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+REAL, DIMENSION(D%NIJT) :: ZWTHVSURF ! Surface w'thetav'
REAL :: ZRDORV ! RD/RV
REAL :: ZRVORD ! RV/RD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3
+REAL, DIMENSION(D%NIJT) :: ZMIX1,ZMIX2,ZMIX3
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
+REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness limit for cloud
+REAL, DIMENSION(D%NIJT) :: ZDEPTH ! Deepness limit for cloud
-INTEGER :: ISV ! Number of scalar variables
-INTEGER :: IKU,IIJU ! array size in k
-INTEGER :: JK,JI,JJ,JSV ! loop counters
+INTEGER :: JK,JIJ,JSV ! loop counters
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGEr :: IKT,IKB,IKE,IKL
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+LOGICAL, DIMENSION(D%NIJT) :: GTEST,GTESTLCL,GTESTETL
! Test if the ascent continue, if LCL or ETL is reached
LOGICAL :: GLMIX
! To choose upward or downward mixing length
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
-LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+LOGICAL, DIMENSION(D%NIJT) :: GWORK1
+LOGICAL, DIMENSION(D%NIJT,D%NKT) :: GWORK2
INTEGER :: ITEST
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZWP2, ZRSATW, ZRSATI
+REAL, DIMENSION(D%NIJT) :: ZRC_UP, ZRI_UP, ZRV_UP, ZWP2, ZRSATW, ZRSATI
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST_FER
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZPHI,ZALIM_STAR_TOT
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZDTHETASDZ,ZALIM_STAR,ZZDZ,ZZZ
-INTEGER, DIMENSION(SIZE(PTHM,1)) :: IALIM
+LOGICAL, DIMENSION(D%NIJT) :: GTEST_FER
+REAL, DIMENSION(D%NIJT) :: ZPHI,ZALIM_STAR_TOT
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZDTHETASDZ,ZALIM_STAR,ZZDZ,ZZZ
+INTEGER, DIMENSION(D%NIJT) :: IALIM
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN !
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZA,ZB,ZQTM,ZQT_UP
+REAL, DIMENSION(D%NIJT) :: ZTEST,ZDZ,ZWUP_MEAN !
+REAL, DIMENSION(D%NIJT) :: ZCOE,ZWCOE,ZBUCOE
+REAL, DIMENSION(D%NIJT) :: ZDETR_BUO, ZDETR_RT
+REAL, DIMENSION(D%NIJT) :: ZW_MAX ! w**2 max of the updraft
+REAL, DIMENSION(D%NIJT) :: ZZTOP ! Top of the updraft
+REAL, DIMENSION(D%NIJT) :: ZA,ZB,ZQTM,ZQT_UP
REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
REAL :: ZTMAX,ZRMAX, ZEPS ! control value
+REAL, DIMENSION(D%NIJT,16) :: ZBUF
-
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAF_RAHA',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
+!
! Thresholds for the perturbation of
! theta_l and r_t at the first level of the updraft
@@ -272,24 +209,17 @@ ZEPS=1.E-15
! INITIALISATION
! Initialisation of the constants
-ZRDORV = XRD / XRV !=0.622
-ZRVORD = (XRV / XRD)
+ZRDORV = CST%XRD / CST%XRV !=0.622
+ZRVORD = (CST%XRV / CST%XRD)
ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched
ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed
! Local variables, internal domain
-! Internal Domain
-
-IKU=SIZE(PTHM,2)
-IIJU =SIZE(PTHM,1)
-!number of scalar variables
-ISV=SIZE(PSVM,3)
-
! Initialisation of intersesting Level :LCL,ETL,CTL
-KKLCL(:)=KKE
-KKETL(:)=KKE
-KKCTL(:)=KKE
+KKLCL(:)=IKE
+KKETL(:)=IKE
+KKCTL(:)=IKE
!
! Initialisation
@@ -308,107 +238,131 @@ ZTH_UP(:,:)=0.
PFRAC_UP(:,:)=0.
PTHV_UP(:,:)=0.
-PBUO_INTEG=0.
-ZBUO =0.
+PBUO_INTEG(:,:)=0.
+ZBUO(:,:) =0.
!no ice cloud coded yet
PRI_UP(:,:)=0.
PFRAC_ICE_UP(:,:)=0.
-PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PRSAT_UP(IIJB:IIJE,1:IKT)=PRVM(IIJB:IIJE,1:IKT) ! should be initialised correctly but is (normaly) not used
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! Initialisation of environment variables at t-dt
! variables at flux level
-ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
-ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:))
-ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:))
-ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:))
-ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:))
+CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
+CALL MZM_MF(D, PRTM(:,:), ZRTM_F(:,:))
+CALL MZM_MF(D, PUM(:,:), ZUM_F(:,:))
+CALL MZM_MF(D, PVM(:,:), ZVM_F(:,:))
+CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:))
!DO JSV=1,ISV
! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV))
-! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV)
+! ZSVM_F(IIJB:IIJE,KKB:IKU,JSV) = 0.5*(PSVM(IIJB:IIJE,KKB:IKU,JSV)+PSVM(IIJB:IIJE,1:IKU-1,JSV))
+! ZSVM_F(IIJB:IIJE,1,JSV) = ZSVM_F(IIJB:IIJE,KKB,JSV)
!END DO
! Initialisation of updraft characteristics
-PTHL_UP(:,:)=ZTHLM_F(:,:)
-PRT_UP(:,:)=ZRTM_F(:,:)
-PU_UP(:,:)=ZUM_F(:,:)
-PV_UP(:,:)=ZVM_F(:,:)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PTHL_UP(IIJB:IIJE,1:IKT)=ZTHLM_F(IIJB:IIJE,1:IKT)
+PRT_UP(IIJB:IIJE,1:IKT)=ZRTM_F(IIJB:IIJE,1:IKT)
+PU_UP(IIJB:IIJE,1:IKT)=ZUM_F(IIJB:IIJE,1:IKT)
+PV_UP(IIJB:IIJE,1:IKT)=ZVM_F(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PSV_UP(:,:,:)=0.
!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then
-! PSV_UP(:,:,:)=ZSVM_F(:,:,:)
+! PSV_UP(IIJB:IIJE,:,:)=ZSVM_F(IIJB:IIJE,:,:)
!ENDIF
! Computation or initialisation of updraft characteristics at the KKB level
! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF)
-PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PTHL_UP(IIJB:IIJE,IKB)= ZTHLM_F(IIJB:IIJE,IKB)+ &
+ & MAX(0.,MIN(ZTMAX,(PSFTH(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))*PARAMMF%XALP_PERT))
+PRT_UP(IIJB:IIJE,IKB) = ZRTM_F(IIJB:IIJE,IKB)+ &
+ & MAX(0.,MIN(ZRMAX,(PSFRV(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))*PARAMMF%XALP_PERT))
-ZQT_UP(:) = PRT_UP(:,KKB)/(1.+PRT_UP(:,KKB))
-ZTHS_UP(:,KKB)=PTHL_UP(:,KKB)*(1.+XLAMBDA_MF*ZQT_UP(:))
+ZQT_UP(IIJB:IIJE) = PRT_UP(IIJB:IIJE,IKB)/(1.+PRT_UP(IIJB:IIJE,IKB))
+ZTHS_UP(IIJB:IIJE,IKB)=PTHL_UP(IIJB:IIJE,IKB)*(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(IIJB:IIJE))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
-ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
-ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
-ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:))
-ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:))
+CALL MZM_MF(D, PTHM (:,:), ZTHM_F(:,:))
+CALL MZM_MF(D, PPABSM(:,:), ZPRES_F(:,:))
+CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F(:,:))
+CALL MZM_MF(D, PRVM(:,:), ZRVM_F(:,:))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! thetav at mass and flux levels
-ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
-ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+ZTHVM_F(IIJB:IIJE,1:IKT)=ZTHM_F(IIJB:IIJE,1:IKT)*((1.+ZRVORD*ZRVM_F(IIJB:IIJE,1:IKT))/&
+ &(1.+ZRTM_F(IIJB:IIJE,1:IKT)))
+ZTHVM(IIJB:IIJE,1:IKT)=PTHM(IIJB:IIJE,1:IKT)*((1.+ZRVORD*PRVM(IIJB:IIJE,1:IKT))/(1.+PRTM(IIJB:IIJE,1:IKT)))
-PTHV_UP(:,:)= ZTHVM_F(:,:)
-PRV_UP (:,:)= ZRVM_F (:,:)
+PTHV_UP(IIJB:IIJE,1:IKT)= ZTHVM_F(IIJB:IIJE,1:IKT)
+PRV_UP(IIJB:IIJE,1:IKT) = ZRVM_F(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZW_UP2(:,:)=ZEPS
-ZW_UP2(:,KKB) = MAX(0.0001,(1./6.)*ZTKEM_F(:,KKB))
-GTEST = (ZW_UP2(:,KKB) > ZEPS)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZW_UP2(IIJB:IIJE,IKB) = MAX(0.0001,(1./6.)*ZTKEM_F(IIJB:IIJE,IKB))
+GTEST(IIJB:IIJE) = (ZW_UP2(IIJB:IIJE,IKB) > ZEPS)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
! Computation of non conservative variable for the KKB level of the updraft
! (all or nothing ajustement)
-PRC_UP(:,KKB)=0.
-PRI_UP(:,KKB)=0.
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PRC_UP(IIJB:IIJE,IKB)=0.
+PRI_UP(IIJB:IIJE,IKB)=0.
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
-CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
- PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
+CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,IKB),ZPRES_F(:,IKB), &
+ PTHL_UP(:,IKB),PRT_UP(:,IKB),ZTH_UP(:,IKB), &
+ PRV_UP(:,IKB),PRC_UP(:,IKB),PRI_UP(:,IKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
! compute updraft thevav and buoyancy term at KKB level
-PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
+PTHV_UP(IIJB:IIJE,IKB) = ZTH_UP(IIJB:IIJE,IKB)*((1+ZRVORD*PRV_UP(IIJB:IIJE,IKB))/(1+PRT_UP(IIJB:IIJE,IKB)))
! compute mean rsat in updraft
-PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
+PRSAT_UP(IIJB:IIJE,IKB) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,IKB)) + &
+ & ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,IKB)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!Tout est commente pour tester dans un premier temps la s�paration en deux de la
! boucle verticale, une pour w et une pour PEMF
-
-ZG_O_THVREF=XG/ZTHVM_F
-
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZG_O_THVREF(IIJB:IIJE,1:IKT)=CST%XG/ZTHVM_F(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! Definition de l'alimentation au sens de la fermeture de Hourdin et al
ZALIM_STAR(:,:) = 0.
ZALIM_STAR_TOT(:) = 0. ! <== Normalization of ZALIM_STAR
-IALIM(:) = KKB ! <== Top level of the alimentation layer
+IALIM(:) = IKB ! <== Top level of the alimentation layer
-DO JK=KKB,KKE-KKL,KKL ! Vertical loop
- ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level
- ZZZ(:,JK) = MAX(0.,0.5*(PZZ(:,JK+KKL)+PZZ(:,JK)) ) ! <== Hight of mass levels
- ZDTHETASDZ(:,JK) = (ZTHVM_F(:,JK)-ZTHVM_F(:,JK+KKL)) ! <== Delta theta_v
+DO JK=IKB,IKE-IKL,IKL ! Vertical loop
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ ZZDZ(IIJB:IIJE,JK) = MAX(ZEPS,PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK)) ! <== Delta Z between two flux level
+ ZZZ(IIJB:IIJE,JK) = MAX(0.,0.5*(PZZ(IIJB:IIJE,JK+IKL)+PZZ(IIJB:IIJE,JK)) ) ! <== Hight of mass levels
+ ZDTHETASDZ(IIJB:IIJE,JK) = (ZTHVM_F(IIJB:IIJE,JK)-ZTHVM_F(IIJB:IIJE,JK+IKL)) ! <== Delta theta_v
- WHERE ((ZTHVM_F(:,JK+KKL)<ZTHVM_F(:,JK)) .AND. (ZTHVM_F(:,KKB)>=ZTHVM_F(:,JK)))
- ZALIM_STAR(:,JK) = SQRT(ZZZ(:,JK))*ZDTHETASDZ(:,JK)/ZZDZ(:,JK)
- ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:)+ZALIM_STAR(:,JK)*ZZDZ(:,JK)
- IALIM(:) = JK
+ WHERE ((ZTHVM_F(IIJB:IIJE,JK+IKL)<ZTHVM_F(IIJB:IIJE,JK)) .AND. &
+ &(ZTHVM_F(IIJB:IIJE,IKB)>=ZTHVM_F(IIJB:IIJE,JK)))
+ ZALIM_STAR(IIJB:IIJE,JK) = SQRT(ZZZ(IIJB:IIJE,JK))*ZDTHETASDZ(IIJB:IIJE,JK)/ZZDZ(IIJB:IIJE,JK)
+ ZALIM_STAR_TOT(IIJB:IIJE) = ZALIM_STAR_TOT(IIJB:IIJE)+ZALIM_STAR(IIJB:IIJE,JK)*ZZDZ(IIJB:IIJE,JK)
+ IALIM(IIJB:IIJE) = JK
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ENDDO
! Normalization of ZALIM_STAR
-DO JK=KKB,KKE-KKL,KKL ! Vertical loop
- WHERE (ZALIM_STAR_TOT > ZEPS)
- ZALIM_STAR(:,JK) = ZALIM_STAR(:,JK)/ZALIM_STAR_TOT(:)
+DO JK=IKB,IKE-IKL,IKL ! Vertical loop
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (ZALIM_STAR_TOT(IIJB:IIJE) > ZEPS)
+ ZALIM_STAR(IIJB:IIJE,JK) = ZALIM_STAR(IIJB:IIJE,JK)/ZALIM_STAR_TOT(IIJB:IIJE)
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ENDDO
ZALIM_STAR_TOT(:) = 0.
@@ -434,214 +388,244 @@ ZZTOP(:) = 0.
ZPHI(:) = 0.
-DO JK=KKB,KKE-KKL,KKL
-
-! IF the updraft top is reached for all column, stop the loop on levels
+DO JK=IKB,IKE-IKL,IKL
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ ! IF the updraft top is reached for all column, stop the loop on levels
-! ITEST=COUNT(GTEST)
-! IF (ITEST==0) CYCLE
+ !ITEST=COUNT(GTEST(IIJB:IIJE))
+ !IF (ITEST==0) CYCLE
-! Computation of entrainment and detrainment with KF90
-! parameterization in clouds and LR01 in subcloud layer
+ ! Computation of entrainment and detrainment with KF90
+ ! parameterization in clouds and LR01 in subcloud layer
-
-! to find the LCL (check if JK is LCL or not)
-
- WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
- KKLCL(:) = JK
- GTESTLCL(:)=.TRUE.
+ ! to find the LCL (check if JK is LCL or not)
+ WHERE ((PRC_UP(IIJB:IIJE,JK)+PRI_UP(IIJB:IIJE,JK)>0.).AND.(.NOT.(GTESTLCL(IIJB:IIJE))))
+ KKLCL(IIJB:IIJE) = JK
+ GTESTLCL(IIJB:IIJE)=.TRUE.
ENDWHERE
-
-! COMPUTE PENTR and PDETR at mass level JK
+ ! COMPUTE PENTR and PDETR at mass level JK
-! Buoyancy is computed on "flux" levels where updraft variables are known
+ ! Buoyancy is computed on "flux" levels where updraft variables are known
! Compute theta_v of updraft at flux level JK
- ZRC_UP(:) = PRC_UP(:,JK)
- ZRI_UP(:) = PRI_UP(:,JK) ! guess
- ZRV_UP(:) = PRV_UP(:,JK)
- ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK))
- PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK))
-
- ZDZ(:) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK))
- ZTEST(:) = XA1*ZBUO(:,JK) - XB*ZW_UP2(:,JK)
+ ZRC_UP(IIJB:IIJE) = PRC_UP(IIJB:IIJE,JK)
+ ZRI_UP(IIJB:IIJE) = PRI_UP(IIJB:IIJE,JK) ! guess
+ ZRV_UP(IIJB:IIJE) = PRV_UP(IIJB:IIJE,JK)
+ ZBUO(IIJB:IIJE,JK) = ZG_O_THVREF(IIJB:IIJE,JK)*(PTHV_UP(IIJB:IIJE,JK) - ZTHVM_F(IIJB:IIJE,JK))
+ PBUO_INTEG(IIJB:IIJE,JK) = ZBUO(IIJB:IIJE,JK)*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))
+
+ ZDZ(IIJB:IIJE) = MAX(ZEPS,PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))
+ ZTEST(IIJB:IIJE) = PARAMMF%XA1*ZBUO(IIJB:IIJE,JK) - PARAMMF%XB*ZW_UP2(IIJB:IIJE,JK)
- ZCOE(:) = ZDZ(:)
- WHERE (ZTEST(:)>0.)
- ZCOE(:) = ZDZ(:)/(1.+ XBETA1)
- ENDWHERE
+ ZCOE(IIJB:IIJE) = ZDZ(IIJB:IIJE)
+ WHERE (ZTEST(IIJB:IIJE)>0.)
+ ZCOE(IIJB:IIJE) = ZDZ(IIJB:IIJE)/(1.+ PARAMMF%XBETA1)
+ ENDWHERE
-! Calcul de la vitesse
+ ! Calcul de la vitesse
- ZWCOE(:) = (1.-XB*ZCOE(:))/(1.+XB*ZCOE(:))
- ZBUCOE(:) = 2.*ZCOE(:)/(1.+XB*ZCOE(:))
-
- ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + XA1*ZBUO(:,JK)*ZBUCOE(:) )
- ZW_MAX(:) = MAX(ZW_MAX(:), SQRT(ZW_UP2(:,JK+KKL)))
- ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP2(:,JK+KKL)+ZW_UP2(:,JK)))
-
-! Entrainement et detrainement
+ ZWCOE(IIJB:IIJE) = (1.-PARAMMF%XB*ZCOE(IIJB:IIJE))/(1.+PARAMMF%XB*ZCOE(IIJB:IIJE))
+ ZBUCOE(IIJB:IIJE) = 2.*ZCOE(IIJB:IIJE)/(1.+PARAMMF%XB*ZCOE(IIJB:IIJE))
- PENTR(:,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(:,JK)/ZWUP_MEAN(:)-XB))
-
- ZDETR_BUO(:) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(:,JK)/ZWUP_MEAN(:))
- ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK))) / MAX(ZEPS,ZRTM_F(:,JK)) / ZWUP_MEAN(:))
- PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:)
+ ZW_UP2(IIJB:IIJE,JK+IKL) = MAX(ZEPS,ZW_UP2(IIJB:IIJE,JK)*ZWCOE(IIJB:IIJE) + &
+ &PARAMMF%XA1*ZBUO(IIJB:IIJE,JK)*ZBUCOE(IIJB:IIJE))
+ ZW_MAX(IIJB:IIJE) = MAX(ZW_MAX(IIJB:IIJE), SQRT(ZW_UP2(IIJB:IIJE,JK+IKL)))
+ ZWUP_MEAN(IIJB:IIJE) = MAX(ZEPS,0.5*(ZW_UP2(IIJB:IIJE,JK+IKL)+ZW_UP2(IIJB:IIJE,JK)))
+
+ ! Entrainement et detrainement
+
+ PENTR(IIJB:IIJE,JK) = MAX(0.,(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))* &
+ &(PARAMMF%XA1*ZBUO(IIJB:IIJE,JK)/ZWUP_MEAN(IIJB:IIJE)-PARAMMF%XB))
+
+ ZDETR_BUO(IIJB:IIJE) = MAX(0., -(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))*PARAMMF%XA1*ZBUO(IIJB:IIJE,JK)/ &
+ &ZWUP_MEAN(IIJB:IIJE))
+ ZDETR_RT(IIJB:IIJE) = PARAMMF%XC*SQRT(MAX(0.,(PRT_UP(IIJB:IIJE,JK) - ZRTM_F(IIJB:IIJE,JK))) / &
+ &MAX(ZEPS,ZRTM_F(IIJB:IIJE,JK)) / ZWUP_MEAN(IIJB:IIJE))
+ PDETR(IIJB:IIJE,JK) = ZDETR_RT(IIJB:IIJE)+ZDETR_BUO(IIJB:IIJE)
-! If the updraft did not stop, compute cons updraft characteritics at jk+1
- WHERE(GTEST)
- ZZTOP(:) = MAX(ZZTOP(:),PZZ(:,JK+KKL))
- ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !&
- ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !&
+ ! If the updraft did not stop, compute cons updraft characteritics at jk+1
+ WHERE(GTEST(IIJB:IIJE))
+ ZZTOP(IIJB:IIJE) = MAX(ZZTOP(IIJB:IIJE),PZZ(IIJB:IIJE,JK+IKL))
+ ZMIX2(IIJB:IIJE) = (PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*PENTR(IIJB:IIJE,JK) !&
+ ZMIX3(IIJB:IIJE) = (PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*PDETR(IIJB:IIJE,JK) !&
- ZQTM(:) = PRTM(:,JK)/(1.+PRTM(:,JK))
- ZTHSM(:,JK) = PTHLM(:,JK)*(1.+XLAMBDA_MF*ZQTM(:))
- ZTHS_UP(:,JK+KKL)=(ZTHS_UP(:,JK)*(1.-0.5*ZMIX2(:)) + ZTHSM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- PRT_UP(:,JK+KKL)=(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- ZQT_UP(:) = PRT_UP(:,JK+KKL)/(1.+PRT_UP(:,JK+KKL))
- PTHL_UP(:,JK+KKL)=ZTHS_UP(:,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(:))
+ ZQTM(IIJB:IIJE) = PRTM(IIJB:IIJE,JK)/(1.+PRTM(IIJB:IIJE,JK))
+ ZTHSM(IIJB:IIJE,JK) = PTHLM(IIJB:IIJE,JK)*(1.+PARAMMF%XLAMBDA_MF*ZQTM(IIJB:IIJE))
+ ZTHS_UP(IIJB:IIJE,JK+IKL)=(ZTHS_UP(IIJB:IIJE,JK)*(1.-0.5*ZMIX2(IIJB:IIJE)) + &
+ &ZTHSM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE))&
+ /(1.+0.5*ZMIX2(IIJB:IIJE))
+ PRT_UP(IIJB:IIJE,JK+IKL)=(PRT_UP(IIJB:IIJE,JK)*(1.-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PRTM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)) &
+ /(1.+0.5*ZMIX2(IIJB:IIJE))
+ ZQT_UP(IIJB:IIJE) = PRT_UP(IIJB:IIJE,JK+IKL)/(1.+PRT_UP(IIJB:IIJE,JK+IKL))
+ PTHL_UP(IIJB:IIJE,JK+IKL)=ZTHS_UP(IIJB:IIJE,JK+IKL)/(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(IIJB:IIJE))
ENDWHERE
- IF(OMIXUV) THEN
- IF(JK/=KKB) THEN
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
- (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
- (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
+ IF(PARAMMF%LMIXUV) THEN
+ IF(JK/=IKB) THEN
+ WHERE(GTEST(IIJB:IIJE))
+ PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ ((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+&
+ (PUM(IIJB:IIJE,JK)-PUM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) &
+ /(1+0.5*ZMIX2(IIJB:IIJE))
+ PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ ((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+&
+ (PVM(IIJB:IIJE,JK)-PVM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) &
+ /(1+0.5*ZMIX2(IIJB:IIJE))
ENDWHERE
ELSE
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
+ WHERE(GTEST(IIJB:IIJE))
+ PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ ((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) &
+ /(1+0.5*ZMIX2(IIJB:IIJE))
+ PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ &PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
+ ((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) &
+ /(1+0.5*ZMIX2(IIJB:IIJE))
ENDWHERE
ENDIF
ENDIF
-! DO JSV=1,ISV
-! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-! WHERE(GTEST)
-! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
-! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
-! ENDWHERE
-! ENDDO
+ !DO JSV=1,ISV
+ ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
+ ! WHERE(GTEST(IIJB:IIJE))
+ ! PSV_UP(IIJB:IIJE,JK+KKL,JSV) = (PSV_UP(IIJB:IIJE,JK,JSV)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+ ! PSVM(IIJB:IIJE,JK,JSV)*ZMIX2(IIJB:IIJE)) /(1+0.5*ZMIX2(IIJB:IIJE))
+ ! ENDWHERE
+ !ENDDO
-! Compute non cons. var. at level JK+KKL
- ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
- ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
- ZRV_UP(:)=PRV_UP(:,JK)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
- PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
- WHERE(GTEST)
- ZT_UP(:) = ZTH_UP(:,JK+KKL)*PEXNM(:,JK+KKL)
- ZCP(:) = XCPD + XCL * ZRC_UP(:)
- ZLVOCPEXN(:)=(XLVTT + (XCPV-XCL) * (ZT_UP(:)-XTT) ) / ZCP(:) / PEXNM(:,JK+KKL)
- PRC_UP(:,JK+KKL)=MIN(0.5E-3,ZRC_UP(:)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
- PTHL_UP(:,JK+KKL) = PTHL_UP(:,JK+KKL)+ZLVOCPEXN(:)*(ZRC_UP(:)-PRC_UP(:,JK+KKL))
- PRV_UP(:,JK+KKL)=ZRV_UP(:)
- PRI_UP(:,JK+KKL)=ZRI_UP(:)
- PRT_UP(:,JK+KKL) = PRC_UP(:,JK+KKL) + PRV_UP(:,JK+KKL)
- PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
+ ! Compute non cons. var. at level JK+KKL
+ ZRC_UP(IIJB:IIJE)=PRC_UP(IIJB:IIJE,JK) ! guess = level just below
+ ZRI_UP(IIJB:IIJE)=PRI_UP(IIJB:IIJE,JK) ! guess = level just below
+ ZRV_UP(IIJB:IIJE)=PRV_UP(IIJB:IIJE,JK)
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+ CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+IKL),ZPRES_F(:,JK+IKL), &
+ PTHL_UP(:,JK+IKL),PRT_UP(:,JK+IKL),ZTH_UP(:,JK+IKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(GTEST(IIJB:IIJE))
+ ZT_UP(IIJB:IIJE) = ZTH_UP(IIJB:IIJE,JK+IKL)*PEXNM(IIJB:IIJE,JK+IKL)
+ ZCP(IIJB:IIJE) = CST%XCPD + CST%XCL * ZRC_UP(IIJB:IIJE)
+ ZLVOCPEXN(IIJB:IIJE)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT_UP(IIJB:IIJE)-CST%XTT) ) / &
+ &ZCP(IIJB:IIJE) / PEXNM(IIJB:IIJE,JK+IKL)
+ PRC_UP(IIJB:IIJE,JK+IKL)=MIN(0.5E-3,ZRC_UP(IIJB:IIJE)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
+ PTHL_UP(IIJB:IIJE,JK+IKL) = PTHL_UP(IIJB:IIJE,JK+IKL)+ &
+ & ZLVOCPEXN(IIJB:IIJE)*(ZRC_UP(IIJB:IIJE)-PRC_UP(IIJB:IIJE,JK+IKL))
+ PRV_UP(IIJB:IIJE,JK+IKL)=ZRV_UP(IIJB:IIJE)
+ PRI_UP(IIJB:IIJE,JK+IKL)=ZRI_UP(IIJB:IIJE)
+ PRT_UP(IIJB:IIJE,JK+IKL) = PRC_UP(IIJB:IIJE,JK+IKL) + PRV_UP(IIJB:IIJE,JK+IKL)
+ PRSAT_UP(IIJB:IIJE,JK+IKL) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)) + &
+ & ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)
ENDWHERE
-! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
- WHERE(GTEST)
-! PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
- PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*(1.+0.608*PRV_UP(:,JK+KKL) - PRC_UP(:,JK+KKL))
- ENDWHERE
+ ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
+ WHERE(GTEST(IIJB:IIJE))
+ !PTHV_UP(IIJB:IIJE,JK+KKL) = ZTH_UP(IIJB:IIJE,JK+KKL)*((1+ZRVORD*PRV_UP(IIJB:IIJE,JK+KKL))/(1+PRT_UP(IIJB:IIJE,JK+KKL)))
+ PTHV_UP(IIJB:IIJE,JK+IKL) = ZTH_UP(IIJB:IIJE,JK+IKL)* &
+ & (1.+0.608*PRV_UP(IIJB:IIJE,JK+IKL) - PRC_UP(IIJB:IIJE,JK+IKL))
+ ENDWHERE
-! Test if the updraft has reach the ETL
- GTESTETL(:)=.FALSE.
- WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
- KKETL(:) = JK+KKL
- GTESTETL(:)=.TRUE.
+ ! Test if the updraft has reach the ETL
+ GTESTETL(IIJB:IIJE)=.FALSE.
+ WHERE (GTEST(IIJB:IIJE).AND.(PBUO_INTEG(IIJB:IIJE,JK)<=0.))
+ KKETL(IIJB:IIJE) = JK+IKL
+ GTESTETL(IIJB:IIJE)=.TRUE.
ENDWHERE
-! Test is we have reached the top of the updraft
-
- WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS)))
- ZW_UP2(:,JK+KKL)=ZEPS
- GTEST(:)=.FALSE.
- PTHL_UP(:,JK+KKL)=ZTHLM_F(:,JK+KKL)
- PRT_UP(:,JK+KKL)=ZRTM_F(:,JK+KKL)
- PRC_UP(:,JK+KKL)=0.
- PRI_UP(:,JK+KKL)=0.
- PRV_UP(:,JK+KKL)=0.
- PTHV_UP(:,JK+KKL)=ZTHVM_F(:,JK+KKL)
- PFRAC_UP(:,JK+KKL)=0.
- KKCTL(:)=JK+KKL
+ ! Test is we have reached the top of the updraft
+ WHERE (GTEST(IIJB:IIJE).AND.((ZW_UP2(IIJB:IIJE,JK+IKL)<=ZEPS)))
+ ZW_UP2(IIJB:IIJE,JK+IKL)=ZEPS
+ GTEST(IIJB:IIJE)=.FALSE.
+ PTHL_UP(IIJB:IIJE,JK+IKL)=ZTHLM_F(IIJB:IIJE,JK+IKL)
+ PRT_UP(IIJB:IIJE,JK+IKL)=ZRTM_F(IIJB:IIJE,JK+IKL)
+ PRC_UP(IIJB:IIJE,JK+IKL)=0.
+ PRI_UP(IIJB:IIJE,JK+IKL)=0.
+ PRV_UP(IIJB:IIJE,JK+IKL)=0.
+ PTHV_UP(IIJB:IIJE,JK+IKL)=ZTHVM_F(IIJB:IIJE,JK+IKL)
+ PFRAC_UP(IIJB:IIJE,JK+IKL)=0.
+ KKCTL(IIJB:IIJE)=JK+IKL
ENDWHERE
-
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ENDDO
-! Closure assumption for mass flux at KKB+1 level (Mass flux is supposed to be 0 at KKB level !)
+! Closure assumption for mass flux at KKB+1 level (Mass flux is supposed to be 0 at KKB level !)
! Hourdin et al 2002 formulation
-ZZTOP(:) = MAX(ZZTOP(:),ZEPS)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZZTOP(IIJB:IIJE) = MAX(ZZTOP(IIJB:IIJE),ZEPS)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
-DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop
- WHERE(JK<=IALIM)
- ZALIM_STAR_TOT(:) = ZALIM_STAR_TOT(:) + ZALIM_STAR(:,JK)*ZALIM_STAR(:,JK)*ZZDZ(:,JK)/PRHODREF(:,JK)
- ENDWHERE
+DO JK=IKB+IKL,IKE-IKL,IKL ! Vertical loop
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(JK<=IALIM(IIJB:IIJE))
+ ZALIM_STAR_TOT(IIJB:IIJE) = ZALIM_STAR_TOT(IIJB:IIJE) + ZALIM_STAR(IIJB:IIJE,JK)**2* &
+ & ZZDZ(IIJB:IIJE,JK)/PRHODREF(IIJB:IIJE,JK)
+ ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ENDDO
-WHERE (ZALIM_STAR_TOT*ZZTOP > ZEPS)
- ZPHI(:) = ZW_MAX(:)/(XR*ZZTOP(:)*ZALIM_STAR_TOT(:))
-ENDWHERE
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE (ZALIM_STAR_TOT(IIJB:IIJE)*ZZTOP(IIJB:IIJE) > ZEPS)
+ ZPHI(IIJB:IIJE) = ZW_MAX(IIJB:IIJE)/(PARAMMF%XR*ZZTOP(IIJB:IIJE)*ZALIM_STAR_TOT(IIJB:IIJE))
+ENDWHERE
-GTEST(:) = .TRUE.
-PEMF(:,KKB+KKL) = ZPHI(:)*ZZDZ(:,KKB)*ZALIM_STAR(:,KKB)
+GTEST(IIJB:IIJE) = .TRUE.
+PEMF(IIJB:IIJE,IKB+IKL) = ZPHI(IIJB:IIJE)*ZZDZ(IIJB:IIJE,IKB)*ZALIM_STAR(IIJB:IIJE,IKB)
! Updraft fraction must be smaller than XFRAC_UP_MAX
-PFRAC_UP(:,KKB+KKL)=PEMF(:,KKB+KKL)/(SQRT(ZW_UP2(:,KKB+KKL))*ZRHO_F(:,KKB+KKL))
-PFRAC_UP(:,KKB+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,KKB+KKL))
-PEMF(:,KKB+KKL) = ZRHO_F(:,KKB+KKL)*PFRAC_UP(:,KKB+KKL)*SQRT(ZW_UP2(:,KKB+KKL))
-
-DO JK=KKB+KKL,KKE-KKL,KKL ! Vertical loop
+PFRAC_UP(IIJB:IIJE,IKB+IKL)=PEMF(IIJB:IIJE,IKB+IKL)/ &
+ &(SQRT(ZW_UP2(IIJB:IIJE,IKB+IKL))*ZRHO_F(IIJB:IIJE,IKB+IKL))
+PFRAC_UP(IIJB:IIJE,IKB+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(IIJB:IIJE,IKB+IKL))
+PEMF(IIJB:IIJE,IKB+IKL) = ZRHO_F(IIJB:IIJE,IKB+IKL)*PFRAC_UP(IIJB:IIJE,IKB+IKL)* &
+ & SQRT(ZW_UP2(IIJB:IIJE,IKB+IKL))
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
+
+DO JK=IKB+IKL,IKE-IKL,IKL ! Vertical loop
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
- GTEST = (ZW_UP2(:,JK) > ZEPS)
+ GTEST(IIJB:IIJE) = (ZW_UP2(IIJB:IIJE,JK) > ZEPS)
- WHERE (GTEST)
- WHERE(JK<IALIM)
- PEMF(:,JK+KKL) = MAX(0.,PEMF(:,JK) + ZPHI(:)*ZZDZ(:,JK)*(PENTR(:,JK) - PDETR(:,JK)))
+ WHERE (GTEST(IIJB:IIJE))
+ WHERE(JK<IALIM(IIJB:IIJE))
+ PEMF(IIJB:IIJE,JK+IKL) = MAX(0.,PEMF(IIJB:IIJE,JK) + ZPHI(IIJB:IIJE)*ZZDZ(IIJB:IIJE,JK)* &
+ & (PENTR(IIJB:IIJE,JK) - PDETR(IIJB:IIJE,JK)))
ELSEWHERE
- ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK))
- PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:))
+ ZMIX1(IIJB:IIJE)=ZZDZ(IIJB:IIJE,JK)*(PENTR(IIJB:IIJE,JK)-PDETR(IIJB:IIJE,JK))
+ PEMF(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK)*EXP(ZMIX1(IIJB:IIJE))
ENDWHERE
! Updraft fraction must be smaller than XFRAC_UP_MAX
- PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
- PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
- PEMF(:,JK+KKL) = ZRHO_F(:,JK+KKL)*PFRAC_UP(:,JK+KKL)*SQRT(ZW_UP2(:,JK+KKL))
+ PFRAC_UP(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK+IKL)/&
+ &(SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))*ZRHO_F(IIJB:IIJE,JK+IKL))
+ PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(IIJB:IIJE,JK+IKL))
+ PEMF(IIJB:IIJE,JK+IKL) = ZRHO_F(IIJB:IIJE,JK+IKL)*PFRAC_UP(IIJB:IIJE,JK+IKL)*&
+ & SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))
ENDWHERE
-
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ENDDO
-PW_UP(:,:)=SQRT(ZW_UP2(:,:))
-PEMF(:,KKB) =0.
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PW_UP(IIJB:IIJE,1:IKT)=SQRT(ZW_UP2(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PEMF(IIJB:IIJE,IKB) =0.
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
! To do this, mass flux is multiplied by a coefficient decreasing linearly
@@ -649,18 +633,32 @@ PEMF(:,KKB) =0.
! This way, all MF fluxes are diminished by this amount.
! Diagnosed cloud fraction is also multiplied by the same coefficient.
!
-DO JI=1,SIZE(PTHM,1)
- PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
+DO JIJ=IIJB,IIJE
+ PDEPTH(JIJ) = MAX(0., PZZ(JIJ,KKCTL(JIJ)) - PZZ(JIJ,KKLCL(JIJ)) )
END DO
-GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
-GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
-ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU)
-ZCOEF=MIN(MAX(ZCOEF,0.),1.)
-WHERE (GWORK2)
- PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
- PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+GWORK1(IIJB:IIJE)= (GTESTLCL(IIJB:IIJE) .AND. (PDEPTH(IIJB:IIJE) > ZDEPTH_MAX1) )
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+DO JK=1,D%NKT
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ GWORK2(IIJB:IIJE,JK) = GWORK1(IIJB:IIJE)
+ ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ZCOEF(IIJB:IIJE,JK)=MIN(MAX(ZCOEF(IIJB:IIJE,JK),0.),1.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ENDDO
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE (GWORK2(IIJB:IIJE,1:IKT))
+ PEMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT) * ZCOEF(IIJB:IIJE,1:IKT)
+ PFRAC_UP(IIJB:IIJE,1:IKT) = PFRAC_UP(IIJB:IIJE,1:IKT) * ZCOEF(IIJB:IIJE,1:IKT)
ENDWHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
-
+IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAF_RAHA',1,ZHOOK_HANDLE)
+!
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE COMPUTE_UPDRAFT_RAHA
+END MODULE MODE_COMPUTE_UPDRAFT_RAHA
diff --git a/src/PHYEX/turb/mode_compute_updraft_rhcj10.f90 b/src/PHYEX/turb/mode_compute_updraft_rhcj10.f90
index a918d05b0021aade1fb26a3458e62a5d7ca027d6..5a4a9cfa0a5ff4edf72b4f626614bc0498528d00 100644
--- a/src/PHYEX/turb/mode_compute_updraft_rhcj10.f90
+++ b/src/PHYEX/turb/mode_compute_updraft_rhcj10.f90
@@ -4,87 +4,15 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODI_COMPUTE_UPDRAFT_RHCJ10
+ MODULE MODE_COMPUTE_UPDRAFT_RHCJ10
! ###########################
!
-INTERFACE
-!
-! #################################################################
- SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV, &
- PPABSM,PRHODREF,PUM,PVM,PTKEM, &
- PTHM,PRVM,PTHLM,PRTM, &
- PSVM,PTHL_UP,PRT_UP, &
- PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
- PW_UP,PU_UP, PV_UP, PSV_UP, &
- PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
- PEMF,PDETR,PENTR, &
- PBUO_INTEG,KKLCL,KKETL,KKCTL, &
- PDEPTH)
-! #################################################################
-!
-!* 1.1 Declaration of Arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
-
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
-! normal surface fluxes of theta,rv,(u,v) parallel to the orography
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
- PRI_UP,PTHV_UP,& ! updraft ri, THv
- PW_UP,PFRAC_UP,& ! updraft w, fraction
- PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
- PRSAT_UP ! Rsat
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
- ! entrainment, detrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
-
-
-END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_UPDRAFT_RHCJ10
+IMPLICIT NONE
+CONTAINS
!
-SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
+SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(D,CST,NEB,PARAMMF,TURBN,CSTURB, &
+ KSV, HFRAC_ICE, &
+ OENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
@@ -99,7 +27,7 @@ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
PDEPTH )
! #################################################################
!!
-!!**** *COMPUTE_UPDRAF_RHCJ10* - calculates caracteristics of the updraft
+!!**** *COMPUTE_UPDRAFT_RHCJ10* - calculates caracteristics of the updraft
!!
!!
!! PURPOSE
@@ -124,137 +52,157 @@ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
!! ------
!! Y. Bouteloup (2012)
!! R. Honert Janv 2013 ==> corection of some bugs
-!! Q.Rodier 01/2019 : support RM17 mixing length
+!! R. El Khatib 15-Oct-2014 Optimization
+!! Q.Rodier 01/2019 : support RM17 mixing length
!! --------------------------------------------------------------------------
! WARNING ==> This updraft is not yet ready to use scalar variables
!* 0. DECLARATIONS
! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_CTURB, ONLY: CSTURB_t
+!
+USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
-USE MODD_CST
-USE MODD_PARAM_MFSHALL_n
-USE MODD_TURB_n, ONLY : CTURBLEN
-USE MODI_COMPUTE_ENTR_DETR
-USE MODI_TH_R_FROM_THL_RT_1D
-USE MODI_SHUMAN_MF
-
-USE MODI_COMPUTE_BL89_ML
+USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
IMPLICIT NONE
!* 1.1 Declaration of Arguments
-
-
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+!
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+INTEGER, INTENT(IN) :: KSV
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metrics coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV
! normal surface fluxes of theta,rv,(u,v) parallel to the orography
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM ! u mean wind
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVM ! v mean wind
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at t-dt
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP ! updraft ri
-REAL, DIMENSION(:,:), INTENT(INOUT):: PTHV_UP ! updraft THv
-REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
-REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
+!REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM ! pot. temp. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
+
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-dt
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRI_UP ! updraft ri
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PTHV_UP ! updraft THv
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRSAT_UP ! Rsat
+
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
+INTEGER, DIMENSION(D%NIJT), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PDEPTH ! Deepness of cloud
! 1.2 Declaration of local variables
-
+!
! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F ! Theta,rv of
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHM_F,ZRVM_F ! Theta,rv of
! updraft environnement
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F,ZTHVM ! interpolated at the flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZPRES_F,ZTHVM_F ! interpolated at the flux point
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZG_O_THVREF ! g*ThetaV ref
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZW_UP2 ! w**2 of the updraft
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables
+REAL, DIMENSION(D%NIJT,D%NKT,KSV) :: ZSVM_F ! scalar variables
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZTH_UP ! updraft THETA
+!REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T
+!REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L
+!REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZBUO ! Buoyancy
+!REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM
+
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZCOEF ! diminution coefficient for too high clouds
-REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
+REAL :: ZWTHVSURF ! Surface w'thetav'
-REAL :: ZRDORV ! RD/RV
REAL :: ZRVORD ! RV/RD
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3
-
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
-
+REAL, DIMENSION(D%NIJT) :: ZMIX1,ZMIX2
-INTEGER :: ISV ! Number of scalar variables
-INTEGER :: IKU,IIJU ! array size in k
-INTEGER :: JK,JI,JJ,JSV ! loop counters
+REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
+INTEGER :: JK,JIJ,JSV ! loop counters
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT,IKB,IKE,IKL
+LOGICAL, DIMENSION(D%NIJT) :: GTEST,GTESTLCL
! Test if the ascent continue, if LCL or ETL is reached
LOGICAL :: GLMIX
! To choose upward or downward mixing length
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
-LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
+LOGICAL, DIMENSION(D%NIJT) :: GWORK1
+LOGICAL, DIMENSION(D%NIJT,D%NKT) :: GWORK2
INTEGER :: ITEST
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
+REAL, DIMENSION(D%NIJT) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZPHI
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZZDZ,ZZZ
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZZDZ
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN !
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZBETA1
+REAL, DIMENSION(D%NIJT) :: ZTEST,ZDZ,ZWUP_MEAN !
+REAL, DIMENSION(D%NIJT) :: ZCOE,ZWCOE,ZBUCOE
+REAL, DIMENSION(D%NIJT) :: ZDETR_BUO, ZDETR_RT
+REAL, DIMENSION(D%NIJT) :: ZW_MAX ! w**2 max of the updraft
+REAL, DIMENSION(D%NIJT) :: ZZTOP ! Top of the updraft
+!REAL, DIMENSION(SIZE(PTHM,1)) :: ZQTM,ZQT_UP
REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
REAL :: ZTMAX,ZRMAX, ZEPS ! control value
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
-
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
+!
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK
+REAL, DIMENSION(D%NIJT,16) :: ZBUF
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
+!
! Thresholds for the perturbation of
! theta_l and r_t at the first level of the updraft
@@ -265,30 +213,19 @@ ZEPS=1.E-15
! INITIALISATION
! Initialisation of the constants
-ZRDORV = XRD / XRV !=0.622
-ZRVORD = (XRV / XRD)
+ZRVORD = (CST%XRV / CST%XRD)
! depth are different in compute_updraft (3000. and 4000.) ==> impact is small
ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched
ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed
-! Initialisation of ZBETA1 ==> I do not remember why I introduced a KLON array for beta1 !
-
-ZBETA1(:) = XBETA1
-
! Local variables, internal domain
-! Internal Domain
-
-IKU=SIZE(PTHM,2)
-IIJU =SIZE(PTHM,1)
-!number of scalar variables
-ISV=SIZE(PSVM,3)
! Initialisation of intersesting Level :LCL,ETL,CTL
-KKLCL(:)=KKE
-KKETL(:)=KKE
-KKCTL(:)=KKE
+KKLCL(:)=IKE
+KKETL(:)=IKE
+KKCTL(:)=IKE
!
! Initialisation
@@ -309,115 +246,155 @@ PTHV_UP(:,:)=0.
PBUO_INTEG=0.
ZBUO =0.
+!no ice cloud coded yet
PRI_UP(:,:)=0.
PFRAC_ICE_UP(:,:)=0.
-PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PRSAT_UP(IIJB:IIJE,1:IKT)=PRVM(IIJB:IIJE,1:IKT) ! should be initialised correctly but is (normaly) not used
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! Initialisation of environment variables at t-dt
-! variables at flux level
-ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
-ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:))
-ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:))
-ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:))
-ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:))
+! variables at flux level
+CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
+CALL MZM_MF(D, PRTM(:,:), ZRTM_F(:,:))
+CALL MZM_MF(D, PUM(:,:), ZUM_F(:,:))
+CALL MZM_MF(D, PVM(:,:), ZVM_F(:,:))
+CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:))
-! This updraft is not yet ready to use scalar variables
+! This updraft is not yet ready to use scalar variables
!DO JSV=1,ISV
! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-! ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV))
+! *** SR merge AROME/Meso-nh: following two lines come from the AROME version
+! ZSVM_F(IIJB:IIJE,KKB:IKU,JSV) = 0.5*(PSVM(IIJB:IIJE,KKB:IKU,JSV)+PSVM(IIJB:IIJE,1:IKU-1,JSV))
+! ZSVM_F(IIJB:IIJE,1,JSV) = ZSVM_F(IIJB:IIJE,KKB,JSV)
+! *** the following single line comes from the Meso-NH version
+! ZSVM_F(IIJB:IIJE,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(IIJB:IIJE,:,JSV))
!END DO
! Initialisation of updraft characteristics
-PTHL_UP(:,:)=ZTHLM_F(:,:)
-PRT_UP(:,:)=ZRTM_F(:,:)
-PU_UP(:,:)=ZUM_F(:,:)
-PV_UP(:,:)=ZVM_F(:,:)
-PSV_UP(:,:,:)=0.
-! This updraft is not yet ready to use scalar variables
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PTHL_UP(IIJB:IIJE,1:IKT)=ZTHLM_F(IIJB:IIJE,1:IKT)
+PRT_UP(IIJB:IIJE,1:IKT)=ZRTM_F(IIJB:IIJE,1:IKT)
+PU_UP(IIJB:IIJE,1:IKT)=ZUM_F(IIJB:IIJE,1:IKT)
+PV_UP(IIJB:IIJE,1:IKT)=ZVM_F(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PSV_UP(IIJB:IIJE,1:IKT,:)=0.
+! This updraft is not yet ready to use scalar variables
!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then
-! PSV_UP(:,:,:)=ZSVM_F(:,:,:)
+! PSV_UP(IIJB:IIJE,:,:)=ZSVM_F(IIJB:IIJE,:,:)
!ENDIF
! Computation or initialisation of updraft characteristics at the KKB level
-! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF)
-
-!PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-!PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)
-PRT_UP(:,KKB) = ZRTM_F(:,KKB)
+! thetal_up,rt_up,thetaV_up, w,Buoyancy term and mass flux (PEMF)
+
+DO JIJ=IIJB,IIJE
+ !PTHL_UP(JIJ,KKB)= ZTHLM_F(JIJ,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JIJ)/SQRT(ZTKEM_F(JIJ,KKB)))*XALP_PERT))
+ !PRT_UP(JIJ,KKB) = ZRTM_F(JIJ,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JIJ)/SQRT(ZTKEM_F(JIJ,KKB)))*XALP_PERT))
+ PTHL_UP(JIJ,IKB)= ZTHLM_F(JIJ,IKB)
+ PRT_UP(JIJ,IKB) = ZRTM_F(JIJ,IKB)
+ !ZQT_UP(JIJ) = PRT_UP(JIJ,KKB)/(1.+PRT_UP(JIJ,KKB))
+ !ZTHS_UP(JIJ,KKB)=PTHL_UP(JIJ,KKB)*(1.+XLAMBDA_MF*ZQT_UP(JIJ))
+ENDDO
-ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
-ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
-ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:))
-ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:))
+CALL MZM_MF(D, PTHM (:,:), ZTHM_F(:,:))
+CALL MZM_MF(D, PPABSM(:,:), ZPRES_F(:,:))
+CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F(:,:))
+CALL MZM_MF(D, PRVM(:,:), ZRVM_F(:,:))
! thetav at mass and flux levels
-ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
-ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
+DO JK=1,IKT
+ DO JIJ=D%NIB,D%NIJE
+ ZTHVM_F(JIJ,JK)=ZTHM_F(JIJ,JK)*((1.+ZRVORD*ZRVM_F(JIJ,JK))/(1.+ZRTM_F(JIJ,JK)))
+ ENDDO
+ENDDO
-PTHV_UP(:,:)= ZTHVM_F(:,:)
-PRV_UP (:,:)= ZRVM_F (:,:)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PTHV_UP(IIJB:IIJE,1:IKT)= ZTHVM_F(IIJB:IIJE,1:IKT)
+PRV_UP(IIJB:IIJE,1:IKT)= ZRVM_F(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZW_UP2(:,:)=ZEPS
-ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+!ZW_UP2(IIJB:IIJE,KKB) = MAX(0.0001,(3./6.)*ZTKEM_F(IIJB:IIJE,KKB))
+ZW_UP2(IIJB:IIJE,IKB) = MAX(0.0001,(2./3.)*ZTKEM_F(IIJB:IIJE,IKB))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
! Computation of non conservative variable for the KKB level of the updraft
! (all or nothing ajustement)
-PRC_UP(:,KKB)=0.
-PRI_UP(:,KKB)=0.
-CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
- PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
-
-! compute updraft thevav and buoyancy term at KKB level
-PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
-! compute mean rsat in updraft
-PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PRC_UP(IIJB:IIJE,IKB)=0.
+PRI_UP(IIJB:IIJE,IKB)=0.
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,PFRAC_ICE_UP(:,IKB),ZPRES_F(:,IKB), &
+ PTHL_UP(:,IKB),PRT_UP(:,IKB),ZTH_UP(:,IKB), &
+ PRV_UP(:,IKB),PRC_UP(:,IKB),PRI_UP(:,IKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
+
+DO JIJ=IIJB,IIJE
+ ! compute updraft thevav and buoyancy term at KKB level
+ PTHV_UP(JIJ,IKB) = ZTH_UP(JIJ,IKB)*((1+ZRVORD*PRV_UP(JIJ,IKB))/(1+PRT_UP(JIJ,IKB)))
+ ! compute mean rsat in updraft
+ PRSAT_UP(JIJ,IKB) = ZRSATW(JIJ)*(1-PFRAC_ICE_UP(JIJ,IKB)) + ZRSATI(JIJ)*PFRAC_ICE_UP(JIJ,IKB)
+ENDDO
-!Tout est commente pour tester dans un premier temps la séparation en deux de la
+!Tout est commente pour tester dans un premier temps la separation en deux de la
! boucle verticale, une pour w et une pour PEMF
-ZG_O_THVREF=XG/ZTHVM_F
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZG_O_THVREF(IIJB:IIJE,1:IKT)=CST%XG/ZTHVM_F(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! Calcul de la fermeture de Julien Pergaut comme limite max de PHY
-DO JK=KKB,KKE-KKL,KKL ! Vertical loop
- ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level
- ZZZ(:,JK) = 0.5*(PZZ(:,JK+KKL)+PZZ(:,JK)) ! <== Hight of mass levels
+DO JK=IKB,IKE-IKL,IKL ! Vertical loop
+ DO JIJ=IIJB,IIJE
+ ZZDZ(JIJ,JK) = MAX(ZEPS,PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK)) ! <== Delta Z between two flux level
+ ENDDO
ENDDO
! compute L_up
GLMIX=.TRUE.
-ZTKEM_F(:,KKB)=0.
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZTKEM_F(IIJB:IIJE,IKB)=0.
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
-IF(CTURBLEN=='RM17') THEN
- ZDUDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PUM,PDZZ))
- ZDVDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PVM,PDZZ))
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+IF(TURBN%CTURBLEN=='RM17') THEN
+ CALL GZ_M_W_MF(D, PUM, PDZZ, ZWK)
+ CALL MZF_MF(D, ZWK, ZDUDZ)
+ CALL GZ_M_W_MF(D, PVM, PDZZ, ZWK)
+ CALL MZF_MF(D, ZWK, ZDVDZ)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)**2 + ZDVDZ(IIJB:IIJE,1:IKT)**2)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- ZSHEAR = 0. !no shear in bl89 mixing length
+ ZSHEAR(IIJB:IIJE,:) = 0. !no shear in bl89 mixing length
END IF
!
-CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), &
- ZTHVM_F,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
-ZLUP(:)=MAX(ZLUP(:),1.E-10)
-
-! Compute Buoyancy flux at the ground
-ZWTHVSURF(:) = (ZTHVM_F(:,KKB)/ZTHM_F(:,KKB))*PSFTH(:)+ &
- (0.61*ZTHM_F(:,KKB))*PSFRV(:)
-
-! Mass flux at KKB level (updraft triggered if PSFTH>0.)
-WHERE (ZWTHVSURF(:)>0.010) ! <== Not 0 Important to have stratocumulus !!!!!
- PEMF(:,KKB) = XCMF * ZRHO_F(:,KKB) * ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.)
- PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX)
- ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2
- GTEST(:)=.TRUE.
-ELSEWHERE
- PEMF(:,KKB) =0.
- GTEST(:)=.FALSE.
-ENDWHERE
+CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,IKB),ZG_O_THVREF(:,IKB), &
+ ZTHVM_F,IKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZLUP(IIJB:IIJE)=MAX(ZLUP(IIJB:IIJE),1.E-10)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+
+DO JIJ=IIJB,IIJE
+ ! Compute Buoyancy flux at the ground
+ ZWTHVSURF = (ZTHVM_F(JIJ,IKB)/ZTHM_F(JIJ,IKB))*PSFTH(JIJ)+ &
+ (0.61*ZTHM_F(JIJ,IKB))*PSFRV(JIJ)
+
+ ! Mass flux at KKB level (updraft triggered if PSFTH>0.)
+ IF (ZWTHVSURF>0.010) THEN ! <== Not 0 Important to have stratocumulus !!!!!
+ PEMF(JIJ,IKB) = PARAMMF%XCMF * ZRHO_F(JIJ,IKB) * ((ZG_O_THVREF(JIJ,IKB))*ZWTHVSURF*ZLUP(JIJ))**(1./3.)
+ PFRAC_UP(JIJ,IKB)=MIN(PEMF(JIJ,IKB)/(SQRT(ZW_UP2(JIJ,IKB))*ZRHO_F(JIJ,IKB)),PARAMMF%XFRAC_UP_MAX)
+ !PEMF(JIJ,KKB) = ZRHO_F(JIJ,KKB)*PFRAC_UP(JIJ,KKB)*SQRT(ZW_UP2(JIJ,KKB))
+ ZW_UP2(JIJ,IKB)=(PEMF(JIJ,IKB)/(PFRAC_UP(JIJ,IKB)*ZRHO_F(JIJ,IKB)))**2
+ GTEST(JIJ)=.TRUE.
+ ELSE
+ PEMF(JIJ,IKB) =0.
+ GTEST(JIJ)=.FALSE.
+ ENDIF
+ENDDO
!--------------------------------------------------------------------------
@@ -429,21 +406,19 @@ ENDWHERE
!
!
GTESTLCL(:)=.FALSE.
-GTESTETL(:)=.FALSE.
! Loop on vertical level to compute W
ZW_MAX(:) = 0.
ZZTOP(:) = 0.
-ZPHI(:) = 0.
-DO JK=KKB,KKE-KKL,KKL
+DO JK=IKB,IKE-IKL,IKL
! IF the updraft top is reached for all column, stop the loop on levels
- ITEST=COUNT(GTEST)
-! IF (ITEST==0) CYCLE ! <== I do not remember why I removed this ...
+ !ITEST=COUNT(GTEST)
+ !IF (ITEST==0) CYCLE
! Computation of entrainment and detrainment with KF90
! parameterization in clouds and LR01 in subcloud layer
@@ -451,10 +426,12 @@ DO JK=KKB,KKE-KKL,KKL
! to find the LCL (check if JK is LCL or not)
- WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
- KKLCL(:) = JK
- GTESTLCL(:)=.TRUE.
- ENDWHERE
+ DO JIJ=IIJB,IIJE
+ IF ((PRC_UP(JIJ,JK)+PRI_UP(JIJ,JK)>0.).AND.(.NOT.(GTESTLCL(JIJ)))) THEN
+ KKLCL(JIJ) = JK
+ GTESTLCL(JIJ)=.TRUE.
+ ENDIF
+ ENDDO
! COMPUTE PENTR and PDETR at mass level JK
@@ -464,142 +441,190 @@ DO JK=KKB,KKE-KKL,KKL
! Compute theta_v of updraft at flux level JK
- ZRC_UP(:) =PRC_UP(:,JK) ! guess
- ZRI_UP(:) =PRI_UP(:,JK) ! guess
- ZRV_UP(:) =PRV_UP(:,JK)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZRC_UP(IIJB:IIJE) =PRC_UP(IIJB:IIJE,JK) ! guess
+ ZRI_UP(IIJB:IIJE) =PRI_UP(IIJB:IIJE,JK) ! guess
+ ZRV_UP(IIJB:IIJE) =PRV_UP(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),&
- ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:))
+ ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
- WHERE (GTEST)
- PTHV_UP (:,JK) = ZTH_UP(:,JK)*(1.+ZRVORD*ZRV_UP(:))/(1.+PRT_UP(:,JK))
- ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK))
- PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK))
+ DO JIJ=IIJB,IIJE
+ IF (GTEST(JIJ)) THEN
+ PTHV_UP(JIJ,JK) = ZTH_UP(JIJ,JK)*(1.+ZRVORD*ZRV_UP(JIJ))/(1.+PRT_UP(JIJ,JK))
+ ZBUO(JIJ,JK) = ZG_O_THVREF(JIJ,JK)*(PTHV_UP(JIJ,JK) - ZTHVM_F(JIJ,JK))
+ PBUO_INTEG(JIJ,JK) = ZBUO(JIJ,JK)*(PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))
- ZDZ(:) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK))
- ZTEST(:) = XA1*ZBUO(:,JK) - XB*ZW_UP2(:,JK)
-
- ZCOE(:) = ZDZ(:)
- WHERE (ZTEST(:)>0.)
- ZCOE(:) = ZDZ(:)/(1.+ ZBETA1(:))
- ENDWHERE
-
-! Convective Vertical speed computation
-
- ZWCOE(:) = (1.-XB*ZCOE(:))/(1.+XB*ZCOE(:))
- ZBUCOE(:) = 2.*ZCOE(:)/(1.+XB*ZCOE(:))
-
-! Second Rachel bug correction (XA1 has been forgotten ... not yet tested ...)
-! ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + ZBUO(:,JK)*ZBUCOE(:) )
- ZW_UP2(:,JK+KKL) = MAX(ZEPS,ZW_UP2(:,JK)*ZWCOE(:) + XA1*ZBUO(:,JK)*ZBUCOE(:) )
- ZW_MAX(:) = MAX(ZW_MAX(:), SQRT(ZW_UP2(:,JK+KKL)))
- ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP2(:,JK+KKL)+ZW_UP2(:,JK)))
+ ZDZ(JIJ) = MAX(ZEPS,PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))
+ ZTEST(JIJ) = PARAMMF%XA1*ZBUO(JIJ,JK) - PARAMMF%XB*ZW_UP2(JIJ,JK)
+
+ ! Ancien calcul de la vitesse
+ ZCOE(JIJ) = ZDZ(JIJ)
+ IF (ZTEST(JIJ)>0.) THEN
+ ZCOE(JIJ) = ZDZ(JIJ)/(1.+ PARAMMF%XBETA1)
+ ENDIF
+
+ ! Convective Vertical speed computation
+ ZWCOE(JIJ) = (1.-PARAMMF%XB*ZCOE(JIJ))/(1.+PARAMMF%XB*ZCOE(JIJ))
+ ZBUCOE(JIJ) = 2.*ZCOE(JIJ)/(1.+PARAMMF%XB*ZCOE(JIJ))
+
+ ! Second Rachel bug correction (XA1 has been forgotten)
+ ZW_UP2(JIJ,JK+IKL) = MAX(ZEPS,ZW_UP2(JIJ,JK)*ZWCOE(JIJ) + PARAMMF%XA1*ZBUO(JIJ,JK)*ZBUCOE(JIJ) )
+ ZW_MAX(JIJ) = MAX(ZW_MAX(JIJ), SQRT(ZW_UP2(JIJ,JK+IKL)))
+ ZWUP_MEAN(JIJ) = MAX(ZEPS,0.5*(ZW_UP2(JIJ,JK+IKL)+ZW_UP2(JIJ,JK)))
-! Entrainement and detrainement
+ ! Entrainement and detrainement
-! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small)
- PENTR(:,JK) = MAX(0.,(ZBETA1(:)/(1.+ZBETA1(:)))*(XA1*ZBUO(:,JK)/ZWUP_MEAN(:)-XB))
- ZDETR_BUO(:) = MAX(0., -(ZBETA1(:)/(1.+ZBETA1(:)))*XA1*ZBUO(:,JK)/ZWUP_MEAN(:))
- ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK))) / MAX(ZEPS,ZRTM_F(:,JK)) / ZWUP_MEAN(:))
- PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:)
+ ! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small)
+ PENTR(JIJ,JK) = MAX(0.,(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))*(PARAMMF%XA1*ZBUO(JIJ,JK)/ZWUP_MEAN(JIJ)-PARAMMF%XB))
+ ZDETR_BUO(JIJ) = MAX(0., -(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))*PARAMMF%XA1*ZBUO(JIJ,JK)/ZWUP_MEAN(JIJ))
+ ZDETR_RT(JIJ) = PARAMMF%XC*SQRT(MAX(0.,(PRT_UP(JIJ,JK) - ZRTM_F(JIJ,JK))) / MAX(ZEPS,ZRTM_F(JIJ,JK)) / ZWUP_MEAN(JIJ))
+ PDETR(JIJ,JK) = ZDETR_RT(JIJ)+ZDETR_BUO(JIJ)
-! If the updraft did not stop, compute cons updraft characteritics at jk+1
-
- ZZTOP(:) = MAX(ZZTOP(:),PZZ(:,JK+KKL))
- ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK) !&
- ZMIX3(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PDETR(:,JK) !&
-
- PTHL_UP(:,JK+KKL)=(PTHL_UP(:,JK)*(1.-0.5*ZMIX2(:)) + PTHLM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- PRT_UP(:,JK+KKL) =(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- ENDWHERE ! GTEST
+ ! If the updraft did not stop, compute cons updraft characteritics at jk+1
+ ZZTOP(JIJ) = MAX(ZZTOP(JIJ),PZZ(JIJ,JK+IKL))
+ ZMIX2(JIJ) = (PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*PENTR(JIJ,JK) !&
+
+ !ZQTM(JIJ) = PRTM(JIJ,JK)/(1.+PRTM(JIJ,JK))
+ !ZTHSM(JIJ,JK) = PTHLM(JIJ,JK)*(1.+XLAMBDA_MF*ZQTM(JIJ))
+ !ZTHS_UP(JIJ,JK+KKL)=(ZTHS_UP(JIJ,JK)*(1.-0.5*ZMIX2(JIJ)) + ZTHSM(JIJ,JK)*ZMIX2(JIJ)) &
+ ! /(1.+0.5*ZMIX2(JIJ))
+ PRT_UP(JIJ,JK+IKL) =(PRT_UP (JIJ,JK)*(1.-0.5*ZMIX2(JIJ)) + PRTM(JIJ,JK)*ZMIX2(JIJ)) &
+ /(1.+0.5*ZMIX2(JIJ))
+ !ZQT_UP(JIJ) = PRT_UP(JIJ,JK+KKL)/(1.+PRT_UP(JIJ,JK+KKL))
+ !PTHL_UP(JIJ,JK+KKL)=ZTHS_UP(JIJ,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(JIJ))
+ PTHL_UP(JIJ,JK+IKL)=(PTHL_UP(JIJ,JK)*(1.-0.5*ZMIX2(JIJ)) + PTHLM(JIJ,JK)*ZMIX2(JIJ)) &
+ /(1.+0.5*ZMIX2(JIJ))
+ ENDIF ! GTEST
+ ENDDO
- IF(OMIXUV) THEN
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
- (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
- (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
- ENDWHERE
+ IF(PARAMMF%LMIXUV) THEN
+ IF(JK/=IKB) THEN
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ PU_UP(JIJ,JK+IKL) = (PU_UP (JIJ,JK)*(1-0.5*ZMIX2(JIJ)) + PUM(JIJ,JK)*ZMIX2(JIJ)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*&
+ ((PUM(JIJ,JK+IKL)-PUM(JIJ,JK))/PDZZ(JIJ,JK+IKL)+&
+ (PUM(JIJ,JK)-PUM(JIJ,JK-IKL))/PDZZ(JIJ,JK)) ) &
+ /(1+0.5*ZMIX2(JIJ))
+ PV_UP(JIJ,JK+IKL) = (PV_UP (JIJ,JK)*(1-0.5*ZMIX2(JIJ)) + PVM(JIJ,JK)*ZMIX2(JIJ)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*&
+ ((PVM(JIJ,JK+IKL)-PVM(JIJ,JK))/PDZZ(JIJ,JK+IKL)+&
+ (PVM(JIJ,JK)-PVM(JIJ,JK-IKL))/PDZZ(JIJ,JK)) ) &
+ /(1+0.5*ZMIX2(JIJ))
+ ENDIF
+ ENDDO
+ ELSE
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ PU_UP(JIJ,JK+IKL) = (PU_UP (JIJ,JK)*(1-0.5*ZMIX2(JIJ)) + PUM(JIJ,JK)*ZMIX2(JIJ)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*&
+ ((PUM(JIJ,JK+IKL)-PUM(JIJ,JK))/PDZZ(JIJ,JK+IKL)) ) &
+ /(1+0.5*ZMIX2(JIJ))
+ PV_UP(JIJ,JK+IKL) = (PV_UP (JIJ,JK)*(1-0.5*ZMIX2(JIJ)) + PVM(JIJ,JK)*ZMIX2(JIJ)+ &
+ 0.5*PARAMMF%XPRES_UV*(PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*&
+ ((PVM(JIJ,JK+IKL)-PVM(JIJ,JK))/PDZZ(JIJ,JK+IKL)) ) &
+ /(1+0.5*ZMIX2(JIJ))
+ ENDIF
+ ENDDO
+ ENDIF
ENDIF
-! This updraft is not yet ready to use scalar variables
+! This updraft is not yet ready to use scalar variables
! DO JSV=1,ISV
! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
! WHERE(GTEST)
-! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
-! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
+! PSV_UP(IIJB:IIJE,JK+KKL,JSV) = (PSV_UP (IIJB:IIJE,JK,JSV)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
+! PSVM(IIJB:IIJE,JK,JSV)*ZMIX2(IIJB:IIJE)) /(1+0.5*ZMIX2(IIJB:IIJE))
! ENDWHERE
! ENDDO
-! Compute non cons. var. at level JK+KKL
- ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
- ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
- ZRV_UP(:)=PRV_UP(:,JK)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
- PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
- WHERE(GTEST)
- PRC_UP(:,JK+KKL)=ZRC_UP(:)
- PRV_UP(:,JK+KKL)=ZRV_UP(:)
- PRI_UP(:,JK+KKL)=ZRI_UP(:)
- PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
- ENDWHERE
-
-
-! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
- WHERE(GTEST)
- PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
- ENDWHERE
-
- WHERE(GTEST)
- ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK))
- PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:))
-
-! Updraft fraction must be smaller than XFRAC_UP_MAX
- PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/(SQRT(ZW_UP2(:,JK+KKL))*ZRHO_F(:,JK+KKL))
- PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
- ENDWHERE
+ ! Compute non cons. var. at level JK+KKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZRC_UP(IIJB:IIJE)=PRC_UP(IIJB:IIJE,JK) ! guess = level just below
+ ZRI_UP(IIJB:IIJE)=PRI_UP(IIJB:IIJE,JK) ! guess = level just below
+ ZRV_UP(IIJB:IIJE)=PRV_UP(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+IKL),ZPRES_F(:,JK+IKL), &
+ PTHL_UP(:,JK+IKL),PRT_UP(:,JK+IKL),ZTH_UP(:,JK+IKL), &
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
+ PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
+
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ !ZT_UP(JIJ) = ZTH_UP(JIJ,JK+KKL)*PEXNM(JIJ,JK+KKL)
+ !ZCP(JIJ) = XCPD + XCL * ZRC_UP(JIJ)
+ !ZLVOCPEXN(JIJ)=(XLVTT + (XCPV-XCL) * (ZT_UP(JIJ)-XTT) ) / ZCP(JIJ) / PEXNM(JIJ,JK+KKL)
+ !PRC_UP(JIJ,JK+KKL)=MIN(0.5E-3,ZRC_UP(JIJ)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
+ !PTHL_UP(JIJ,JK+KKL) = PTHL_UP(JIJ,JK+KKL)+ZLVOCPEXN(JIJ)*(ZRC_UP(JIJ)-PRC_UP(JIJ,JK+KKL))
+ PRC_UP(JIJ,JK+IKL)=ZRC_UP(JIJ)
+ PRV_UP(JIJ,JK+IKL)=ZRV_UP(JIJ)
+ PRI_UP(JIJ,JK+IKL)=ZRI_UP(JIJ)
+ !PRT_UP(JIJ,JK+KKL) = PRC_UP(JIJ,JK+KKL) + PRV_UP(JIJ,JK+KKL)
+ PRSAT_UP(JIJ,JK+IKL) = ZRSATW(JIJ)*(1-PFRAC_ICE_UP(JIJ,JK+IKL)) + ZRSATI(JIJ)*PFRAC_ICE_UP(JIJ,JK+IKL)
+
+ ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
+ !PTHV_UP(IIJB:IIJE,JK+KKL) = PTH_UP(IIJB:IIJE,JK+KKL)*((1+ZRVORD*PRV_UP(IIJB:IIJE,JK+KKL))/(1+PRT_UP(IIJB:IIJE,JK+KKL)))
+ !PTHV_UP(JIJ,JK+KKL) = ZTH_UP(JIJ,JK+KKL)*(1.+0.608*PRV_UP(JIJ,JK+KKL) - PRC_UP(JIJ,JK+KKL))
+ !! A corriger pour utiliser q et non r !!!!
+ !ZMIX1(JIJ)=ZZDZ(JIJ,JK)*(PENTR(JIJ,JK)-PDETR(JIJ,JK))
+ PTHV_UP(JIJ,JK+IKL) = ZTH_UP(JIJ,JK+IKL)*((1+ZRVORD*PRV_UP(JIJ,JK+IKL))/(1+PRT_UP(JIJ,JK+IKL)))
+ ZMIX1(JIJ)=ZZDZ(JIJ,JK)*(PENTR(JIJ,JK)-PDETR(JIJ,JK))
+ ENDIF
+ ENDDO
+
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ PEMF(JIJ,JK+IKL)=PEMF(JIJ,JK)*EXP(ZMIX1(JIJ))
+ ENDIF
+ ENDDO
+
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ ! Updraft fraction must be smaller than XFRAC_UP_MAX
+ PFRAC_UP(JIJ,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX, &
+ &PEMF(JIJ,JK+IKL)/(SQRT(ZW_UP2(JIJ,JK+IKL))*ZRHO_F(JIJ,JK+IKL)))
+ !PEMF(JIJ,JK+KKL) = ZRHO_F(JIJ,JK+KKL)*PFRAC_UP(JIJ,JK+KKL)*SQRT(ZW_UP2(JIJ,JK+KKL))
+ ENDIF
+ ENDDO
! Test if the updraft has reach the ETL
- GTESTETL(:)=.FALSE.
- WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
- KKETL(:) = JK+KKL
- GTESTETL(:)=.TRUE.
- ENDWHERE
+ DO JIJ=IIJB,IIJE
+ IF (GTEST(JIJ) .AND. (PBUO_INTEG(JIJ,JK)<=0.)) THEN
+ KKETL(JIJ) = JK+IKL
+ ENDIF
+ ENDDO
! Test is we have reached the top of the updraft
-
- WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS).OR.(PEMF(:,JK+KKL)<=ZEPS)))
- ZW_UP2 (:,JK+KKL)=ZEPS
- PEMF (:,JK+KKL)=0.
- GTEST (:) =.FALSE.
- PTHL_UP (:,JK+KKL)=ZTHLM_F(:,JK+KKL)
- PRT_UP (:,JK+KKL)=ZRTM_F(:,JK+KKL)
- PRC_UP (:,JK+KKL)=0.
- PRI_UP (:,JK+KKL)=0.
- PRV_UP (:,JK+KKL)=ZRVM_F (:,JK+KKL)
- PTHV_UP (:,JK+KKL)=ZTHVM_F(:,JK+KKL)
- PFRAC_UP (:,JK+KKL)=0.
- KKCTL (:) =JK+KKL
-
- ENDWHERE
-
+ DO JIJ=IIJB,IIJE
+ IF (GTEST(JIJ) .AND. ((ZW_UP2(JIJ,JK+IKL)<=ZEPS).OR.(PEMF(JIJ,JK+IKL)<=ZEPS))) THEN
+ ZW_UP2 (JIJ,JK+IKL)=ZEPS
+ PEMF (JIJ,JK+IKL)=0.
+ GTEST (JIJ) =.FALSE.
+ PTHL_UP (JIJ,JK+IKL)=ZTHLM_F(JIJ,JK+IKL)
+ PRT_UP (JIJ,JK+IKL)=ZRTM_F(JIJ,JK+IKL)
+ PRC_UP (JIJ,JK+IKL)=0.
+ PRI_UP (JIJ,JK+IKL)=0.
+ PRV_UP (JIJ,JK+IKL)=ZRVM_F (JIJ,JK+IKL)
+ PTHV_UP (JIJ,JK+IKL)=ZTHVM_F(JIJ,JK+IKL)
+ PFRAC_UP (JIJ,JK+IKL)=0.
+ KKCTL (JIJ) =JK+IKL
+ ENDIF
+ ENDDO
ENDDO ! Fin de la boucle verticale
-PW_UP(:,:)=SQRT(ZW_UP2(:,:))
-PEMF(:,KKB) =0.
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PW_UP(IIJB:IIJE,1:IKT)=SQRT(ZW_UP2(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PEMF(IIJB:IIJE,IKB) =0.
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
! To do this, mass flux is multiplied by a coefficient decreasing linearly
@@ -607,19 +632,34 @@ PEMF(:,KKB) =0.
! This way, all MF fluxes are diminished by this amount.
! Diagnosed cloud fraction is also multiplied by the same coefficient.
!
-DO JI=1,SIZE(PTHM,1)
- PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
-END DO
-
-GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
-GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
-ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU)
-ZCOEF=MIN(MAX(ZCOEF,0.),1.)
-WHERE (GWORK2)
- PEMF(:,:) = PEMF(:,:) * ZCOEF(:,:)
- PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
-ENDWHERE
-
-END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10
+DO JIJ=IIJB,IIJE
+ PDEPTH(JIJ) = MAX(0., PZZ(JIJ,KKCTL(JIJ)) - PZZ(JIJ,KKLCL(JIJ)) )
+ENDDO
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+GWORK1(IIJB:IIJE)= (GTESTLCL(IIJB:IIJE) .AND. (PDEPTH(IIJB:IIJE) > ZDEPTH_MAX1) )
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+DO JK=1,IKT
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ GWORK2(IIJB:IIJE,JK) = GWORK1(IIJB:IIJE)
+ ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ZCOEF(IIJB:IIJE,JK)=MIN(MAX(ZCOEF(IIJB:IIJE,JK),0.),1.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ENDDO
+DO JK=1,IKT
+ DO JIJ=IIJB,IIJE
+ IF (GWORK2(JIJ,JK)) THEN
+ PEMF(JIJ,JK) = PEMF(JIJ,JK) * ZCOEF(JIJ,JK)
+ PFRAC_UP(JIJ,JK) = PFRAC_UP(JIJ,JK) * ZCOEF(JIJ,JK)
+ ENDIF
+ ENDDO
+ENDDO
+IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',1,ZHOOK_HANDLE)
+!
+CONTAINS
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
+!
+END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10
+END MODULE MODE_COMPUTE_UPDRAFT_RHCJ10
diff --git a/src/PHYEX/turb/mode_emoist.f90 b/src/PHYEX/turb/mode_emoist.f90
index 7703fb388efc28be14bffeb7d070dcdc0167af19..477e6373791683a053476a0fe0b71dcbc3383f91 100644
--- a/src/PHYEX/turb/mode_emoist.f90
+++ b/src/PHYEX/turb/mode_emoist.f90
@@ -1,37 +1,13 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!#################
-MODULE MODI_EMOIST
-!#################
-!
-INTERFACE
-!
-FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
-!
-INTEGER :: KRR ! number of moist var.
-INTEGER :: KRRI ! number of ice var.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
-! PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! Amoist
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
- ! moment s'r'c/2Sigma_s2
-!
-REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PEMOIST ! result
-!
-END FUNCTION EMOIST
-!
-END INTERFACE
-!
-END MODULE MODI_EMOIST
-!
-! ############################################################################
-FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
+MODULE MODE_EMOIST
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE EMOIST(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN,PEMOIST)
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ############################################################################
!
! PURPOSE
@@ -81,105 +57,139 @@ FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
!
!* 0. DECLARATIONS
! ------------
-USE MODD_CST
-USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_CST, ONLY : CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
INTEGER :: KRR ! number of moist var.
INTEGER :: KRRI ! number of ice var.
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHLM ! Conservative pot. temperature
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), INTENT(IN) :: PRM ! Mixing ratios, where
! PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! Amoist
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PAMOIST ! Amoist
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PSRCM ! Normalized 2dn_order
! moment s'r'c/2Sigma_s2
!
-REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PEMOIST ! result
+REAL,DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PEMOIST ! result
!
!* 0.2 declarations of local variables
!
-REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+REAL,DIMENSION(D%NIT,D%NJT,D%NKT) :: &
ZA, ZRW
! ZA = coeft A, ZRW = total mixing ratio rw
REAL :: ZDELTA ! = Rv/Rd - 1
INTEGER :: JRR ! moist loop counter
+INTEGER :: JI,JJ,JK ! loop counter
+INTEGER :: IIB,IJB,IIE,IJE,IKT
!
!---------------------------------------------------------------------------
!
!
!* 1. COMPUTE EMOIST
! --------------
-IF (LOCEAN) THEN
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('EMOIST',0,ZHOOK_HANDLE)
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+!
+IF (OOCEAN) THEN
IF ( KRR == 0 ) THEN ! Unsalted
- PEMOIST(:,:,:) = 0.
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = 0.
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ELSE
- PEMOIST(:,:,:) = 1. ! Salted case
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = 1. ! Salted case
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
END IF
!
ELSE
!
IF ( KRR == 0 ) THEN ! dry case
- PEMOIST(:,:,:) = 0.
+ PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = 0.
ELSE IF ( KRR == 1 ) THEN ! only vapor
- ZDELTA = (XRV/XRD) - 1.
- PEMOIST(:,:,:) = ZDELTA*PTHLM(:,:,:)
+ ZDELTA = (CST%XRV/CST%XRD) - 1.
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = ZDELTA*PTHLM(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ELSE ! liquid water & ice present
- ZDELTA = (XRV/XRD) - 1.
- ZRW(:,:,:) = PRM(:,:,:,1)
+ ZDELTA = (CST%XRV/CST%XRD) - 1.
+ ZRW(IIB:IIE,IJB:IJE,1:IKT) = PRM(IIB:IIE,IJB:IJE,1:IKT,1)
!
- IF ( KRRI>0) THEN ! rc and ri case
- ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,3)
+ IF ( KRRI>0) THEN ! rc and ri case
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,3)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
DO JRR=5,KRR
- ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,JRR)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,JRR)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ENDDO
- ZA(:,:,:) = 1. + ( & ! Compute A
- (1.+ZDELTA) * (PRM(:,:,:,1) - PRM(:,:,:,2) - PRM(:,:,:,4)) &
- -ZRW(:,:,:) &
- ) / (1. + ZRW(:,:,:))
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ( & ! Compute A
+ (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:IKT,1) - PRM(IIB:IIE,IJB:IJE,1:IKT,2) - PRM(IIB:IIE,IJB:IJE,1:IKT,4)) &
+ -ZRW(IIB:IIE,IJB:IJE,1:IKT) &
+ ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT))
!
! Emoist = ZB + ZC * Amoist
! ZB is computed from line 1 to line 2
! ZC is computed from line 3 to line 5
! Amoist* 2 * SRC is computed at line 6
!
- PEMOIST(:,:,:) = ZDELTA * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*( &
- PRM(:,:,:,2)+PRM(:,:,:,4)))&
- / (1. + ZRW(:,:,:)) &
- +( PLOCPEXNM(:,:,:) * ZA(:,:,:) &
- -(1.+ZDELTA) * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*( &
- PRM(:,:,:,2)+PRM(:,:,:,4)))&
- / (1. + ZRW(:,:,:)) &
- ) * PAMOIST(:,:,:) * 2. * PSRCM(:,:,:)
+ PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = ZDELTA * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)*( &
+ PRM(IIB:IIE,IJB:IJE,1:IKT,2)+PRM(IIB:IIE,IJB:IJE,1:IKT,4)))&
+ / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) &
+ +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT) * ZA(IIB:IIE,IJB:IJE,1:IKT) &
+ -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)*( &
+ PRM(IIB:IIE,IJB:IJE,1:IKT,2)+PRM(IIB:IIE,IJB:IJE,1:IKT,4)))&
+ / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) &
+ ) * PAMOIST(IIB:IIE,IJB:IJE,1:IKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ELSE
DO JRR=3,KRR
- ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,JRR)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,JRR)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ENDDO
- ZA(:,:,:) = 1. + ( & ! Compute ZA
- (1.+ZDELTA) * (PRM(:,:,:,1) - PRM(:,:,:,2)) &
- -ZRW(:,:,:) &
- ) / (1. + ZRW(:,:,:))
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ( & ! Compute ZA
+ (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:IKT,1) - PRM(IIB:IIE,IJB:IJE,1:IKT,2)) &
+ -ZRW(IIB:IIE,IJB:IJE,1:IKT) &
+ ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT))
!
! Emoist = ZB + ZC * Amoist
! ZB is computed from line 1 to line 2
! ZC is computed from line 3 to line 5
! Amoist* 2 * SRC is computed at line 6
!
- PEMOIST(:,:,:) = ZDELTA * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*PRM(:,:,:,2)) &
- / (1. + ZRW(:,:,:)) &
- +( PLOCPEXNM(:,:,:) * ZA(:,:,:) &
- -(1.+ZDELTA) * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*PRM(:,:,:,2)) &
- / (1. + ZRW(:,:,:)) &
- ) * PAMOIST(:,:,:) * 2. * PSRCM(:,:,:)
+ PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = ZDELTA * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)* &
+ PRM(IIB:IIE,IJB:IJE,1:IKT,2)) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) &
+ +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT) * ZA(IIB:IIE,IJB:IJE,1:IKT) &
+ -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)* &
+ PRM(IIB:IIE,IJB:IJE,1:IKT,2)) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) &
+ ) * PAMOIST(IIB:IIE,IJB:IJE,1:IKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
END IF
END IF
!
END IF
!---------------------------------------------------------------------------
!
-END FUNCTION EMOIST
+IF (LHOOK) CALL DR_HOOK('EMOIST',1,ZHOOK_HANDLE)
+END SUBROUTINE EMOIST
+END MODULE MODE_EMOIST
diff --git a/src/PHYEX/turb/mode_etheta.f90 b/src/PHYEX/turb/mode_etheta.f90
index 3ef29178b721660ec33639f4199166e0f6d1a9d0..0c03e420beea467ac2ab2fbc8d5a95a9890b87db 100644
--- a/src/PHYEX/turb/mode_etheta.f90
+++ b/src/PHYEX/turb/mode_etheta.f90
@@ -2,38 +2,12 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!#################
-MODULE MODI_ETHETA
-!#################
-!
-INTERFACE
-!
-FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
-!
-INTEGER :: KRR ! number of moist var.
-INTEGER :: KRRI ! number of ice var.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
-! PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! Atheta
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
- ! moment s'r'c/2Sigma_s2
-!
-REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PETHETA ! result
-!
-!
-END FUNCTION ETHETA
-!
-END INTERFACE
-!
-END MODULE MODI_ETHETA
-!
-! ############################################################################
-FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
+MODULE MODE_ETHETA
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE ETHETA(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN,OCOMPUTE_SRC,PETHETA)
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ############################################################################
!
! PURPOSE
@@ -82,37 +56,45 @@ FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
!
!* 0. DECLARATIONS
! ------------
-USE MODD_CST
-USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_CST, ONLY : CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
INTEGER :: KRR ! number of moist var.
INTEGER :: KRRI ! number of ice var.
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHLM ! Conservative pot. temperature
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), INTENT(IN) :: PRM ! Mixing ratios, where
! PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! Atheta
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PATHETA ! Atheta
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and
+REAL, DIMENSION(MERGE(D%NIT,0,OCOMPUTE_SRC),&
+ MERGE(D%NJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(IN) :: PSRCM ! Normalized 2dn_order
! moment s'r'c/2Sigma_s2
!
-REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PETHETA ! result
+REAL,DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PETHETA ! result
!
!
!
!* 0.2 declarations of local variables
!
-REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+REAL,DIMENSION(D%NIT,D%NJT,D%NKT) :: &
ZA, ZRW
! ZA = coeft A, ZRW = total mixing ratio rw
REAL :: ZDELTA ! = Rv/Rd - 1
INTEGER :: JRR ! moist loop counter
+INTEGER :: JI,JJ,JK ! loop counter
+INTEGER :: IIB,IJB,IIE,IJE,IKT
!
!---------------------------------------------------------------------------
!
@@ -121,60 +103,89 @@ INTEGER :: JRR ! moist loop counter
! --------------
!
!
-IF (LOCEAN) THEN ! ocean case
- PETHETA(:,:,:) = 1.
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('ETHETA',0,ZHOOK_HANDLE)
+!
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IKT=D%NKT
+!
+IF (OOCEAN) THEN ! ocean case
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PETHETA(IIB:IIE,IJB:IJE,1:IKT) = 1.
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ELSE
- IF ( KRR == 0.) THEN ! dry case
- PETHETA(:,:,:) = 1.
+ IF ( KRR == 0) THEN ! dry case
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PETHETA(IIB:IIE,IJB:IJE,1:IKT) = 1.
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ELSE IF ( KRR == 1 ) THEN ! only vapor
- ZDELTA = (XRV/XRD) - 1.
- PETHETA(:,:,:) = 1. + ZDELTA*PRM(:,:,:,1)
+ ZDELTA = (CST%XRV/CST%XRD) - 1.
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ PETHETA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ZDELTA*PRM(IIB:IIE,IJB:IJE,1:IKT,1)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ELSE ! liquid water & ice present
- ZDELTA = (XRV/XRD) - 1.
- ZRW(:,:,:) = PRM(:,:,:,1)
+ ZDELTA = (CST%XRV/CST%XRD) - 1.
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZRW(IIB:IIE,IJB:IJE,1:IKT) = PRM(IIB:IIE,IJB:IJE,1:IKT,1)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
!
IF ( KRRI>0 ) THEN ! rc and ri case
- ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,3)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,3)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
DO JRR=5,KRR
- ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,JRR)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,JRR)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ENDDO
- ZA(:,:,:) = 1. + ( & ! Compute A
- (1.+ZDELTA) * (PRM(:,:,:,1) - PRM(:,:,:,2) - PRM(:,:,:,4)) &
- -ZRW(:,:,:) &
- ) / (1. + ZRW(:,:,:))
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ( & ! Compute A
+ (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:IKT,1) - PRM(IIB:IIE,IJB:IJE,1:IKT,2) - PRM(IIB:IIE,IJB:IJE,1:IKT,4)) &
+ -ZRW(IIB:IIE,IJB:IJE,1:IKT) &
+ ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT))
!
! Etheta = ZA + ZC * Atheta
! ZC is computed from line 2 to line 5
! - Atheta * 2. * SRC is computed at line 6
!
- PETHETA(:,:,:) = ZA(:,:,:) &
- +( PLOCPEXNM(:,:,:) * ZA(:,:,:) &
- -(1.+ZDELTA) * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*( &
- PRM(:,:,:,2)+PRM(:,:,:,4)))&
- / (1. + ZRW(:,:,:)) &
- ) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
+ PETHETA(IIB:IIE,IJB:IJE,1:IKT) = ZA(IIB:IIE,IJB:IJE,1:IKT) &
+ +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT) * ZA(IIB:IIE,IJB:IJE,1:IKT) &
+ -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)*( &
+ PRM(IIB:IIE,IJB:IJE,1:IKT,2)+PRM(IIB:IIE,IJB:IJE,1:IKT,4)))&
+ / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) &
+ ) * PATHETA(IIB:IIE,IJB:IJE,1:IKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ELSE
DO JRR=3,KRR
- ZRW(:,:,:) = ZRW(:,:,:) + PRM(:,:,:,JRR)
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,JRR)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
ENDDO
- ZA(:,:,:) = 1. + ( & ! Compute A
- (1.+ZDELTA) * (PRM(:,:,:,1) - PRM(:,:,:,2)) &
- -ZRW(:,:,:) &
- ) / (1. + ZRW(:,:,:))
+ !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
+ ZA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ( & ! Compute A
+ (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:IKT,1) - PRM(IIB:IIE,IJB:IJE,1:IKT,2)) &
+ -ZRW(IIB:IIE,IJB:IJE,1:IKT) &
+ ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT))
!
! Etheta = ZA + ZC * Atheta
! ZC is computed from line 2 to line 5
! - Atheta * 2. * SRC is computed at line 6
!
- PETHETA(:,:,:) = ZA(:,:,:) &
- +( PLOCPEXNM(:,:,:) * ZA(:,:,:) &
- -(1.+ZDELTA) * (PTHLM(:,:,:) + PLOCPEXNM(:,:,:)*PRM(:,:,:,2)) &
- / (1. + ZRW(:,:,:)) &
- ) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
+ PETHETA(IIB:IIE,IJB:IJE,1:IKT) = ZA(IIB:IIE,IJB:IJE,1:IKT) &
+ +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT) * ZA(IIB:IIE,IJB:IJE,1:IKT) -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) &
+ + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)*PRM(IIB:IIE,IJB:IJE,1:IKT,2)) &
+ / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) &
+ ) * PATHETA(IIB:IIE,IJB:IJE,1:IKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:IKT)
+ !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT)
END IF
END IF
!
END IF
!---------------------------------------------------------------------------
!
-END FUNCTION ETHETA
+IF (LHOOK) CALL DR_HOOK('ETHETA',1,ZHOOK_HANDLE)
+END SUBROUTINE ETHETA
+END MODULE MODE_ETHETA
diff --git a/src/PHYEX/turb/mode_ibm_mixinglength.f90 b/src/PHYEX/turb/mode_ibm_mixinglength.f90
index 14bb0dd89b6effcd7d00516aea80b62a9b222b78..7f74c571a60118414f48f509d1f3b7f95e3d5e26 100644
--- a/src/PHYEX/turb/mode_ibm_mixinglength.f90
+++ b/src/PHYEX/turb/mode_ibm_mixinglength.f90
@@ -4,28 +4,10 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!
-! ############################
-MODULE MODI_IBM_MIXINGLENGTH
- ! ############################
- !
- INTERFACE
- !
- SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
- !
- REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
- REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
- REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- !
- END SUBROUTINE IBM_MIXINGLENGTH
- !
- END INTERFACE
- !
-END MODULE MODI_IBM_MIXINGLENGTH
-!
-! ###################################################
-SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+MODULE MODE_IBM_MIXINGLENGTH
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE IBM_MIXINGLENGTH(D,PLM,PLEPS,PMU,PHI,PTKE)
! ###################################################
!
!**** *IBM_MIXINGLENGTH* - Alteration of the mixing lenght (IBM)
@@ -63,10 +45,8 @@ SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
! ------------------
!
! module
- USE MODE_POS
USE MODE_ll
- USE MODE_IO
- USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
! declaration
USE MODD_FIELD_n
@@ -84,27 +64,30 @@ SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
!------------------------------------------------------------------------------
!
! 0.1 Declaration of arguments
- REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
- REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
- REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PMU
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PHI
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTKE
!
!------------------------------------------------------------------------------
!
! 0.2 Declaration of local variables
- REAL, DIMENSION(size(PLM,1),size(PLM,2),size(PLM,3)) :: ZALPHA,ZBETA
- REAL, DIMENSION(size(PLM,1),size(PLM,2),size(PLM,3)) :: ZLM,ZMU,ZLN
- TYPE(LIST_ll), POINTER :: TZFIELDS_ll
- INTEGER :: IINFO_ll,IKU,IKB,IKE,IIB,IIE,IJB,IJE
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZALPHA,ZBETA
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZLM,ZMU,ZLN
+ INTEGER :: IKU,IKB,IKE,IIB,IIE,IJB,IJE
REAL :: ZKARMAN
!
!-------------------------------------------------------------------------------
!
- IKU=SIZE(PLM,3)
- IKE = IKU - JPVEXT
- IKB = 1 + JPVEXT
- CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+ IKU = D%NKT
+ IKE = D%NKE
+ IKB = D%NKB
+ IIB = D%NIB
+ IIE = D%NIE
+ IJB = D%NJB
+ IJE = D%NJE
!
! Turbulent velocity
!
@@ -159,6 +142,5 @@ SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
PLEPS(:,:,:) = PLM(:,:,:)
PMU(:,:,:) = ZMU(:,:,:)
!
- RETURN
- !
END SUBROUTINE IBM_MIXINGLENGTH
+END MODULE MODE_IBM_MIXINGLENGTH
diff --git a/src/PHYEX/turb/mode_mf_turb.f90 b/src/PHYEX/turb/mode_mf_turb.f90
index 2a96b713ab98f74b0fc5fd8128825d6028bacf87..f168dfc9606cf5ea552063937da23328a00a934e 100644
--- a/src/PHYEX/turb/mode_mf_turb.f90
+++ b/src/PHYEX/turb/mode_mf_turb.f90
@@ -3,84 +3,12 @@
!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_MF_TURB
+ MODULE MODE_MF_TURB
! ######################
!
-INTERFACE
-! #################################################################
- SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL, PTSTEP, &
- PDZZ, &
- PRHODJ, &
- PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
- PTHLDT,PRTDT,PUDT,PVDT,PSVDT, &
- PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, &
- PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
- PFLXZSVMF )
-
-! #################################################################
-!
-!
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-
-! Conservative var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
-! Virtual potential temperature at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
-! Momentum at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM
-! scalar variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
-!
-! Tendencies of conservative variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
-! Tendencies of momentum
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
-! Tendencies of scalar variables
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
-
-
-! Updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP
-! Fluxes
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
-
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
-
-END SUBROUTINE MF_TURB
-
-END INTERFACE
-!
-END MODULE MODI_MF_TURB
-
-
-! #################################################################
- SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE MF_TURB(D, KSV, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PIMPL, PTSTEP, &
PDZZ, &
@@ -134,10 +62,13 @@ END MODULE MODI_MF_TURB
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_MFSHALL_n
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+USE MODI_SHUMAN_MF, ONLY: MZM_MF
+USE MODE_TRIDIAG_MASSFLUX, ONLY: TRIDIAG_MASSFLUX
!
-USE MODI_SHUMAN_MF
-USE MODI_TRIDIAG_MASSFLUX
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
@@ -145,11 +76,8 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+INTEGER, INTENT(IN) :: KSV
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
@@ -157,39 +85,39 @@ INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
! Conservative var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRTM ! water var. where
! Virtual potential temperature at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVM
! Momentum at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVM
! scalar variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM
!
! Tendencies of conservative variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTHLDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRTDT
! Tendencies of momentum
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PUDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PVDT
! Tendencies of scalar variables
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT) :: PSVDT
! Updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSV_UP
! Fluxes
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT):: PFLXZSVMF
!
!
!
@@ -198,20 +126,23 @@ REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
! 0.2 declaration of local variables
!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZVARS
-
-!
-INTEGER :: ISV,JSV !number of scalar variables and Loop counter
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZVARS
+INTEGER :: JSV !number of scalar variables and Loop counter
+INTEGER :: JIJ, JK
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!----------------------------------------------------------------------------
!
!* 1.PRELIMINARIES
! -------------
!
+IF (LHOOK) CALL DR_HOOK('MF_TURB',0,ZHOOK_HANDLE)
!
-! number of scalar var
-ISV=SIZE(PSVM,3)
-
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
!
PFLXZSVMF = 0.
PSVDT = 0.
@@ -226,15 +157,23 @@ PSVDT = 0.
! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
!
-PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:)))
-
-PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,PRTM(:,:)))
+CALL MZM_MF(D, PTHLM(:,:), PFLXZTHMF(:,:))
+CALL MZM_MF(D, PRTM(:,:), PFLXZRMF(:,:))
+CALL MZM_MF(D, PTHVM(:,:), PFLXZTHVMF(:,:))
-PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHVM(:,:)))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PFLXZTHMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHL_UP(IIJB:IIJE,1:IKT)-PFLXZTHMF(IIJB:IIJE,1:IKT))
+PFLXZRMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PRT_UP(IIJB:IIJE,1:IKT)-PFLXZRMF(IIJB:IIJE,1:IKT))
+PFLXZTHVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHV_UP(IIJB:IIJE,1:IKT)-PFLXZTHVMF(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
IF (OMIXUV) THEN
- PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,PUM(:,:)))
- PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PVM(:,:)))
+ CALL MZM_MF(D, PUM(:,:), PFLXZUMF(:,:))
+ CALL MZM_MF(D, PVM(:,:), PFLXZVMF(:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PFLXZUMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PU_UP(IIJB:IIJE,1:IKT)-PFLXZUMF(IIJB:IIJE,1:IKT))
+ PFLXZVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PV_UP(IIJB:IIJE,1:IKT)-PFLXZVMF(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
PFLXZUMF(:,:) = 0.
PFLXZVMF(:,:) = 0.
@@ -253,25 +192,26 @@ ENDIF
! 3.1 Compute the tendency for the conservative potential temperature
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
-CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, &
+CALL TRIDIAG_MASSFLUX(D,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
-! compute new flux
-PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
-
-!!! compute THL tendency
-!
-PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP
+! compute new flux and THL tendency
+CALL MZM_MF(D, ZVARS(:,:), PFLXZTHMF(:,:))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PFLXZTHMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHL_UP(IIJB:IIJE,1:IKT)-PFLXZTHMF(IIJB:IIJE,1:IKT))
+PTHLDT(IIJB:IIJE,1:IKT)= (ZVARS(IIJB:IIJE,1:IKT)-PTHLM(IIJB:IIJE,1:IKT))/PTSTEP
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! 3.2 Compute the tendency for the conservative mixing ratio
!
-CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, &
+CALL TRIDIAG_MASSFLUX(D,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
-! compute new flux
-PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
-
-!!! compute RT tendency
-PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP
+! compute new flux and RT tendency
+CALL MZM_MF(D, ZVARS(:,:), PFLXZRMF(:,:))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PFLXZRMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PRT_UP(IIJB:IIJE,1:IKT)-PFLXZRMF(IIJB:IIJE,1:IKT))
+PRTDT(IIJB:IIJE,1:IKT) = (ZVARS(IIJB:IIJE,1:IKT)-PRTM(IIJB:IIJE,1:IKT))/PTSTEP
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
IF (OMIXUV) THEN
@@ -280,53 +220,61 @@ IF (OMIXUV) THEN
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL, &
+ CALL TRIDIAG_MASSFLUX(D,PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
-
- ! compute U tendency
- PUDT(:,:)= (ZVARS(:,:)-PUM(:,:))/PTSTEP
-
+ ! compute new flux and U tendency
+ CALL MZM_MF(D, ZVARS(:,:), PFLXZUMF(:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PFLXZUMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PU_UP(IIJB:IIJE,1:IKT)-PFLXZUMF(IIJB:IIJE,1:IKT))
+ PUDT(IIJB:IIJE,1:IKT)= (ZVARS(IIJB:IIJE,1:IKT)-PUM(IIJB:IIJE,1:IKT))/PTSTEP
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
! 3.4 Compute the tendency for the (non conservative but treated as it for the time beiing)
! meridian momentum
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL, &
+ CALL TRIDIAG_MASSFLUX(D,PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
-
- ! compute V tendency
- PVDT(:,:)= (ZVARS(:,:)-PVM(:,:))/PTSTEP
+ ! compute new flux and V tendency
+ CALL MZM_MF(D, ZVARS(:,:), PFLXZVMF(:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PFLXZVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PV_UP(IIJB:IIJE,1:IKT)-PFLXZVMF(IIJB:IIJE,1:IKT))
+ PVDT(IIJB:IIJE,1:IKT)= (ZVARS(IIJB:IIJE,1:IKT)-PVM(IIJB:IIJE,1:IKT))/PTSTEP
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
PUDT(:,:)=0.
PVDT(:,:)=0.
ENDIF
-DO JSV=1,ISV
+DO JSV=1,KSV
IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
!* compute mean flux of scalar variables at time t-dt
! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
- PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV)))
-
+ CALL MZM_MF(D, PSVM(:,:,JSV), PFLXZSVMF(:,:,JSV))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PFLXZSVMF(IIJB:IIJE,1:IKT,JSV) = PEMF(IIJB:IIJE,1:IKT)*&
+ & (PSV_UP(IIJB:IIJE,1:IKT,JSV)-PFLXZSVMF(IIJB:IIJE,1:IKT,JSV))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! 3.5 Compute the tendency for scalar variables
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),&
+ CALL TRIDIAG_MASSFLUX(D,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),&
-PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,ZVARS))
-
- ! compute Sv tendency
- PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP
+ ! compute new flux and Sv tendency
+ CALL MZM_MF(D, ZVARS, PFLXZSVMF(:,:,JSV))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PFLXZSVMF(IIJB:IIJE,1:IKT,JSV) = PEMF(IIJB:IIJE,1:IKT)*&
+ & (PSV_UP(IIJB:IIJE,1:IKT,JSV)-PFLXZSVMF(IIJB:IIJE,1:IKT,JSV))
+ PSVDT(IIJB:IIJE,1:IKT,JSV)= (ZVARS(IIJB:IIJE,1:IKT)-PSVM(IIJB:IIJE,1:IKT,JSV))/PTSTEP
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDDO
!
+IF (LHOOK) CALL DR_HOOK('MF_TURB',1,ZHOOK_HANDLE)
END SUBROUTINE MF_TURB
+END MODULE MODE_MF_TURB
diff --git a/src/PHYEX/turb/mode_mf_turb_expl.f90 b/src/PHYEX/turb/mode_mf_turb_expl.f90
index a22f092c2747410eef8c2728b1966736f8eeed2a..79fc3919e2eaa1ad73986573b672e0ef3787812c 100644
--- a/src/PHYEX/turb/mode_mf_turb_expl.f90
+++ b/src/PHYEX/turb/mode_mf_turb_expl.f90
@@ -3,68 +3,12 @@
!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_MF_TURB_EXPL
+ MODULE MODE_MF_TURB_EXPL
! ######################
-!
-INTERFACE
-!
-! #################################################################
- SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
- PRHODJ, &
- PTHLM,PTHVM,PRTM,PUM,PVM, &
- PTHLDT,PRTDT,PUDT,PVDT, &
- PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
- PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
-! #################################################################
-!
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-
-! Conservative var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
-
-! Virtual potential temperature at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
-! Momentum at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM
-!
-! Tendencies of conservative variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
-
-! Tendencies of momentum
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
-
-! Updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
-
-! Fluxes
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
-
-END SUBROUTINE MF_TURB_EXPL
-
-END INTERFACE
-!
-END MODULE MODI_MF_TURB_EXPL
-!
-
-! ######spl
- SUBROUTINE MF_TURB_EXPL(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
- PRHODJ, &
- PTHLM,PTHVM,PRTM,PUM,PVM, &
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE MF_TURB_EXPL(D, PARAMMF, &
+ PRHODJ,PTHLM,PTHVM,PRTM,PUM,PVM, &
PTHLDT,PRTDT,PUDT,PVDT, &
PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
@@ -106,9 +50,12 @@ END MODULE MODI_MF_TURB_EXPL
!
!* 0. DECLARATIONS
! ------------
-
-USE MODD_PARAM_MFSHALL_n
-USE MODI_SHUMAN_MF
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODI_SHUMAN_MF, ONLY: MZM_MF
IMPLICIT NONE
@@ -116,51 +63,59 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
! Conservative var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM ! conservative pot. temp.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRTM ! water var. where
! Virtual potential temperature at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVM
! Momentum at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVM
!
! Tendencies of conservative variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTHLDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRTDT
! Tendencies of momentum
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PUDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PVDT
! Updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
! Fluxes
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZTHLMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
-REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZFLXZTHSMF,ZTHS_UP,ZTHSM ! Theta S flux
-REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZQT_UP,ZQTM,ZTHSDT,ZQTDT
-REAL, DIMENSION(SIZE(PFLXZTHLMF,1),SIZE(PFLXZTHLMF,2)) :: ZTHLM_F,ZRTM_F
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZFLXZTHSMF,ZTHS_UP,ZTHSM ! Theta S flux
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZQT_UP,ZQTM,ZTHSDT,ZQTDT
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHLM_F,ZRTM_F
-INTEGER :: JK ! loop counter
+INTEGER :: JK, JIJ ! loop counter
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT,IKB,IKE,IKL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
!* 1.PRELIMINARIES
! -------------
+IF (LHOOK) CALL DR_HOOK('MF_TURB_EXPL',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
+!
PFLXZRMF = 0.
PFLXZTHVMF = 0.
PFLXZTHLMF = 0.
@@ -180,22 +135,33 @@ PVDT = 0.
! -----------------------------------------------
! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
-ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM (:,:))
-ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
-ZQTM (:,:) = ZRTM_F (:,:)/(1.+ZRTM_F (:,:))
-ZQT_UP (:,:) = PRT_UP (:,:)/(1.+PRT_UP (:,:))
-ZTHS_UP(:,:) = PTHL_UP(:,:)*(1.+XLAMBDA_MF*ZQT_UP(:,:))
-ZTHSM (:,:) = ZTHLM_F(:,:)*(1.+XLAMBDA_MF*ZQTM(:,:))
-
-PFLXZTHLMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHLM(:,:))) ! ThetaL
-PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP (:,:)-MZM_MF(KKA,KKU,KKL,PRTM (:,:))) ! Rt
-PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PTHVM(:,:))) ! ThetaV
-
-ZFLXZTHSMF(:,:) = PEMF(:,:)*(ZTHS_UP(:,:)-ZTHSM(:,:)) ! Theta S flux
-
-IF (OMIXUV) THEN
- PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,PUM(:,:))) ! U
- PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,PVM(:,:))) ! V
+CALL MZM_MF(D, PRTM (:,:), ZRTM_F(:,:))
+CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZQTM(IIJB:IIJE,1:IKT) = ZRTM_F(IIJB:IIJE,1:IKT)/(1.+ZRTM_F(IIJB:IIJE,1:IKT))
+ZQT_UP(IIJB:IIJE,1:IKT) = PRT_UP(IIJB:IIJE,1:IKT)/(1.+PRT_UP(IIJB:IIJE,1:IKT))
+ZTHS_UP(IIJB:IIJE,1:IKT)= PTHL_UP(IIJB:IIJE,1:IKT)*(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(IIJB:IIJE,1:IKT))
+ZTHSM(IIJB:IIJE,1:IKT) = ZTHLM_F(IIJB:IIJE,1:IKT)*(1.+PARAMMF%XLAMBDA_MF*ZQTM(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+
+CALL MZM_MF(D, PTHLM(:,:), PFLXZTHLMF(:,:))
+CALL MZM_MF(D, PRTM(:,:), PFLXZRMF(:,:))
+CALL MZM_MF(D, PTHVM(:,:), PFLXZTHVMF(:,:))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PFLXZTHLMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHL_UP(IIJB:IIJE,1:IKT)-PFLXZTHLMF(IIJB:IIJE,1:IKT)) ! ThetaL
+PFLXZRMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PRT_UP(IIJB:IIJE,1:IKT)-PFLXZRMF(IIJB:IIJE,1:IKT)) ! Rt
+PFLXZTHVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHV_UP(IIJB:IIJE,1:IKT)-PFLXZTHVMF(IIJB:IIJE,1:IKT)) ! ThetaV
+
+ZFLXZTHSMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(ZTHS_UP(IIJB:IIJE,1:IKT)-ZTHSM(IIJB:IIJE,1:IKT)) ! Theta S flux
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+
+IF (PARAMMF%LMIXUV) THEN
+ CALL MZM_MF(D, PUM(:,:), PFLXZUMF(:,:))
+ CALL MZM_MF(D, PVM(:,:), PFLXZVMF(:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PFLXZUMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PU_UP(IIJB:IIJE,1:IKT)-PFLXZUMF(IIJB:IIJE,1:IKT)) ! U
+ PFLXZVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PV_UP(IIJB:IIJE,1:IKT)-PFLXZVMF(IIJB:IIJE,1:IKT)) ! V
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
PFLXZUMF(:,:) = 0.
PFLXZVMF(:,:) = 0.
@@ -208,20 +174,26 @@ ENDIF
! (explicit formulation)
! --------------------------------------------
-DO JK=KKB,KKE-KKL,KKL
-! PTHLDT(:,JK) = (PFLXZTHLMF(:,JK ) - PFLXZTHLMF(:,JK+KKL)) / PRHODJ(:,JK)
- PRTDT (:,JK) = (PFLXZRMF (:,JK ) - PFLXZRMF (:,JK+KKL)) / PRHODJ(:,JK)
- ZQTDT (:,JK) = PRTDT (:,JK)/(1.+ ZRTM_F (:,JK)*ZRTM_F (:,JK))
- ZTHSDT(:,JK) = (ZFLXZTHSMF(:,JK ) - ZFLXZTHSMF(:,JK+KKL)) / PRHODJ(:,JK)
- PTHLDT(:,JK) = ZTHSDT(:,JK)/(1.+XLAMBDA_MF*ZQTM(:,JK)) - ZTHLM_F(:,JK)*XLAMBDA_MF*ZQTDT(:,JK)
+DO JK=IKB,IKE-IKL,IKL
+ DO JIJ=IIJB,IIJE
+ !PTHLDT(JIJ,JK) = (PFLXZTHLMF(JIJ,JK ) - PFLXZTHLMF(JIJ,JK+IKL)) / PRHODJ(JIJ,JK)
+ PRTDT(JIJ,JK) = (PFLXZRMF(JIJ,JK) - PFLXZRMF(JIJ,JK+IKL)) / PRHODJ(JIJ,JK)
+ ZQTDT(JIJ,JK) = PRTDT(JIJ,JK)/(1.+ ZRTM_F(JIJ,JK)*ZRTM_F(JIJ,JK))
+ ZTHSDT(JIJ,JK)= (ZFLXZTHSMF(JIJ,JK) - ZFLXZTHSMF(JIJ,JK+IKL)) / PRHODJ(JIJ,JK)
+ PTHLDT(JIJ,JK) = ZTHSDT(JIJ,JK)/(1.+PARAMMF%XLAMBDA_MF*ZQTM(JIJ,JK)) - ZTHLM_F(JIJ,JK)*PARAMMF%XLAMBDA_MF*ZQTDT(JIJ,JK)
+ ENDDO
END DO
-IF (OMIXUV) THEN
- DO JK=KKB,KKE-KKL,KKL
- PUDT(:,JK) = (PFLXZUMF(:,JK ) - PFLXZUMF(:,JK+KKL)) / PRHODJ(:,JK)
- PVDT(:,JK) = (PFLXZVMF(:,JK ) - PFLXZVMF(:,JK+KKL)) / PRHODJ(:,JK)
+IF (PARAMMF%LMIXUV) THEN
+ DO JK=IKB,IKE-IKL,IKL
+ DO JIJ=IIJB,IIJE
+ PUDT(JIJ,JK) = (PFLXZUMF(JIJ,JK) - PFLXZUMF(JIJ,JK+IKL)) / PRHODJ(JIJ,JK)
+ PVDT(JIJ,JK) = (PFLXZVMF(JIJ,JK) - PFLXZVMF(JIJ,JK+IKL)) / PRHODJ(JIJ,JK)
+ ENDDO
END DO
ENDIF
+IF (LHOOK) CALL DR_HOOK('MF_TURB_EXPL',1,ZHOOK_HANDLE)
END SUBROUTINE MF_TURB_EXPL
+END MODULE MODE_MF_TURB_EXPL
diff --git a/src/PHYEX/turb/mode_prandtl.f90 b/src/PHYEX/turb/mode_prandtl.f90
index fbfe0a7621714cebb151faee288c99338a4a555b..120b784a5e170829bae52f188ff7f2b49a1501ce 100644
--- a/src/PHYEX/turb/mode_prandtl.f90
+++ b/src/PHYEX/turb/mode_prandtl.f90
@@ -1,84 +1,31 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ###################
- MODULE MODI_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, &
+! ####################
+ MODULE MODE_PRANDTL
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! ####################
+!
+!* modification 08/2010 V. Masson smoothing of the discontinuity in functions
+! used for implicitation of exchange coefficients
+! 05/2020 V. Masson and C. Lac : bug in D_PHI3DTDZ2_O_DDTDZ
+!
+USE MODD_CTURB, ONLY : CSTURB_t
+USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
+!
+USE SHUMAN_PHY, ONLY: MZM_PHY,MZF_PHY
+USE MODE_GRADIENT_M_PHY
+IMPLICIT NONE
+!----------------------------------------------------------------------------
+CONTAINS
+!----------------------------------------------------------------------------
+ SUBROUTINE PRANDTL(D,CST,CSTURB,KRR,KSV,KRRI,OTURB_DIAG,&
+ HTURBDIM,OOCEAN,OHARAT,O2D,OCOMPUTE_SRC,&
+ TPFILE, OFLAT, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
@@ -136,11 +83,11 @@ END MODULE MODI_PRANDTL
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : contains physical constants
-!! XG : gravity constant
+!! CST%XG : gravity constant
!!
!! Module MODD_CTURB: contains the set of constants for
!! the turbulence scheme
-!! XCTV,XCPR2 : constants for the turbulent prandtl numbers
+!! CSTURB%XCTV,XCPR2 : constants for the turbulent prandtl numbers
!! XTKEMIN : minimum value allowed for the TKE
!!
!! Module MODD_PARAMETERS
@@ -185,6 +132,7 @@ END MODULE MODI_PRANDTL
!! change of YCOMMENT
!! 2012-02 Y. Seity, add possibility to run with reversed
!! vertical levels
+!! Modifications: July 2015 (Wim de Rooy) OHARAT (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
@@ -193,80 +141,92 @@ END MODULE MODI_PRANDTL
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_CONF
-USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
-use modd_field, only: tfielddata, TYPEREAL
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_CST, ONLY : CST_t
+USE MODD_CTURB, ONLY : CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
!
-USE MODI_GRADIENT_M
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_SHUMAN
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_GRADIENT_M_PHY, ONLY: GX_M_M_PHY, GY_M_M_PHY
+USE MODE_EMOIST, ONLY : EMOIST
+USE MODE_ETHETA, ONLY : ETHETA
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
!
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
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+INTEGER, INTENT(IN) :: KSV ! number of scalar variables
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.
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: OHARAT
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
! metric coefficients
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
+REAL, DIMENSION(D%NIJT,D%NKT), 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(D%NIJT,D%NKT), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(D%NIJT,D%NKT), 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM ! Turbulent Mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS ! Dissipative length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
! Temperature and TKE at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), 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
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! Scalars at t-1
+REAL, DIMENSION(MERGE(D%NIT,0,OCOMPUTE_SRC),&
+ MERGE(D%NJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT):: PREDS1 ! Redelsperger number R_s
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PETHETA ! coefficient E_theta
+REAL, DIMENSION(D%NIJT,D%NKT), 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
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
+ ZW1, ZW2, ZW3, &
! working variables
+ ZWORK1,ZWORK2,ZWORK3,ZWORK4, ZWORK5, ZWORK6,ZWORK7, &
+ ZGXMM_PTH,ZGYMM_PTH,ZGXMM_PRM,ZGYMM_PRM, ZGXMM_PSV,ZGYMM_PSV
+! working variables for explicit array
!
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:: JSV,JIJ,JK ! loop index
+INTEGER :: IIJB,IIJE,IKT,IKA,IKL
INTEGER :: JLOOP
REAL :: ZMINVAL
@@ -276,93 +236,157 @@ 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)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('PRANDTL',0,ZHOOK_HANDLE)
+
+IF (OHARAT) THEN
+PREDTH1(:,:)=0.
+PREDR1(:,:)=0.
+PRED2TH3(:,:)=0.
+PRED2R3(:,:)=0.
+PRED2THR3(:,:)=0.
+PREDS1(:,:,:)=0.
+PRED2THS3(:,:,:)=0.
+PRED2RS3(:,:,:)=0.
+PBLL_O_E(:,:)=0.
+ENDIF
+!
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKA=D%NKA
+IKL=D%NKL
+!
+CALL ETHETA(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN,OCOMPUTE_SRC,ZWORK1)
+CALL EMOIST(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN,ZWORK2)
+CALL MZM_PHY(D,ZWORK1,PETHETA)
+CALL MZM_PHY(D,ZWORK2,PEMOIST)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PETHETA(IIJB:IIJE,IKA) = 2.*PETHETA(IIJB:IIJE,IKB) - PETHETA(IIJB:IIJE,IKB+IKL)
+PEMOIST(IIJB:IIJE,IKA) = 2.*PEMOIST(IIJB:IIJE,IKB) - PEMOIST(IIJB:IIJE,IKB+IKL)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!---------------------------------------------------------------------------
+IF (.NOT. OHARAT) THEN
!
! 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.
+IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = CST%XG * CST%XALPHAOC * PLM(IIJB:IIJE,1:IKT) &
+ * PLEPS(IIJB:IIJE,1:IKT) / PTKEM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * PLM(IIJB:IIJE,1:IKT) &
+ * PLEPS(IIJB:IIJE,1:IKT) / PTKEM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
+!
+CALL MZM_PHY(D,ZWORK1,PBLL_O_E)
+CALL GZ_M_W_PHY(D,PTHLM,PDZZ,ZWORK1)
+!
+IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PREDTH1(IIJB:IIJE,1:IKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ 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)
+ CALL GZ_M_W_PHY(D,PRM(:,:,1),PDZZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PREDTH1(IIJB:IIJE,1:IKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ PREDR1(IIJB:IIJE,1:IKT) = CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) * PEMOIST(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE ! dry case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = 0.
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PREDTH1(IIJB:IIJE,1:IKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ PREDR1(IIJB:IIJE,1:IKT) = 0.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ZMINVAL = (1.-1./CSTURB%XPHI_LIM)
+!
+DO JK=1,IKT
+ DO JIJ=IIJB,IIJE
+ ZW1(JIJ,JK) = 1.
+ ZW2(JIJ,JK) = 1.
+ !
+ IF (PREDTH1(JIJ,JK)+PREDR1(JIJ,JK)<-ZMINVAL)THEN
+ ZW1(JIJ,JK) = (-ZMINVAL) / (PREDTH1(JIJ,JK)+PREDR1(JIJ,JK))
+ ENDIF
+ !
+ IF (PREDTH1(JIJ,JK)<-ZMINVAL)THEN
+ ZW2(JIJ,JK) = (-ZMINVAL) / (PREDTH1(JIJ,JK))
+ ENDIF
+ ZW2(JIJ,JK) = MIN(ZW1(JIJ,JK),ZW2(JIJ,JK))
+ !
+ ZW1(JIJ,JK) = 1.
+ IF (PREDR1(JIJ,JK)<-ZMINVAL)THEN
+ ZW1(JIJ,JK) = (-ZMINVAL) / (PREDR1(JIJ,JK))
+ ENDIF
+ ZW1(JIJ,JK) = MIN(ZW2(JIJ,JK),ZW1(JIJ,JK))
+ !
+ !
+ ! 3. Modification of Mixing length and dissipative length
+ ! ----------------------------------------------------
+ !
+ PBLL_O_E(JIJ,JK) = PBLL_O_E(JIJ,JK) * ZW1(JIJ,JK)
+ PREDTH1(JIJ,JK) = PREDTH1(JIJ,JK) * ZW1(JIJ,JK)
+ PREDR1(JIJ,JK) = PREDR1(JIJ,JK) * ZW1(JIJ,JK)
+ !
+ ! 4. Threshold for very small (in absolute value) Redelperger numbers
+ ! ----------------------------------------------------------------
+ !
+ IF(PREDTH1(JIJ,JK) < 0.) THEN
+ ZW2(JIJ,JK)=-1.
+ ELSE
+ ZW2(JIJ,JK)=1.
+ END IF
+ PREDTH1(JIJ,JK)= ZW2(JIJ,JK) * MAX(CST%XMNH_TINY_12, ZW2(JIJ,JK)*PREDTH1(JIJ,JK))
+ !
+ IF (KRR /= 0) THEN ! moist case
+ IF(PREDR1(JIJ,JK) < 0.) THEN
+ ZW2(JIJ,JK)=-1.
+ ELSE
+ ZW2(JIJ,JK)=1.
+ END IF
+ PREDR1(JIJ,JK)= ZW2(JIJ,JK) * MAX(CST%XMNH_TINY_12, ZW2(JIJ,JK)*PREDR1(JIJ,JK))
+ END IF
+ ENDDO
+ENDDO
!
!
!---------------------------------------------------------------------------
!
! For the scalar variables
-DO JSV=1,ISV
- PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
+DO JSV=1,KSV
+ CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PREDS1(IIJB:IIJE,1:IKT,JSV)=CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
!
-DO JSV=1,ISV
- ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
- PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
-END DO
+DO JSV=1,KSV
+ DO JK=1,IKT
+ DO JIJ=IIJB,IIJE
+ IF(PREDS1(JIJ,JK,JSV) < 0.) THEN
+ ZW2(JIJ,JK)=-1.
+ ELSE
+ ZW2(JIJ,JK)=1.
+ END IF
+ PREDS1(JIJ,JK,JSV)= ZW2(JIJ,JK) * MAX(CST%XMNH_TINY_12, ZW2(JIJ,JK)*PREDS1(JIJ,JK,JSV))
+ ENDDO
+ ENDDO
+ENDDO
!
!---------------------------------------------------------------------------
!
@@ -372,70 +396,115 @@ END DO
IF(HTURBDIM=='1DIM') THEN ! 1D case
!
!
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2TH3(IIJB:IIJE,1:IKT) = PREDTH1(IIJB:IIJE,1:IKT)**2
!
- PRED2R3(:,:,:) = PREDR1(:,:,:) **2
+ PRED2R3(IIJB:IIJE,1:IKT) = PREDR1(IIJB:IIJE,1:IKT) **2
!
- PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
+ PRED2THR3(IIJB:IIJE,1:IKT) = PREDTH1(IIJB:IIJE,1:IKT) * PREDR1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-ELSE IF (L2D) THEN ! 3D case in a 2D model
+ELSE IF (O2D) THEN ! 3D case in a 2D model
!
+ CALL GX_M_M_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZGXMM_PTH)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PTH(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK2)
+ !
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)
+ CALL GX_M_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZGXMM_PRM)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PRM(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PTH(IIJB:IIJE,1:IKT) * ZGXMM_PRM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK4)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2TH3(IIJB:IIJE,1:IKT)= PREDTH1(IIJB:IIJE,1:IKT)**2+(CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) &
+ *PETHETA(IIJB:IIJE,1:IKT) )**2 * ZWORK2(IIJB:IIJE,1:IKT)
+!
+ PRED2R3(IIJB:IIJE,1:IKT)= PREDR1(IIJB:IIJE,1:IKT)**2 + (CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) &
+ * PEMOIST(IIJB:IIJE,1:IKT))**2 * ZWORK3(IIJB:IIJE,1:IKT)
+!
+ PRED2THR3(IIJB:IIJE,1:IKT)= PREDR1(IIJB:IIJE,1:IKT) * PREDTH1(IIJB:IIJE,1:IKT) + CSTURB%XCTV**2 &
+ * PBLL_O_E(IIJB:IIJE,1:IKT)**2 &
+ * PEMOIST(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) &
+ * ZWORK4(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+ PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+IKL)
+ PRED2R3(IIJB:IIJE,IKB)=PRED2R3(IIJB:IIJE,IKB+IKL)
+ PRED2THR3(IIJB:IIJE,IKB)=PRED2THR3(IIJB:IIJE,IKB+IKL)
!
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)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2TH3(IIJB:IIJE,1:IKT) = PREDTH1(IIJB:IIJE,1:IKT)**2 + CSTURB%XCTV**2 &
+ * PBLL_O_E(IIJB:IIJE,1:IKT)**2 * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+IKL)
!
- PRED2R3(:,:,:) = 0.
+ PRED2R3(IIJB:IIJE,1:IKT) = 0.
!
- PRED2THR3(:,:,:) = 0.
+ PRED2THR3(IIJB:IIJE,1:IKT) = 0.
!
END IF
!
ELSE ! 3D case in a 3D model
!
+ CALL GX_M_M_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZGXMM_PTH)
+ CALL GY_M_M_PHY(D,OFLAT,PTHLM,PDYY,PDZZ,PDZY,ZGYMM_PTH)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PTH(IIJB:IIJE,1:IKT)**2 + ZGYMM_PTH(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK2)
+ !
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)
+ CALL GX_M_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZGXMM_PRM)
+ CALL GY_M_M_PHY(D,OFLAT,PRM(:,:,1),PDYY,PDZZ,PDZY,ZGYMM_PRM)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PRM(IIJB:IIJE,1:IKT)**2 + ZGYMM_PRM(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PRM(IIJB:IIJE,1:IKT) * ZGXMM_PTH(IIJB:IIJE,1:IKT) &
+ + ZGYMM_PRM(IIJB:IIJE,1:IKT) * ZGYMM_PTH(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK4)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2TH3(IIJB:IIJE,1:IKT)= PREDTH1(IIJB:IIJE,1:IKT)**2 + ( CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) &
+ * PETHETA(IIJB:IIJE,1:IKT) )**2 * ZWORK2(IIJB:IIJE,1:IKT)
+!
+ PRED2R3(IIJB:IIJE,1:IKT)= PREDR1(IIJB:IIJE,1:IKT)**2 + (CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) &
+ * PEMOIST(IIJB:IIJE,1:IKT))**2 * ZWORK3(IIJB:IIJE,1:IKT)
+!
+ PRED2THR3(IIJB:IIJE,1:IKT)= PREDR1(IIJB:IIJE,1:IKT) * PREDTH1(IIJB:IIJE,1:IKT) + CSTURB%XCTV**2 &
+ * PBLL_O_E(IIJB:IIJE,1:IKT)**2 * &
+ PEMOIST(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) * ZWORK4(IIJB:IIJE,1:IKT)
+
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+ PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+IKL)
+ PRED2R3(IIJB:IIJE,IKB)=PRED2R3(IIJB:IIJE,IKB+IKL)
+ PRED2THR3(IIJB:IIJE,IKB)=PRED2THR3(IIJB:IIJE,IKB+IKL)
!
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)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2TH3(IIJB:IIJE,1:IKT) = PREDTH1(IIJB:IIJE,1:IKT)**2 + CSTURB%XCTV**2 &
+ * PBLL_O_E(IIJB:IIJE,1:IKT)**2 * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+ PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+IKL)
!
- PRED2R3(:,:,:) = 0.
+ PRED2R3(IIJB:IIJE,1:IKT) = 0.
!
- PRED2THR3(:,:,:) = 0.
+ PRED2THR3(IIJB:IIJE,1:IKT) = 0.
!
END IF
!
@@ -446,96 +515,145 @@ END IF ! end of the if structure on the turbulence dimensionnality
!
! 5. Prandtl numbers for scalars
! ---------------------------
-IF(HTURBDIM=='1DIM') THEN
+DO JSV=1,KSV
+!
+ IF(HTURBDIM=='1DIM') THEN
! 1D case
- DO JSV=1,ISV
- PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2THS3(IIJB:IIJE,1:IKT,JSV) = PREDS1(IIJB:IIJE,1:IKT,JSV) * PREDTH1(IIJB:IIJE,1:IKT)
IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
+ PRED2RS3(IIJB:IIJE,1:IKT,JSV) = PREDR1(IIJB:IIJE,1:IKT) *PREDS1(IIJB:IIJE,1:IKT,JSV)
ELSE
- PRED2RS3(:,:,:,JSV) = 0.
+ PRED2RS3(IIJB:IIJE,1:IKT,JSV) = 0.
END IF
- ENDDO
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-ELSE IF (L2D) THEN ! 3D case in a 2D model
+ ELSE IF (O2D) THEN ! 3D case in a 2D model
!
- IF (LOCEAN) THEN
- IF (KRR /= 0) THEN
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = (CST%XG *CST%XALPHAOC * PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) &
+ / PTKEM(IIJB:IIJE,1:IKT))**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK2)
+ IF (KRR /= 0) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZW1(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ ZW1 = ZWORK2
+ END IF
ELSE
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
- END IF
- ELSE
- DO JSV=1,ISV
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = (CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * PLM(IIJB:IIJE,1:IKT) &
+ * PLEPS(IIJB:IIJE,1:IKT) / PTKEM(IIJB:IIJE,1:IKT))**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZW1)
+ !
+ CALL GX_M_M_PHY(D,OFLAT,PSVM(:,:,JSV),PDXX,PDZZ,PDZX,ZGXMM_PSV)
+ CALL GX_M_M_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZGXMM_PTH)
+ CALL GX_M_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZGXMM_PRM)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PSV(IIJB:IIJE,1:IKT) * ZGXMM_PTH(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PSV(IIJB:IIJE,1:IKT) * ZGXMM_PRM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK3)
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ZWORK1(IIJB:IIJE,1:IKT) = ZW1(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT)
ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZW1(IIJB:IIJE,1:IKT)
END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
- )
-!
+ PRED2THS3(IIJB:IIJE,1:IKT,JSV) = PREDTH1(IIJB:IIJE,1:IKT) * PREDS1(IIJB:IIJE,1:IKT,JSV) + &
+ ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !
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) &
- )
+ PRED2RS3(IIJB:IIJE,1:IKT,JSV) = PREDR1(IIJB:IIJE,1:IKT) * PREDS1(IIJB:IIJE,1:IKT,JSV) + &
+ ZW1(IIJB:IIJE,1:IKT) * PEMOIST(IIJB:IIJE,1:IKT) * ZWORK3(IIJB:IIJE,1:IKT)
ELSE
- PRED2RS3(:,:,:,JSV) = 0.
+ PRED2RS3(IIJB:IIJE,1:IKT,JSV) = 0.
END IF
- ENDDO
- END IF
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
!
-ELSE ! 3D case in a 3D model
+ ELSE ! 3D case in a 3D model
!
- IF (LOCEAN) THEN
- IF (KRR /= 0) THEN
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = (CST%XG *CST%XALPHAOC * PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) &
+ / PTKEM(IIJB:IIJE,1:IKT))**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK2)
+ IF (KRR /= 0) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZW1(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
+ ZW1 = ZWORK2
END IF
- ELSE
- DO JSV=1,ISV
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = (CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * PLM(IIJB:IIJE,1:IKT) &
+ * PLEPS(IIJB:IIJE,1:IKT) / PTKEM(IIJB:IIJE,1:IKT))**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZW1)
+ !
+ CALL GX_M_M_PHY(D,OFLAT,PSVM(:,:,JSV),PDXX,PDZZ,PDZX,ZGXMM_PSV)
+ CALL GX_M_M_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZGXMM_PTH)
+ CALL GX_M_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZGXMM_PRM)
+ CALL GY_M_M_PHY(D,OFLAT,PSVM(:,:,JSV),PDYY,PDZZ,PDZY,ZGYMM_PSV)
+ CALL GY_M_M_PHY(D,OFLAT,PTHLM,PDYY,PDZZ,PDZY,ZGYMM_PTH)
+ CALL GY_M_M_PHY(D,OFLAT,PRM(:,:,1),PDYY,PDZZ,PDZY,ZGYMM_PRM)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PSV(IIJB:IIJE,1:IKT) * ZGXMM_PTH(IIJB:IIJE,1:IKT) &
+ + ZGYMM_PSV(IIJB:IIJE,1:IKT) * ZGYMM_PTH(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PSV(IIJB:IIJE,1:IKT) * ZGXMM_PRM(IIJB:IIJE,1:IKT) &
+ + ZGYMM_PSV(IIJB:IIJE,1:IKT) * ZGYMM_PRM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK3)
+ !
IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZW1(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZW1(IIJB:IIJE,1:IKT)
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) &
- )
-!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2THS3(IIJB:IIJE,1:IKT,JSV) = PREDTH1(IIJB:IIJE,1:IKT) * PREDS1(IIJB:IIJE,1:IKT,JSV) + &
+ ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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) &
- )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRED2RS3(IIJB:IIJE,1:IKT,JSV) = PREDR1(IIJB:IIJE,1:IKT) * PREDS1(IIJB:IIJE,1:IKT,JSV) + &
+ ZW1(IIJB:IIJE,1:IKT) * PEMOIST(IIJB:IIJE,1:IKT) * ZWORK3(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- PRED2RS3(:,:,:,JSV) = 0.
+ PRED2RS3(IIJB:IIJE,1:IKT,JSV) = 0.
END IF
- ENDDO
- END IF
+ END IF
!
-END IF ! end of HTURBDIM if-block
+ END IF ! end of HTURBDIM if-block
!
+END DO
!
!---------------------------------------------------------------------------
!
!* 6. SAVES THE REDELSPERGER NUMBERS
! ------------------------------
!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
!
! stores the RED_TH1
TZFIELD%CMNHNAME = 'RED_TH1'
@@ -548,7 +666,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PREDTH1)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PREDTH1)
!
! stores the RED_R1
TZFIELD%CMNHNAME = 'RED_R1'
@@ -561,7 +679,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PREDR1)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PREDR1)
!
! stores the RED2_TH3
TZFIELD%CMNHNAME = 'RED2_TH3'
@@ -574,7 +692,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2TH3)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PRED2TH3)
!
! stores the RED2_R3
TZFIELD%CMNHNAME = 'RED2_R3'
@@ -587,7 +705,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2R3)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PRED2R3)
!
! stores the RED2_THR3
TZFIELD%CMNHNAME = 'RED2_THR3'
@@ -600,10 +718,2073 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2THR3)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PRED2THR3)
!
END IF
!
!---------------------------------------------------------------------------
+ENDIF ! (Done only if OHARAT is FALSE)
!
+IF (LHOOK) CALL DR_HOOK('PRANDTL',1,ZHOOK_HANDLE)
END SUBROUTINE PRANDTL
+!
+SUBROUTINE SMOOTH_TURB_FUNCT(D,CSTURB,PPHI3,PF_LIM,PF)
+!
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3 ! Phi3
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PF_LIM ! Value of F when Phi3 is
+! ! larger than Phi_lim
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PF ! function F to smooth
+!
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZCOEF
+INTEGER :: JIJ,JK, IIJB,IIJE,IKT
+!
+!* adds a artificial correction to smooth the function near the discontinuity
+! point at Phi3 = Phi_lim
+! This smoothing is applied between 0.9*phi_lim (=2.7) and Phi_lim (=3)
+! Note that in the Boundary layer, phi is usually between 0.8 and 1
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZCOEF(IIJB:IIJE,1:IKT) = MAX(MIN(( 10.*(1.-PPHI3(IIJB:IIJE,1:IKT)/CSTURB%XPHI_LIM)) ,1.), 0.)
+!
+PF(IIJB:IIJE,1:IKT) = ZCOEF(IIJB:IIJE,1:IKT) * PF(IIJB:IIJE,1:IKT) &
+ + (1.-ZCOEF(IIJB:IIJE,1:IKT)) * PF_LIM(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+END SUBROUTINE SMOOTH_TURB_FUNCT
+!----------------------------------------------------------------------------
+SUBROUTINE PHI3(D,CSTURB,PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PPHI3)
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
+ CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PPHI3
+!
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZW1, ZW2
+ INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE, IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PHI3',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+IF (HTURBDIM=='3DIM') THEN
+ !* 3DIM case
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ IF (OUSERV) THEN
+ ZW1(IIJB:IIJE,1:IKT) = 1. + 1.5* (PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) + &
+ ( 0.5 * (PREDTH1(IIJB:IIJE,1:IKT)**2+PREDR1(IIJB:IIJE,1:IKT)**2) &
+ + PREDTH1(IIJB:IIJE,1:IKT) * PREDR1(IIJB:IIJE,1:IKT) &
+ )
+
+ ZW2(IIJB:IIJE,1:IKT) = 0.5 * (PRED2TH3(IIJB:IIJE,1:IKT)-PRED2R3(IIJB:IIJE,1:IKT))
+
+ PPHI3(IIJB:IIJE,1:IKT)= 1. - &
+ ( ( (1.+PREDR1(IIJB:IIJE,1:IKT)) * &
+ (PRED2THR3(IIJB:IIJE,1:IKT) + PRED2TH3(IIJB:IIJE,1:IKT)) / PREDTH1(IIJB:IIJE,1:IKT) &
+ ) + ZW2(IIJB:IIJE,1:IKT) &
+ ) / ZW1(IIJB:IIJE,1:IKT)
+ ELSE
+ ZW1(IIJB:IIJE,1:IKT) = 1. + 1.5* PREDTH1(IIJB:IIJE,1:IKT) + &
+ 0.5* PREDTH1(IIJB:IIJE,1:IKT)**2
+
+ ZW2(IIJB:IIJE,1:IKT) = 0.5* PRED2TH3(IIJB:IIJE,1:IKT)
+
+ PPHI3(IIJB:IIJE,1:IKT)= 1. - &
+ (PRED2TH3(IIJB:IIJE,1:IKT) / PREDTH1(IIJB:IIJE,1:IKT) + ZW2(IIJB:IIJE,1:IKT)) &
+ / ZW1(IIJB:IIJE,1:IKT)
+ END IF
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE( PPHI3(IIJB:IIJE,1:IKT) <= 0. .OR. PPHI3(IIJB:IIJE,1:IKT) > CSTURB%XPHI_LIM )
+ PPHI3(IIJB:IIJE,1:IKT) = CSTURB%XPHI_LIM
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !* 1DIM case
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ IF (OUSERV) THEN
+ PPHI3(IIJB:IIJE,1:IKT)= 1./(1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))
+ ELSE
+ PPHI3(IIJB:IIJE,1:IKT)= 1./(1.+PREDTH1(IIJB:IIJE,1:IKT))
+ END IF
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
+!
+PPHI3(IIJB:IIJE,IKB-1)=PPHI3(IIJB:IIJE,IKB)
+PPHI3(IIJB:IIJE,IKE+1)=PPHI3(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PHI3',1,ZHOOK_HANDLE)
+END SUBROUTINE PHI3
+!----------------------------------------------------------------------------
+SUBROUTINE PSI_SV(D,CSTURB,KSV,PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3,PPSI_SV)
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ INTEGER, INTENT(IN) :: KSV
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PREDS1
+ REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PRED2THS
+ REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PRED2RS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPSI3
+ REAL, DIMENSION(D%NIJT,D%NKT,KSV),INTENT(OUT) :: PPSI_SV
+!
+ INTEGER :: IKB, IKE, IIJB,IIJE, IKT
+ INTEGER :: JSV,JIJ,JK
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI_SV',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+DO JSV=1,KSV
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PPSI_SV(IIJB:IIJE,1:IKT,JSV) = ( 1. &
+ - (CSTURB%XCPR3+CSTURB%XCPR5) * &
+ (PRED2THS(IIJB:IIJE,1:IKT,JSV)/PREDS1(IIJB:IIJE,1:IKT,JSV)-PREDTH1(IIJB:IIJE,1:IKT)) &
+ - (CSTURB%XCPR4+CSTURB%XCPR5) * &
+ (PRED2RS(IIJB:IIJE,1:IKT,JSV)/PREDS1(IIJB:IIJE,1:IKT,JSV)-PREDR1(IIJB:IIJE,1:IKT)) &
+ - CSTURB%XCPR3 * &
+ PREDTH1(IIJB:IIJE,1:IKT) * PPHI3(IIJB:IIJE,1:IKT) &
+ - CSTURB%XCPR4 * PREDR1(IIJB:IIJE,1:IKT) * PPSI3(IIJB:IIJE,1:IKT) &
+ ) / ( 1. + CSTURB%XCPR5 * ( PREDTH1(IIJB:IIJE,1:IKT) + PREDR1(IIJB:IIJE,1:IKT) ) )
+
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+! control of the PSI_SV positivity
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE ( (PPSI_SV(IIJB:IIJE,1:IKT,JSV) <=0.).AND. (PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))<=0.)
+ PPSI_SV(IIJB:IIJE,1:IKT,JSV)=CSTURB%XPHI_LIM
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PPSI_SV(IIJB:IIJE,1:IKT,JSV) = MAX( 1.E-4, MIN(CSTURB%XPHI_LIM,PPSI_SV(IIJB:IIJE,1:IKT,JSV)) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+ PPSI_SV(IIJB:IIJE,IKB-1,JSV)=PPSI_SV(IIJB:IIJE,IKB,JSV)
+ PPSI_SV(IIJB:IIJE,IKE+1,JSV)=PPSI_SV(IIJB:IIJE,IKE,JSV)
+END DO
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI_SV',1,ZHOOK_HANDLE)
+END SUBROUTINE PSI_SV
+!----------------------------------------------------------------------------
+SUBROUTINE D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PD_PHI3DTDZ_O_DDTDZ)
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
+ CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PHI3DTDZ_O_DDTDZ
+ INTEGER :: IKB, IKE,JIJ,JK, IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+IF (HTURBDIM=='3DIM') THEN
+ !* 3DIM case
+ IF (OUSERV) THEN
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+#ifdef REPRO48
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM)
+#else
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM)
+#endif
+ PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) &
+ * (1. - PREDTH1(IIJB:IIJE,1:IKT) * (3./2.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) &
+ /((1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) &
+ *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))))) &
+ + (1.+PREDR1(IIJB:IIJE,1:IKT))*(PRED2THR3(IIJB:IIJE,1:IKT)+PRED2TH3(IIJB:IIJE,1:IKT)) &
+ / (PREDTH1(IIJB:IIJE,1:IKT)*(1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))* &
+ (1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)))) &
+ - (1./2.*PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT) &
+ * (1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))) &
+ / ((1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))&
+ *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))))
+ ELSEWHERE
+ PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT)
+ ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+
+!
+ ELSE
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+#ifdef REPRO48
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM)
+#else
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM)
+#endif
+ PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) &
+ * (1. - PREDTH1(IIJB:IIJE,1:IKT) * (3./2.+PREDTH1(IIJB:IIJE,1:IKT)) &
+ /((1.+PREDTH1(IIJB:IIJE,1:IKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:IKT)))) &
+ + PRED2TH3(IIJB:IIJE,1:IKT) &
+ / (PREDTH1(IIJB:IIJE,1:IKT)*(1.+PREDTH1(IIJB:IIJE,1:IKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:IKT))) &
+ - 1./2.*PREDTH1(IIJB:IIJE,1:IKT) &
+ / ((1.+PREDTH1(IIJB:IIJE,1:IKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:IKT)))
+ ELSEWHERE
+ PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT)
+ ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+ END IF
+ELSE
+ !* 1DIM case
+DO JK=1,IKT
+ DO JIJ=IIJB,IIJE
+ IF ( ABS(PPHI3(JIJ,JK)-CSTURB%XPHI_LIM) < 1.E-12 ) THEN
+ PD_PHI3DTDZ_O_DDTDZ(JIJ,JK)=PPHI3(JIJ,JK)*&
+& (1. - PREDTH1(JIJ,JK)*PPHI3(JIJ,JK))
+ ELSE
+ PD_PHI3DTDZ_O_DDTDZ(JIJ,JK)=PPHI3(JIJ,JK)
+ ENDIF
+ ENDDO
+ENDDO
+END IF
+!
+#ifdef REPRO48
+#else
+!* smoothing
+CALL SMOOTH_TURB_FUNCT(D,CSTURB,PPHI3,PPHI3,PD_PHI3DTDZ_O_DDTDZ)
+#endif
+!
+PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,IKB)
+PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_PHI3DTDZ_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_PHI3DRDZ_O_DDRDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PD_PHI3DRDZ_O_DDRDZ)
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
+ CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PHI3DRDZ_O_DDRDZ
+ INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!
+IF (HTURBDIM=='3DIM') THEN
+ !* 3DIM case
+ IF (OUSERV) THEN
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+#ifdef REPRO48
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM)
+#else
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM)
+#endif
+ PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) &
+ * (1.-PREDR1(IIJB:IIJE,1:IKT)*(3./2.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) &
+ / ((1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) &
+ *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))))) &
+ - PREDR1(IIJB:IIJE,1:IKT) &
+ * (PRED2THR3(IIJB:IIJE,1:IKT)+PRED2TH3(IIJB:IIJE,1:IKT)) / (PREDTH1(IIJB:IIJE,1:IKT) &
+ * (1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))*&
+ (1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)))) &
+ + PREDR1(IIJB:IIJE,1:IKT) * (1./2.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) &
+ / ((1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))&
+ *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))))
+ ELSEWHERE
+ PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT)
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT)
+ END IF
+ELSE
+ !* 1DIM case
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+#ifdef REPRO48
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM)
+#else
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM)
+#endif
+ PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) &
+ * (1. - PREDR1(IIJB:IIJE,1:IKT)*PPHI3(IIJB:IIJE,1:IKT))
+ ELSEWHERE
+ PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT)
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
+!
+#ifdef REPRO48
+#else
+!* smoothing
+CALL SMOOTH_TURB_FUNCT(D,CSTURB,PPHI3,PPHI3,PD_PHI3DRDZ_O_DDRDZ)
+#endif
+!
+PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,IKB-1)=PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,IKB)
+PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,IKE+1)=PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_PHI3DRDZ_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_PHI3DTDZ2_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV,PD_PHI3DTDZ2_O_DDTDZ)
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PHI3DTDZ2_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!
+IF (HTURBDIM=='3DIM') THEN
+ ! by derivation of (phi3 dtdz) * dtdz according to dtdz we obtain:
+ CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:IKT) = PDTDZ(IIJB:IIJE,1:IKT) &
+ * (PPHI3(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !* 1DIM case
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+#ifdef REPRO48
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM)
+#else
+ WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM)
+#endif
+ PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT)*PDTDZ(IIJB:IIJE,1:IKT) &
+ * (2. - PREDTH1(IIJB:IIJE,1:IKT)*PPHI3(IIJB:IIJE,1:IKT))
+ ELSEWHERE
+ PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) * 2. * PDTDZ(IIJB:IIJE,1:IKT)
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
+!
+#ifdef REPRO48
+#else
+!* smoothing
+CALL SMOOTH_TURB_FUNCT(D,CSTURB,PPHI3,PPHI3*2.*PDTDZ,PD_PHI3DTDZ2_O_DDTDZ)
+#endif
+!
+!
+PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,IKB)
+PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_PHI3DTDZ2_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WTH_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PM3_WTH_WTH2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_WTH2
+ INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_WTH_WTH2(IIJB:IIJE,1:IKT) = CSTURB%XCSHF*PBLL_O_E(IIJB:IIJE,1:IKT)&
+ * PETHETA(IIJB:IIJE,1:IKT)*0.5/CSTURB%XCTD &
+ * (1.+0.5*PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) / PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_WTH_WTH2(IIJB:IIJE,IKB-1)=PM3_WTH_WTH2(IIJB:IIJE,IKB)
+PM3_WTH_WTH2(IIJB:IIJE,IKE+1)=PM3_WTH_WTH2(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WTH_WTH2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PD_M3_WTH_WTH2_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PM3_WTH_WTH2
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_WTH2_O_DDTDZ
+ INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,1:IKT) = &
+(0.5*CSTURB%XCSHF*PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT)*0.5/CSTURB%XCTD/PD(IIJB:IIJE,1:IKT) &
+- PM3_WTH_WTH2(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)&
+*(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) )&
+* PBLL_O_E(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) * CSTURB%XCTV
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WTH_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PM3_WTH_W2TH)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_W2TH
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+CALL MZM_PHY(D,PTKE,ZWORK1)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_WTH_W2TH(IIJB:IIJE,1:IKT) = CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*1.5/ZWORK1(IIJB:IIJE,1:IKT) &
+ * (1. - 0.5*PREDR1(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) ) &
+ / (1.+PREDTH1(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_WTH_W2TH(IIJB:IIJE,IKB-1)=PM3_WTH_W2TH(IIJB:IIJE,IKB)
+PM3_WTH_W2TH(IIJB:IIJE,IKE+1)=PM3_WTH_W2TH(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WTH_W2TH
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE,PD_M3_WTH_W2TH_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_W2TH_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+CALL MZM_PHY(D,PTKE,ZWORK1)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = &
+ - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*1.5/ZWORK1(IIJB:IIJE,1:IKT)/(1.+PREDTH1(IIJB:IIJE,1:IKT))**2 &
+ * CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) &
+ * (1. - 0.5*PREDR1(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)* &
+ ( 1.+(1.+PREDTH1(IIJB:IIJE,1:IKT))*(1.5+PREDR1(IIJB:IIJE,1:IKT)+PREDTH1(IIJB:IIJE,1:IKT))&
+ /PD(IIJB:IIJE,1:IKT)) )
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WTH_W2R(D,CSTURB,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_WTH_W2R)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_W2R
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+CALL MZM_PHY(D,PTKE,ZWORK1)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_WTH_W2R(IIJB:IIJE,1:IKT) = &
+ - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*0.75*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) &
+ /ZWORK1(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)*PDTDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_WTH_W2R(IIJB:IIJE,IKB-1)=PM3_WTH_W2R(IIJB:IIJE,IKB)
+PM3_WTH_W2R(IIJB:IIJE,IKE+1)=PM3_WTH_W2R(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WTH_W2R
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PD_M3_WTH_W2R_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_W2R_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+CALL MZM_PHY(D,PTKE,ZWORK1)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,1:IKT) = &
+- CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*0.75*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) &
+ /ZWORK1(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT) &
+ * (1. - PREDTH1(IIJB:IIJE,1:IKT)*(1.5+PREDTH1(IIJB:IIJE,1:IKT)&
+ +PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WTH_W2R_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WTH_WR2(D,CSTURB,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ,PM3_WTH_WR2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_WR2
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT) &
+ /(PSQRT_TKE(IIJB:IIJE,1:IKT)*PTKE(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZM_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_WTH_WR2(IIJB:IIJE,1:IKT) = - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)&
+ *0.25*PBLL_O_E(IIJB:IIJE,1:IKT)*CSTURB%XCTV*PEMOIST(IIJB:IIJE,1:IKT)**2 &
+ *ZWORK2(IIJB:IIJE,1:IKT)/CSTURB%XCTD*PDTDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_WTH_WR2(IIJB:IIJE,IKB-1)=PM3_WTH_WR2(IIJB:IIJE,IKB)
+PM3_WTH_WR2(IIJB:IIJE,IKE+1)=PM3_WTH_WR2(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WTH_WR2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PD_M3_WTH_WR2_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_WR2_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)&
+ /(PSQRT_TKE(IIJB:IIJE,1:IKT)*PTKE(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZM_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,1:IKT) = - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)&
+ *0.25*PBLL_O_E(IIJB:IIJE,1:IKT)*CSTURB%XCTV*PEMOIST(IIJB:IIJE,1:IKT)**2 &
+ *ZWORK2(IIJB:IIJE,1:IKT)/CSTURB%XCTD/PD(IIJB:IIJE,1:IKT) &
+ * (1. - PREDTH1(IIJB:IIJE,1:IKT)* &
+ (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WTH_WR2_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WTH_WTHR(D,CSTURB,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST,PM3_WTH_WTHR)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_WTHR
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)&
+ /(PSQRT_TKE(IIJB:IIJE,1:IKT)*PTKE(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZM_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_WTH_WTHR(IIJB:IIJE,1:IKT) = &
+ CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) &
+ *0.5*PLEPS(IIJB:IIJE,1:IKT)/CSTURB%XCTD*(1+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_WTH_WTHR(IIJB:IIJE,IKB-1)=PM3_WTH_WTHR(IIJB:IIJE,IKB)
+PM3_WTH_WTHR(IIJB:IIJE,IKE+1)=PM3_WTH_WTHR(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WTH_WTHR
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PD_M3_WTH_WTHR_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PM3_WTH_WTHR
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_WTHR_O_DDTDZ
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,1:IKT) = &
+ - PM3_WTH_WTHR(IIJB:IIJE,1:IKT) * (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))&
+ /PD(IIJB:IIJE,1:IKT)*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_TH2_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE,PM3_TH2_W2TH)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_W2TH
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = (1.-0.5*PREDR1(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))&
+ /PD(IIJB:IIJE,1:IKT))/(1.+PREDTH1(IIJB:IIJE,1:IKT))*PDTDZ(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_TH2_W2TH(IIJB:IIJE,1:IKT) = - ZWORK2(IIJB:IIJE,1:IKT) &
+ * 1.5*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)/PTKE(IIJB:IIJE,1:IKT)*CSTURB%XCTV
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_TH2_W2TH(IIJB:IIJE,IKB-1)=PM3_TH2_W2TH(IIJB:IIJE,IKB)
+PM3_TH2_W2TH(IIJB:IIJE,IKE+1)=PM3_TH2_W2TH(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_TH2_W2TH
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV,PD_M3_TH2_W2TH_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ LOGICAL, INTENT(IN) :: OUSERV
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_W2TH_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+IF (OUSERV) THEN
+! D_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = - 1.5*PLM*PLEPS/PTKE*CSTURB%XCTV * MZF( &
+! (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)*(1.+PREDTH1)/PD ) &
+! / (1.+PREDTH1)**2, IKA, IKU, IKL)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = (1.-0.5*PREDR1(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))&
+ / PD(IIJB:IIJE,1:IKT))*(1.-(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) &
+ * PREDTH1(IIJB:IIJE,1:IKT)*(1.+PREDTH1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) ) &
+ / (1.+PREDTH1(IIJB:IIJE,1:IKT))**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = - 1.5*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT) &
+ /PTKE(IIJB:IIJE,1:IKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = 1./(1.+PREDTH1(IIJB:IIJE,1:IKT))**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = - 1.5*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT) &
+ /PTKE(IIJB:IIJE,1:IKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
+!
+PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_TH2_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_TH2_WTH2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_WTH2
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = (1.+0.5*PREDTH1(IIJB:IIJE,1:IKT) &
+ +1.5*PREDR1(IIJB:IIJE,1:IKT)+0.5*PREDR1(IIJB:IIJE,1:IKT)**2)/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_TH2_WTH2(IIJB:IIJE,1:IKT) = PLEPS(IIJB:IIJE,1:IKT)*0.5/CSTURB%XCTD/PSQRT_TKE(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_TH2_WTH2(IIJB:IIJE,IKB-1)=PM3_TH2_WTH2(IIJB:IIJE,IKB)
+PM3_TH2_WTH2(IIJB:IIJE,IKE+1)=PM3_TH2_WTH2(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_TH2_WTH2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_TH2_WTH2_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_WTH2_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) &
+ * (0.5/PD(IIJB:IIJE,1:IKT) - (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))&
+ *(1.+0.5*PREDTH1(IIJB:IIJE,1:IKT)+1.5*PREDR1(IIJB:IIJE,1:IKT)&
+ +0.5*PREDR1(IIJB:IIJE,1:IKT)**2)/PD(IIJB:IIJE,1:IKT)**2)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,1:IKT) = PLEPS(IIJB:IIJE,1:IKT) &
+ *0.5/CSTURB%XCTD/PSQRT_TKE(IIJB:IIJE,1:IKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_TH2_W2R(D,CSTURB,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_W2R)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_W2R
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT) &
+ /PD(IIJB:IIJE,1:IKT)*PDTDZ(IIJB:IIJE,1:IKT)**2
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_TH2_W2R(IIJB:IIJE,1:IKT) = 0.75*CSTURB%XCTV**2*ZWORK2(IIJB:IIJE,1:IKT) &
+ *PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)/PTKE(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_TH2_W2R(IIJB:IIJE,IKB-1)=PM3_TH2_W2R(IIJB:IIJE,IKB)
+PM3_TH2_W2R(IIJB:IIJE,IKE+1)=PM3_TH2_W2R(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_TH2_W2R
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_W2R_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_W2R_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)&
+ /PD(IIJB:IIJE,1:IKT)*PDTDZ(IIJB:IIJE,1:IKT)*(2.-PREDTH1(IIJB:IIJE,1:IKT)* &
+ (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,1:IKT) = 0.75*CSTURB%XCTV**2*PLM(IIJB:IIJE,1:IKT) *PLEPS(IIJB:IIJE,1:IKT) &
+ /PTKE(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_TH2_W2R_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_TH2_WR2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WR2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_WR2
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = (PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)&
+ *PDTDZ(IIJB:IIJE,1:IKT))**2/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_TH2_WR2(IIJB:IIJE,1:IKT) = 0.25*CSTURB%XCTV**2*ZWORK2(IIJB:IIJE,1:IKT)&
+ *PLEPS(IIJB:IIJE,1:IKT)/PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_TH2_WR2(IIJB:IIJE,IKB-1)=PM3_TH2_WR2(IIJB:IIJE,IKB)
+PM3_TH2_WR2(IIJB:IIJE,IKE+1)=PM3_TH2_WR2(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_TH2_WR2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_WR2_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_WR2_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = (PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT))**2 &
+*PDTDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)*(2.-PREDTH1(IIJB:IIJE,1:IKT) &
+*(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,1:IKT) = 0.25*CSTURB%XCTV**2*PLEPS(IIJB:IIJE,1:IKT) &
+ / PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_TH2_WR2_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_TH2_WTHR(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WTHR)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_WTHR
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT) &
+ * PDTDZ(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_TH2_WTHR(IIJB:IIJE,1:IKT) = - 0.5*CSTURB%XCTV*PLEPS(IIJB:IIJE,1:IKT) &
+ / PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_TH2_WTHR(IIJB:IIJE,IKB-1)=PM3_TH2_WTHR(IIJB:IIJE,IKB)
+PM3_TH2_WTHR(IIJB:IIJE,IKE+1)=PM3_TH2_WTHR(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_TH2_WTHR
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_WTHR_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_WTHR_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)* &
+ (1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) * (1. -PREDTH1(IIJB:IIJE,1:IKT)*&
+ (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,1:IKT) = - 0.5*CSTURB%XCTV*PLEPS(IIJB:IIJE,1:IKT) &
+ / PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_THR_WTHR(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_THR_WTHR)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_THR_WTHR
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = (1.+PREDTH1(IIJB:IIJE,1:IKT))* &
+ (1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_THR_WTHR(IIJB:IIJE,1:IKT) = 0.5*PLEPS(IIJB:IIJE,1:IKT)/PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_THR_WTHR(IIJB:IIJE,IKB-1)=PM3_THR_WTHR(IIJB:IIJE,IKB)
+PM3_THR_WTHR(IIJB:IIJE,IKE+1)=PM3_THR_WTHR(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_THR_WTHR
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_THR_WTHR_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WTHR_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PETHETA(IIJB:IIJE,1:IKT)*PBLL_O_E(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT) &
+ *(1.+PREDR1(IIJB:IIJE,1:IKT))*(1.-(1.+PREDTH1(IIJB:IIJE,1:IKT)) &
+ *(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,1:IKT) = 0.5*PLEPS(IIJB:IIJE,1:IKT)/PSQRT_TKE(IIJB:IIJE,1:IKT) &
+ / CSTURB%XCTD * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_WTHR_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_THR_WTH2(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_THR_WTH2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_THR_WTH2
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = (1.+PREDR1(IIJB:IIJE,1:IKT))*PBLL_O_E(IIJB:IIJE,1:IKT)* &
+ PETHETA(IIJB:IIJE,1:IKT)*PDRDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_THR_WTH2(IIJB:IIJE,1:IKT) = - 0.25*PLEPS(IIJB:IIJE,1:IKT) &
+ / PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_THR_WTH2(IIJB:IIJE,IKB-1)=PM3_THR_WTH2(IIJB:IIJE,IKB)
+PM3_THR_WTH2(IIJB:IIJE,IKE+1)=PM3_THR_WTH2(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_THR_WTH2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_THR_WTH2_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WTH2_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = -(1.+PREDR1(IIJB:IIJE,1:IKT))*(PBLL_O_E(IIJB:IIJE,1:IKT) &
+ *PETHETA(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT))**2&
+ *PDRDZ(IIJB:IIJE,1:IKT)&
+ *(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,1:IKT) = - 0.25*PLEPS(IIJB:IIJE,1:IKT) &
+ /PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD*CSTURB%XCTV**2 * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_WTH2_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_THR_WTH2_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WTH2_O_DDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)&
+ *(-(1.+PREDR1(IIJB:IIJE,1:IKT))*PREDR1(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)&
+ *(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))+(1.+2.*PREDR1(IIJB:IIJE,1:IKT)))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,1:IKT) = - 0.25*PLEPS(IIJB:IIJE,1:IKT)/PSQRT_TKE(IIJB:IIJE,1:IKT)&
+ / CSTURB%XCTD*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,IKB)
+PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_WTH2_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_THR_W2TH(D,CSTURB,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ,PM3_THR_W2TH)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_THR_W2TH
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2TH',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = (1.+PREDR1(IIJB:IIJE,1:IKT))*PDRDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PM3_THR_W2TH(IIJB:IIJE,1:IKT) = - 0.75*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)&
+ / PTKE(IIJB:IIJE,1:IKT) * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PM3_THR_W2TH(IIJB:IIJE,IKB-1)=PM3_THR_W2TH(IIJB:IIJE,IKB)
+PM3_THR_W2TH(IIJB:IIJE,IKE+1)=PM3_THR_W2TH(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2TH',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_THR_W2TH
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA,PD_M3_THR_W2TH_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_W2TH_O_DDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = -PETHETA(IIJB:IIJE,1:IKT)*PBLL_O_E(IIJB:IIJE,1:IKT)*&
+(1.+PREDR1(IIJB:IIJE,1:IKT))*PDRDZ(IIJB:IIJE,1:IKT)&
+*(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)**2
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = - 0.75*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)&
+ / PTKE(IIJB:IIJE,1:IKT) * CSTURB%XCTV**2 * ZWORK1(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,IKB)
+PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_W2TH_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2TH_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_W2TH_O_DDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
+ INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = -(1.+PREDR1(IIJB:IIJE,1:IKT))*PREDR1(IIJB:IIJE,1:IKT)&
+* (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)**2 &
+ +(1.+2.*PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MZF_PHY(D,ZWORK1,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,1:IKT) = - 0.75*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)&
+ / PTKE(IIJB:IIJE,1:IKT) * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,IKB)
+PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,IKE)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_W2TH_O_DDRDZ
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+!
+SUBROUTINE PSI3(D,CSTURB,PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PPSI3)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2TH3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
+ CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PPSI3
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI3',0,ZHOOK_HANDLE)
+CALL PHI3(D,CSTURB,PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PPSI3)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI3',1,ZHOOK_HANDLE)
+END SUBROUTINE PSI3
+!----------------------------------------------------------------------------
+SUBROUTINE D_PSI3DRDZ_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DRDZ_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPSI3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
+ CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PSI3DRDZ_O_DDRDZ
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DRDZ_O_DDRDZ)
+!
+!C'est ok?!
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_PSI3DRDZ_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_PSI3DTDZ_O_DDTDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DTDZ_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPSI3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
+ CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PSI3DTDZ_O_DDTDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DTDZ_O_DDTDZ',0,ZHOOK_HANDLE)
+CALL D_PHI3DRDZ_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DTDZ_O_DDTDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DTDZ_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_PSI3DTDZ_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_PSI3DRDZ2_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV,PD_PSI3DRDZ2_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPSI3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2R3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
+ LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PSI3DRDZ2_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ2_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_PHI3DTDZ2_O_DDTDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV,PD_PSI3DRDZ2_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ2_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_PSI3DRDZ2_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WR_WR2(D,CSTURB,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PM3_WR_WR2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WR_WR2
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WR2',0,ZHOOK_HANDLE)
+CALL M3_WTH_WTH2(D,CSTURB,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PM3_WR_WR2)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WR2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WR_WR2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WR_WR2_O_DDRDZ(D,CSTURB,PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WR2_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PM3_WR_WR2
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_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)
+CALL D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WR2_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WR_WR2_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WR_W2R(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PM3_WR_W2R)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WR_W2R
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2R',0,ZHOOK_HANDLE)
+CALL M3_WTH_W2TH(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PM3_WR_W2R)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2R',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WR_W2R
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE,PD_M3_WR_W2R_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WR_W2R_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE,PD_M3_WR_W2R_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WR_W2R_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WR_W2TH(D,CSTURB,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_WR_W2TH)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WR_W2TH
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2TH',0,ZHOOK_HANDLE)
+CALL M3_WTH_W2R(D,CSTURB,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_WR_W2TH)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2TH',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WR_W2TH
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WR_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PD_M3_WR_W2TH_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WR_W2TH_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PD_M3_WR_W2TH_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WR_W2TH_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WR_WTH2(D,CSTURB,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ,PM3_WR_WTH2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WR_WTH2
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTH2',0,ZHOOK_HANDLE)
+CALL M3_WTH_WR2(D,CSTURB,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ,PM3_WR_WTH2)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTH2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WR_WTH2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WR_WTH2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PD_M3_WR_WTH2_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WR_WTH2_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PD_M3_WR_WTH2_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WR_WTH2_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_WR_WTHR(D,CSTURB,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA,PM3_WR_WTHR)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WR_WTHR
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTHR',0,ZHOOK_HANDLE)
+CALL M3_WTH_WTHR(D,CSTURB,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA,PM3_WR_WTHR)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTHR',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_WR_WTHR
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_WR_WTHR_O_DDRDZ(D,CSTURB,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WTHR_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PM3_WR_WTHR
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_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)
+CALL D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WTHR_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_WR_WTHR_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_R2_W2R(D,CSTURB,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE,PM3_R2_W2R)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PM3_R2_W2R
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2R',0,ZHOOK_HANDLE)
+CALL M3_TH2_W2TH(D,CSTURB,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE,PM3_R2_W2R)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2R',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_R2_W2R
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_R2_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV,PD_M3_R2_W2R_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ LOGICAL, INTENT(IN) :: OUSERV
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_R2_W2R_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV,PD_M3_R2_W2R_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_R2_W2R_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_R2_WR2(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PM3_R2_WR2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_R2_WR2
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WR2',0,ZHOOK_HANDLE)
+CALL M3_TH2_WTH2(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PM3_R2_WR2)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WR2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_R2_WR2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_R2_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_R2_WR2_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_R2_WR2_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WR2_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_R2_WR2_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_R2_WR2_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_R2_W2TH(D,CSTURB,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_W2TH)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_R2_W2TH
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2TH',0,ZHOOK_HANDLE)
+CALL M3_TH2_W2R(D,CSTURB,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_W2TH)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2TH',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_R2_W2TH
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_R2_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_W2TH_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_R2_W2TH_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_W2TH_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_R2_W2TH_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_R2_WTH2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTH2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_R2_WTH2
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTH2',0,ZHOOK_HANDLE)
+CALL M3_TH2_WR2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTH2)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTH2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_R2_WTH2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_R2_WTH2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTH2_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_R2_WTH2_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTH2_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_R2_WTH2_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_R2_WTHR(D,CSTURB,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTHR)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_R2_WTHR
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTHR',0,ZHOOK_HANDLE)
+CALL M3_TH2_WTHR(D,CSTURB,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTHR)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTHR',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_R2_WTHR
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_R2_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTHR_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_R2_WTHR_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTHR_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTHR_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_R2_WTHR_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WTHR_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WTHR_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WTHR_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_WTHR_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_THR_WR2(D,CSTURB,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_THR_WR2)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_THR_WR2
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WR2',0,ZHOOK_HANDLE)
+CALL M3_THR_WTH2(D,CSTURB,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_THR_WR2)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WR2',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_THR_WR2
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_THR_WR2_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WR2_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_THR_WR2_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_WR2_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_WR2_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WR2_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WR2_O_DDTDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
+CALL D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WR2_O_DDTDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_WR2_O_DDTDZ
+!----------------------------------------------------------------------------
+SUBROUTINE M3_THR_W2R(D,CSTURB,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ,PM3_THR_W2R)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_THR_W2R
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2R',0,ZHOOK_HANDLE)
+CALL M3_THR_W2TH(D,CSTURB,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ,PM3_THR_W2R)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2R',1,ZHOOK_HANDLE)
+END SUBROUTINE M3_THR_W2R
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST,PD_M3_THR_W2R_O_DDRDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_W2R_O_DDRDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+CALL D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST,PD_M3_THR_W2R_O_DDRDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_W2R_O_DDRDZ
+!----------------------------------------------------------------------------
+SUBROUTINE D_M3_THR_W2R_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2R_O_DDTDZ)
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
+ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
+ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_W2R_O_DDTDZ
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
+CALL D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2R_O_DDTDZ)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
+END SUBROUTINE D_M3_THR_W2R_O_DDTDZ
+!----------------------------------------------------------------------------
+!
+END MODULE MODE_PRANDTL
+
diff --git a/src/PHYEX/turb/mode_rmc01.f90 b/src/PHYEX/turb/mode_rmc01.f90
index cf77c5033063e8dc4aae3ea2752f02b0b29850de..5a980a92be0abf8fd509eba3bf3a572b9df28d89 100644
--- a/src/PHYEX/turb/mode_rmc01.f90
+++ b/src/PHYEX/turb/mode_rmc01.f90
@@ -1,40 +1,17 @@
-!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ################
- MODULE MODI_RMC01
-! ################
-INTERFACE
- SUBROUTINE RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW, &
- PSBL_DEPTH, PLMO, PLK, PLEPS )
-!
-CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! type of mixing length
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! width of grid mesh (X dir)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! width of grid mesh (Y dir)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! width of vert. layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus
-REAL, DIMENSION(:,:), INTENT(IN) :: PSBL_DEPTH! SBL depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin Obuhkov length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLK ! Mixing length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! Dissipative length
-
-END SUBROUTINE RMC01
-END INTERFACE
-END MODULE MODI_RMC01
-!
-! ##############################################################
- SUBROUTINE RMC01(HTURBLEN,KKA, KKU, KKL, PZZ, PDXX, PDYY, PDZZ, PDIRCOSZW, &
- PSBL_DEPTH, PLMO, PLK, PLEPS )
+MODULE MODE_RMC01
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE RMC01(D,CST,CSTURB,HTURBLEN,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,PLMO,PLK,PLEPS)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ##############################################################
!
!!**** *RMC01* -
-!!
+!!
!! PURPOSE
!! -------
!! This routine modifies the mixing and dissipative length near the SBL.
@@ -57,7 +34,7 @@ END MODULE MODI_RMC01
!!
!! AUTHOR
!! ------
-!!
+!!
!! V. Masson - Meteo-France -
!!
!! MODIFICATIONS
@@ -68,84 +45,89 @@ END MODULE MODI_RMC01
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_CTURB
+USE MODD_PARAMETERS, ONLY: XUNDEF
+USE MODD_CST, ONLY : CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CTURB, ONLY: CSTURB_t
!
-USE MODE_SBL
+USE MODE_UPDATE_IIJU_PHY, ONLY: UPDATE_IIJU_PHY
+USE MODE_SBL_PHY, ONLY: BUSINGER_PHIM, BUSINGER_PHIE
!
-USE MODI_SHUMAN
+USE SHUMAN_PHY, ONLY: MZF_PHY, MYF_PHY, MXF_PHY
!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
! ------------------------
!
-CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! type of mixing length
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! width of grid mesh (X dir)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! width of grid mesh (Y dir)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! width of vert. layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus
-REAL, DIMENSION(:,:), INTENT(IN) :: PSBL_DEPTH! SBL depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin Obuhkov length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLK ! Mixing length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! Dissipative length
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! type of mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDXX ! width of grid mesh (X dir)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDYY ! width of grid mesh (Y dir)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! width of vert. layers
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDIRCOSZW ! Director Cosinus
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSBL_DEPTH! SBL depth
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PLMO ! Monin Obuhkov length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PLK ! Mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PLEPS ! Dissipative length
!
!* 0.2 Declaration of local variables
! ------------------------------
!
INTEGER :: IKB,IKE ! first,last physical level
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
-INTEGER :: IIU ! horizontal x boundary
-INTEGER :: IJU ! horizontal y boundary
-INTEGER :: JK ! loop counter
+INTEGER :: IKTB,IKTE,IKT,IKA,IKU,IKL ! start, end of k loops in physical domain
+INTEGER :: JK,JIJ ! loop counter
+INTEGER :: IIJB,IIJE
!
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZZZ ! height of mass
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZZZ ! height of mass
! points above ground
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZZ_O_LMO ! height / LMO
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZGAM ! factor controling
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZZ_O_LMO ! height / LMO
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZGAM ! factor controling
! transition betw.
! SBL and free BL
-
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZPHIM! MO function
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZPHIM! MO function
! for stress
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZPHIE! MO function
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZPHIE! MO function
! for TKE
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZDH ! hor. grid mesh
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZZC ! alt. where turb. is isotr.
! size
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZL ! SBL length
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZZC ! alt. where
- ! turb. is isotr.
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZL ! SBL length
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1, ZWORK2
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZDH ! hor. grid mesh
!-------------------------------------------------------------------------------
!
!* 1. Initializations
! ---------------
!
! horizontal boundaries
-IIU=SIZE(PZZ,1)
-IJU=SIZE(PZZ,2)
-!
-! vertical boundaries
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-
-IKTB=1+JPVEXT_TURB
-IKT=SIZE(PZZ,3)
-IKTE=IKT-JPVEXT_TURB
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('RMC01',0,ZHOOK_HANDLE)
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IIJB=D%NIJB
+IIJE=D%NIJE
+IKT=D%NKT
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
!
! altitude of mass points
-ZZZ=MZF(PZZ)
+CALL MZF_PHY(D,PZZ,ZZZ)
! replace by height of mass points
DO JK=1,IKT
- ZZZ(:,:,JK) = ZZZ(:,:,JK) - PZZ(:,:,IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZZZ(IIJB:IIJE,JK) = ZZZ(IIJB:IIJE,JK) - PZZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
! fill upper level with physical value
-ZZZ(:,:,KKU) = 2.*ZZZ(:,:,KKU-KKL) - ZZZ(:,:,KKU-2*KKL)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZZZ(IIJB:IIJE,IKU) = 2.*ZZZ(IIJB:IIJE,IKU-IKL) - ZZZ(IIJB:IIJE,IKU-2*IKL)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
@@ -154,21 +136,25 @@ ZZZ(:,:,KKU) = 2.*ZZZ(:,:,KKU-KKL) - ZZZ(:,:,KKU-2*KKL)
!
! z/LMO
DO JK=1,IKT
- WHERE (PLMO(:,:)==XUNDEF)
- ZZ_O_LMO(:,:,JK)=0.
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (PLMO(IIJB:IIJE)==XUNDEF)
+ ZZ_O_LMO(IIJB:IIJE,JK)=0.
ELSEWHERE
- ZZ_O_LMO(:,:,JK)=ZZZ(:,:,JK)*PDIRCOSZW(:,:)/PLMO(:,:)
+ ZZ_O_LMO(IIJB:IIJE,JK)=ZZZ(IIJB:IIJE,JK)*PDIRCOSZW(IIJB:IIJE)/PLMO(IIJB:IIJE)
END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
-ZZ_O_LMO(:,:,:) = MAX(ZZ_O_LMO(:,:,:),-10.)
-ZZ_O_LMO(:,:,:) = MIN(ZZ_O_LMO(:,:,:), 10.)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZZ_O_LMO(IIJB:IIJE,1:IKT) = MAX(ZZ_O_LMO(IIJB:IIJE,1:IKT),-10.)
+ZZ_O_LMO(IIJB:IIJE,1:IKT) = MIN(ZZ_O_LMO(IIJB:IIJE,1:IKT), 10.)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
! MO function for stress
-ZPHIM(:,:,:) = BUSINGER_PHIM(ZZ_O_LMO)
+CALL BUSINGER_PHIM(D,ZZ_O_LMO,ZPHIM)
!
! MO function for TKE
-ZPHIE(:,:,:) = BUSINGER_PHIE(ZZ_O_LMO)
+CALL BUSINGER_PHIE(D,CSTURB,ZZ_O_LMO,ZPHIE)
!
!-------------------------------------------------------------------------------
SELECT CASE (HTURBLEN)
@@ -183,25 +169,46 @@ SELECT CASE (HTURBLEN)
! same law as in the neutral case (i.e. with Phim = 1).
!
CASE ('DELT','DEAR')
- ZDH = SQRT(MXF(PDXX)*MYF(PDYY))
- ZDH(IIU,:,:) = ZDH(IIU-1,:,:)
- ZDH(:,IJU,:) = ZDH(:,IJU-1,:)
+ CALL MXF_PHY(D,PDXX,ZWORK1)
+ CALL MYF_PHY(D,PDYY,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZDH(IIJB:IIJE,1:IKT) = SQRT(ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !
+ CALL UPDATE_IIJU_PHY(D,ZZC)
+ !
DO JK=1,IKT
- ZZC(:,:,JK) = 2.*MIN(ZPHIM(:,:,JK),1.)/XKARMAN &
- * MAX( PDZZ(:,:,JK)*PDIRCOSZW(:,:) , ZDH(:,:,JK)/PDIRCOSZW(:,:)/3. )
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZZC(IIJB:IIJE,JK) = 2.*MIN(ZPHIM(IIJB:IIJE,JK),1.)/CST%XKARMAN &
+ * MAX( PDZZ(IIJB:IIJE,JK)*PDIRCOSZW(IIJB:IIJE) , &
+ ZDH(IIJB:IIJE,JK)/PDIRCOSZW(IIJB:IIJE)/3. )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-!
+ !
!* 4. factor controling the transition between SBL and free isotropic turb. (3D case)
! --------------------------------------------------------------------
!
- ZGAM(:,:,KKA) = 0.
+ ZGAM(IIJB:IIJE,IKA) = 0.
DO JK=IKTB,IKTE
- ZGAM(:,:,JK) = 1. - EXP( -3.*(ZZZ(:,:,JK)-ZZZ(:,:,IKB))/(ZZC(:,:,JK)) )
- WHERE (ZGAM(:,:,JK-KKL)>ZGAM(:,:,JK) .OR. ZGAM(:,:,JK-KKL)>0.99 ) ZGAM(:,:,JK) = 1.
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZGAM(IIJB:IIJE,JK) = 1. - EXP( -3.*(ZZZ(IIJB:IIJE,JK)-ZZZ(IIJB:IIJE,IKB))/(ZZC(IIJB:IIJE,JK)) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (ZGAM(IIJB:IIJE,JK-IKL)>ZGAM(IIJB:IIJE,JK) .OR. ZGAM(IIJB:IIJE,JK-IKL)>0.99 )
+ ZGAM(IIJB:IIJE,JK) = 1.
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
- ZGAM(:,:,KKU) = 1. - EXP( -3.*(ZZZ(:,:,KKU)-ZZZ(:,:,IKB))/(ZZC(:,:,KKU)) )
- WHERE (ZGAM(:,:,KKU-KKL)>ZGAM(:,:,KKU) .OR. ZGAM(:,:,KKU-KKL)>0.99 ) ZGAM(:,:,KKU) = 1.
-!
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZGAM(IIJB:IIJE,IKU) = 1. - EXP( -3.*(ZZZ(IIJB:IIJE,IKU)-ZZZ(IIJB:IIJE,IKB))&
+ /(ZZC(IIJB:IIJE,IKU)) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (ZGAM(IIJB:IIJE,IKU-IKL)>ZGAM(IIJB:IIJE,IKU) .OR. ZGAM(IIJB:IIJE,IKU-IKL)>0.99 )
+ ZGAM(IIJB:IIJE,IKU) = 1.
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+!
!
!-------------------------------------------------------------------------------
!
@@ -210,16 +217,30 @@ SELECT CASE (HTURBLEN)
!
CASE DEFAULT
!* SBL depth is used
- ZGAM(:,:,:) = 1.
- ZGAM(:,:,KKA) = 0.
+ ZGAM(IIJB:IIJE,1:IKT) = 1.
+ ZGAM(IIJB:IIJE,IKA) = 0.
DO JK=IKTB,IKTE
- WHERE(PSBL_DEPTH>0.) &
- ZGAM(:,:,JK) = TANH( (ZZZ(:,:,JK)-ZZZ(:,:,IKB))/PSBL_DEPTH(:,:) )
- WHERE (ZGAM(:,:,JK-KKL)>0.99 ) ZGAM(:,:,JK) = 1.
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(PSBL_DEPTH(IIJB:IIJE)>0.)
+ ZGAM(IIJB:IIJE,JK) = TANH( (ZZZ(IIJB:IIJE,JK)-ZZZ(IIJB:IIJE,IKB))/PSBL_DEPTH(IIJB:IIJE) )
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (ZGAM(IIJB:IIJE,JK-IKL)>0.99 )
+ ZGAM(IIJB:IIJE,JK) = 1.
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
- WHERE(PSBL_DEPTH>0.) &
- ZGAM(:,:,KKU) = TANH( (ZZZ(:,:,KKU)-ZZZ(:,:,IKB))/PSBL_DEPTH(:,:) )
- WHERE (ZGAM(:,:,KKU-KKL)>0.99 ) ZGAM(:,:,JK) = 1.
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(PSBL_DEPTH(IIJB:IIJE)>0.)
+ ZGAM(IIJB:IIJE,IKU) = TANH( (ZZZ(IIJB:IIJE,IKU)-ZZZ(IIJB:IIJE,IKB))/PSBL_DEPTH(IIJB:IIJE) )
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (ZGAM(IIJB:IIJE,IKU-IKL)>0.99 )
+ ZGAM(IIJB:IIJE,JK) = 1.
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
END SELECT
@@ -229,32 +250,46 @@ END SELECT
! ---------------------------------
!
DO JK=1,IKT
- ZL(:,:,JK) = XKARMAN/SQRT(XALPSBL)/XCMFS &
- * ZZZ(:,:,JK)*PDIRCOSZW(:,:)/(ZPHIM(:,:,JK)**2*SQRT(ZPHIE(:,:,JK)))
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZL(IIJB:IIJE,JK) = CST%XKARMAN/SQRT(CSTURB%XALPSBL)/CSTURB%XCMFS &
+ * ZZZ(IIJB:IIJE,JK)*PDIRCOSZW(IIJB:IIJE)/(ZPHIM(IIJB:IIJE,JK)**2*SQRT(ZPHIE(IIJB:IIJE,JK)))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
-PLK(:,:,:)=(1.-ZGAM)*ZL+ZGAM*PLK
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PLK(IIJB:IIJE,1:IKT)=(1.-ZGAM(IIJB:IIJE,1:IKT))*ZL(IIJB:IIJE,1:IKT) &
+ +ZGAM(IIJB:IIJE,1:IKT)*PLK(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-PLK(:,:,KKA) = PLK(:,:,IKB)
-PLK(:,:,KKU) = PLK(:,:,IKE)
+PLK(IIJB:IIJE,IKA) = PLK(IIJB:IIJE,IKB)
+PLK(IIJB:IIJE,IKU) = PLK(IIJB:IIJE,IKE)
!-------------------------------------------------------------------------------
!
!* 7. Modification of the dissipative length
! --------------------------------------
!
-ZL = ZL * (XALPSBL**(3./2.)*XKARMAN*XCED) &
- / (XKARMAN/SQRT(XALPSBL)/XCMFS)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZL(IIJB:IIJE,1:IKT) = ZL(IIJB:IIJE,1:IKT) * (CSTURB%XALPSBL**(3./2.)*CST%XKARMAN*CSTURB%XCED) &
+ / (CST%XKARMAN/SQRT(CSTURB%XALPSBL)/CSTURB%XCMFS)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-WHERE (ZZ_O_LMO<0.)
- ZL = ZL/(1.-1.9*ZZ_O_LMO)
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE (ZZ_O_LMO(IIJB:IIJE,1:IKT)<0.)
+ ZL(IIJB:IIJE,1:IKT) = ZL(IIJB:IIJE,1:IKT)/(1.-1.9*ZZ_O_LMO(IIJB:IIJE,1:IKT))
ELSEWHERE
- ZL = ZL/(1.-0.3*SQRT(ZZ_O_LMO))
-ENDWHERE
+ ZL(IIJB:IIJE,1:IKT) = ZL(IIJB:IIJE,1:IKT)/(1.-0.3*SQRT(ZZ_O_LMO(IIJB:IIJE,1:IKT)))
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!
-PLEPS(:,:,:)=(1.-ZGAM)*ZL+ZGAM*PLEPS
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PLEPS(IIJB:IIJE,1:IKT)=(1.-ZGAM(IIJB:IIJE,1:IKT))*ZL(IIJB:IIJE,1:IKT) &
+ +ZGAM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-PLEPS(:,:,KKA) = PLEPS(:,:,IKB)
-PLEPS(:,:,KKU ) = PLEPS(:,:,IKE)
+PLEPS(IIJB:IIJE,IKA) = PLEPS(IIJB:IIJE,IKB)
+PLEPS(IIJB:IIJE,IKU) = PLEPS(IIJB:IIJE,IKE)
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('RMC01',1,ZHOOK_HANDLE)
END SUBROUTINE RMC01
+END MODULE MODE_RMC01
diff --git a/src/PHYEX/turb/mode_rotate_wind.f90 b/src/PHYEX/turb/mode_rotate_wind.f90
index 3c02a915cd8ad89cf2176d7b6f5e21d5b7ad29da..74c4932ffa5656f1d643b37efd7fbbf41dfee7a0 100644
--- a/src/PHYEX/turb/mode_rotate_wind.f90
+++ b/src/PHYEX/turb/mode_rotate_wind.f90
@@ -2,51 +2,13 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #######################
- MODULE MODI_ROTATE_WIND
+ MODULE MODE_ROTATE_WIND
! #######################
-!
-INTERFACE
-!
- SUBROUTINE ROTATE_WIND(PU,PV,PW, &
- PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PDXX,PDYY,PDZZ, &
- PUSLOPE,PVSLOPE )
-!
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PU,PV,PW ! cartesian components
- ! of the wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
-! Director Cosinus along x, y and z directions at surface w-point
-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) :: PDXX, PDYY, PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUSLOPE ! wind component along
- ! the maximum slope direction
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVSLOPE ! wind component along
- ! the direction normal to the maximum slope one
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ROTATE_WIND
-!
-END INTERFACE
-!
-END MODULE MODI_ROTATE_WIND
-!
+IMPLICIT NONE
+CONTAINS
! ###########################################################
- SUBROUTINE ROTATE_WIND(PU,PV,PW, &
+ SUBROUTINE ROTATE_WIND(D,PU,PV,PW, &
PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
PDXX,PDYY,PDZZ, &
@@ -111,35 +73,37 @@ END MODULE MODI_ROTATE_WIND
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAMETERS
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PU,PV,PW ! cartesian components
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PU,PV,PW ! cartesian components
! of the wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PSINSLOPE ! sinus of the angle
! between i and the slope vector
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDXX, PDYY, PDZZ
! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUSLOPE ! wind component along
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PUSLOPE ! wind component along
! the maximum slope direction
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVSLOPE ! wind component along
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: PVSLOPE ! wind component along
! the direction normal to the maximum slope one
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
-INTEGER, DIMENSION(SIZE(PDIRCOSXW,1),SIZE(PDIRCOSXW,2)) :: ILOC,JLOC
+INTEGER, DIMENSION(D%NIT,D%NJT) :: ILOC,JLOC
! shift index to find the 4 nearest points in x and y directions
-REAL, DIMENSION(SIZE(PDIRCOSXW,1),SIZE(PDIRCOSXW,2)) :: ZCOEFF,ZCOEFM, &
+REAL, DIMENSION(D%NIT,D%NJT) :: ZCOEFF,ZCOEFM, &
! interpolation weigths for flux and mass locations
ZUINT,ZVINT,ZWINT, &
! intermediate values of the cartesian components after x interp.
@@ -159,8 +123,8 @@ INTEGER :: JI,JJ
!* 1. PRELIMINARIES
! -------------
!
-PUSLOPE=0.
-PVSLOPE=0.
+PUSLOPE(:,:)=0.
+PVSLOPE(:,:)=0.
!
IIB = 2
IJB = 2
@@ -239,3 +203,76 @@ END DO
!----------------------------------------------------------------------------
!
END SUBROUTINE ROTATE_WIND
+!
+! ##############################################
+ SUBROUTINE UPDATE_ROTATE_WIND(D,PUSLOPE,PVSLOPE,HLBCX,HLBCY)
+! ##############################################
+!!
+!!**** *UPDATE_ROTATE_WIND* routine to set rotate wind values at the border
+!
+!! AUTHOR
+!! ------
+!!
+!! P Jabouille *CNRM METEO-FRANCE
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/06/99
+!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll, ONLY: ADD2DFIELD_ll, UPDATE_HALO_ll, CLEANLIST_ll, &
+ LWEST_ll, LEAST_ll, LSOUTH_ll, LNORTH_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(INOUT) :: PUSLOPE,PVSLOPE
+!
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+INTEGER :: IINFO_ll ! return code of parallel routine
+!
+! tangential surface fluxes in the axes following the orography
+!
+!* 1 PROLOGUE
+!
+NULLIFY(TZFIELDS_ll)
+!
+! 2 Update halo if necessary
+!
+!!$IF (NHALO == 1) THEN
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, PUSLOPE, 'UPDATE_ROTATE_WIND::PUSLOPE' )
+ CALL ADD2DFIELD_ll( TZFIELDS_ll, PVSLOPE, 'UPDATE_ROTATE_WIND::PVSLOPE' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+!!$ENDIF
+!
+! 3 Boundary conditions for non cyclic case
+!
+IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ PUSLOPE(D%NIB-1,:)=PUSLOPE(D%NIB,:)
+ PVSLOPE(D%NIB-1,:)=PVSLOPE(D%NIB,:)
+END IF
+IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ PUSLOPE(D%NIE+1,:)=PUSLOPE(D%NIE,:)
+ PVSLOPE(D%NIE+1,:)=PVSLOPE(D%NIE,:)
+END IF
+IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ PUSLOPE(:,D%NJB-1)=PUSLOPE(:,D%NJB)
+ PVSLOPE(:,D%NJB-1)=PVSLOPE(:,D%NJB)
+END IF
+IF( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ PUSLOPE(:,D%NJE+1)=PUSLOPE(:,D%NJE)
+ PVSLOPE(:,D%NJE+1)=PVSLOPE(:,D%NJE)
+END IF
+!
+END SUBROUTINE UPDATE_ROTATE_WIND
+END MODULE MODE_ROTATE_WIND
diff --git a/src/PHYEX/turb/mode_sbl.f90 b/src/PHYEX/turb/mode_sbl.f90
index 1c5e1da7f4600a7d6fe0a5a228b4708bab55c526..c219c43f422d073e7f1d3cc0f5743df1e6d9ecb9 100644
--- a/src/PHYEX/turb/mode_sbl.f90
+++ b/src/PHYEX/turb/mode_sbl.f90
@@ -3,13 +3,8 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 mode 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###############
- MODULE MODE_SBL
+! ###############
+ MODULE MODE_SBL
! ###############
!
!!**** *MODE_SBL * - contains Surface Boundary Layer characteristics functions
@@ -19,24 +14,24 @@
!
!!** METHOD
!! ------
-!!
-!!
+!!
+!!
!!
!! EXTERNAL
!! --------
-!!
+!!
!! IMPLICIT ARGUMENTS
-!! ------------------
+!! ------------------
!!
!! REFERENCE
!! ---------
!!
!! Businger et al 1971, Wyngaard and Cote 1974
-!!
+!!
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
@@ -44,6 +39,8 @@
!! V. Masson 06/11/02 optimization and add Businger fonction for TKE
!! V. Masson 01/01/03 use PAULSON_PSIM function
!-----------------------------------------------------------------------------
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
!* 0. DECLARATIONS
!
@@ -83,374 +80,435 @@ END INTERFACE
CONTAINS
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIM_3D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIM_3D(PZ_O_LMO,BUSINGER_PHIM3D)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
- SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIM_3D
+ SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)),INTENT(OUT) :: BUSINGER_PHIM3D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_3D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:,:) < 0. )
- BUSINGER_PHIM_3D(:,:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
+ BUSINGER_PHIM3D(:,:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
ELSEWHERE
- BUSINGER_PHIM_3D(:,:,:) = 1. + 4.7 * PZ_O_LMO
+ BUSINGER_PHIM3D(:,:,:) = 1. + 4.7 * PZ_O_LMO
END WHERE
-END FUNCTION BUSINGER_PHIM_3D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_3D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIM_3D
!
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIM_2D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIM_2D(PZ_O_LMO,BUSINGER_PHIM2D)
REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIM_2D
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)),INTENT(OUT) :: BUSINGER_PHIM2D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_2D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:) < 0. )
- BUSINGER_PHIM_2D(:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
+ BUSINGER_PHIM2D(:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
ELSEWHERE
- BUSINGER_PHIM_2D(:,:) = 1. + 4.7 * PZ_O_LMO
+ BUSINGER_PHIM2D(:,:) = 1. + 4.7 * PZ_O_LMO
END WHERE
-END FUNCTION BUSINGER_PHIM_2D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_2D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIM_2D
!
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIM_1D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIM_1D(PZ_O_LMO,BUSINGER_PHIM1D)
REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO)) :: BUSINGER_PHIM_1D
+ REAL, DIMENSION(SIZE(PZ_O_LMO)),INTENT(OUT) :: BUSINGER_PHIM1D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_1D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:) < 0. )
- BUSINGER_PHIM_1D(:) = (1.-15.*PZ_O_LMO)**(-0.25)
+ BUSINGER_PHIM1D(:) = (1.-15.*PZ_O_LMO)**(-0.25)
ELSEWHERE
- BUSINGER_PHIM_1D(:) = 1. + 4.7 * PZ_O_LMO
+ BUSINGER_PHIM1D(:) = 1. + 4.7 * PZ_O_LMO
END WHERE
-END FUNCTION BUSINGER_PHIM_1D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_1D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIM_1D
!
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIM_0D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIM_0D(PZ_O_LMO,BUSINGER_PHIM0D)
REAL, INTENT(IN) :: PZ_O_LMO
- REAL :: BUSINGER_PHIM_0D
+ REAL,INTENT(OUT) :: BUSINGER_PHIM0D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_0D',0,ZHOOK_HANDLE)
IF ( PZ_O_LMO < 0. ) THEN
- BUSINGER_PHIM_0D = (1.-15.*PZ_O_LMO)**(-0.25)
+ BUSINGER_PHIM0D = (1.-15.*PZ_O_LMO)**(-0.25)
ELSE
- BUSINGER_PHIM_0D = 1. + 4.7 * PZ_O_LMO
+ BUSINGER_PHIM0D = 1. + 4.7 * PZ_O_LMO
END IF
-END FUNCTION BUSINGER_PHIM_0D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_0D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIM_0D
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIH_3D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIH_3D(PZ_O_LMO,BUSINGER_PHIH3D)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
- SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIH_3D
+ SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)),INTENT(OUT) :: BUSINGER_PHIH3D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_3D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:,:) < 0. )
- BUSINGER_PHIH_3D(:,:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
+ BUSINGER_PHIH3D(:,:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
ELSEWHERE
- BUSINGER_PHIH_3D(:,:,:) = 0.74 + 4.7 * PZ_O_LMO
+ BUSINGER_PHIH3D(:,:,:) = 0.74 + 4.7 * PZ_O_LMO
END WHERE
-END FUNCTION BUSINGER_PHIH_3D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_3D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIH_3D
!
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIH_2D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIH_2D(PZ_O_LMO,BUSINGER_PHIH2D)
REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIH_2D
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)),INTENT(OUT) :: BUSINGER_PHIH2D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_2D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:) < 0. )
- BUSINGER_PHIH_2D(:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
+ BUSINGER_PHIH2D(:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
ELSEWHERE
- BUSINGER_PHIH_2D(:,:) = 0.74 + 4.7 * PZ_O_LMO
+ BUSINGER_PHIH2D(:,:) = 0.74 + 4.7 * PZ_O_LMO
END WHERE
-END FUNCTION BUSINGER_PHIH_2D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_2D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIH_2D
!
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIH_1D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIH_1D(PZ_O_LMO,BUSINGER_PHIH1D)
REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO)) :: BUSINGER_PHIH_1D
+ REAL, DIMENSION(SIZE(PZ_O_LMO)),INTENT(OUT) :: BUSINGER_PHIH1D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_1D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:) < 0. )
- BUSINGER_PHIH_1D(:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
+ BUSINGER_PHIH1D(:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
ELSEWHERE
- BUSINGER_PHIH_1D(:) = 0.74 + 4.7 * PZ_O_LMO
+ BUSINGER_PHIH1D(:) = 0.74 + 4.7 * PZ_O_LMO
END WHERE
-END FUNCTION BUSINGER_PHIH_1D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_1D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIH_1D
!
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIH_0D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIH_0D(PZ_O_LMO,BUSINGER_PHIH0D)
REAL, INTENT(IN) :: PZ_O_LMO
- REAL :: BUSINGER_PHIH_0D
+ REAL,INTENT(OUT) :: BUSINGER_PHIH0D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_0D',0,ZHOOK_HANDLE)
IF ( PZ_O_LMO < 0. ) THEN
- BUSINGER_PHIH_0D = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
+ BUSINGER_PHIH0D = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
ELSE
- BUSINGER_PHIH_0D = 0.74 + 4.7 * PZ_O_LMO
+ BUSINGER_PHIH0D = 0.74 + 4.7 * PZ_O_LMO
END IF
-END FUNCTION BUSINGER_PHIH_0D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_0D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIH_0D
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-FUNCTION BUSINGER_PHIE_3D(PZ_O_LMO)
+SUBROUTINE BUSINGER_PHIE_3D(PZ_O_LMO,BUSINGER_PHIE3D)
USE MODD_CTURB
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
- SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIE_3D
+ SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)),INTENT(OUT) :: BUSINGER_PHIE3D
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE_3D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:,:) < 0. )
- BUSINGER_PHIE_3D(:,:,:) = (1.+(-PZ_O_LMO)**(2./3.)/XALPSBL) &
+ BUSINGER_PHIE3D(:,:,:) = (1.+(-PZ_O_LMO)**(2./3.)/XALPSBL) &
* (1.-15.*PZ_O_LMO)**(0.5)
ELSEWHERE
- BUSINGER_PHIE_3D(:,:,:) = 1./(1. + 4.7 * PZ_O_LMO)**2
+ BUSINGER_PHIE3D(:,:,:) = 1./(1. + 4.7 * PZ_O_LMO)**2
END WHERE
-END FUNCTION BUSINGER_PHIE_3D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE_3D',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIE_3D
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-FUNCTION PAULSON_PSIM_2D(PZ_O_LMO)
+SUBROUTINE PAULSON_PSIM_2D(PZ_O_LMO,PAULSON_PSIM2D)
USE MODD_CST
REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: PAULSON_PSIM_2D
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)),INTENT(OUT) :: PAULSON_PSIM2D
!
REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: ZX
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_2D',0,ZHOOK_HANDLE)
ZX=1.
WHERE ( PZ_O_LMO(:,:) < 0. )
ZX=(1.-15.*PZ_O_LMO)**(0.25)
- PAULSON_PSIM_2D(:,:) = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
+ PAULSON_PSIM2D(:,:) = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
ELSEWHERE
- PAULSON_PSIM_2D(:,:) = - 4.7 * PZ_O_LMO
+ PAULSON_PSIM2D(:,:) = - 4.7 * PZ_O_LMO
END WHERE
-END FUNCTION PAULSON_PSIM_2D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_2D',1,ZHOOK_HANDLE)
+END SUBROUTINE PAULSON_PSIM_2D
!
!-------------------------------------------------------------------------------
!
-FUNCTION PAULSON_PSIM_1D(PZ_O_LMO)
+SUBROUTINE PAULSON_PSIM_1D(PZ_O_LMO,PAULSON_PSIM1D)
USE MODD_CST
REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: PAULSON_PSIM_1D
+ REAL, DIMENSION(SIZE(PZ_O_LMO,1)),INTENT(OUT) :: PAULSON_PSIM1D
!
REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: ZX
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_1D',0,ZHOOK_HANDLE)
ZX=1.
WHERE ( PZ_O_LMO(:) < 0. )
ZX=(1.-15.*PZ_O_LMO)**(0.25)
- PAULSON_PSIM_1D(:) = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
+ PAULSON_PSIM1D(:) = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
ELSEWHERE
- PAULSON_PSIM_1D(:) = - 4.7 * PZ_O_LMO
+ PAULSON_PSIM1D(:) = - 4.7 * PZ_O_LMO
END WHERE
-END FUNCTION PAULSON_PSIM_1D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_1D',1,ZHOOK_HANDLE)
+END SUBROUTINE PAULSON_PSIM_1D
!
!-------------------------------------------------------------------------------
!
-FUNCTION PAULSON_PSIM_0D(PZ_O_LMO)
+SUBROUTINE PAULSON_PSIM_0D(PZ_O_LMO,PAULSON_PSIM0D)
USE MODD_CST
REAL, INTENT(IN) :: PZ_O_LMO
- REAL :: PAULSON_PSIM_0D
+ REAL,INTENT(OUT) :: PAULSON_PSIM0D
!
REAL :: ZX
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_0D',0,ZHOOK_HANDLE)
ZX=1.
IF ( PZ_O_LMO < 0. ) THEN
ZX=(1.-15.*PZ_O_LMO)**(0.25)
- PAULSON_PSIM_0D = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
+ PAULSON_PSIM0D = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
ELSE
- PAULSON_PSIM_0D = - 4.7 * PZ_O_LMO
+ PAULSON_PSIM0D = - 4.7 * PZ_O_LMO
END IF
-END FUNCTION PAULSON_PSIM_0D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_0D',1,ZHOOK_HANDLE)
+END SUBROUTINE PAULSON_PSIM_0D
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-FUNCTION LMO_2D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
+SUBROUTINE LMO_2D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO2D)
USE MODD_CST
- USE MODD_PARAMETERS
+ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
REAL, DIMENSION(:,:), INTENT(IN) :: PUSTAR
REAL, DIMENSION(:,:), INTENT(IN) :: PTHETA
REAL, DIMENSION(:,:), INTENT(IN) :: PRV
REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH
REAL, DIMENSION(:,:), INTENT(IN) :: PSFRV
- REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: LMO_2D
+ REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)),INTENT(OUT) :: LMO2D
!
REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: ZTHETAV
REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: ZQ0
REAL :: ZEPS
!
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_2D',0,ZHOOK_HANDLE)
ZEPS=(XRV-XRD)/XRD
ZTHETAV(:,:) = PTHETA(:,:) * ( 1. +ZEPS * PRV(:,:))
- ZQ0 (:,:) = PSFTH(:,:) + ZTHETAV(:,:) * ZEPS * PSFRV(:,:)
+ ZQ0 (:,:) = PSFTH(:,:) + ZTHETAV(:,:) * ZEPS * PSFRV(:,:)
!
- LMO_2D(:,:) = XUNDEF
+ LMO2D(:,:) = XUNDEF
WHERE ( ZQ0(:,:) /=0. ) &
- LMO_2D(:,:) = - MAX(PUSTAR(:,:),1.E-6)**3 &
+ LMO2D(:,:) = - MAX(PUSTAR(:,:),1.E-6)**3 &
/ ( XKARMAN * XG / ZTHETAV(:,:) *ZQ0(:,:) )
-END FUNCTION LMO_2D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_2D',1,ZHOOK_HANDLE)
+END SUBROUTINE LMO_2D
!
!-------------------------------------------------------------------------------
!
-FUNCTION LMO_1D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
+SUBROUTINE LMO_1D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO1D)
USE MODD_CST
- USE MODD_PARAMETERS
+ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
REAL, DIMENSION(:), INTENT(IN) :: PUSTAR
REAL, DIMENSION(:), INTENT(IN) :: PTHETA
REAL, DIMENSION(:), INTENT(IN) :: PRV
REAL, DIMENSION(:), INTENT(IN) :: PSFTH
REAL, DIMENSION(:), INTENT(IN) :: PSFRV
- REAL, DIMENSION(SIZE(PUSTAR)) :: LMO_1D
+ REAL, DIMENSION(SIZE(PUSTAR)),INTENT(OUT) :: LMO1D
!
REAL, DIMENSION(SIZE(PUSTAR)) :: ZTHETAV
REAL :: ZEPS
!
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_1D',0,ZHOOK_HANDLE)
ZEPS=(XRV-XRD)/XRD
!
ZTHETAV(:) = PTHETA(:) * ( 1. +ZEPS * PRV(:))
!
- LMO_1D(:) = XUNDEF
+ LMO1D(:) = XUNDEF
WHERE ( PSFTH(:)/ZTHETAV(:)+ZEPS*PSFRV(:)/=0. ) &
- LMO_1D(:) = - MAX(PUSTAR(:),1.E-6)**3 &
+ LMO1D(:) = - MAX(PUSTAR(:),1.E-6)**3 &
/ ( XKARMAN * ( XG / ZTHETAV(:) * PSFTH(:) &
+ XG * ZEPS * PSFRV(:) ) )
-END FUNCTION LMO_1D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_1D',1,ZHOOK_HANDLE)
+END SUBROUTINE LMO_1D
!
!-------------------------------------------------------------------------------
!
-FUNCTION LMO_0D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
+SUBROUTINE LMO_0D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO0D)
USE MODD_CST
- USE MODD_PARAMETERS
+ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
REAL, INTENT(IN) :: PUSTAR
REAL, INTENT(IN) :: PTHETA
REAL, INTENT(IN) :: PRV
REAL, INTENT(IN) :: PSFTH
REAL, INTENT(IN) :: PSFRV
- REAL :: LMO_0D
+ REAL, INTENT(OUT) :: LMO0D
!
REAL :: ZTHETAV
REAL :: ZEPS
!
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_0D',0,ZHOOK_HANDLE)
ZEPS=(XRV-XRD)/XRD
!
!
ZTHETAV = PTHETA * ( 1. +ZEPS * PRV)
!
- LMO_0D = XUNDEF
+ LMO0D = XUNDEF
IF ( PSFTH/ZTHETAV+ZEPS*PSFRV/=0. ) &
- LMO_0D = - MAX(PUSTAR,1.E-6)**3 &
+ LMO0D = - MAX(PUSTAR,1.E-6)**3 &
/ ( XKARMAN * ( XG / ZTHETAV * PSFTH &
+ XG * ZEPS * PSFRV ) )
-END FUNCTION LMO_0D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_0D',1,ZHOOK_HANDLE)
+END SUBROUTINE LMO_0D
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-FUNCTION USTAR_2D(PU,PV,PZ,PZ0,PLMO)
+SUBROUTINE USTAR_2D(PU,PV,PZ,PZ0,PLMO,USTAR2D)
USE MODD_CST
- USE MODD_PARAMETERS
+ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
REAL, DIMENSION(:,:), INTENT(IN) :: PU
REAL, DIMENSION(:,:), INTENT(IN) :: PV
REAL, DIMENSION(:,:), INTENT(IN) :: PZ
REAL, DIMENSION(:,:), INTENT(IN) :: PZ0
REAL, DIMENSION(:,:), INTENT(IN) :: PLMO
- REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: USTAR_2D
+ REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)),INTENT(OUT) :: USTAR2D
REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: ZZ_O_LMO
REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: ZZ0_O_LMO
+ REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: ZWORK1,ZWORK2
!
!* purely unstable case
- USTAR_2D(:,:) = 0.
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_2D',0,ZHOOK_HANDLE)
+ USTAR2D(:,:) = 0.
ZZ_O_LMO(:,:) = XUNDEF
ZZ0_O_LMO(:,:) = XUNDEF
!
!* general case
+ CALL PAULSON_PSIM(ZZ_O_LMO,ZWORK1)
+ CALL PAULSON_PSIM(ZZ0_O_LMO,ZWORK2)
WHERE(ABS(PLMO) > 1.E-20 .AND. PLMO/=XUNDEF)
ZZ_O_LMO = PZ(:,:) / PLMO(:,:)
- ZZ0_O_LMO = PZ0(:,:) / PLMO(:,:)
- USTAR_2D(:,:) = SQRT( PU(:,:)**2+PV(:,:)**2 ) &
+ ZZ0_O_LMO = PZ0(:,:) / PLMO(:,:)
+ USTAR2D(:,:) = SQRT( PU(:,:)**2+PV(:,:)**2 ) &
* XKARMAN / ( LOG(PZ(:,:)/PZ0(:,:)) &
- - PAULSON_PSIM(ZZ_O_LMO(:,:)) &
- + PAULSON_PSIM(ZZ0_O_LMO(:,:)) )
+ - ZWORK1(:,:) + ZWORK2(:,:))
END WHERE
!
!* purely neutral case
WHERE(PLMO==XUNDEF)
ZZ_O_LMO = 0.
- USTAR_2D(:,:) = SQRT( PU(:,:)**2+PV(:,:)**2 ) &
+ USTAR2D(:,:) = SQRT( PU(:,:)**2+PV(:,:)**2 ) &
* XKARMAN / LOG(PZ(:,:)/PZ0(:,:))
END WHERE
!
-END FUNCTION USTAR_2D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_2D',1,ZHOOK_HANDLE)
+END SUBROUTINE USTAR_2D
!
!-------------------------------------------------------------------------------
!
-FUNCTION USTAR_1D(PU,PV,PZ,PZ0,PLMO)
+SUBROUTINE USTAR_1D(PU,PV,PZ,PZ0,PLMO,USTAR1D)
USE MODD_CST
- USE MODD_PARAMETERS
+ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
REAL, DIMENSION(:), INTENT(IN) :: PU
REAL, DIMENSION(:), INTENT(IN) :: PV
REAL, DIMENSION(:), INTENT(IN) :: PZ
REAL, DIMENSION(:), INTENT(IN) :: PZ0
REAL, DIMENSION(:), INTENT(IN) :: PLMO
- REAL, DIMENSION(SIZE(PU)) :: USTAR_1D
+ REAL, DIMENSION(SIZE(PU)),INTENT(OUT) :: USTAR1D
REAL, DIMENSION(SIZE(PU)) :: ZZ_O_LMO
REAL, DIMENSION(SIZE(PU)) :: ZZ0_O_LMO
+ REAL, DIMENSION(SIZE(PU)) :: ZWORK1,ZWORK2
!
!* purely unstable case
- USTAR_1D(:) = 0.
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_1D',0,ZHOOK_HANDLE)
+ USTAR1D(:) = 0.
ZZ_O_LMO(:) = XUNDEF
ZZ0_O_LMO(:) = XUNDEF
!
!* general case
+ CALL PAULSON_PSIM(ZZ_O_LMO,ZWORK1)
+ CALL PAULSON_PSIM(ZZ0_O_LMO,ZWORK2)
WHERE(ABS(PLMO) > 1.E-20 .AND. PLMO/=XUNDEF)
ZZ_O_LMO = PZ(:) / PLMO(:)
ZZ0_O_LMO = PZ0(:) / PLMO(:)
- USTAR_1D(:) = SQRT( PU(:)**2+PV(:)**2 ) &
+ USTAR1D(:) = SQRT( PU(:)**2+PV(:)**2 ) &
* XKARMAN / ( LOG(PZ(:)/PZ0(:)) &
- - PAULSON_PSIM(ZZ_O_LMO(:)) &
- + PAULSON_PSIM(ZZ0_O_LMO(:)) )
+ - ZWORK1(:) + ZWORK2(:))
END WHERE
!
!* purely neutral case
WHERE(PLMO==XUNDEF)
ZZ_O_LMO = 0.
- USTAR_1D(:) = SQRT( PU(:)**2+PV(:)**2 ) &
+ USTAR1D(:) = SQRT( PU(:)**2+PV(:)**2 ) &
* XKARMAN / LOG(PZ(:)/PZ0(:))
END WHERE
!
-END FUNCTION USTAR_1D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_1D',1,ZHOOK_HANDLE)
+END SUBROUTINE USTAR_1D
!
!-------------------------------------------------------------------------------
!
-FUNCTION USTAR_0D(PU,PV,PZ,PZ0,PLMO)
+SUBROUTINE USTAR_0D(PU,PV,PZ,PZ0,PLMO,USTAR0D)
USE MODD_CST
- USE MODD_PARAMETERS
+ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
REAL, INTENT(IN) :: PU
REAL, INTENT(IN) :: PV
REAL, INTENT(IN) :: PZ
REAL, INTENT(IN) :: PZ0
REAL, INTENT(IN) :: PLMO
- REAL :: USTAR_0D
+ REAL, INTENT(OUT) :: USTAR0D
+ REAL :: ZWORK, ZWORK2
!
!* purely unstable case
- USTAR_0D = 0.
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_0D',0,ZHOOK_HANDLE)
+ USTAR0D = 0.
!
!* general case
- IF ( ABS(PLMO) >= 1.E-20 .AND. PLMO/=XUNDEF) &
- USTAR_0D = SQRT( PU**2+PV**2 ) &
+ IF ( ABS(PLMO) >= 1.E-20 .AND. PLMO/=XUNDEF) THEN
+ CALL PAULSON_PSIM(PZ/PLMO,ZWORK1)
+ CALL PAULSON_PSIM(PZ0/PLMO,ZWORK2)
+ USTAR0D = SQRT( PU**2+PV**2 ) &
* XKARMAN / ( LOG(PZ/PZ0) &
- - PAULSON_PSIM(PZ/PLMO) &
- + PAULSON_PSIM(PZ0/PLMO))
+ - ZWORK1 + ZWORK2)
+ END IF
!
!* purely neutral case
IF (PLMO==XUNDEF) &
- USTAR_0D = SQRT( PU**2+PV**2 ) &
+ USTAR0D = SQRT( PU**2+PV**2 ) &
* XKARMAN / LOG(PZ/PZ0)
-END FUNCTION USTAR_0D
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_0D',1,ZHOOK_HANDLE)
+END SUBROUTINE USTAR_0D
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/turb/mode_sbl_depth.f90 b/src/PHYEX/turb/mode_sbl_depth.f90
index e83d8f784d4b1f4b84e755fe227fff2c588f24fc..f9312586278142cdd23407ea05538d4d31f3b78c 100644
--- a/src/PHYEX/turb/mode_sbl_depth.f90
+++ b/src/PHYEX/turb/mode_sbl_depth.f90
@@ -1,34 +1,14 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! ################
- MODULE MODI_SBL_DEPTH
-! ################
-!
-INTERFACE
-!
- SUBROUTINE SBL_DEPTH(KKB,KKE,PZZ,PFLXU,PFLXV,PWTHV,PLMO,PSBL_DEPTH)
-!
-INTEGER, INTENT(IN) :: KKB ! first physical level
-INTEGER, INTENT(IN) :: KKE ! upper physical level
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXU ! u'w'
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXV ! v'w'
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHV ! buoyancy flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SBL_DEPTH
-!
-END INTERFACE
-!
-END MODULE MODI_SBL_DEPTH
-!
-! #################################################################
- SUBROUTINE SBL_DEPTH(KKB,KKE,PZZ,PFLXU,PFLXV,PWTHV,PLMO,PSBL_DEPTH)
+MODULE MODE_SBL_DEPTH
+IMPLICIT NONE
+CONTAINS
+! ######spl
+ SUBROUTINE SBL_DEPTH(D,CSTURB,PZZ,PFLXU,PFLXV,PWTHV,PLMO,PSBL_DEPTH)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #################################################################
!
!
@@ -65,81 +45,129 @@ END MODULE MODI_SBL_DEPTH
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_PARAMETERS, ONLY : XUNDEF
-USE MODD_CTURB, ONLY : XFTOP_O_FSURF, XSBL_O_BL
!
-USE MODI_BL_DEPTH_DIAG
+USE MODE_BL_DEPTH_DIAG, ONLY : BL_DEPTH_DIAG
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
-INTEGER, INTENT(IN) :: KKB ! first physical level
-INTEGER, INTENT(IN) :: KKE ! upper physical level
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXU ! u'w'
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXV ! v'w'
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHV ! buoyancy flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLXU ! u'w'
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLXV ! v'w'
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PWTHV ! buoyancy flux
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PLMO ! Monin-Obukhov length
+REAL, DIMENSION(D%NIJT), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
!
-INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZQ0 ! surface buoyancy flux
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZWU ! surface friction u'w'
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZWV ! surface friction v'w'
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZUSTAR2 ! surface friction
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSBL_DYN ! SBL wih dynamical criteria
-REAL, DIMENSION(SIZE(PFLXU,1),SIZE(PFLXU,2),SIZE(PFLXU,3)) :: ZWIND
+INTEGER :: JLOOP,JIJ,JK ! loop counter
+INTEGER :: IKB,IKE,IIJB,IIJE,IKT ! index value for the Beginning
+REAL, DIMENSION(D%NIJT) :: ZQ0 ! surface buoyancy flux
+REAL, DIMENSION(D%NIJT) :: ZWU ! surface friction u'w'
+REAL, DIMENSION(D%NIJT) :: ZWV ! surface friction v'w'
+REAL, DIMENSION(D%NIJT) :: ZUSTAR2 ! surface friction
+REAL, DIMENSION(D%NIJT) :: ZSBL_DYN ! SBL wih dynamical criteria
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWIND
! intermediate wind for SBL calculation
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSBL_THER! SBL wih thermal criteria
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZA ! ponderation coefficient
+REAL, DIMENSION(D%NIJT) :: ZSBL_THER! SBL wih thermal criteria
+REAL, DIMENSION(D%NIJT) :: ZA ! ponderation coefficient
!----------------------------------------------------------------------------
!
!* initialisations
!
!
-ZWU (:,:) = PFLXU(:,:,KKB)
-ZWV (:,:) = PFLXV(:,:,KKB)
-ZQ0 (:,:) = PWTHV(:,:,KKB)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('SBL_DEPTH',0,ZHOOK_HANDLE)
+!
+IKB=D%NKTB
+IKE=D%NKTE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZWU(IIJB:IIJE) = PFLXU(IIJB:IIJE,IKB)
+ZWV(IIJB:IIJE) = PFLXV(IIJB:IIJE,IKB)
+ZQ0(IIJB:IIJE) = PWTHV(IIJB:IIJE,IKB)
!
-ZUSTAR2(:,:) = SQRT(ZWU**2+ZWV**2)
+ZUSTAR2(IIJB:IIJE) = SQRT(ZWU(IIJB:IIJE)**2+ZWV(IIJB:IIJE)**2)
!
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!----------------------------------------------------------------------------
!
!* BL and SBL diagnosed with friction criteria
!
-ZWIND=SQRT(PFLXU**2+PFLXV**2)
-ZSBL_DYN = XSBL_O_BL * BL_DEPTH_DIAG(KKB,KKE,ZUSTAR2,PZZ(:,:,KKB),ZWIND,PZZ,XFTOP_O_FSURF)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWIND(IIJB:IIJE,1:IKT)=SQRT(PFLXU(IIJB:IIJE,1:IKT)**2+PFLXV(IIJB:IIJE,1:IKT)**2)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL BL_DEPTH_DIAG(D,ZUSTAR2,PZZ(:,IKB),ZWIND,PZZ,CSTURB%XFTOP_O_FSURF,ZSBL_DYN)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZSBL_DYN(IIJB:IIJE) = CSTURB%XSBL_O_BL * ZSBL_DYN(IIJB:IIJE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!----------------------------------------------------------------------------
!
!* BL and SBL diagnosed with buoyancy flux criteria
!
-ZSBL_THER= XSBL_O_BL * BL_DEPTH_DIAG(KKB,KKE,ZQ0,PZZ(:,:,KKB),PWTHV,PZZ,XFTOP_O_FSURF)
+CALL BL_DEPTH_DIAG(D,ZQ0,PZZ(:,IKB),PWTHV,PZZ,CSTURB%XFTOP_O_FSURF,ZSBL_THER)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZSBL_THER(IIJB:IIJE)= CSTURB%XSBL_O_BL * ZSBL_THER(IIJB:IIJE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!----------------------------------------------------------------------------
!
!* SBL depth
!
-PSBL_DEPTH = 0.
-WHERE (ZSBL_THER> 0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = MIN(ZSBL_THER(:,:),ZSBL_DYN(:,:))
-WHERE (ZSBL_THER> 0. .AND. ZSBL_DYN==0.) PSBL_DEPTH = ZSBL_THER(:,:)
-WHERE (ZSBL_THER==0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = ZSBL_DYN(:,:)
+PSBL_DEPTH(:) = 0.
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE (ZSBL_THER(IIJB:IIJE)> 0. .AND. ZSBL_DYN(IIJB:IIJE)> 0.)
+ PSBL_DEPTH = MIN(ZSBL_THER(IIJB:IIJE),ZSBL_DYN(IIJB:IIJE))
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
+!
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE (ZSBL_THER(IIJB:IIJE)> 0. .AND. ZSBL_DYN(IIJB:IIJE)==0.)
+ PSBL_DEPTH(IIJB:IIJE) = ZSBL_THER(IIJB:IIJE)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
+!
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE (ZSBL_THER(IIJB:IIJE)==0. .AND. ZSBL_DYN(IIJB:IIJE)> 0.)
+ PSBL_DEPTH(IIJB:IIJE) = ZSBL_DYN(IIJB:IIJE)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
DO JLOOP=1,5
- WHERE (PLMO(:,:)/=XUNDEF .AND. ABS(PLMO(:,:))>=0.01 )
- ZA = TANH(2.*PSBL_DEPTH/PLMO)**2
- PSBL_DEPTH = 0.2 * PSBL_DEPTH + 0.8 * ((1.-ZA) * ZSBL_DYN + ZA * ZSBL_THER )
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (PLMO(IIJB:IIJE)/=XUNDEF .AND. ABS(PLMO(IIJB:IIJE))>=0.01 )
+ ZA(IIJB:IIJE) = TANH(2.*PSBL_DEPTH(IIJB:IIJE)/PLMO(IIJB:IIJE))**2
+ PSBL_DEPTH(IIJB:IIJE) = 0.2 * PSBL_DEPTH(IIJB:IIJE) + 0.8 * ((1.-ZA(IIJB:IIJE)) &
+ * ZSBL_DYN(IIJB:IIJE) + ZA(IIJB:IIJE) * ZSBL_THER(IIJB:IIJE) )
END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
-WHERE (ABS(PLMO(:,:))<=0.01 ) PSBL_DEPTH = ZSBL_THER
-WHERE (PLMO(:,:)==XUNDEF) PSBL_DEPTH = ZSBL_DYN
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE (ABS(PLMO(IIJB:IIJE))<=0.01 )
+ PSBL_DEPTH(IIJB:IIJE) = ZSBL_THER(IIJB:IIJE)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE (PLMO(IIJB:IIJE)==XUNDEF)
+ PSBL_DEPTH(IIJB:IIJE) = ZSBL_DYN(IIJB:IIJE)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
!----------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SBL_DEPTH',1,ZHOOK_HANDLE)
END SUBROUTINE SBL_DEPTH
+END MODULE MODE_SBL_DEPTH
diff --git a/src/PHYEX/turb/mode_sbl_phy.f90 b/src/PHYEX/turb/mode_sbl_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c3d8be4f0a876451e0267d88c4a3ee535dd5ac7c
--- /dev/null
+++ b/src/PHYEX/turb/mode_sbl_phy.f90
@@ -0,0 +1,184 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###############
+ MODULE MODE_SBL_PHY
+! ###############
+!
+!!**** *MODE_SBL * - contains Surface Boundary Layer characteristics functions
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Businger et al 1971, Wyngaard and Cote 1974
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/10/99
+!! V. Masson 06/11/02 optimization and add Businger fonction for TKE
+!! V. Masson 01/01/03 use PAULSON_PSIM function
+!-----------------------------------------------------------------------------
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+IMPLICIT NONE
+!-------------------------------------------------------------------------------
+CONTAINS
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE BUSINGER_PHIM(D,PZ_O_LMO,BUSINGERPHIM)
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZ_O_LMO
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: BUSINGERPHIM
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: JIJ,JK,IIJB,IIJE,IKT
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE ( PZ_O_LMO(IIJB:IIJE,1:IKT) < 0. )
+ BUSINGERPHIM(IIJB:IIJE,1:IKT) = (1.-15.*PZ_O_LMO(IIJB:IIJE,1:IKT))**(-0.25)
+ELSEWHERE
+ BUSINGERPHIM(IIJB:IIJE,1:IKT) = 1. + 4.7 * PZ_O_LMO(IIJB:IIJE,1:IKT)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIM
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE BUSINGER_PHIH(D,PZ_O_LMO,BUSINGERPHIH)
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZ_O_LMO
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: BUSINGERPHIH
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: JIJ,JK,IIJB,IIJE,IKT
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE ( PZ_O_LMO(IIJB:IIJE,1:IKT) < 0. )
+ BUSINGERPHIH(IIJB:IIJE,1:IKT) = 0.74 * (1.-9.*PZ_O_LMO(IIJB:IIJE,1:IKT))**(-0.5)
+ELSEWHERE
+ BUSINGERPHIH(IIJB:IIJE,1:IKT) = 0.74 + 4.7 * PZ_O_LMO(IIJB:IIJE,1:IKT)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIH
+!
+!-------------------------------------------------------------------------------
+SUBROUTINE BUSINGER_PHIE(D,CSTURB,PZ_O_LMO,BUSINGERPHIE)
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CTURB, ONLY: CSTURB_t
+!
+IMPLICIT NONE
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZ_O_LMO
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: BUSINGERPHIE
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: JIJ,JK,IIJB,IIJE,IKT
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE ( PZ_O_LMO(IIJB:IIJE,1:IKT) < 0. )
+ BUSINGERPHIE(IIJB:IIJE,1:IKT)=(1.+(-PZ_O_LMO(IIJB:IIJE,1:IKT))**(2./3.)/CSTURB%XALPSBL)&
+ * (1.-15.*PZ_O_LMO(IIJB:IIJE,1:IKT))**(0.5)
+ELSEWHERE
+ BUSINGERPHIE(IIJB:IIJE,1:IKT) = 1./(1. + 4.7 * PZ_O_LMO(IIJB:IIJE,1:IKT))**2
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE',1,ZHOOK_HANDLE)
+END SUBROUTINE BUSINGER_PHIE
+!
+SUBROUTINE LMO(D,CST,PUSTAR,PTHETA,PRV,PSFTH,PSFRV,PLMO)
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+ USE MODD_CST, ONLY: CST_t
+ USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
+ !
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(CST_t), INTENT(IN) :: CST
+ REAL, DIMENSION(D%NIJT), INTENT(IN) :: PUSTAR
+ REAL, DIMENSION(D%NIJT), INTENT(IN) :: PTHETA
+ REAL, DIMENSION(D%NIJT), INTENT(IN) :: PRV
+ REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH
+ REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFRV
+ REAL, DIMENSION(D%NIJT),INTENT(OUT) :: PLMO
+!
+ REAL, DIMENSION(D%NIJT) :: ZTHETAV, ZQ0
+ REAL :: ZEPS
+ INTEGER :: IIJB,IIJE, JIJ,IKT
+!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO',0,ZHOOK_HANDLE)
+!
+ IIJE=D%NIJE
+ IIJB=D%NIJB
+ IKT=D%NKT
+ ZEPS=(CST%XRV-CST%XRD)/CST%XRD
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZTHETAV(IIJB:IIJE) = PTHETA(IIJB:IIJE) * ( 1. +ZEPS * PRV(IIJB:IIJE))
+ ZQ0(IIJB:IIJE) = PSFTH(IIJB:IIJE) + ZTHETAV(IIJB:IIJE) * ZEPS * PSFRV(IIJB:IIJE)
+!
+ PLMO(IIJB:IIJE) = XUNDEF
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE ( ZQ0(IIJB:IIJE)/=0. )
+ PLMO(IIJB:IIJE) = - MAX(PUSTAR(IIJB:IIJE),1.E-6)**3 &
+ / ( CST%XKARMAN * CST%XG / ZTHETAV(IIJB:IIJE) *ZQ0(IIJB:IIJE) )
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO',1,ZHOOK_HANDLE)
+END SUBROUTINE LMO
+!
+END MODULE MODE_SBL_PHY
diff --git a/src/PHYEX/turb/mode_thl_rt_from_th_r_mf.f90 b/src/PHYEX/turb/mode_thl_rt_from_th_r_mf.f90
index 1fb982a1a082c9812051d3242c7c92387cef8354..6c8aa463a23ef4eae31ab6ad909ca8ae77a90b49 100644
--- a/src/PHYEX/turb/mode_thl_rt_from_th_r_mf.f90
+++ b/src/PHYEX/turb/mode_thl_rt_from_th_r_mf.f90
@@ -1,40 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! ######spl
- MODULE MODI_THL_RT_FROM_TH_R_MF
-! ###############################
-!
-INTERFACE
-! #################################################################
- SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
- PTH, PR, PEXN, &
- PTHL, PRT )
-! #################################################################
-!
-!
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXN ! exner function
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL ! th_l
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
-!
-END SUBROUTINE THL_RT_FROM_TH_R_MF
-
-END INTERFACE
-!
-END MODULE MODI_THL_RT_FROM_TH_R_MF
-! #################################################################
- SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
+MODULE MODE_THL_RT_FROM_TH_R_MF
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE THL_RT_FROM_TH_R_MF( D, CST, KRR, KRRL, KRRI, &
PTH, PR, PEXN, &
PTHL, PRT )
! #################################################################
@@ -76,23 +47,28 @@ END MODULE MODI_THL_RT_FROM_TH_R_MF
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY : CST_t
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXN ! exner function
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! exner function
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL ! th_l
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTHL ! th_l
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRT ! total non precip. water
!
!-------------------------------------------------------------------------------
!
@@ -100,47 +76,73 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
!
!----------------------------------------------------------------------------
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZCP, ZT
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZLVOCPEXN, ZLSOCPEXN
-INTEGER :: JRR
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZCP, ZT
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZLVOCPEXN, ZLSOCPEXN
+INTEGER :: JRR, JIJ, JK
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
!
+IF (LHOOK) CALL DR_HOOK('THL_RT_FRM_TH_R_MF',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!temperature
-ZT(:,:) = PTH(:,:) * PEXN(:,:)
+ZT(IIJB:IIJE,:) = PTH(IIJB:IIJE,:) * PEXN(IIJB:IIJE,:)
!Cp
-ZCP=XCPD
-IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + XCPV * PR(:,:,1)
+ZCP(IIJB:IIJE,:)=CST%XCPD
+IF (KRR > 0) ZCP(IIJB:IIJE,:) = ZCP(IIJB:IIJE,:) + CST%XCPV * PR(IIJB:IIJE,:,1)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
DO JRR = 2,1+KRRL ! loop on the liquid components
- ZCP(:,:) = ZCP(:,:) + XCL * PR(:,:,JRR)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZCP(IIJB:IIJE,:) = ZCP(IIJB:IIJE,:) + CST%XCL * PR(IIJB:IIJE,:,JRR)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
- ZCP(:,:) = ZCP(:,:) + XCI * PR(:,:,JRR)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZCP(IIJB:IIJE,:) = ZCP(IIJB:IIJE,:) + CST%XCI * PR(IIJB:IIJE,:,JRR)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!ZLVOCPEXN and ZLSOCPEXN
- ZLVOCPEXN(:,:)=(XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
- ZLSOCPEXN(:,:)=(XLSTT + (XCPV-XCI) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
+ ZLVOCPEXN(IIJB:IIJE,:)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT(IIJB:IIJE,:)-CST%XTT) ) &
+ &/ ZCP(IIJB:IIJE,:) / PEXN(IIJB:IIJE,:)
+ ZLSOCPEXN(IIJB:IIJE,:)=(CST%XLSTT + (CST%XCPV-CST%XCI) * (ZT(IIJB:IIJE,:)-CST%XTT) ) &
+ &/ ZCP(IIJB:IIJE,:) / PEXN(IIJB:IIJE,:)
! Rnp
- PRT(:,:) = PR(:,:,1) + PR(:,:,2) + PR(:,:,4)
+ PRT(IIJB:IIJE,:) = PR(IIJB:IIJE,:,1) + PR(IIJB:IIJE,:,2) + PR(IIJB:IIJE,:,4)
! Theta_l
- PTHL(:,:) = PTH(:,:) - ZLVOCPEXN(:,:) * PR(:,:,2) &
- - ZLSOCPEXN(:,:) * PR(:,:,4)
+ PTHL(IIJB:IIJE,:) = PTH(IIJB:IIJE,:) - ZLVOCPEXN(IIJB:IIJE,:) * PR(IIJB:IIJE,:,2) &
+ - ZLSOCPEXN(IIJB:IIJE,:) * PR(IIJB:IIJE,:,4)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!ZLVOCPEXN
- ZLVOCPEXN(:,:)=(XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
+ ZLVOCPEXN(IIJB:IIJE,:)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT(IIJB:IIJE,:)-CST%XTT) ) &
+ &/ ZCP(IIJB:IIJE,:) / PEXN(IIJB:IIJE,:)
! Rnp
- PRT(:,:) = PR(:,:,1) + PR(:,:,2)
+ PRT(IIJB:IIJE,:) = PR(IIJB:IIJE,:,1) + PR(IIJB:IIJE,:,2)
! Theta_l
- PTHL(:,:) = PTH(:,:) - ZLVOCPEXN(:,:) * PR(:,:,2)
+ PTHL(IIJB:IIJE,:) = PTH(IIJB:IIJE,:) - ZLVOCPEXN(IIJB:IIJE,:) * PR(IIJB:IIJE,:,2)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! Rnp = rv
- PRT(:,:) = PR(:,:,1)
+ PRT(IIJB:IIJE,:) = PR(IIJB:IIJE,:,1)
! Theta_l = Theta
- PTHL(:,:) = PTH(:,:)
+ PTHL(IIJB:IIJE,:) = PTH(IIJB:IIJE,:)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
+IF (LHOOK) CALL DR_HOOK('THL_RT_FRM_TH_R_MF',1,ZHOOK_HANDLE)
END SUBROUTINE THL_RT_FROM_TH_R_MF
+END MODULE MODE_THL_RT_FROM_TH_R_MF
diff --git a/src/PHYEX/turb/mode_tke_eps_sources.f90 b/src/PHYEX/turb/mode_tke_eps_sources.f90
index 4efe246beff2b829a835448166f9ad33bd6ea51f..516d4e6896a51f3b007965a5f8cae6dae742175b 100644
--- a/src/PHYEX/turb/mode_tke_eps_sources.f90
+++ b/src/PHYEX/turb/mode_tke_eps_sources.f90
@@ -1,67 +1,19 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_TKE_EPS_SOURCES
-! ###########################
-INTERFACE
-!
- SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP,PTRH, &
- PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- PTSTEP,PIMPL,PEXPL, &
- HTURBLEN,HTURBDIM, &
- TPFILE,OTURB_DIAG, &
- PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
-!
-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) :: KMI ! model index number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTRH
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Ther. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
- ! TKE at t+deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipati prod. of TKE
-!
-!
-!
-END SUBROUTINE TKE_EPS_SOURCES
-!
-END INTERFACE
-!
-END MODULE MODI_TKE_EPS_SOURCES
-!
-! ##################################################################
- SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP, &
- PTRH,PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- PTSTEP,PIMPL,PEXPL, &
- HTURBLEN,HTURBDIM, &
- TPFILE,OTURB_DIAG, &
- PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
+MODULE MODE_TKE_EPS_SOURCES
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TKE_EPS_SOURCES(D,CST,CSTURB,BUCONF,TURBN,TLES, &
+ & HPROGRAM, KMI,PTKEM,PLM,PLEPS,PDP, &
+ & PTRH,PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+ & PTSTEP,PEXPL, &
+ & TPFILE,ODIAG_IN_RUN,OOCEAN, &
+ & PSFUM,PSFVM, &
+ & PTP,PRTKES,PRTHLS,PCOEF_DISS,PTDIFF,PTDISS,PRTKEMS,&
+ & TBUDGETS, KBUDGETS, &
+ & PEDR, PTR,PDISS, PCURRENT_TKE_DISS )
! ##################################################################
!
!
@@ -84,7 +36,7 @@ END MODULE MODI_TKE_EPS_SOURCES
!! In high resolution, the horizontal transport terms are also
!! calculated, but explicitly.
!! The evolution of the dissipation as a variable is made if
-!! the parameter HTURBLEN is set equal to KEPS. The same reasoning
+!! the parameter TURBN%CTURBLEN is set equal to KEPS. The same reasoning
!! made for TKE applies.
!!
!! EXTERNAL
@@ -95,6 +47,8 @@ END MODULE MODI_TKE_EPS_SOURCES
!! MXF,MXM.MYF,MYM,MZF,MZM: Shuman functions (mean operators)
!! DZF : Shuman functions (difference operators)
!!
+!! SUBROUTINE TRIDIAG : to solve an implicit temporal scheme
+!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -105,15 +59,15 @@ END MODULE MODI_TKE_EPS_SOURCES
!! Module MODD_CTURB: contains the set of constants for
!! the turbulence scheme
!!
-!! XCET,XCED : transport and dissipation cts. for the TKE
+!! CSTURB%XCET,CSTURB%XCED : transport and dissipation cts. for the TKE
!! XCDP,XCDD,XCDT: constants from the parameterization of
!! the K-epsilon equation
-!! XTKEMIN,XEPSMIN : minimum values for the TKE and its
+!! CSTURB%XTKEMIN,XEPSMIN : minimum values for the TKE and its
!! dissipation
!!
!! Module MODD_PARAMETERS:
!!
-!! JPVEXT
+!! JPVEXT_TURB
!! Module MODD_BUDGET:
!! NBUMOD : model in which budget is calculated
!! CBUTYPE : type of desired budget
@@ -161,6 +115,8 @@ END MODULE MODI_TKE_EPS_SOURCES
!! change of YCOMMENT
!! 2012-02 Y. Seity, add possibility to run with reversed
!! vertical levels
+!! 2014-11 Y. Seity, add output terms for TKE DDHs budgets
+!! --------------------------------------------------------------------------
!! 2015-01 (J. Escobar) missing get_halo(ZRES) for JPHEXT<> 1
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
@@ -171,29 +127,30 @@ END MODULE MODI_TKE_EPS_SOURCES
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-use modd_budget, only: lbudget_tke, lbudget_th, NBUDGET_TKE, NBUDGET_TH, tbudgets
-USE MODD_CONF
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_PARAMETERS
-!
-use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODD_BUDGET, ONLY: TBUDGETCONF_t, NBUDGET_TKE, NBUDGET_TH, TBUDGETDATA
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LES, ONLY: TLES_t
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+!
+USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_END_PHY, BUDGET_STORE_INIT_PHY
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
USE MODE_ll
!
+USE SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZF_PHY, DZM_PHY
+!
USE MODI_GET_HALO
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_SHUMAN
-USE MODI_TRIDIAG_TKE
+USE MODI_LES_MEAN_SUBGRID_PHY
+USE MODE_TRIDIAG_TKE, ONLY: TRIDIAG_TKE
+!
!
IMPLICIT NONE
!
@@ -201,42 +158,49 @@ 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
-
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES
INTEGER, INTENT(IN) :: KMI ! model index number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at t-deltat
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM ! mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! physical height w-pt
REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
+REAL, INTENT(IN) :: PEXPL ! Coef. temporal. disc.
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! CPROGRAM is the program currently running (modd_conf)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTRH
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Ther. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
+LOGICAL, INTENT(IN) :: ODIAG_IN_RUN ! switch to activate online diagnostics (mesonh)
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTRH
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTP ! Ther. prod. of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
! TKE at t+deltat
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipati prod. of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRTHLS ! Source of Theta_l
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTDISS ! Dissipation TKE term
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRTKEMS ! Advection source
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PTR ! Transport prod. of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PDISS ! Dissipation of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PEDR ! EDR
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT), OPTIONAL :: PCURRENT_TKE_DISS ! if ODIAG_IN_RUN in mesonh
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFUM,PSFVM ! momentum sfc flux
!
!
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)):: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZA, & ! under diagonal elements of the tri-diagonal matrix involved
! in the temporal implicit scheme
ZRES, & ! treated variable at t+ deltat when the turbu-
@@ -245,17 +209,20 @@ REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)):: &
! temporarily store some diagnostics stored in FM file
ZFLX, & ! horizontal or vertical flux of the treated variable
ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-!LOGICAL,DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: GTKENEG
-! ! 3D mask .T. if TKE < XTKEMIN
-INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
- ! Index values for the Beginning and End
- ! mass points of the domain
-INTEGER :: IIU,IJU,IKU ! array size in the 3 dimensions
+ ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
+ ZTR, & ! Transport term
+ ZMWORK1,ZMWORK2,& ! working var. for MZM/MZF operators (array syntax)
+ ZDWORK1,ZDWORK2 ! working var. for DZM/DZF operators (array syntax)
+
+LOGICAL,DIMENSION(D%NIJT,D%NKT) :: GTKENEG
+ ! 3D mask .T. if TKE < CSTURB%XTKEMIN
+INTEGER :: IIJB,IIJE,IKB,IKE,IKT,IKA,IKL ! Index value for the mass points of the domain
!
TYPE(LIST_ll), POINTER :: TZFIELDDISS_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(TFIELDDATA) :: TZFIELD
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: JIJ,JK
!
!----------------------------------------------------------------------------
NULLIFY(TZFIELDDISS_ll)
@@ -263,17 +230,21 @@ NULLIFY(TZFIELDDISS_ll)
!* 1. PRELIMINARY COMPUTATIONS
! ------------------------
!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IIU=SIZE(PTKEM,1)
-IJU=SIZE(PTKEM,2)
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
+IF (LHOOK) CALL DR_HOOK('TKE_EPS_SOURCES',0,ZHOOK_HANDLE)
+!
+IKB=D%NKB
+IKE=D%NKE
+IIJB=D%NIJB
+IIJE=D%NIJE
+IKT=D%NKT
+IKA=D%NKA
+IKL=D%NKL
!
! compute the effective diffusion coefficient at the mass point
-ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
-
-if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
-
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZKEFF(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
!----------------------------------------------------------------------------
!
!* 2. TKE EQUATION
@@ -284,134 +255,224 @@ if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'DISSH', prthls(
!
! Complete the sources of TKE with the horizontal turbulent explicit transport
!
-IF (HTURBDIM=='3DIM') THEN
- PTR=PTRH
+IF (TURBN%CTURBDIM=='3DIM') THEN
+ ZTR(IIJB:IIJE,1:IKT)=PTRH(IIJB:IIJE,1:IKT)
ELSE
- PTR=0.
+ ZTR(IIJB:IIJE,1:IKT)=0.
END IF
!
!
-!
!* 2.2 Explicit TKE sources except horizontal turbulent transport
!
-!
! extrapolate the dynamic production with a 1/Z law from its value at the
-! W(IKB+1) value stored in PDP(IKB) to the mass localization tke(IKB)
-PDP(:,:,IKB) = PDP(:,:,IKB) * (1. + PDZZ(:,:,IKB+KKL)/PDZZ(:,:,IKB))
+IF (OOCEAN) THEN
+ ! W(IKE) value stored in PDP(IKE) to the mass localization of tke(IKE)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PDP(IIJB:IIJE,IKE) = PDP(IIJB:IIJE,IKE) * (1. + PDZZ(IIJB:IIJE,IKE)/PDZZ(IIJB:IIJE,IKE+1))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ELSE
+ ! W(IKB+1) value stored in PDP(IKB) to the mass localization tke(IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PDP(IIJB:IIJE,IKB) = PDP(IIJB:IIJE,IKB) * (1. + PDZZ(IIJB:IIJE,IKB+IKL)/PDZZ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+END IF
!
! Compute the source terms for TKE: ( ADVECtion + NUMerical DIFFusion + ..)
! + (Dynamical Production) + (Thermal Production) - (dissipation)
-ZFLX(:,:,:) = XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:)
-ZSOURCE(:,:,:) = ( PRTKES(:,:,:) + PRTKESM(:,:,:) ) / PRHODJ(:,:,:) &
- - PTKEM(:,:,:) / PTSTEP &
- + PDP(:,:,:) + PTP(:,:,:) + PTR(:,:,:) - PEXPL * ZFLX(:,:,:) * PTKEM(:,:,:)
+!
+CALL MZM_PHY(D,ZKEFF,ZMWORK1)
+CALL MZM_PHY(D,PRHODJ,ZMWORK2)
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZFLX(IIJB:IIJE,1:IKT) = CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT)) / PLEPS(IIJB:IIJE,1:IKT)
+ZSOURCE(IIJB:IIJE,1:IKT) = ( PRTKES(IIJB:IIJE,1:IKT) + PRTKEMS(IIJB:IIJE,1:IKT) ) &
+ / PRHODJ(IIJB:IIJE,1:IKT) - PTKEM(IIJB:IIJE,1:IKT) / PTSTEP &
+ + PDP(IIJB:IIJE,1:IKT) + PTP(IIJB:IIJE,1:IKT) + ZTR(IIJB:IIJE,1:IKT) &
+ - PEXPL * ZFLX(IIJB:IIJE,1:IKT) * PTKEM(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!* 2.2 implicit vertical TKE transport
!
!
+! To add here in ZSOURCE surface flux of TKE
+!(assumed to be 0 for ATM,
+IF (OOCEAN) THEN
+ !for ocean:wave breaking simple/very rough param wE = 100 Ustar**3 where ustar is the Tau_atmi/rhocea
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE (IIJB:IIJE,IKE)=ZSOURCE(IIJB:IIJE,IKE)-1.E2*((PSFUM(IIJB:IIJE)**2 + PSFVM(IIJB:IIJE)**2)**1.5) /PDZZ(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+END IF
! Compute the vector giving the elements just under the diagonal for the
! matrix inverted in TRIDIAG
!
-ZA(:,:,:) = - PTSTEP * XCET * &
- MZM(ZKEFF) * MZM(PRHODJ) / PDZZ**2
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZA(IIJB:IIJE,1:IKT) = - PTSTEP * CSTURB%XCET * ZMWORK1(IIJB:IIJE,1:IKT) &
+ * ZMWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)**2
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! Compute TKE at time t+deltat: ( stored in ZRES )
!
-CALL TRIDIAG_TKE(KKA,KKU,KKL,PTKEM,ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,&
- & ZSOURCE,PTSTEP*ZFLX,ZRES)
-CALL GET_HALO(ZRES)
+CALL TRIDIAG_TKE(D,PTKEM,ZA,PTSTEP,PEXPL,TURBN%XIMPL,PRHODJ,ZSOURCE,PTSTEP*ZFLX,ZRES)
+CALL GET_HALO_PHY(D,ZRES)
!
!* diagnose the dissipation
!
-IF (LDIAG_IN_RUN) THEN
- XCURRENT_TKE_DISS = ZFLX(:,:,:) * PTKEM(:,:,:) &
- *(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:))
- CALL ADD3DFIELD_ll( TZFIELDDISS_ll, XCURRENT_TKE_DISS, 'TKE_EPS_SOURCES::XCURRENT_TKE_DISS' )
+IF (ODIAG_IN_RUN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PCURRENT_TKE_DISS(IIJB:IIJE,1:IKT) = ZFLX(IIJB:IIJE,1:IKT) * PTKEM(IIJB:IIJE,1:IKT) &
+ *(PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+ CALL ADD2DFIELD_ll(TZFIELDDISS_ll, PCURRENT_TKE_DISS, 'TKE_EPS_SOURCES::PCURRENT_TKE_DISS' )
CALL UPDATE_HALO_ll(TZFIELDDISS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDDISS_ll)
ENDIF
!
! TKE must be greater than its minimum value
+! CL : Now done at the end of the time step in ADVECTION_METSV for MesoNH
+IF(HPROGRAM/='MESONH') THEN
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ GTKENEG(IIJB:IIJE,1:IKT) = ZRES(IIJB:IIJE,1:IKT) <= CSTURB%XTKEMIN
+ WHERE ( GTKENEG(IIJB:IIJE,1:IKT) )
+ ZRES(IIJB:IIJE,1:IKT) = CSTURB%XTKEMIN
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
!
-! CL : Now done at the end of the time step in ADVECTION_METSV
-!GTKENEG = ZRES <= XTKEMIN
-!WHERE ( GTKENEG )
-! ZRES = XTKEMIN
-!END WHERE
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PTDISS(IIJB:IIJE,1:IKT) = - ZFLX(IIJB:IIJE,1:IKT)*(PEXPL*PTKEM(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-IF ( LLES_CALL .OR. &
- (OTURB_DIAG .AND. tpfile%lopened) ) THEN
+IF ( TLES%LLES_CALL .OR. &
+ (TURBN%LTURB_DIAG .AND. TPFILE%LOPENED) ) THEN
!
! Compute the cartesian vertical flux of TKE in ZFLX
!
-
- ZFLX(:,:,:) = - XCET * MZM(ZKEFF) * &
- DZM(PIMPL * ZRES + PEXPL * PTKEM ) / PDZZ
+ CALL MZM_PHY(D,ZKEFF,ZMWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZDWORK1(IIJB:IIJE,1:IKT) = TURBN%XIMPL * ZRES(IIJB:IIJE,1:IKT) + PEXPL * PTKEM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZM_PHY(D,ZDWORK1,ZDWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLX(IIJB:IIJE,1:IKT) = - CSTURB%XCET * ZMWORK1(IIJB:IIJE,1:IKT) &
+ * ZDWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
- ZFLX(:,:,IKB) = 0.
- ZFLX(:,:,KKA) = 0.
+ ZFLX(IIJB:IIJE,IKB) = 0.
+ ZFLX(IIJB:IIJE,IKA) = 0.
!
! Compute the whole turbulent TRansport of TKE:
!
- PTR(:,:,:)= PTR - DZF( MZM(PRHODJ) * ZFLX / PDZZ ) /PRHODJ
+ CALL MZM_PHY(D,PRHODJ,ZMWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZMWORK2(IIJB:IIJE,1:IKT) = ZMWORK1(IIJB:IIJE,1:IKT) * ZFLX(IIJB:IIJE,1:IKT) &
+ / PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZF_PHY(D,ZMWORK2,ZDWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZTR(IIJB:IIJE,1:IKT)= ZTR(IIJB:IIJE,1:IKT) - ZDWORK1(IIJB:IIJE,1:IKT) &
+ /PRHODJ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! Storage in the LES configuration
!
- IF (LLES_CALL) THEN
- CALL LES_MEAN_SUBGRID( MZF(ZFLX), X_LES_SUBGRID_WTke )
- CALL LES_MEAN_SUBGRID( -PTR, X_LES_SUBGRID_ddz_WTke )
+ IF (TLES%LLES_CALL) THEN
+ CALL MZF_PHY(D,ZFLX,ZMWORK1)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMWORK1, TLES%X_LES_SUBGRID_WTke )
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES, -ZTR, TLES%X_LES_SUBGRID_ddz_WTke )
END IF
!
END IF
!
!* 2.4 stores the explicit sources for budget purposes
!
-if (lbudget_tke) then
+IF (BUCONF%LBUDGET_TKE) THEN
! Dynamical production
- call Budget_store_add( tbudgets(NBUDGET_TKE), 'DP', pdp(:, :, :) * prhodj(:, :, :) )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZMWORK1(IIJB:IIJE,1:IKT) = PDP(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TKE), 'DP', ZMWORK1)
+ !
! Thermal production
- call Budget_store_add( tbudgets(NBUDGET_TKE), 'TP', ptp(:, :, :) * prhodj(:, :, :) )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZMWORK1(IIJB:IIJE,1:IKT) = PTP(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TKE), 'TP', ZMWORK1)
+ !
! Dissipation
- call Budget_store_add( tbudgets(NBUDGET_TKE), 'DISS', -xced * sqrt( ptkem(:, :, :) ) / pleps(:, :, :) &
- * ( pexpl * ptkem(:, :, :) + pimpl * zres(:, :, :) ) * prhodj(:, :, :) )
-end if
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZMWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT))/PLEPS(IIJB:IIJE,1:IKT) * &
+ (PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT))*PRHODJ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TKE), 'DISS',ZMWORK1)
+END IF
!
!* 2.5 computes the final RTKE and stores the whole turbulent transport
-! with the removal of the advection part
+! with the removal of the advection part for MesoNH
-if (lbudget_tke) then
- !Store the previous source terms in prtkes before initializing the next one
- PRTKES(:,:,:) = PRTKES(:,:,:) + PRHODJ(:,:,:) * &
- ( PDP(:,:,:) + PTP(:,:,:) &
- - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * ( PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:) ) )
-
- call Budget_store_init( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
-end if
-
-PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP - PRTKESM(:,:,:)
+!Should be in IF LBUDGET_TKE only. Was removed out for a correct comput. of PTDIFF in case of LBUDGET_TKE=F in AROME
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+#ifdef REPRO48
+IF (BUCONF%LBUDGET_TKE) THEN
+PRTKES(IIJB:IIJE,1:IKT) = PRTKES(IIJB:IIJE,1:IKT) + PDP(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT)
+PRTKES(IIJB:IIJE,1:IKT) = PRTKES(IIJB:IIJE,1:IKT) + PTP(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT)
+PRTKES(IIJB:IIJE,1:IKT) = PRTKES(IIJB:IIJE,1:IKT) - CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT)) / PLEPS(IIJB:IIJE,1:IKT) * &
+ (PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT)) * PRHODJ(IIJB:IIJE,1:IKT)
+END IF
+#else
+PRTKES(IIJB:IIJE,1:IKT) = PRTKES(IIJB:IIJE,1:IKT) + PRHODJ(IIJB:IIJE,1:IKT) * &
+ ( PDP(IIJB:IIJE,1:IKT) + PTP(IIJB:IIJE,1:IKT) &
+ - CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT)) / PLEPS(IIJB:IIJE,1:IKT) &
+ * ( PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT) ) )
+#endif
+!
+PTDIFF(IIJB:IIJE,1:IKT) = ZRES(IIJB:IIJE,1:IKT) / PTSTEP - PRTKES(IIJB:IIJE,1:IKT)&
+ /PRHODJ(IIJB:IIJE,1:IKT) &
+ & - PDP(IIJB:IIJE,1:IKT)- PTP(IIJB:IIJE,1:IKT) - PTDISS(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+IF (BUCONF%LBUDGET_TKE) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TKE), 'TR', PRTKES)
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PRTKES(IIJB:IIJE,1:IKT) = ZRES(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT) / PTSTEP &
+ - PRTKEMS(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! stores the whole turbulent transport
!
-if (lbudget_tke) call Budget_store_end( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
-
+IF (BUCONF%LBUDGET_TKE) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TKE), 'TR', PRTKES)
+!
!----------------------------------------------------------------------------
!
!* 3. COMPUTE THE DISSIPATIVE HEATING
! -------------------------------
!
-PRTHLS(:,:,:) = PRTHLS(:,:,:) + XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
- (PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:) * PCOEF_DISS(:,:,:)
-
-if (lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
-
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) + &
+ CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT)) / PLEPS(IIJB:IIJE,1:IKT) * &
+ (PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT)) &
+ * PRHODJ(IIJB:IIJE,1:IKT) * PCOEF_DISS(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!----------------------------------------------------------------------------
!
!* 4. STORES SOME DIAGNOSTICS
! -----------------------
!
-PDISS(:,:,:) = -XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
+IF(PRESENT(PTR)) PTR=ZTR
+IF(PRESENT(PDISS)) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PDISS(IIJB:IIJE,1:IKT) = -CSTURB%XCED * (PTKEM(IIJB:IIJE,1:IKT)**1.5) / PLEPS(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
+!
+IF(PRESENT(PEDR)) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PEDR(IIJB:IIJE,1:IKT) = CSTURB%XCED * (PTKEM(IIJB:IIJE,1:IKT)**1.5) / PLEPS(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
!
! stores the dynamic production
!
@@ -425,7 +486,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PDP)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PDP)
!
! stores the thermal production
!
@@ -439,7 +500,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PTP)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PTP)
!
! stores the whole turbulent transport
!
@@ -453,7 +514,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PTR)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZTR)
!
! stores the dissipation of TKE
!
@@ -467,19 +528,18 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PDISS)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PDISS)
END IF
!
! Storage in the LES configuration of the Dynamic Production of TKE and
! the dissipation of TKE
!
-IF (LLES_CALL ) THEN
- CALL LES_MEAN_SUBGRID( PDISS, X_LES_SUBGRID_DISS_Tke )
+IF (TLES%LLES_CALL ) THEN
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES, PDISS, TLES%X_LES_SUBGRID_DISS_Tke )
END IF
!
!----------------------------------------------------------------------------
-!
-!
-!----------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TKE_EPS_SOURCES',1,ZHOOK_HANDLE)
END SUBROUTINE TKE_EPS_SOURCES
+END MODULE MODE_TKE_EPS_SOURCES
diff --git a/src/PHYEX/turb/mode_tm06.f90 b/src/PHYEX/turb/mode_tm06.f90
index eb82548d9a8a51fd1c1a803ffdb957db48d26e5a..d5f9ea2de34a14418c499634b7f78224ac6be80d 100644
--- a/src/PHYEX/turb/mode_tm06.f90
+++ b/src/PHYEX/turb/mode_tm06.f90
@@ -2,40 +2,12 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 newsrc 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ################
- MODULE MODI_TM06
-! ################
-!
-INTERFACE
-!
- SUBROUTINE TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference potential temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PBL_DEPTH ! boundary layer height
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH ! surface heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PMWTH ! w'2th'
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PMTH2 ! w'th'2
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE TM06
-!
-END INTERFACE
-!
-END MODULE MODI_TM06
-!
-! #################################################################
- SUBROUTINE TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
+MODULE MODE_TM06
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TM06(D,CST,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #################################################################
!
!
@@ -73,10 +45,9 @@ END MODULE MODI_TM06
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : XUNDEF
-USE MODD_CST, ONLY : XG
-USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
-
+USE MODD_CST, ONLY: CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY: XUNDEF,JPVEXT_TURB
!
!
IMPLICIT NONE
@@ -84,82 +55,106 @@ 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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference potential temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PBL_DEPTH ! boundary layer height
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH ! surface heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PMWTH ! w'2th'
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PMTH2 ! w'th'2
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVREF ! reference potential temperature
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PBL_DEPTH ! boundary layer height
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH ! surface heat flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PMWTH ! w'2th'
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PMTH2 ! w'th'2
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZ_O_H ! normalized height z/h (where h=BL height)
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZWSTAR ! normalized convective velocity w*
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZTSTAR ! normalized temperature velocity w*
+REAL, DIMENSION(D%NIJT,D%NKT):: ZZ_O_H ! normalized height z/h (where h=BL height)
+REAL, DIMENSION(D%NIJT) :: ZWSTAR ! normalized convective velocity w*
+REAL, DIMENSION(D%NIJT) :: ZTSTAR ! normalized temperature velocity w*
!
-INTEGER :: JK ! loop counter
-INTEGER :: IKT ! vertical size
-INTEGER :: IKTB,IKTE,IKB,IKE ! vertical levels
+INTEGER :: JK,JIJ ! loop counter
+INTEGER :: IIJE,IIJB
+INTEGER :: IKTB,IKTE,IKB,IKE,IKT,IKU ! vertical levels
!----------------------------------------------------------------------------
!
-IKT=SIZE(PZZ,3)
-IKTB=1+JPVEXT_TURB
-IKTE=IKT-JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TM06',0,ZHOOK_HANDLE)
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKT=D%NKT
+IKE=D%NKE
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKU=D%NKU
!
!
!* w* and T*
!
-WHERE(PSFTH>0.)
- ZWSTAR = ((XG/PTHVREF(:,:,IKB))*PSFTH*PBL_DEPTH)**(1./3.)
- ZTSTAR = PSFTH / ZWSTAR
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE(PSFTH(IIJB:IIJE)>0.)
+ ZWSTAR(IIJB:IIJE) = ((CST%XG/PTHVREF(IIJB:IIJE,IKB))*PSFTH(IIJB:IIJE)*PBL_DEPTH(IIJB:IIJE))**(1./3.)
+ ZTSTAR(IIJB:IIJE) = PSFTH(IIJB:IIJE) / ZWSTAR(IIJB:IIJE)
ELSEWHERE
- ZWSTAR = 0.
- ZTSTAR = 0.
+ ZWSTAR(IIJB:IIJE) = 0.
+ ZTSTAR(IIJB:IIJE) = 0.
END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
!
!* normalized height
!
-ZZ_O_H = XUNDEF
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZZ_O_H(IIJB:IIJE,1:IKT) = XUNDEF
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
DO JK=1,IKT
- WHERE (PBL_DEPTH/=XUNDEF)
- ZZ_O_H(:,:,JK) = (PZZ(:,:,JK)-PZZ(:,:,IKB)) / PBL_DEPTH(:,:)
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE (PBL_DEPTH(IIJB:IIJE)/=XUNDEF)
+ ZZ_O_H(IIJB:IIJE,JK) = (PZZ(IIJB:IIJE,JK)-PZZ(IIJB:IIJE,IKB)) / PBL_DEPTH(IIJB:IIJE)
END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
!
!* w'th'2
!
-PMTH2 = 0.
-WHERE(ZZ_O_H < 0.95 .AND. ZZ_O_H/=XUNDEF)
- PMTH2(:,:,:) = 4.*(MAX(ZZ_O_H,0.))**0.4*(ZZ_O_H-0.95)**2
+PMTH2(IIJB:IIJE,1:IKT) = 0.
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE(ZZ_O_H(IIJB:IIJE,1:IKT) < 0.95 .AND. ZZ_O_H(IIJB:IIJE,1:IKT)/=XUNDEF)
+ PMTH2(IIJB:IIJE,1:IKT) = 4.*(MAX(ZZ_O_H(IIJB:IIJE,1:IKT),0.))**0.4*(ZZ_O_H(IIJB:IIJE,1:IKT)-0.95)**2
END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
DO JK=IKTB+1,IKTE-1
- PMTH2(:,:,JK) = PMTH2(:,:,JK) * ZTSTAR(:,:)**2*ZWSTAR(:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PMTH2(IIJB:IIJE,JK) = PMTH2(IIJB:IIJE,JK) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-PMTH2(:,:,IKE)=PMTH2(:,:,IKE) * ZTSTAR(:,:)**2*ZWSTAR(:,:)
-PMTH2(:,:,KKU)=PMTH2(:,:,KKU) * ZTSTAR(:,:)**2*ZWSTAR(:,:)
-
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PMTH2(IIJB:IIJE,IKE)=PMTH2(IIJB:IIJE,IKE) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE)
+PMTH2(IIJB:IIJE,IKU)=PMTH2(IIJB:IIJE,IKU) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!
!* w'2th'
!
-PMWTH = 0.
-WHERE(ZZ_O_H <0.9 .AND. ZZ_O_H/=XUNDEF)
- PMWTH(:,:,:) = MAX(-7.9*(ABS(ZZ_O_H-0.35))**2.9 * (ABS(ZZ_O_H-1.))**0.58 + 0.37, 0.)
+PMWTH(IIJB:IIJE,1:IKT) = 0.
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE(ZZ_O_H(IIJB:IIJE,1:IKT) <0.9 .AND. ZZ_O_H(IIJB:IIJE,1:IKT)/=XUNDEF)
+ PMWTH(IIJB:IIJE,1:IKT) = MAX(-7.9*(ABS(ZZ_O_H(IIJB:IIJE,1:IKT)-0.35))**2.9 &
+ * (ABS(ZZ_O_H(IIJB:IIJE,1:IKT)-1.))**0.58 + 0.37, 0.)
END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+
DO JK=IKTB+1,IKTE-1
- PMWTH(:,:,JK) = PMWTH(:,:,JK) * ZWSTAR(:,:)**2*ZTSTAR(:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PMWTH(IIJB:IIJE,JK) = PMWTH(IIJB:IIJE,JK) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-PMWTH(:,:,IKE) = PMWTH(:,:,IKE) * ZWSTAR(:,:)**2*ZTSTAR(:,:)
-PMWTH(:,:,KKU) = PMWTH(:,:,KKU) * ZWSTAR(:,:)**2*ZTSTAR(:,:)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PMWTH(IIJB:IIJE,IKE) = PMWTH(IIJB:IIJE,IKE) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE)
+PMWTH(IIJB:IIJE,IKU) = PMWTH(IIJB:IIJE,IKU) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!----------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('TM06',1,ZHOOK_HANDLE)
END SUBROUTINE TM06
+END MODULE MODE_TM06
diff --git a/src/PHYEX/turb/mode_tm06_h.f90 b/src/PHYEX/turb/mode_tm06_h.f90
index 58f018554c2b444b1126f1d2f986c3e9cb3a4628..02af4cf442f27a9bb99da0945c6e337af767200c 100644
--- a/src/PHYEX/turb/mode_tm06_h.f90
+++ b/src/PHYEX/turb/mode_tm06_h.f90
@@ -1,40 +1,13 @@
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 newsrc 2006/06/02 17:34:59
-!-----------------------------------------------------------------
-! ################
- MODULE MODI_TM06_H
-! ################
-!
-INTERFACE
-!
- SUBROUTINE TM06_H(KKB,KKTB,KKTE,PTSTEP,PZZ,PFLXZ,PBL_DEPTH)
-!
-INTEGER, INTENT(IN) :: KKB ! index of 1st physical level
- ! close to ground
-INTEGER, INTENT(IN) :: KKTB ! first physical level in k
-INTEGER, INTENT(IN) :: KKTE ! last physical level in k
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZ ! heat flux
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE TM06_H
-!
-END INTERFACE
-!
-END MODULE MODI_TM06_H
-!
-! #################################################################
- SUBROUTINE TM06_H(KKB,KKTB,KKTE,PTSTEP,PZZ,PFLXZ,PBL_DEPTH)
+!MNH_LIC for details. version 1
+MODULE MODE_TM06_H
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TM06_H(D,PTSTEP,PZZ,PFLXZ,PBL_DEPTH)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #################################################################
!
!
@@ -73,6 +46,7 @@ END MODULE MODI_TM06_H
! ------------
!
USE MODD_PARAMETERS, ONLY : XUNDEF
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
!
IMPLICIT NONE
@@ -80,45 +54,67 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-INTEGER, INTENT(IN) :: KKB ! index of 1st physical level
- ! close to ground
-INTEGER, INTENT(IN) :: KKTB ! first physical level in k
-INTEGER, INTENT(IN) :: KKTE ! last physical level in k
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZ ! heat flux
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux levels
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLXZ ! heat flux
+REAL, DIMENSION(D%NIJT), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
!
-INTEGER :: JK ! loop counter
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZFLXZMIN ! minimum of temperature flux
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZBL_DEPTH! BL depth at previous time-step
+INTEGER :: JK,JIJ ! loop counter
+INTEGER :: IKB,IKTB,IKTE,IIJB,IIJE
+REAL, DIMENSION(D%NIJT) :: ZFLXZMIN ! minimum of temperature flux
+REAL, DIMENSION(D%NIJT) :: ZBL_DEPTH! BL depth at previous time-step
REAL :: ZGROWTH ! maximum BL growth rate
!----------------------------------------------------------------------------
!
!* mixed boundary layer cannot grow more rapidly than 1800m/h
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TM06_H',0,ZHOOK_HANDLE)
ZGROWTH = 2.0 ! (m/s)
!
!----------------------------------------------------------------------------
!
-ZBL_DEPTH(:,:) = PBL_DEPTH(:,:)
-WHERE(ZBL_DEPTH(:,:)==XUNDEF) ZBL_DEPTH(:,:)=0.
-!
-PBL_DEPTH(:,:) = XUNDEF
-ZFLXZMIN (:,:) = PFLXZ(:,:,KKB)
-!
-DO JK=KKTB,KKTE
- WHERE (PFLXZ(:,:,KKB)>0. .AND. PFLXZ(:,:,JK)<ZFLXZMIN(:,:))
- PBL_DEPTH(:,:) = PZZ (:,:,JK) - PZZ(:,:,KKB)
- ZFLXZMIN (:,:) = PFLXZ(:,:,JK)
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IIJE=D%NIJE
+IIJB=D%NIJB
+
+!
+ZBL_DEPTH(IIJB:IIJE) = PBL_DEPTH(IIJB:IIJE)
+!
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE(ZBL_DEPTH(IIJB:IIJE)==XUNDEF)
+ ZBL_DEPTH(IIJB:IIJE)=0.
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PBL_DEPTH(IIJB:IIJE) = XUNDEF
+ZFLXZMIN(IIJB:IIJE) = PFLXZ(IIJB:IIJE,IKB)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+DO JK=IKTB,IKTE
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+ WHERE(PFLXZ(IIJB:IIJE,IKB)>0. .AND. PFLXZ(IIJB:IIJE,JK)<ZFLXZMIN(IIJB:IIJE))
+ PBL_DEPTH(IIJB:IIJE) = PZZ(IIJB:IIJE,JK) - PZZ(IIJB:IIJE,IKB)
+ ZFLXZMIN(IIJB:IIJE) = PFLXZ(IIJB:IIJE,JK)
END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
!
-WHERE(PBL_DEPTH(:,:)/=XUNDEF) PBL_DEPTH(:,:)=MIN(PBL_DEPTH(:,:),ZBL_DEPTH(:,:)+ZGROWTH*PTSTEP)
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE(PBL_DEPTH(IIJB:IIJE)/=XUNDEF)
+ PBL_DEPTH(IIJB:IIJE)=MIN(PBL_DEPTH(IIJB:IIJE),ZBL_DEPTH(IIJB:IIJE)+ZGROWTH*PTSTEP)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
!----------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('TM06_H',1,ZHOOK_HANDLE)
END SUBROUTINE TM06_H
+END MODULE MODE_TM06_H
diff --git a/src/PHYEX/turb/mode_tridiag.f90 b/src/PHYEX/turb/mode_tridiag.f90
index 20a4213da2fc107cf0a5e6edd9ea028892c39a64..6c15c7dc20122a834aa5487c98a185bacdaa1bcd 100644
--- a/src/PHYEX/turb/mode_tridiag.f90
+++ b/src/PHYEX/turb/mode_tridiag.f90
@@ -2,43 +2,13 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 turb 2006/06/06 09:55:03
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_TRIDIAG
-! ###################
-INTERFACE
-!
- SUBROUTINE TRIDIAG(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
- PRHODJ,PSOURCE,PVARP )
-!
-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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
-!
-END SUBROUTINE TRIDIAG
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG
-!
-!
-!
-! #################################################
- SUBROUTINE TRIDIAG(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
+MODULE MODE_TRIDIAG
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG(D,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
PRHODJ,PSOURCE,PVARP )
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #################################################
!
!
@@ -144,35 +114,35 @@ END MODULE MODI_TRIDIAG
!
!* 0. DECLARATIONS
!
-USE MODD_PARAMETERS
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! upper diag. elements
REAL, INTENT(IN) :: PTSTEP ! Double time step
REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! (dry rho)*J
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSOURCE ! source term of PVAR
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PVARP ! variable at t+1
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZY ,ZGAM
! RHS of the equation, 3D work array
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
+REAL, DIMENSION(D%NIJT) :: ZBET
! 2D work array
-INTEGER :: JK ! loop counter
+INTEGER :: JIJ,JK ! loop counter
INTEGER :: IKB,IKE ! inner vertical limits
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IKT,IKA,IKU,IKL! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IIJB, IIJE ! start, end of ij loops in physical domain
!
! ---------------------------------------------------------------------------
@@ -180,27 +150,41 @@ INTEGER :: IKTB,IKTE ! start, end of k loops in
!* 1. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-IKTB=1+JPVEXT_TURB
-IKT=SIZE(PVARM,3)
-IKTE=IKT-JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-!
-!
-ZY(:,:,IKB) = PVARM(:,:,IKB) + PTSTEP*PSOURCE(:,:,IKB) - &
- PEXPL / PRHODJ(:,:,IKB) * PA(:,:,IKB+KKL) * (PVARM(:,:,IKB+KKL) - PVARM(:,:,IKB))
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TRIDIAG',0,ZHOOK_HANDLE)
+!
+IKT=D%NKT
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
+IIJB=D%NIJB
+IIJE=D%NIJE
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKB) = PVARM(IIJB:IIJE,IKB) + PTSTEP*PSOURCE(IIJB:IIJE,IKB) - &
+ PEXPL / PRHODJ(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+IKL) * &
+ (PVARM(IIJB:IIJE,IKB+IKL) - PVARM(IIJB:IIJE,IKB))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
DO JK=IKTB+1,IKTE-1
- ZY(:,:,JK)= PVARM(:,:,JK) + PTSTEP*PSOURCE(:,:,JK) - &
- PEXPL / PRHODJ(:,:,JK) * &
- ( PVARM(:,:,JK-KKL)*PA(:,:,JK) &
- -PVARM(:,:,JK)*(PA(:,:,JK)+PA(:,:,JK+KKL)) &
- +PVARM(:,:,JK+KKL)*PA(:,:,JK+KKL) &
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZY(IIJB:IIJE,JK)= PVARM(IIJB:IIJE,JK) + PTSTEP*PSOURCE(IIJB:IIJE,JK) - &
+ PEXPL / PRHODJ(IIJB:IIJE,JK) * &
+ ( PVARM(IIJB:IIJE,JK-IKL)*PA(IIJB:IIJE,JK) &
+ -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL)) &
+ +PVARM(IIJB:IIJE,JK+IKL)*PA(IIJB:IIJE,JK+IKL) &
)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
-ZY(:,:,IKE)= PVARM(:,:,IKE) + PTSTEP*PSOURCE(:,:,IKE) + &
- PEXPL / PRHODJ(:,:,IKE) * PA(:,:,IKE) * (PVARM(:,:,IKE)-PVARM(:,:,IKE-KKL))
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKE)= PVARM(IIJB:IIJE,IKE) + PTSTEP*PSOURCE(IIJB:IIJE,IKE) + &
+ PEXPL / PRHODJ(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-IKL))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!
!* 2. INVERSION OF THE TRIDIAGONAL SYSTEM
@@ -211,41 +195,53 @@ IF ( PIMPL > 1.E-10 ) THEN
!
! going up
!
- ZBET(:,:) = 1. - PIMPL * PA(:,:,IKB+KKL) / PRHODJ(:,:,IKB) ! bet = b(ikb)
- PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZBET(IIJB:IIJE) = 1. - PIMPL * PA(IIJB:IIJE,IKB+IKL) / PRHODJ(IIJB:IIJE,IKB) ! bet = b(ikb)
+ PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- DO JK = IKB+KKL,IKE-KKL,KKL
- ZGAM(:,:,JK) = PIMPL * PA(:,:,JK) / PRHODJ(:,:,JK-KKL) / ZBET(:,:)
+ DO JK = IKB+IKL,IKE-IKL,IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:,:) = 1. - PIMPL * ( PA(:,:,JK) * (1. + ZGAM(:,:,JK)) &
- + PA(:,:,JK+KKL) &
- ) / PRHODJ(:,:,JK)
+ ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,JK) * (1. + ZGAM(IIJB:IIJE,JK)) &
+ + PA(IIJB:IIJE,JK+IKL) &
+ ) / PRHODJ(IIJB:IIJE,JK)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,:,JK)= ( ZY(:,:,JK) - PIMPL * PA(:,:,JK) / PRHODJ(:,:,JK) &
- * PVARP(:,:,JK-KKL) &
- ) / ZBET(:,:)
+ PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK) &
+ * PVARP(IIJB:IIJE,JK-IKL) &
+ ) / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
- END DO
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END DO
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
! special treatment for the last level
- ZGAM(:,:,IKE) = PIMPL * PA(:,:,IKE) / PRHODJ(:,:,IKE-KKL) / ZBET(:,:)
+ ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:,:) = 1. - PIMPL * ( PA(:,:,IKE) * (1. + ZGAM(:,:,IKE)) &
- ) / PRHODJ(:,:,IKE)
+ ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,IKE) * (1. + ZGAM(IIJB:IIJE,IKE)) &
+ ) / PRHODJ(IIJB:IIJE,IKE)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,:,IKE)= ( ZY(:,:,IKE) - PIMPL * PA(:,:,IKE) / PRHODJ(:,:,IKE) &
- * PVARP(:,:,IKE-KKL) &
- ) / ZBET(:,:)
+ PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE) &
+ * PVARP(IIJB:IIJE,IKE-IKL) &
+ ) / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
!
! going down
!
- DO JK = IKE-KKL,IKB,-1*KKL
- PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ DO JK = IKE-IKL,IKB,-1*IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
ELSE
!
- PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE)
+ DO JK=IKTB,IKTE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = ZY(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END DO
!
END IF
!
@@ -253,9 +249,13 @@ END IF
!* 3. FILL THE UPPER AND LOWER EXTERNAL VALUES
! ----------------------------------------
!
-PVARP(:,:,KKA)=PVARP(:,:,IKB)
-PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB)
+PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TRIDIAG',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG
+END MODULE MODE_TRIDIAG
diff --git a/src/PHYEX/turb/mode_tridiag_massflux.f90 b/src/PHYEX/turb/mode_tridiag_massflux.f90
index 122fcf31827d0213902b85e09d64f0d76c21ac4e..e58c9a3d0c258c888f280eeef7b14f65b797e634 100644
--- a/src/PHYEX/turb/mode_tridiag_massflux.f90
+++ b/src/PHYEX/turb/mode_tridiag_massflux.f90
@@ -2,39 +2,14 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! ###################
- MODULE MODI_TRIDIAG_MASSFLUX
-! ###################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
+MODULE MODE_TRIDIAG_MASSFLUX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG_MASSFLUX(D,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
PDZZ,PRHODJ,PVARP )
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
-REAL, DIMENSION(:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDFDT ! dF/dT at flux point
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PIMPL ! implicit weight
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Dz at flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
-!
-END SUBROUTINE TRIDIAG_MASSFLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_MASSFLUX
-
-! #################################################
- SUBROUTINE TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
- PDZZ,PRHODJ,PVARP )
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #################################################
!
!
@@ -146,48 +121,65 @@ END MODULE MODI_TRIDIAG_MASSFLUX
!
!* 0. DECLARATIONS
!
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODI_SHUMAN_MF
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+USE MODI_SHUMAN_MF, ONLY: MZM_MF
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
-REAL, DIMENSION(:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDFDT ! dF/dT at flux point
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVARM ! variable at t-1 at mass point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDFDT ! dF/dT at flux point
REAL, INTENT(IN) :: PTSTEP ! Double time step
REAL, INTENT(IN) :: PIMPL ! implicit weight
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Dz at flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Dz at flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
!
-REAL, DIMENSION(:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PVARP ! variable at t+1 at mass point
!
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZRHODJ_DFDT_O_DZ
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZMZM_RHODJ
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZA, ZB, ZC
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZY ,ZGAM
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRHODJ_DFDT_O_DZ
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZMZM_RHODJ
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZA, ZB, ZC
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZY ,ZGAM
! RHS of the equation, 3D work array
-REAL, DIMENSION(SIZE(PVARM,1)) :: ZBET
+REAL, DIMENSION(D%NIJT) :: ZBET
! 2D work array
-INTEGER :: JK ! loop counter
+INTEGER :: JK, JIJ ! loop counter
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKTB,IKTE
+INTEGER :: IKT,IKB,IKA,IKU,IKE
+INTEGER :: IKL
!
! ---------------------------------------------------------------------------
!
!* 1. Preliminaries
! -------------
!
-ZMZM_RHODJ = MZM_MF(KKA,KKU,KKL,PRHODJ)
-ZRHODJ_DFDT_O_DZ = ZMZM_RHODJ*PDFDT/PDZZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TRIDIAG_MASSFLUX',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKB=D%NKB
+IKL=D%NKL
+IKA=D%NKA
+IKU=D%NKU
+IKE=D%NKE
+IKTB=D%NKTB
+IKTE=D%NKTE
+!
+CALL MZM_MF(D, PRHODJ, ZMZM_RHODJ)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZRHODJ_DFDT_O_DZ(IIJB:IIJE,1:IKT) = ZMZM_RHODJ(IIJB:IIJE,1:IKT)*PDFDT(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
ZA=0.
ZB=0.
@@ -198,30 +190,38 @@ ZY=0.
!* 2. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-ZY(:,KKB) = PRHODJ(:,KKB)*PVARM(:,KKB)/PTSTEP &
- - ZMZM_RHODJ(:,KKB+KKL) * PF(:,KKB+KKL)/PDZZ(:,KKB+KKL) &
- + ZMZM_RHODJ(:,KKB ) * PF(:,KKB )/PDZZ(:,KKB ) &
- + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL * PVARM(:,KKB+KKL) &
- + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL * PVARM(:,KKB )
-!
-DO JK=2+JPVEXT,SIZE(ZY,2)-JPVEXT-1
- ZY(:,JK) = PRHODJ(:,JK)*PVARM(:,JK)/PTSTEP &
- - ZMZM_RHODJ(:,JK+KKL) * PF(:,JK+KKL)/PDZZ(:,JK+KKL) &
- + ZMZM_RHODJ(:,JK ) * PF(:,JK )/PDZZ(:,JK ) &
- + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL * PVARM(:,JK+KKL) &
- + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL * PVARM(:,JK ) &
- - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL * PVARM(:,JK ) &
- - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL * PVARM(:,JK-KKL)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKB) = PRHODJ(IIJB:IIJE,IKB)*PVARM(IIJB:IIJE,IKB)/PTSTEP &
+ - ZMZM_RHODJ(IIJB:IIJE,IKB+IKL) * PF(IIJB:IIJE,IKB+IKL)/PDZZ(IIJB:IIJE,IKB+IKL) &
+ + ZMZM_RHODJ(IIJB:IIJE,IKB ) * PF(IIJB:IIJE,IKB )/PDZZ(IIJB:IIJE,IKB ) &
+ + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKB+IKL) * 0.5*PIMPL * PVARM(IIJB:IIJE,IKB+IKL) &
+ + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKB+IKL) * 0.5*PIMPL * PVARM(IIJB:IIJE,IKB )
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+DO JK=1+IKTB,IKTE-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZY(IIJB:IIJE,JK) = PRHODJ(IIJB:IIJE,JK)*PVARM(IIJB:IIJE,JK)/PTSTEP &
+ - ZMZM_RHODJ(IIJB:IIJE,JK+IKL) * PF(IIJB:IIJE,JK+IKL)/PDZZ(IIJB:IIJE,JK+IKL) &
+ + ZMZM_RHODJ(IIJB:IIJE,JK ) * PF(IIJB:IIJE,JK )/PDZZ(IIJB:IIJE,JK ) &
+ + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK+IKL) * 0.5*PIMPL * PVARM(IIJB:IIJE,JK+IKL) &
+ + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK+IKL) * 0.5*PIMPL * PVARM(IIJB:IIJE,JK ) &
+ - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK ) * 0.5*PIMPL * PVARM(IIJB:IIJE,JK ) &
+ - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK ) * 0.5*PIMPL * PVARM(IIJB:IIJE,JK-IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
-IF (JPVEXT==0) THEN
- ZY(:,KKE) = PRHODJ(:,KKE)*PVARM(:,KKE)/PTSTEP
+IF (IKE==IKU) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZY(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)*PVARM(IIJB:IIJE,IKE)/PTSTEP
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
- ZY(:,KKE) = PRHODJ(:,KKE)*PVARM(:,KKE)/PTSTEP &
- - ZMZM_RHODJ(:,KKE+KKL) * PF(:,KKE+KKL)/PDZZ(:,KKE+KKL) &
- + ZMZM_RHODJ(:,KKE ) * PF(:,KKE )/PDZZ(:,KKE ) &
- - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL * PVARM(:,KKE ) &
- - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL * PVARM(:,KKE-KKL)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZY(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)*PVARM(IIJB:IIJE,IKE)/PTSTEP &
+ - ZMZM_RHODJ(IIJB:IIJE,IKE+IKL) * PF(IIJB:IIJE,IKE+IKL)/PDZZ(IIJB:IIJE,IKE+IKL) &
+ + ZMZM_RHODJ(IIJB:IIJE,IKE ) * PF(IIJB:IIJE,IKE )/PDZZ(IIJB:IIJE,IKE ) &
+ - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKE ) * 0.5*PIMPL * PVARM(IIJB:IIJE,IKE ) &
+ - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKE ) * 0.5*PIMPL * PVARM(IIJB:IIJE,IKE-IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDIF
!
!
@@ -233,58 +233,74 @@ IF ( PIMPL > 1.E-10 ) THEN
!* 3.1 arrays A, B, C
! --------------
!
- ZB(:,KKB) = PRHODJ(:,KKB)/PTSTEP &
- + ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL
- ZC(:,KKB) = ZRHODJ_DFDT_O_DZ(:,KKB+KKL) * 0.5*PIMPL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZB(IIJB:IIJE,IKB) = PRHODJ(IIJB:IIJE,IKB)/PTSTEP &
+ + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKB+IKL) * 0.5*PIMPL
+ ZC(IIJB:IIJE,IKB) = ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKB+IKL) * 0.5*PIMPL
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
- DO JK=2+JPVEXT,SIZE(ZY,2)-JPVEXT-1
- ZA(:,JK) = - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL
- ZB(:,JK) = PRHODJ(:,JK)/PTSTEP &
- + ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL &
- - ZRHODJ_DFDT_O_DZ(:,JK ) * 0.5*PIMPL
- ZC(:,JK) = ZRHODJ_DFDT_O_DZ(:,JK+KKL) * 0.5*PIMPL
+ DO JK=1+IKTB,IKTE-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,JK) = - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK ) * 0.5*PIMPL
+ ZB(IIJB:IIJE,JK) = PRHODJ(IIJB:IIJE,JK)/PTSTEP &
+ + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK+IKL) * 0.5*PIMPL &
+ - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK ) * 0.5*PIMPL
+ ZC(IIJB:IIJE,JK) = ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK+IKL) * 0.5*PIMPL
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-
- ZA(:,KKE) = - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL
- ZB(:,KKE) = PRHODJ(:,KKE)/PTSTEP &
- - ZRHODJ_DFDT_O_DZ(:,KKE ) * 0.5*PIMPL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,IKE) = - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKE ) * 0.5*PIMPL
+ ZB(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)/PTSTEP &
+ - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKE ) * 0.5*PIMPL
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!* 3.2 going up
! --------
!
- ZBET(:) = ZB(:,KKB) ! bet = b(KKB)
- PVARP(:,KKB) = ZY(:,KKB) / ZBET(:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,IKB) ! bet = b(IKB)
+ PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- DO JK = KKB+KKL,KKE-KKL,KKL
- ZGAM(:,JK) = ZC(:,JK-KKL) / ZBET(:)
+ DO JK = IKB+IKL,IKE-IKL,IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZGAM(IIJB:IIJE,JK) = ZC(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:) = ZB(:,JK) - ZA(:,JK) * ZGAM(:,JK)
+ ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * ZGAM(IIJB:IIJE,JK)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,JK)= ( ZY(:,JK) - ZA(:,JK) * PVARP(:,JK-KKL) ) / ZBET(:)
+ PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * PVARP(IIJB:IIJE,JK-IKL) ) / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
! special treatment for the last level
- ZGAM(:,KKE) = ZC(:,KKE-KKL) / ZBET(:)
+ ZGAM(IIJB:IIJE,IKE) = ZC(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:) = ZB(:,KKE) - ZA(:,KKE) * ZGAM(:,KKE)
+ ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * ZGAM(IIJB:IIJE,IKE)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,KKE)= ( ZY(:,KKE) - ZA(:,KKE) * PVARP(:,KKE-KKL) ) / ZBET(:)
+ PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * PVARP(IIJB:IIJE,IKE-IKL) ) / &
+ &ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!* 3.3 going down
! ----------
!
- DO JK = KKE-KKL,KKB,-KKL
- PVARP(:,JK) = PVARP(:,JK) - ZGAM(:,JK+KKL) * PVARP(:,JK+KKL)
+ DO JK = IKE-IKL,IKB,-IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
!
ELSE
!!! EXPLICIT FORMULATION
!
- DO JK=1+JPVEXT,SIZE(PVARP,2)-JPVEXT
- PVARP(:,JK) = ZY(:,JK) * PTSTEP / PRHODJ(:,JK)
+ DO JK=IKTB,IKTE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = ZY(IIJB:IIJE,JK) * PTSTEP / PRHODJ(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDDO
!
END IF
@@ -293,9 +309,13 @@ END IF
!* 4. FILL THE UPPER AND LOWER EXTERNAL VALUES
! ----------------------------------------
!
-PVARP(:,KKA)=PVARP(:,KKB)
-PVARP(:,KKU)=PVARP(:,KKE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB)
+PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TRIDIAG_MASSFLUX',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG_MASSFLUX
+END MODULE MODE_TRIDIAG_MASSFLUX
diff --git a/src/PHYEX/turb/mode_tridiag_thermo.f90 b/src/PHYEX/turb/mode_tridiag_thermo.f90
index 2a02b634692cfebf10465a38fea4875eb8cc12db..fcef93a9789f5513e9b7a213a0c24796dcc516a8 100644
--- a/src/PHYEX/turb/mode_tridiag_thermo.f90
+++ b/src/PHYEX/turb/mode_tridiag_thermo.f90
@@ -2,39 +2,10 @@
!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_TRIDIAG_THERMO
-! ###################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_THERMO(KKA,KKU,KKL,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
- PDZZ,PRHODJ,PVARP )
-!
-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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDFDDTDZ! dF/d(dT/dz) at flux point
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PIMPL ! implicit weight
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Dz at flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
-!
-END SUBROUTINE TRIDIAG_THERMO
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_THERMO
-!
-!
-!
-
-! #################################################
- SUBROUTINE TRIDIAG_THERMO(KKA,KKU,KKL,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
+MODULE MODE_TRIDIAG_THERMO
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG_THERMO(D,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
PDZZ,PRHODJ,PVARP )
! #################################################
!
@@ -145,57 +116,70 @@ END MODULE MODI_TRIDIAG_THERMO
!
!* 0. DECLARATIONS
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
!
-USE MODI_SHUMAN
+USE MODI_SHUMAN, ONLY : MZM
+USE SHUMAN_PHY, ONLY: MZM_PHY
!
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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDFDDTDZ! dF/d(dT/dz) at flux point
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVARM ! variable at t-1 at mass point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDFDDTDZ! dF/d(dT/dz) at flux point
REAL, INTENT(IN) :: PTSTEP ! Double time step
REAL, INTENT(IN) :: PIMPL ! implicit weight
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Dz at flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Dz at flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
!
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PVARP ! variable at t+1 at mass point
!
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZRHODJ_DFDDTDZ_O_DZ2
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZMZM_RHODJ
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZA, ZB, ZC
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRHODJ_DFDDTDZ_O_DZ2
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZMZM_RHODJ
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZA, ZB, ZC
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZY ,ZGAM
! RHS of the equation, 3D work array
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
+REAL, DIMENSION(D%NIJT) :: ZBET
! 2D work array
-INTEGER :: JK ! loop counter
-INTEGER :: IKB,IKE ! inner vertical limits
-INTEGER :: IKT ! array size in k direction
+INTEGER :: JIJ,JK ! loop counter
+INTEGER :: IKB,IKE ! inner limits
+INTEGER :: IKT,IKA,IKU ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IIJB,IIJE ! start, end of ij loops in physical domain
+INTEGER :: IKL
!
! ---------------------------------------------------------------------------
!
!* 1. Preliminaries
! -------------
!
-IKT=SIZE(PVARM,3)
-IKTB=1+JPVEXT_TURB
-IKTE=IKT-JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-
-!
-ZMZM_RHODJ = MZM(PRHODJ)
-ZRHODJ_DFDDTDZ_O_DZ2 = ZMZM_RHODJ*PDFDDTDZ/PDZZ**2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TRIDIAG_THERMO',0,ZHOOK_HANDLE)
+IKT=D%NKT
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
+IIJB=D%NIJB
+IIJE=D%NIJE
+!
+CALL MZM_PHY(D,PRHODJ,ZMZM_RHODJ)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,1:IKT) = ZMZM_RHODJ(IIJB:IIJE,1:IKT)*PDFDDTDZ(IIJB:IIJE,1:IKT) &
+ /PDZZ(IIJB:IIJE,1:IKT)**2
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
ZA=0.
ZB=0.
@@ -206,25 +190,33 @@ ZY=0.
!* 2. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-ZY(:,:,IKB) = PRHODJ(:,:,IKB)*PVARM(:,:,IKB)/PTSTEP &
- - ZMZM_RHODJ(:,:,IKB+KKL) * PF(:,:,IKB+KKL)/PDZZ(:,:,IKB+KKL) &
- + ZMZM_RHODJ(:,:,IKB ) * PF(:,:,IKB )/PDZZ(:,:,IKB ) &
- + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL * PVARM(:,:,IKB+KKL) &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL * PVARM(:,:,IKB )
-!
- ZY(:,:,IKTB+1:IKTE-1) = PRHODJ(:,:,IKTB+1:IKTE-1)*PVARM(:,:,IKTB+1:IKTE-1)/PTSTEP &
- - ZMZM_RHODJ(:,:,IKTB+1+KKL:IKTE-1+KKL) * PF(:,:,IKTB+1+KKL:IKTE-1+KKL)/PDZZ(:,:,IKTB+1+KKL:IKTE-1+KKL) &
- + ZMZM_RHODJ(:,:,IKTB+1:IKTE-1 ) * PF(:,:,IKTB+1:IKTE-1 )/PDZZ(:,:,IKTB+1:IKTE-1 ) &
- + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL * PVARM(:,:,IKTB+1+KKL:IKTE-1+KKL) &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL * PVARM(:,:,IKTB+1:IKTE-1 ) &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1 ) * PIMPL * PVARM(:,:,IKTB+1:IKTE-1 ) &
- + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1 ) * PIMPL * PVARM(:,:,IKTB+1-KKL:IKTE-1-KKL)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKB) = PRHODJ(IIJB:IIJE,IKB)*PVARM(IIJB:IIJE,IKB)/PTSTEP &
+ - ZMZM_RHODJ(IIJB:IIJE,IKB+IKL) * PF(IIJB:IIJE,IKB+IKL)/PDZZ(IIJB:IIJE,IKB+IKL) &
+ + ZMZM_RHODJ(IIJB:IIJE,IKB ) * PF(IIJB:IIJE,IKB )/PDZZ(IIJB:IIJE,IKB ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+IKL) * PIMPL * PVARM(IIJB:IIJE,IKB+IKL) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+IKL) * PIMPL * PVARM(IIJB:IIJE,IKB )
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+DO JK=IKTB+1,IKTE-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZY(IIJB:IIJE,JK) = PRHODJ(IIJB:IIJE,JK)*PVARM(IIJB:IIJE,JK)/PTSTEP &
+ - ZMZM_RHODJ(IIJB:IIJE,JK+IKL) * PF(IIJB:IIJE,JK+IKL)/PDZZ(IIJB:IIJE,JK+IKL) &
+ + ZMZM_RHODJ(IIJB:IIJE,JK ) * PF(IIJB:IIJE,JK )/PDZZ(IIJB:IIJE,JK ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+IKL) * PIMPL * PVARM(IIJB:IIJE,JK+IKL) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+IKL) * PIMPL * PVARM(IIJB:IIJE,JK ) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK ) * PIMPL * PVARM(IIJB:IIJE,JK ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK ) * PIMPL * PVARM(IIJB:IIJE,JK-IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+END DO
!
-ZY(:,:,IKE) = PRHODJ(:,:,IKE)*PVARM(:,:,IKE)/PTSTEP &
- - ZMZM_RHODJ(:,:,IKE+KKL) * PF(:,:,IKE+KKL)/PDZZ(:,:,IKE+KKL) &
- + ZMZM_RHODJ(:,:,IKE ) * PF(:,:,IKE )/PDZZ(:,:,IKE ) &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL * PVARM(:,:,IKE ) &
- + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL * PVARM(:,:,IKE-KKL)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)*PVARM(IIJB:IIJE,IKE)/PTSTEP &
+ - ZMZM_RHODJ(IIJB:IIJE,IKE+IKL) * PF(IIJB:IIJE,IKE+IKL)/PDZZ(IIJB:IIJE,IKE+IKL) &
+ + ZMZM_RHODJ(IIJB:IIJE,IKE ) * PF(IIJB:IIJE,IKE )/PDZZ(IIJB:IIJE,IKE ) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKE ) * PIMPL * PVARM(IIJB:IIJE,IKE ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKE ) * PIMPL * PVARM(IIJB:IIJE,IKE-IKL)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!
!* 3. INVERSION OF THE TRIDIAGONAL SYSTEM
@@ -235,53 +227,73 @@ IF ( PIMPL > 1.E-10 ) THEN
!* 3.1 arrays A, B, C
! --------------
!
- ZB(:,:,IKB) = PRHODJ(:,:,IKB)/PTSTEP &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL
- ZC(:,:,IKB) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL
-!
- ZA(:,:,IKTB+1:IKTE-1) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1) * PIMPL
- ZB(:,:,IKTB+1:IKTE-1) = PRHODJ(:,:,IKTB+1:IKTE-1)/PTSTEP &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1) * PIMPL
- ZC(:,:,IKTB+1:IKTE-1) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZB(IIJB:IIJE,IKB) = PRHODJ(IIJB:IIJE,IKB)/PTSTEP &
+ - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+IKL) * PIMPL
+ ZC(IIJB:IIJE,IKB) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+IKL) * PIMPL
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+ DO JK=IKTB+1,IKTE-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,JK) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK) * PIMPL
+ ZB(IIJB:IIJE,JK) = PRHODJ(IIJB:IIJE,JK)/PTSTEP &
+ - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+IKL) * PIMPL &
+ - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK) * PIMPL
+ ZC(IIJB:IIJE,JK) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+IKL) * PIMPL
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END DO
!
- ZA(:,:,IKE) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL
- ZB(:,:,IKE) = PRHODJ(:,:,IKE)/PTSTEP &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,IKE) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKE ) * PIMPL
+ ZB(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)/PTSTEP &
+ - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKE ) * PIMPL
!
!* 3.2 going up
! --------
!
- ZBET(:,:) = ZB(:,:,IKB) ! bet = b(ikb)
- PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
+ ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,IKB) ! bet = b(ikb)
+ PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- DO JK = IKB+KKL,IKE-KKL,KKL
- ZGAM(:,:,JK) = ZC(:,:,JK-KKL) / ZBET(:,:)
+ DO JK = IKB+IKL,IKE-IKL,IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZGAM(IIJB:IIJE,JK) = ZC(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:,:) = ZB(:,:,JK) - ZA(:,:,JK) * ZGAM(:,:,JK)
+ ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * ZGAM(IIJB:IIJE,JK)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,:,JK)= ( ZY(:,:,JK) - ZA(:,:,JK) * PVARP(:,:,JK-KKL) ) / ZBET(:,:)
+ PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * PVARP(IIJB:IIJE,JK-IKL) ) &
+ / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
! special treatment for the last level
- ZGAM(:,:,IKE) = ZC(:,:,IKE-KKL) / ZBET(:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZGAM(IIJB:IIJE,IKE) = ZC(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:,:) = ZB(:,:,IKE) - ZA(:,:,IKE) * ZGAM(:,:,IKE)
+ ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * ZGAM(IIJB:IIJE,IKE)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,:,IKE)= ( ZY(:,:,IKE) - ZA(:,:,IKE) * PVARP(:,:,IKE-KKL) ) / ZBET(:,:)
+ PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * PVARP(IIJB:IIJE,IKE-IKL) ) &
+ / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!* 3.3 going down
! ----------
!
- DO JK = IKE-KKL,IKB,-1*KKL
- PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
+ DO JK = IKE-IKL,IKB,-1*IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
ELSE
!
- PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE) * PTSTEP / PRHODJ(:,:,IKTB:IKTE)
+ DO JK=IKTB,IKTE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = ZY(IIJB:IIJE,JK) * PTSTEP / PRHODJ(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END DO
!
END IF
!
@@ -289,9 +301,13 @@ END IF
!* 4. FILL THE UPPER AND LOWER EXTERNAL VALUES
! ----------------------------------------
!
-PVARP(:,:,KKA)=PVARP(:,:,IKB)
-PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB)
+PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TRIDIAG_THERMO',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG_THERMO
+END MODULE MODE_TRIDIAG_THERMO
diff --git a/src/PHYEX/turb/mode_tridiag_tke.f90 b/src/PHYEX/turb/mode_tridiag_tke.f90
index 170f83f6c3bf867f5828d170c1c4dbede9218aef..cc761d7ad6692eee4041148e7f4c3f12a7e4f6e8 100644
--- a/src/PHYEX/turb/mode_tridiag_tke.f90
+++ b/src/PHYEX/turb/mode_tridiag_tke.f90
@@ -2,45 +2,13 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 turb 2006/06/06 10:00:49
-!-----------------------------------------------------------------
-! ##########################
- MODULE MODI_TRIDIAG_TKE
-! ##########################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_TKE(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
- PRHODJ,PSOURCE,PDIAG,PVARP )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIAG ! diagonal term linked to
- ! the implicit dissipation
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
-!
-END SUBROUTINE TRIDIAG_TKE
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_TKE
-!
-!
-!
-! ########################################################
- SUBROUTINE TRIDIAG_TKE(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
+MODULE MODE_TRIDIAG_TKE
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG_TKE(D,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
PRHODJ,PSOURCE,PDIAG,PVARP )
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ########################################################
!
!
@@ -145,64 +113,78 @@ END MODULE MODI_TRIDIAG_TKE
!* 0. DECLARATIONS
!
USE MODD_PARAMETERS
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIAG ! diagonal term linked to
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! upper diag. elements
+REAL, INTENT(IN) :: PTSTEP ! Double time step
+REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! (dry rho)*J
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSOURCE ! source term of PVAR
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDIAG ! diagonal term linked to
! the implicit dissipation
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PVARP ! variable at t+1
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZY ,ZGAM
! RHS of the equation, 3D work array
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
+REAL, DIMENSION(D%NIJT) :: ZBET
! 2D work array
-INTEGER :: JK ! loop counter
-INTEGER :: IKB,IKE ! inner vertical limits
-INTEGER :: IKT ! array size in k direction
+INTEGER :: JIJ,JK ! loop counter
+INTEGER :: IKB,IKE ! inner vertical limits
+INTEGER :: IKT,IKA,IKU ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IIJB, IIJE ! start, end of ij loops in physical domain
+INTEGER :: IKL
!
! ---------------------------------------------------------------------------
!
!* 1. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-IKT=SIZE(PVARM,3)
-IKTB=1+JPVEXT_TURB
-IKTE=IKT-JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-
-!
-!
-ZY(:,:,IKB) = PVARM(:,:,IKB) + PTSTEP*PSOURCE(:,:,IKB) - &
- PEXPL / PRHODJ(:,:,IKB) * PA(:,:,IKB+KKL) * (PVARM(:,:,IKB+KKL) - PVARM(:,:,IKB))
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TRIDIAG_TKE',0,ZHOOK_HANDLE)
+!
+IKT=D%NKT
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
+IIJB=D%NIJB
+IIJE=D%NIJE
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKB) = PVARM(IIJB:IIJE,IKB) + PTSTEP*PSOURCE(IIJB:IIJE,IKB) - &
+ PEXPL / PRHODJ(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+IKL) * &
+ (PVARM(IIJB:IIJE,IKB+IKL) - PVARM(IIJB:IIJE,IKB))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
DO JK=IKTB+1,IKTE-1
- ZY(:,:,JK)= PVARM(:,:,JK) + PTSTEP*PSOURCE(:,:,JK) - &
- PEXPL / PRHODJ(:,:,JK) * &
- ( PVARM(:,:,JK-KKL)*PA(:,:,JK) &
- -PVARM(:,:,JK)*(PA(:,:,JK)+PA(:,:,JK+KKL)) &
- +PVARM(:,:,JK+KKL)*PA(:,:,JK+KKL) &
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZY(IIJB:IIJE,JK)= PVARM(IIJB:IIJE,JK) + PTSTEP*PSOURCE(IIJB:IIJE,JK) - &
+ PEXPL / PRHODJ(IIJB:IIJE,JK) * &
+ ( PVARM(IIJB:IIJE,JK-IKL)*PA(IIJB:IIJE,JK) &
+ -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL)) &
+ +PVARM(IIJB:IIJE,JK+IKL)*PA(IIJB:IIJE,JK+IKL) &
)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
-ZY(:,:,IKE)= PVARM(:,:,IKE) + PTSTEP*PSOURCE(:,:,IKE) + &
- PEXPL / PRHODJ(:,:,IKE) * PA(:,:,IKE) * (PVARM(:,:,IKE)-PVARM(:,:,IKE-KKL))
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKE)= PVARM(IIJB:IIJE,IKE) + PTSTEP*PSOURCE(IIJB:IIJE,IKE) + &
+ PEXPL / PRHODJ(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-IKL))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!
!* 2. INVERSION OF THE TRIDIAGONAL SYSTEM
@@ -213,44 +195,56 @@ IF ( PIMPL > 1.E-10 ) THEN
!
! going up
!
- ZBET(:,:) = 1. + PIMPL * (PDIAG(:,:,IKB)-PA(:,:,IKB+KKL) / PRHODJ(:,:,IKB))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZBET(IIJB:IIJE) = 1. + PIMPL * (PDIAG(IIJB:IIJE,IKB)-PA(IIJB:IIJE,IKB+IKL) / PRHODJ(IIJB:IIJE,IKB))
! bet = b(ikb)
- PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
+ PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- DO JK = IKB+KKL,IKE-KKL,KKL
- ZGAM(:,:,JK) = PIMPL * PA(:,:,JK) / PRHODJ(:,:,JK-KKL) / ZBET(:,:)
+ DO JK = IKB+IKL,IKE-IKL,IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:,:) = 1. + PIMPL * ( PDIAG(:,:,JK) - &
- ( PA(:,:,JK) * (1. + ZGAM(:,:,JK)) &
- + PA(:,:,JK+KKL) &
- ) / PRHODJ(:,:,JK) &
+ ZBET(IIJB:IIJE) = 1. + PIMPL * ( PDIAG(IIJB:IIJE,JK) - &
+ ( PA(IIJB:IIJE,JK) * (1. + ZGAM(IIJB:IIJE,JK)) &
+ + PA(IIJB:IIJE,JK+IKL) &
+ ) / PRHODJ(IIJB:IIJE,JK) &
) ! bet = b(k) - a(k)* gam(k)
- PVARP(:,:,JK)= ( ZY(:,:,JK) - PIMPL * PA(:,:,JK) / PRHODJ(:,:,JK) &
- * PVARP(:,:,JK-KKL) &
- ) / ZBET(:,:)
+ PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK) &
+ * PVARP(IIJB:IIJE,JK-IKL) &
+ ) / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
- END DO
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END DO
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
! special treatment for the last level
- ZGAM(:,:,IKE) = PIMPL * PA(:,:,IKE) / PRHODJ(:,:,IKE-KKL) / ZBET(:,:)
+ ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:,:) = 1. + PIMPL * ( PDIAG(:,:,IKE) - &
- ( PA(:,:,IKE) * (1. + ZGAM(:,:,IKE)) ) / PRHODJ(:,:,IKE) &
+ ZBET(IIJB:IIJE) = 1. + PIMPL * ( PDIAG(IIJB:IIJE,IKE) - &
+ ( PA(IIJB:IIJE,IKE) * (1. + ZGAM(IIJB:IIJE,IKE)) ) / PRHODJ(IIJB:IIJE,IKE) &
)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,:,IKE)= ( ZY(:,:,IKE) - PIMPL * PA(:,:,IKE) / PRHODJ(:,:,IKE) &
- * PVARP(:,:,IKE-KKL) &
- ) / ZBET(:,:)
+ PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE) &
+ * PVARP(IIJB:IIJE,IKE-IKL) &
+ ) / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
!
! going down
!
- DO JK = IKE-KKL,IKB,-1*KKL
- PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ DO JK = IKE-IKL,IKB,-1*IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
ELSE
!
- PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE)
+ DO JK=IKTB,IKTE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = ZY(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END DO
!
END IF
!
@@ -258,9 +252,13 @@ END IF
!* 3. FILL THE UPPER AND LOWER EXTERNAL VALUES
! ----------------------------------------
!
-PVARP(:,:,KKA)=PVARP(:,:,IKB)
-PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB)
+PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TRIDIAG_TKE',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG_TKE
+END MODULE MODE_TRIDIAG_TKE
diff --git a/src/PHYEX/turb/mode_tridiag_w.f90 b/src/PHYEX/turb/mode_tridiag_w.f90
index c995d91f1e226456490b6f5cd817694b380cb9f0..8c976336add7c73953d62bf9bb0bc3c67c2260dc 100644
--- a/src/PHYEX/turb/mode_tridiag_w.f90
+++ b/src/PHYEX/turb/mode_tridiag_w.f90
@@ -4,27 +4,10 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
- MODULE MODI_TRIDIAG_W
+ MODULE MODE_TRIDIAG_W
! ###################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_W(PVARM,PF,PDFDDWDZ,PTSTEP, &
- PMZF_DZZ,PRHODJ,PVARP )
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1 at flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at mass point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDFDDWDZ! dF/d(dW/dz) at mass point
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZF_DZZ! Dz at mass point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at flux point
-!
-END SUBROUTINE TRIDIAG_W
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_W
+IMPLICIT NONE
+CONTAINS
!
!
!
@@ -296,3 +279,5 @@ PVARP(:,:,IKE+1)=0.
!-------------------------------------------------------------------------------
!
END SUBROUTINE TRIDIAG_W
+!
+END MODULE MODE_TRIDIAG_W
diff --git a/src/PHYEX/turb/mode_tridiag_wind.f90 b/src/PHYEX/turb/mode_tridiag_wind.f90
index 5dc35f1b1411c77450d13aee9575bdc3c3a5199a..0c57fc93e758dc8fd1cda909ab53842ba688765f 100644
--- a/src/PHYEX/turb/mode_tridiag_wind.f90
+++ b/src/PHYEX/turb/mode_tridiag_wind.f90
@@ -2,45 +2,13 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 turb 2006/06/06 09:36:38
-!-----------------------------------------------------------------
-! ########################
- MODULE MODI_TRIDIAG_WIND
-! ########################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_WIND(KKA,KKU,KKL,PVARM,PA,PCOEFS,PTSTEP,PEXPL,PIMPL, &
- PRHODJA,PSOURCE,PVARP )
-!
-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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFS ! implicit coeff for the
- ! surface flux
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJA ! (dry rho)*J averaged
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
-!
-END SUBROUTINE TRIDIAG_WIND
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_WIND
-!
-!
-!
-! #############################################################
- SUBROUTINE TRIDIAG_WIND(KKA,KKU,KKL,PVARM,PA,PCOEFS,PTSTEP,PEXPL,PIMPL, &
+MODULE MODE_TRIDIAG_WIND
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG_WIND(D,PVARM,PA,PCOEFS,PTSTEP,PEXPL,PIMPL, &
PRHODJA,PSOURCE,PVARP )
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #############################################################
!
!
@@ -150,62 +118,78 @@ END MODULE MODI_TRIDIAG_WIND
!* 0. DECLARATIONS
!
USE MODD_PARAMETERS
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
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
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFS ! implicit coeff for the
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVARM ! variable at t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! upper diag. elements
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PCOEFS ! implicit coeff for the
! surface flux
REAL, INTENT(IN) :: PTSTEP ! Double time step
REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJA ! (dry rho)*J averaged
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJA ! (dry rho)*J averaged
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSOURCE ! source term of PVAR
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PVARP ! variable at t+1
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZY ,ZGAM
! RHS of the equation, 3D work array
-REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
+REAL, DIMENSION(D%NIJT) :: ZBET
! 2D work array
-INTEGER :: JK ! loop counter
-INTEGER :: IKB,IKE ! inner vertical limits
-INTEGER :: IKT ! array size in k direction
+INTEGER :: JIJ,JK ! loop counter
+INTEGER :: IKB,IKE ! inner vertical limits
+INTEGER :: IKT,IKA,IKU ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IIJB, IIJE ! start, end of ij loops in physical domain
+INTEGER :: IKL
!
! ---------------------------------------------------------------------------
!
!* 1. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-IKT=SIZE(PVARM,3)
-IKTB=1+JPVEXT_TURB
-IKTE=IKT-JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-
-!
-!
-ZY(:,:,IKB) = PVARM(:,:,IKB) + PTSTEP*PSOURCE(:,:,IKB) - &
- PEXPL / PRHODJA(:,:,IKB) * PA(:,:,IKB+KKL) * (PVARM(:,:,IKB+KKL) - PVARM(:,:,IKB))
-!
- ZY(:,:,IKTB+1:IKTE-1)= PVARM(:,:,IKTB+1:IKTE-1) + PTSTEP*PSOURCE(:,:,IKTB+1:IKTE-1) - &
- PEXPL / PRHODJA(:,:,IKTB+1:IKTE-1) * &
- ( PVARM(:,:,IKTB+1-KKL:IKTE-1-KKL)*PA(:,:,IKTB+1:IKTE-1) &
- -PVARM(:,:,IKTB+1:IKTE-1)*(PA(:,:,IKTB+1:IKTE-1)+PA(:,:,IKTB+1+KKL:IKTE-1+KKL)) &
- +PVARM(:,:,IKTB+1+KKL:IKTE-1+KKL)*PA(:,:,IKTB+1+KKL:IKTE-1+KKL) &
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TRIDIAG_WIND',0,ZHOOK_HANDLE)
+!
+IKT=D%NKT
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
+IIJB=D%NIJB
+IIJE=D%NIJE
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKB) = PVARM(IIJB:IIJE,IKB) + PTSTEP*PSOURCE(IIJB:IIJE,IKB) - &
+ PEXPL / PRHODJA(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+IKL) * &
+ (PVARM(IIJB:IIJE,IKB+IKL) - PVARM(IIJB:IIJE,IKB))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+DO JK=IKTB+1,IKTE-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZY(IIJB:IIJE,JK)= PVARM(IIJB:IIJE,JK) + PTSTEP*PSOURCE(IIJB:IIJE,JK) - &
+ PEXPL / PRHODJA(IIJB:IIJE,JK) * &
+ ( PVARM(IIJB:IIJE,JK-IKL)*PA(IIJB:IIJE,JK) &
+ -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL)) &
+ +PVARM(IIJB:IIJE,JK+IKL)*PA(IIJB:IIJE,JK+IKL) &
)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+END DO
!
-ZY(:,:,IKE)= PVARM(:,:,IKE) + PTSTEP*PSOURCE(:,:,IKE) + &
- PEXPL / PRHODJA(:,:,IKE) * PA(:,:,IKE) * (PVARM(:,:,IKE)-PVARM(:,:,IKE-KKL))
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZY(IIJB:IIJE,IKE)= PVARM(IIJB:IIJE,IKE) + PTSTEP*PSOURCE(IIJB:IIJE,IKE) + &
+ PEXPL / PRHODJA(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-IKL))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!
!* 2. INVERSION OF THE TRIDIAGONAL SYSTEM
@@ -216,42 +200,54 @@ IF ( PIMPL > 1.E-10 ) THEN
!
! going up
!
- ZBET(:,:) = 1. - PIMPL * ( PA(:,:,IKB+KKL) / PRHODJA(:,:,IKB) &
- + PCOEFS(:,:) * PTSTEP ) ! bet = b(ikb)
- PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,IKB+IKL) / PRHODJA(IIJB:IIJE,IKB) &
+ + PCOEFS(IIJB:IIJE) * PTSTEP ) ! bet = b(ikb)
+ PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- DO JK = IKB+KKL,IKE-KKL,KKL
- ZGAM(:,:,JK) = PIMPL * PA(:,:,JK) / PRHODJA(:,:,JK-KKL) / ZBET(:,:)
+ DO JK = IKB+IKL,IKE-IKL,IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJA(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:,:) = 1. - PIMPL * ( PA(:,:,JK) * (1. + ZGAM(:,:,JK)) &
- + PA(:,:,JK+KKL) &
- ) / PRHODJA(:,:,JK)
+ ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,JK) * (1. + ZGAM(IIJB:IIJE,JK)) &
+ + PA(IIJB:IIJE,JK+IKL) &
+ ) / PRHODJA(IIJB:IIJE,JK)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,:,JK)= ( ZY(:,:,JK) - PIMPL * PA(:,:,JK) / PRHODJA(:,:,JK) &
- * PVARP(:,:,JK-KKL) &
- ) / ZBET(:,:)
+ PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - PIMPL * PA(IIJB:IIJE,JK) / PRHODJA(IIJB:IIJE,JK) &
+ * PVARP(IIJB:IIJE,JK-IKL) &
+ ) / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
! special treatment for the last level
- ZGAM(:,:,IKE) = PIMPL * PA(:,:,IKE) / PRHODJA(:,:,IKE-KKL) / ZBET(:,:)
+ ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJA(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE)
! gam(k) = c(k-1) / bet
- ZBET(:,:) = 1. - PIMPL * ( PA(:,:,IKE) * (1. + ZGAM(:,:,IKE)) &
- ) / PRHODJA(:,:,IKE)
+ ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,IKE) * (1. + ZGAM(IIJB:IIJE,IKE)) &
+ ) / PRHODJA(IIJB:IIJE,IKE)
! bet = b(k) - a(k)* gam(k)
- PVARP(:,:,IKE)= ( ZY(:,:,IKE) - PIMPL * PA(:,:,IKE) / PRHODJA(:,:,IKE) &
- * PVARP(:,:,IKE-KKL) &
- ) / ZBET(:,:)
+ PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - PIMPL * PA(IIJB:IIJE,IKE) / PRHODJA(IIJB:IIJE,IKE) &
+ * PVARP(IIJB:IIJE,IKE-IKL) &
+ ) / ZBET(IIJB:IIJE)
! res(k) = (y(k) -a(k)*res(k-1))/ bet
!
- ! going down
+ ! going down
!
- DO JK = IKE-KKL,IKB,-1*KKL
- PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ DO JK = IKE-IKL,IKB,-1*IKL
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
ELSE
!
- PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE)
+ DO JK=IKTB,IKTE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PVARP(IIJB:IIJE,JK) = ZY(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END DO
!
END IF
!
@@ -259,9 +255,13 @@ END IF
!* 3. FILL THE UPPER AND LOWER EXTERNAL VALUES
! ----------------------------------------
!
-PVARP(:,:,KKA)=PVARP(:,:,IKB)
-PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB)
+PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
-!
+!
+IF (LHOOK) CALL DR_HOOK('TRIDIAG_WIND',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG_WIND
+END MODULE MODE_TRIDIAG_WIND
diff --git a/src/PHYEX/turb/mode_turb_hor.f90 b/src/PHYEX/turb/mode_turb_hor.f90
index 8c872dcee439fe7faea9f96ce4f171a76ea4ff8a..c4a03a1be51710935bc3defb4f7827c96137c079 100644
--- a/src/PHYEX/turb/mode_turb_hor.f90
+++ b/src/PHYEX/turb/mode_turb_hor.f90
@@ -2,116 +2,15 @@
!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_HOR
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OTURB_FLX,OSUBG_COND, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
- PK, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFSVM, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PDP,PTP,PSIGS, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
-
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! current split index
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, INTENT(IN) :: PTSTEP !
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
-! Director Cosinus along x, y and z directions at surface w-point
-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 ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
-!
-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) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
- ! where PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-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) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner 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(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
- ! IN: Vertical part of Sigma_s at t
- ! OUT: Total Sigma_s at t
-!
-!
-!
-END SUBROUTINE TURB_HOR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR
-! ################################################################
- SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OTURB_FLX,OSUBG_COND, &
+MODULE MODE_TURB_HOR
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR(D,CST,CSTURB,TURBN,TLES, &
+ KSPLT, KRR, KRRL, KRRI, PTSTEP, &
+ KSV, KSV_LGBEG, KSV_LGEND, OFLAT,O2D,ONOMIXLG, &
+ OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ,PRSNOW, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
@@ -239,20 +138,22 @@ END MODULE MODI_TURB_HOR
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_CTURB
+USE MODD_CST, ONLY : CST_t
+USE MODD_CTURB, ONLY : CSTURB_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_LES
+USE MODD_LES, ONLY: TLES_t
!
-USE MODI_TURB_HOR_THERMO_FLUX
-USE MODI_TURB_HOR_THERMO_CORR
-USE MODI_TURB_HOR_DYN_CORR
-USE MODI_TURB_HOR_UV
-USE MODI_TURB_HOR_UW
-USE MODI_TURB_HOR_VW
-USE MODI_TURB_HOR_SV_FLUX
-USE MODI_TURB_HOR_SV_CORR
+USE MODE_TURB_HOR_THERMO_FLUX, ONLY: TURB_HOR_THERMO_FLUX
+USE MODE_TURB_HOR_THERMO_CORR, ONLY: TURB_HOR_THERMO_CORR
+USE MODE_TURB_HOR_DYN_CORR, ONLY: TURB_HOR_DYN_CORR
+USE MODE_TURB_HOR_UV, ONLY: TURB_HOR_UV
+USE MODE_TURB_HOR_UW, ONLY: TURB_HOR_UW
+USE MODE_TURB_HOR_VW, ONLY: TURB_HOR_VW
+USE MODE_TURB_HOR_SV_FLUX, ONLY: TURB_HOR_SV_FLUX
+USE MODE_TURB_HOR_SV_CORR, ONLY: TURB_HOR_SV_CORR
!
IMPLICIT NONE
!
@@ -260,20 +161,30 @@ IMPLICIT NONE
!* 0.1 declaration of arguments
!
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! current split index
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+INTEGER, INTENT(IN) :: KSV,KSV_LGBEG,KSV_LGEND ! number of sv var.
REAL, INTENT(IN) :: PTSTEP !
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for ocean version
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
! Director Cosinus along x, y and z directions at surface w-point
REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
@@ -351,9 +262,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!* 6. < V' R'np >
!* 7. < V' TPV' >
!
- CALL TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
- TPFILE, &
+ CALL TURB_HOR_THERMO_FLUX(TURBN,TLES,KSPLT, KRR, KRRL, KRRI,&
+ TPFILE,OFLAT, O2D, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
PDIRCOSXW,PDIRCOSYW, &
@@ -367,8 +277,9 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!* 8. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>, Sigma_s
!
IF (KSPLT==1) &
- CALL TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
+ CALL TURB_HOR_THERMO_CORR(D,CST,TURBN,TLES, &
+ KRR, KRRL, KRRI, &
+ OOCEAN,OCOMPUTE_SRC,O2D, &
TPFILE, &
PINV_PDXX,PINV_PDYY, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -383,8 +294,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!* 10. < V'V'>
!* 11. < W'W'>
!
- CALL TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
- OTURB_FLX,KRR, &
+ CALL TURB_HOR_DYN_CORR(TURBN,TLES,KSPLT, PTSTEP, &
+ KRR,KSV,OFLAT, O2D, &
TPFILE, &
PK,PINV_PDZZ, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
@@ -401,8 +312,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!
!* 12. < U'V'>
!
- CALL TURB_HOR_UV(KSPLT, &
- OTURB_FLX, &
+ CALL TURB_HOR_UV(TURBN,TLES,KSPLT,OFLAT,O2D, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -417,8 +327,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!
!* 13. < U'W'>
!
- CALL TURB_HOR_UW(KSPLT, &
- OTURB_FLX,KRR, &
+ CALL TURB_HOR_UW(TURBN,TLES,KSPLT, &
+ KRR,KSV,OFLAT, &
TPFILE, &
PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDZZ,PDZX, &
@@ -431,8 +341,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!
!* 14. < V'W'>
!
- CALL TURB_HOR_VW(KSPLT, &
- OTURB_FLX,KRR, &
+ CALL TURB_HOR_VW(TURBN,TLES,KSPLT, &
+ KRR,KSV,OFLAT,O2D, &
TPFILE, &
PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDYY,PDZZ,PDZY, &
@@ -446,20 +356,22 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!
!* 15. HORIZONTAL FLUXES OF PASSIVE SCALARS
!
- CALL TURB_HOR_SV_FLUX(KSPLT, &
- OTURB_FLX, &
- TPFILE, &
+ CALL TURB_HOR_SV_FLUX(TURBN,TLES,KSPLT,OBLOWSNOW,OFLAT, &
+ TPFILE,KSV_LGBEG,KSV_LGEND,O2D,ONOMIXLG, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PRSNOW, &
PDIRCOSXW,PDIRCOSYW, &
PRHODJ,PWM, &
PSFSVM, &
PSVM, &
PRSVS )
!
- IF (KSPLT==1 .AND. LLES_CALL) &
- CALL TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ IF (KSPLT==1 .AND. TLES%LLES_CALL) &
+ CALL TURB_HOR_SV_CORR(D,CST,CSTURB,TLES, &
+ KSV,KSV_LGBEG,KSV_LGEND, &
+ KRR,KRRL,KRRI,OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
+ ONOMIXLG,O2D, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PRSNOW, &
PLM,PLEPS,PTKEM,PTHVREF, &
PTHLM,PRM, &
PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
@@ -467,3 +379,4 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!
!
END SUBROUTINE TURB_HOR
+END MODULE MODE_TURB_HOR
diff --git a/src/PHYEX/turb/mode_turb_hor_dyn_corr.f90 b/src/PHYEX/turb/mode_turb_hor_dyn_corr.f90
index 2a4a3e98d7fa391aa25e8b6c048680eca238bb63..6bfd6f98ef8d968586fcd46d5bea23844f4855f1 100644
--- a/src/PHYEX/turb/mode_turb_hor_dyn_corr.f90
+++ b/src/PHYEX/turb/mode_turb_hor_dyn_corr.f90
@@ -3,81 +3,11 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_TURB_HOR_DYN_CORR
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
- OTURB_FLX,KRR, &
- TPFILE, &
- PK,PINV_PDZZ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTHLM,PRM,PSVM, &
- PTKEM,PLM, &
- PDP,PTP, &
- PRUS,PRVS,PRWS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-REAL, INTENT(IN) :: PTSTEP ! timestep
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
-! Director Cosinus along z directions at surface w-point
-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 ! density * grid volume
-!
-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) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
-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- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
-!
-!
-!
-END SUBROUTINE TURB_HOR_DYN_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_DYN_CORR
-! ################################################################
- SUBROUTINE TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
- OTURB_FLX,KRR, &
+MODULE MODE_TURB_HOR_DYN_CORR
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_DYN_CORR(TURBN,TLES,KSPLT, PTSTEP, &
+ KRR, KSV,OFLAT,O2D, &
TPFILE, &
PK,PINV_PDZZ, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
@@ -121,7 +51,7 @@ END MODULE MODI_TURB_HOR_DYN_CORR
!! -------------
!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
!! Nov 27, 1997 (V. Masson) clearing of the routine
-!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Oct 18, 2000 (V. Masson) LES computations + OFLAT switch
!! Feb 15, 2001 (J. Stein) remove the use of w=0 at the
!! ground
!! Mar 12, 2001 (V. Masson and J. Stein) major bugs
@@ -140,27 +70,27 @@ END MODULE MODI_TURB_HOR_DYN_CORR
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TURB_n, ONLY: TURB_t
+!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODD_CST
-USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_NSV
+USE MODD_LES, ONLY: TLES_t
!
USE MODE_ll
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
-USE MODI_TRIDIAG_W
+USE MODE_TRIDIAG_W, ONLY: TRIDIAG_W
!
USE MODI_SECOND_MNH
USE MODE_MPPDB
@@ -172,11 +102,14 @@ IMPLICIT NONE
!
!
!
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! split process index
REAL, INTENT(IN) :: PTSTEP ! timestep
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KSV ! number of sv var.
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
@@ -271,7 +204,7 @@ IKU = SIZE(PUM,3)
ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
!
GX_U_M_PUM = GX_U_M(PUM,PDXX,PDZZ,PDZX)
-IF (.NOT. L2D) GY_V_M_PVM = GY_V_M(PVM,PDYY,PDZZ,PDZY)
+IF (.NOT. O2D) GY_V_M_PVM = GY_V_M(PVM,PDYY,PDZZ,PDZY)
GZ_W_M_PWM = GZ_W_M(PWM,PDZZ)
!
ZMZF_DZZ = MZF(PDZZ)
@@ -286,7 +219,7 @@ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZFLX, 'TURB_HOR_DYN_CORR::ZFLX' )
! -------
!
! Computes the U variance
-IF (.NOT. L2D) THEN
+IF (.NOT. O2D) THEN
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *( (4./3.) * GX_U_M_PUM &
-(2./3.) * ( GY_V_M_PVM &
@@ -369,7 +302,7 @@ ZFLX(:,:,IKB-1) = &
ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
!
CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
! stores <U U>
TZFIELD%CMNHNAME = 'U_VAR'
TZFIELD%CSTDNAME = ''
@@ -381,11 +314,11 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Complete the U tendency
-IF (.NOT. LFLAT) THEN
+IF (.NOT. OFLAT) THEN
CALL MPPDB_CHECK3DM("before turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
& PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
@@ -411,12 +344,12 @@ END IF
!
! Storage in the LES configuration
!
-IF (LLES_CALL .AND. KSPLT==1) THEN
+IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_U2 )
- CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ CALL LES_MEAN_SUBGRID( ZFLX, TLES%X_LES_SUBGRID_U2 )
+ CALL LES_MEAN_SUBGRID( -ZWORK, TLES%X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
@@ -424,7 +357,7 @@ END IF
! -------
!
! Computes the V variance
-IF (.NOT. L2D) THEN
+IF (.NOT. O2D) THEN
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *( (4./3.) * GY_V_M_PVM &
-(2./3.) * ( GX_U_M_PUM &
@@ -464,7 +397,7 @@ ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
!
CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
!
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
! stores <V V>
TZFIELD%CMNHNAME = 'V_VAR'
TZFIELD%CSTDNAME = ''
@@ -476,12 +409,12 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Complete the V tendency
-IF (.NOT. L2D) THEN
- IF (.NOT. LFLAT) THEN
+IF (.NOT. O2D) THEN
+ IF (.NOT. OFLAT) THEN
PRVS(:,:,:)=PRVS &
-DYM(PRHODJ * ZFLX / MYF(PDYY) ) &
+DZF( PDZY / MZM(PDYY) * &
@@ -507,19 +440,19 @@ END IF
!
! Storage in the LES configuration
!
-IF (LLES_CALL .AND. KSPLT==1) THEN
+IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_V2 )
- CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ CALL LES_MEAN_SUBGRID( ZFLX, TLES%X_LES_SUBGRID_V2 )
+ CALL LES_MEAN_SUBGRID( -ZWORK, TLES%X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!* 11. < W'W'>
! -------
!
! Computes the W variance
-IF (.NOT. L2D) THEN
+IF (.NOT. O2D) THEN
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *( (4./3.) * GZ_W_M_PWM &
-(2./3.) * ( GX_U_M_PUM &
@@ -551,7 +484,7 @@ ZFLX(:,:,IKB-1) = &
!
ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
!
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
! stores <W W>
TZFIELD%CMNHNAME = 'W_VAR'
TZFIELD%CSTDNAME = ''
@@ -563,7 +496,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Complete the W tendency
@@ -597,29 +530,30 @@ END IF
! Storage in the LES configuration
!
!
-IF (LLES_CALL .AND. KSPLT==1) THEN
+IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_W2 )
- CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
- CALL LES_MEAN_SUBGRID( GZ_M_M(PTHLM,PDZZ)*ZFLX, X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
- CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PTHLM,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
+ CALL LES_MEAN_SUBGRID( ZFLX, TLES%X_LES_SUBGRID_W2 )
+ CALL LES_MEAN_SUBGRID( -ZWORK, TLES%X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID( GZ_M_M(PTHLM,PDZZ)*ZFLX, TLES%X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PTHLM,PDZZ)),TLES%X_LES_RES_ddz_Thl_SBG_W2)
IF (KRR>=1) THEN
CALL LES_MEAN_SUBGRID( GZ_M_M(PRM(:,:,:,1),PDZZ)*ZFLX, &
- X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ TLES%X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PRM(:,:,:,1),PDZZ)), &
- X_LES_RES_ddz_Rt_SBG_W2)
+ TLES%X_LES_RES_ddz_Rt_SBG_W2)
END IF
- DO JSV=1,NSV
+ DO JSV=1,KSV
CALL LES_MEAN_SUBGRID( GZ_M_M(PSVM(:,:,:,JSV),PDZZ)*ZFLX, &
- X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
+ TLES%X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
CALL LES_MEAN_SUBGRID(ZFLX*MZF(GZ_M_W(1,IKU,1,PSVM(:,:,:,JSV),PDZZ)), &
- X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
+ TLES%X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
END DO
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
CALL CLEANLIST_ll(TZFIELDS_ll)
!
!
END SUBROUTINE TURB_HOR_DYN_CORR
+END MODULE MODE_TURB_HOR_DYN_CORR
diff --git a/src/PHYEX/turb/mode_turb_hor_splt.f90 b/src/PHYEX/turb/mode_turb_hor_splt.f90
index 2de0ca9a8cdea58c8f98279e1ddcbc7d2038070a..83fdd1ed2d39f76780a3613955029e4f50e1dfa5 100644
--- a/src/PHYEX/turb/mode_turb_hor_splt.f90
+++ b/src/PHYEX/turb/mode_turb_hor_splt.f90
@@ -2,110 +2,14 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #########################
- MODULE MODI_TURB_HOR_SPLT
-! #########################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFSVM, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PDP,PTP,PSIGS, &
- PTRH, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
-
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLIT ! number of time splitting
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, INTENT(IN) :: PTSTEP ! timestep
-CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
-! Director Cosinus along x, y and z directions at surface w-point
-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 ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
-!
-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) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
- ! where PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-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- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner 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(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH
-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
- ! IN: Vertical part of Sigma_s at t
- ! OUT: Total Sigma_s at t
-!
-!
-!
-END SUBROUTINE TURB_HOR_SPLT
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_SPLT
-! ################################################################
- SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
- TPFILE, &
+MODULE MODE_TURB_HOR_SPLT
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_SPLT(D,CST,CSTURB,TURBN,TLES, &
+ KSPLIT, KRR,KRRL,KRRI,KSV, KSV_LGBEG,KSV_LGEND,&
+ PTSTEP,HLBCX,HLBCY, OFLAT, O2D, ONOMIXLG, &
+ OOCEAN,OCOMPUTE_SRC,OBLOWSNOW,PRSNOW, &
+ TPFILE, HPROGRAM, KHALO, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
@@ -210,7 +114,7 @@ END MODULE MODI_TURB_HOR_SPLT
!!
!! Module MODD_CONF
!!
-!! CPROGRAM
+!! HPROGRAM
!!
!!
!! REFERENCE
@@ -253,16 +157,19 @@ END MODULE MODI_TURB_HOR_SPLT
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF
-USE MODD_CST
-USE MODD_CTURB
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
+USE MODD_LES, ONLY: TLES_t
+USE MODD_TURB_n, ONLY: TURB_t
+!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
!
!
USE MODI_SHUMAN
-USE MODI_TURB_HOR
-USE MODI_TURB_HOR_TKE
+USE MODE_TURB_HOR
+USE MODE_TURB_HOR_TKE
!
USE MODE_ll
!
@@ -272,69 +179,81 @@ IMPLICIT NONE
!* 0.1 declaration of arguments
!
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLIT ! number of time splitting
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+INTEGER, INTENT(IN) :: KSV,KSV_LGBEG,KSV_LGEND ! number of sv var.
REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! HPROGRAM is the program currently running (modd_conf)
+INTEGER, INTENT(IN) :: KHALO ! Size of the halo for parallel distribution
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZZ ! vertical grid
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PSINSLOPE ! sinus of the angle
! between i and the slope vector
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! density * grid volume
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTHVREF ! ref. state VPT
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PSFTHM,PSFRM
+REAL, DIMENSION(D%NIT,D%NJT,KSV), INTENT(IN) :: PSFSVM ! surface fluxes
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(D%NIT,D%NJT), 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) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PTAU22M ! <vv> in the same axes
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), INTENT(IN) :: PRM ! mixing ratios at t-1,
! where PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-1
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PUSLOPEM ! wind component along the
! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PVSLOPEM ! wind component along the
! direction normal to the maximum slope one
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at time t- dt
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), 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(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), INTENT(INOUT) :: PRRS ! var. at t+1 -split-
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KSV), INTENT(INOUT) :: PRSVS ! var. at t+1 -split-
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PDP,PTP ! TKE production terms
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PTRH
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PSIGS
! IN: Vertical part of Sigma_s at t
! OUT: Total Sigma_s at t
!
@@ -395,7 +314,7 @@ NULLIFY(TZFIELDS_ll)
!* 2. SPLIT PROCESS LOOP
! ------------------
!
-IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
+IF (KSPLIT>1 .AND. HPROGRAM=='MESONH') THEN
!
!* 2.1 allocations
! -----------
@@ -453,10 +372,12 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
DO JSPLT=1,KSPLIT
!
! compute the turbulent tendencies for the small time step
- CALL TURB_HOR(JSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OTURB_FLX,OSUBG_COND, &
+ CALL TURB_HOR(D,CST,CSTURB,TURBN,TLES, &
+ JSPLT, KRR, KRRL, KRRI, PTSTEP, &
+ KSV, KSV_LGBEG, KSV_LGEND, OFLAT,O2D, ONOMIXLG,&
+ OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ,PRSNOW, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
ZINV_PDXX, ZINV_PDYY, ZINV_PDZZ, ZMZM_PRHODJ, &
@@ -472,7 +393,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
!
! horizontal transport of Tke
!
- CALL TURB_HOR_TKE(JSPLT, &
+ CALL TURB_HOR_TKE(JSPLT,TLES,OFLAT,O2D, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
ZINV_PDXX, ZINV_PDYY, ZINV_PDZZ, ZMZM_PRHODJ, &
ZK, PRHODJ, ZTKEM, &
@@ -497,7 +418,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
!
! reinforce boundary conditions
!
- IF (JSPLT<KSPLIT-NHALO+1) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ IF (JSPLT<KSPLIT-KHALO+1) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
!
IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
ZUM(IIB ,:,:)=PUM(IIB ,:,:)
@@ -594,10 +515,12 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
!
ELSE
!
- CALL TURB_HOR(1, KRR, KRRL, KRRI, PTSTEP, &
- OTURB_FLX,OSUBG_COND, &
+ CALL TURB_HOR(D,CST,CSTURB,TURBN,TLES, &
+ 1, KRR, KRRL, KRRI, PTSTEP, &
+ KSV, KSV_LGBEG, KSV_LGEND, OFLAT,O2D, ONOMIXLG,&
+ OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ,PRSNOW, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
ZINV_PDXX, ZINV_PDYY, ZINV_PDZZ, ZMZM_PRHODJ, &
@@ -614,7 +537,7 @@ ELSE
! horizontal transport of Tke
!
- CALL TURB_HOR_TKE(1, &
+ CALL TURB_HOR_TKE(1,TLES,OFLAT,O2D, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
ZINV_PDXX, ZINV_PDYY, ZINV_PDZZ, ZMZM_PRHODJ, &
ZK, PRHODJ, PTKEM, &
@@ -630,3 +553,4 @@ DEALLOCATE(ZINV_PDZZ)
DEALLOCATE(ZMZM_PRHODJ)
!
END SUBROUTINE TURB_HOR_SPLT
+END MODULE MODE_TURB_HOR_SPLT
diff --git a/src/PHYEX/turb/mode_turb_hor_sv_corr.f90 b/src/PHYEX/turb/mode_turb_hor_sv_corr.f90
index f9e2c7b5557ff6c0f31e75efcf9a3aa3347b3406..1ebc83f7fdef805bfb4504376260aecb9009c9bb 100644
--- a/src/PHYEX/turb/mode_turb_hor_sv_corr.f90
+++ b/src/PHYEX/turb/mode_turb_hor_sv_corr.f90
@@ -2,48 +2,13 @@
!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_HOR_SV_CORR
-! ############################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PLM,PLEPS,PTKEM,PTHVREF, &
- PTHLM,PRM, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- PWM,PSVM )
-!
-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) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
-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) :: 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) :: PWM ! w at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-!
-!
-END SUBROUTINE TURB_HOR_SV_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_SV_CORR
-! ################################################################
- SUBROUTINE TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
+MODULE MODE_TURB_HOR_SV_CORR
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_SV_CORR(D,CST,CSTURB,TLES,KSV,KSV_LGBEG,KSV_LGEND,&
+ KRR,KRRL,KRRI,OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
+ ONOMIXLG,O2D, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PRSNOW, &
PLM,PLEPS,PTKEM,PTHVREF, &
PTHLM,PRM, &
PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
@@ -84,13 +49,11 @@ END MODULE MODI_TURB_HOR_SV_CORR
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_CONF
-USE MODD_CTURB
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY : CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_PARAMETERS
-USE MODD_NSV, ONLY : NSV,NSV_LGBEG,NSV_LGEND
-USE MODD_LES
-USE MODD_BLOWSNOW
+USE MODD_LES, ONLY: TLES_t
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -98,8 +61,8 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
USE MODI_LES_MEAN_SUBGRID
-USE MODI_EMOIST
-USE MODI_ETHETA
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
!
USE MODI_SECOND_MNH
!
@@ -110,9 +73,20 @@ IMPLICIT NONE
!
!
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+INTEGER, INTENT(IN) :: KSV,KSV_LGBEG,KSV_LGEND ! number of sv var.
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
@@ -137,6 +111,7 @@ REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) &
:: ZFLX, ZA
!
INTEGER :: JSV ! loop counter
+INTEGER :: IKU
!
REAL :: ZTIME1, ZTIME2
!
@@ -147,23 +122,24 @@ REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
REAL :: ZCSV !constant for the scalar flux
! ---------------------------------------------------------------------------
!
+IKU=SIZE(PTKEM,3)
CALL SECOND_MNH(ZTIME1)
!
-IF(LBLOWSNOW) THEN
+IF(OBLOWSNOW) THEN
! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
- ZCSV= XCHF/XRSNOW
+ ZCSV= CSTURB%XCHF/PRSNOW
ELSE
- ZCSV= XCHF
+ ZCSV= CSTURB%XCHF
ENDIF
!
-DO JSV=1,NSV
+DO JSV=1,KSV
!
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
!
! variance Sv2
!
- IF (LLES_CALL) THEN
- IF (.NOT. L2D) THEN
+ IF (TLES%LLES_CALL) THEN
+ IF (.NOT. O2D) THEN
ZFLX(:,:,:) = ZCSV / ZCSVD * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)**2 &
+ GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)**2 )
@@ -172,47 +148,49 @@ DO JSV=1,NSV
GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)**2
END IF
CALL LES_MEAN_SUBGRID( -2.*ZCSVD*SQRT(PTKEM)*ZFLX/PLEPS, &
- X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV), .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Sv2(:,:,:,JSV), .TRUE. )
+ TLES%X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV), .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, TLES%X_LES_RES_W_SBG_Sv2(:,:,:,JSV), .TRUE. )
END IF
!
! covariance SvThv
!
- IF (LLES_CALL) THEN
- ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
- IF (.NOT. L2D) THEN
+ IF (TLES%LLES_CALL) THEN
+ CALL ETHETA(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN,OCOMPUTE_SRC,ZA)
+ IF (.NOT. O2D) THEN
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* ( GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY) * GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY) &
- ) * (XCSHF+ZCSV) / (2.*ZCTSVD)
+ ) * (CSTURB%XCSHF+ZCSV) / (2.*ZCTSVD)
ELSE
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
- * (XCSHF+ZCSV) / (2.*ZCTSVD)
+ * (CSTURB%XCSHF+ZCSV) / (2.*ZCTSVD)
END IF
- CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE. )
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, TLES%X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
+ CALL LES_MEAN_SUBGRID( -CST%XG/PTHVREF/3.*ZA*ZFLX, TLES%X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE. )
!
IF (KRR>=1) THEN
- ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
- IF (.NOT. L2D) THEN
+ CALL EMOIST(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN,ZA)
+ IF (.NOT. O2D) THEN
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* ( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) * GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY) &
- ) * (XCHF+ZCSV) / (2.*ZCQSVD)
+ ) * (CSTURB%XCHF+ZCSV) / (2.*ZCQSVD)
ELSE
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
- * (XCHF+ZCSV) / (2.*ZCQSVD)
+ * (CSTURB%XCHF+ZCSV) / (2.*ZCQSVD)
END IF
- CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE. )
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, TLES%X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
+ CALL LES_MEAN_SUBGRID( -CST%XG/PTHVREF/3.*ZA*ZFLX, TLES%X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE. )
END IF
END IF
!
END DO ! end loop JSV
!
CALL SECOND_MNH(ZTIME2)
-XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
!
END SUBROUTINE TURB_HOR_SV_CORR
+END MODULE MODE_TURB_HOR_SV_CORR
+
diff --git a/src/PHYEX/turb/mode_turb_hor_sv_flux.f90 b/src/PHYEX/turb/mode_turb_hor_sv_flux.f90
index 163ee3d0203f1e9cad04a62d18573d07707c4c20..ae50bb870a833b4b7553d7eb95c33ba992679fcd 100644
--- a/src/PHYEX/turb/mode_turb_hor_sv_flux.f90
+++ b/src/PHYEX/turb/mode_turb_hor_sv_flux.f90
@@ -3,64 +3,13 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ############################
- MODULE MODI_TURB_HOR_SV_FLUX
-! ############################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_SV_FLUX(KSPLT, &
- OTURB_FLX, &
- TPFILE, &
- PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PDIRCOSXW,PDIRCOSYW, &
- PRHODJ,PWM, &
- PSFSVM, &
- PSVM, &
- PRSVS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW
-! Director Cosinus along x and y directions at surface w-point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
-!
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! var. at t+1 -split-
-!
-!
-!
-END SUBROUTINE TURB_HOR_SV_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_SV_FLUX
-! ################################################################
- SUBROUTINE TURB_HOR_SV_FLUX(KSPLT, &
- OTURB_FLX, &
- TPFILE, &
+MODULE MODE_TURB_HOR_SV_FLUX
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_SV_FLUX(TURBN,TLES,KSPLT,OBLOWSNOW,OFLAT, &
+ TPFILE,KSV_LGBEG,KSV_LGEND,O2D,ONOMIXLG, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY,PRSNOW, &
PDIRCOSXW,PDIRCOSYW, &
PRHODJ,PWM, &
PSFSVM, &
@@ -98,7 +47,7 @@ END MODULE MODI_TURB_HOR_SV_FLUX
!! -------------
!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
!! Nov 27, 1997 (V. Masson) clearing of the routine
-!! Oct 18, 2000 (V. Masson) LES computations + LFLAT swith
+!! Oct 18, 2000 (V. Masson) LES computations + OFLAT swith
!! + bug on Y scalar flux
!! Jun 20, 2001 (J Stein) case of lagragian variables
!! Nov 06, 2002 (V. Masson) LES budgets
@@ -110,24 +59,23 @@ END MODULE MODI_TURB_HOR_SV_FLUX
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TURB_n, ONLY: TURB_t
+!
USE MODD_CST
-USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_NSV, ONLY: NSV_LGBEG, NSV_LGEND
-USE MODD_LES
-USE MODD_BLOWSNOW
+USE MODD_LES, ONLY: TLES_t
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -139,13 +87,19 @@ IMPLICIT NONE
!
!
!
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+INTEGER, INTENT(IN) :: KSV_LGBEG,KSV_LGEND ! number of sv var.
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
! PK = PLM * SQRT(PTKEM)
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
@@ -199,9 +153,9 @@ IKU = SIZE(PSVM,3)
!
ISV = SIZE(PSVM,4)
!
-IF(LBLOWSNOW) THEN
+IF(OBLOWSNOW) THEN
! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
- ZCSV= XCHF/XRSNOW
+ ZCSV= XCHF/PRSNOW
ELSE
ZCSV= XCHF
ENDIF
@@ -222,7 +176,7 @@ ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
!
DO JSV=1,ISV
!
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
!
! 15.1 <U' SVth'>
! ----------
@@ -247,7 +201,7 @@ DO JSV=1,ISV
ZFLXX(:,:,IKB-1:IKB-1) = 2. * MXM( ZWORK2D(:,:,1:1) ) - ZFLXX(:,:,IKB:IKB)
!
! stores <U SVth>
- IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
WRITE(TZFIELD%CMNHNAME,'("USV_FLX_",I3.3)') JSV
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -258,24 +212,24 @@ DO JSV=1,ISV
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLXX)
END IF
!
- IF (LLES_CALL .AND. KSPLT==1) THEN
+ IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MXF(ZFLXX), X_LES_SUBGRID_USv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MXF(ZFLXX), TLES%X_LES_SUBGRID_USv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLXX))), &
- X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ TLES%X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
CALL LES_MEAN_SUBGRID( GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MXF(ZFLXX), &
- X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV), .TRUE. )
+ TLES%X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV), .TRUE. )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
! 15.2 <V' SVth'>
! ----------
!
- IF (.NOT. L2D) THEN
+ IF (.NOT. O2D) THEN
!
! Computes the flux in the Y direction
ZFLXY(:,:,:)=-ZCSV * MYM(PK) * GY_M_V(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)
@@ -298,7 +252,7 @@ DO JSV=1,ISV
ZFLXY(:,:,IKB-1:IKB-1) = 2. * MYM( ZWORK2D(:,:,1:1) ) - ZFLXY(:,:,IKB:IKB)
!
! stores <V SVth>
- IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
WRITE(TZFIELD%CMNHNAME,'("VSV_FLX_",I3.3)') JSV
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -309,30 +263,30 @@ DO JSV=1,ISV
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXY)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLXY)
END IF
!
ELSE
ZFLXY=0.
END IF
!
- IF (LLES_CALL .AND. KSPLT==1) THEN
+ IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MYF(ZFLXY), X_LES_SUBGRID_VSv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID( MYF(ZFLXY), TLES%X_LES_SUBGRID_VSv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLXY))), &
- X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ TLES%X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
CALL LES_MEAN_SUBGRID( GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MYF(ZFLXY), &
- X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ TLES%X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) , .TRUE. )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!
! 15.3 Horizontal source terms
! -----------------------
!
- IF (.NOT. L2D) THEN
- IF (.NOT. LFLAT) THEN
+ IF (.NOT. O2D) THEN
+ IF (.NOT. OFLAT) THEN
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
-DXF( MXM(PRHODJ) * ZFLXX * PINV_PDXX ) &
-DYF( MYM(PRHODJ) * ZFLXY * PINV_PDYY ) &
@@ -345,7 +299,7 @@ DO JSV=1,ISV
-DYF( MYM(PRHODJ) * ZFLXY * PINV_PDYY )
END IF
ELSE
- IF (.NOT. LFLAT) THEN
+ IF (.NOT. OFLAT) THEN
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
-DXF( MXM(PRHODJ) * ZFLXX * PINV_PDXX ) &
+DZF( PMZM_PRHODJ * PINV_PDZZ * &
@@ -362,3 +316,4 @@ END DO ! end loop JSV
!
!
END SUBROUTINE TURB_HOR_SV_FLUX
+END MODULE MODE_TURB_HOR_SV_FLUX
diff --git a/src/PHYEX/turb/mode_turb_hor_thermo_corr.f90 b/src/PHYEX/turb/mode_turb_hor_thermo_corr.f90
index b619486765f9001c536c5b7860997c9c8894aaca..6c00603eac98ae37d90ce1b495ed6df6a695eaf3 100644
--- a/src/PHYEX/turb/mode_turb_hor_thermo_corr.f90
+++ b/src/PHYEX/turb/mode_turb_hor_thermo_corr.f90
@@ -3,71 +3,12 @@
!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_HOR_THERMO_CORR
-! ################################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
- TPFILE, &
- PINV_PDXX,PINV_PDYY, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF, &
- PWM,PTHLM,PRM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- PSIGS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-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
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
- ! where PRM(:,:,:,1) = conservative mixing ratio
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! Turb. Kin. Energy
-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(INOUT) :: PSIGS
- ! IN: Vertical part of Sigma_s at t
- ! OUT: Total Sigma_s at t
-!
-!
-!
-END SUBROUTINE TURB_HOR_THERMO_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_THERMO_CORR
-! ################################################################
- SUBROUTINE TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
+MODULE MODE_TURB_HOR_THERMO_CORR
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_THERMO_CORR(D,CST,TURBN,TLES, &
+ KRR, KRRL, KRRI, &
+ OOCEAN,OCOMPUTE_SRC,O2D, &
TPFILE, &
PINV_PDXX,PINV_PDYY, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -118,15 +59,16 @@ END MODULE MODI_TURB_HOR_THERMO_CORR
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_CONF
+USE MODD_CST, ONLY : CST_t
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_TURB_n, ONLY: TURB_t
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_LES
+USE MODD_LES, ONLY: TLES_t
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -135,8 +77,8 @@ USE MODI_GRADIENT_W
USE MODI_SHUMAN
USE MODI_LES_MEAN_SUBGRID
!
-USE MODI_EMOIST
-USE MODI_ETHETA
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
!
USE MODI_SECOND_MNH
!
@@ -147,13 +89,16 @@ IMPLICIT NONE
!
!
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
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
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
@@ -224,13 +169,13 @@ ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
!
!
!
-IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
- .OR. ( LLES_CALL ) ) THEN
+IF ( ( KRRL > 0 .AND. TURBN%LSUBG_COND) .OR. ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) &
+ .OR. ( TLES%LLES_CALL ) ) THEN
!
!* 8.1 <THl THl>
!
! Computes the horizontal variance <THl THl>
- IF (.NOT. L2D) THEN
+ IF (.NOT. O2D) THEN
ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
ELSE
@@ -265,7 +210,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
END IF
!
! stores <THl THl>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'THL_HVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THL_HVAR'
@@ -276,21 +221,21 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
!
- IF (LLES_CALL) THEN
+ IF (TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Thl2, .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Thl2, .TRUE. )
- CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_Thl2, .TRUE. )
- ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
- CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_ThlPz, .TRUE. )
+ CALL LES_MEAN_SUBGRID( ZFLX, TLES%X_LES_SUBGRID_Thl2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, TLES%X_LES_RES_W_SBG_Thl2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,TLES%X_LES_SUBGRID_DISS_Thl2, .TRUE. )
+ CALL ETHETA(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN,OCOMPUTE_SRC,ZA)
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, TLES%X_LES_SUBGRID_ThlThv, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -CST%XG/PTHVREF/3.*ZA*ZFLX, TLES%X_LES_SUBGRID_ThlPz, .TRUE. )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
IF ( KRR /= 0 ) THEN
@@ -298,7 +243,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
!* 8.3 <THl Rnp>
!
! Computes the horizontal correlation <THl Rnp>
- IF (.NOT. L2D) THEN
+ IF (.NOT. O2D) THEN
ZFLX(:,:,:)= &
PLM(:,:,:) * PLEPS(:,:,:) * &
(GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
@@ -353,7 +298,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
END IF
!
! stores <THl Rnp>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'THLR_HCOR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THLR_HCOR'
@@ -364,29 +309,29 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
!
- IF (LLES_CALL) THEN
+ IF (TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_ThlRt, .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_ThlRt, .TRUE. )
- CALL LES_MEAN_SUBGRID( -XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_ThlRt, .TRUE. )
- CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_RtThv, .TRUE. )
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_RtPz,.TRUE.)
- ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
- CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_ThlPz,.TRUE.)
+ CALL LES_MEAN_SUBGRID( ZFLX, TLES%X_LES_SUBGRID_ThlRt, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, TLES%X_LES_RES_W_SBG_ThlRt, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,TLES%X_LES_SUBGRID_DISS_ThlRt, .TRUE. )
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, TLES%X_LES_SUBGRID_RtThv, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -CST%XG/PTHVREF/3.*ZA*ZFLX, TLES%X_LES_SUBGRID_RtPz,.TRUE.)
+ CALL EMOIST(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN,ZA)
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, TLES%X_LES_SUBGRID_ThlThv, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -CST%XG/PTHVREF/3.*ZA*ZFLX, TLES%X_LES_SUBGRID_ThlPz,.TRUE.)
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!* 8.4 <Rnp Rnp>
!
! Computes the horizontal variance <Rnp Rnp>
- IF (.NOT. L2D) THEN
+ IF (.NOT. O2D) THEN
ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
@@ -421,7 +366,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
END IF
!
! stores <Rnp Rnp>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'R_HVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'R_HVAR'
@@ -432,20 +377,20 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
!
- IF (LLES_CALL) THEN
+ IF (TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Rt2, .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Rt2, .TRUE. )
- CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_RtThv, .TRUE. )
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_RtPz,.TRUE.)
- CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS, X_LES_SUBGRID_DISS_Rt2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( ZFLX, TLES%X_LES_SUBGRID_Rt2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, TLES%X_LES_RES_W_SBG_Rt2, .TRUE. )
+ CALL LES_MEAN_SUBGRID( ZA*ZFLX, TLES%X_LES_SUBGRID_RtThv, .TRUE. )
+ CALL LES_MEAN_SUBGRID( -CST%XG/PTHVREF/3.*ZA*ZFLX, TLES%X_LES_SUBGRID_RtPz,.TRUE.)
+ CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS, TLES%X_LES_SUBGRID_DISS_Rt2, .TRUE. )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END IF
@@ -466,3 +411,4 @@ END IF
!
!
END SUBROUTINE TURB_HOR_THERMO_CORR
+END MODULE MODE_TURB_HOR_THERMO_CORR
diff --git a/src/PHYEX/turb/mode_turb_hor_thermo_flux.f90 b/src/PHYEX/turb/mode_turb_hor_thermo_flux.f90
index 90d189a2bf41c8261bc26bc692a95ec3fc2297a6..93313669a3ffc01ca0ddf57ed8b0a999e541259f 100644
--- a/src/PHYEX/turb/mode_turb_hor_thermo_flux.f90
+++ b/src/PHYEX/turb/mode_turb_hor_thermo_flux.f90
@@ -3,78 +3,12 @@
!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_HOR_THERMO_FLUX
-! ################################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
- TPFILE, &
- PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PDIRCOSXW,PDIRCOSYW, &
- PRHODJ, &
- PSFTHM,PSFRM, &
- PWM,PTHLM,PRM, &
- PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PRTHLS,PRRS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-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
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW
-! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
- ! where PRM(:,:,:,1) = conservative mixing ratio
-!
-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(INOUT) :: PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! var. at t+1 -split-
-!
-!
-END SUBROUTINE TURB_HOR_THERMO_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_THERMO_FLUX
+MODULE MODE_TURB_HOR_THERMO_FLUX
+IMPLICIT NONE
+CONTAINS
! ################################################################
- SUBROUTINE TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
- TPFILE, &
+ SUBROUTINE TURB_HOR_THERMO_FLUX(TURBN, TLES,KSPLT, KRR, KRRL, KRRI, &
+ TPFILE,OFLAT,O2D, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
PDIRCOSXW,PDIRCOSYW, &
@@ -116,7 +50,7 @@ END MODULE MODI_TURB_HOR_THERMO_FLUX
!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
!! Nov 27, 1997 (V. Masson) clearing of the routine
!! Feb. 18, 1998 (J. Stein) bug for v'RC'
-!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Oct 18, 2000 (V. Masson) LES computations + OFLAT switch
!! Nov 06, 2002 (V. Masson) LES budgets
!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
@@ -127,15 +61,16 @@ END MODULE MODI_TURB_HOR_THERMO_FLUX
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TURB_n, ONLY: TURB_t
+!
USE MODD_CST
-USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_LES
+USE MODD_LES, ONLY: TLES_t
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -143,8 +78,8 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
USE MODI_LES_MEAN_SUBGRID
-!!USE MODI_EMOIST
-!!USE MODI_ETHETA
+!!USE MODE_EMOIST, ONLY: EMOIST
+!!USE MODE_ETHETA, ONLY: ETHETA
!
USE MODI_SECOND_MNH
!
@@ -155,14 +90,14 @@ IMPLICIT NONE
!
!
!
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! split process index
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
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
@@ -258,7 +193,7 @@ ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( SPREAD( PSFTHM(:,:)* PDIRCOSXW(:,:), 3,1) )
!
! Add this source to the Theta_l sources
!
-IF (.NOT. LFLAT) THEN
+IF (.NOT. OFLAT) THEN
PRTHLS(:,:,:) = PRTHLS &
- DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX ) &
+ DZF( PMZM_PRHODJ *MXF(PDZX*(MZM(ZFLX * PINV_PDXX))) * PINV_PDZZ )
@@ -269,7 +204,7 @@ END IF
! Compute the equivalent tendancy for Rc and Ri
!
IF ( KRRL >= 1 ) THEN
- IF (.NOT. LFLAT) THEN
+ IF (.NOT. OFLAT) THEN
ZFLXC = 2.*( MXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX ) &
+MZF( MZM( PRHODJ*PATHETA*PSRCM )*MXF( &
PDZX*(MZM( ZFLX*PINV_PDXX )) ) )&
@@ -310,7 +245,7 @@ END IF
!!ZWORK(:,:,:) = ZFLX(:,:,:)
!
! stores the horizontal <U THl>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UTHL_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UTHL_FLX'
@@ -321,22 +256,22 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
-IF (KSPLT==1 .AND. LLES_CALL) THEN
+IF (KSPLT==1 .AND. TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_UThl )
+ CALL LES_MEAN_SUBGRID( MXF(ZFLX), TLES%X_LES_SUBGRID_UThl )
CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLX))),&
- X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
+ TLES%X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
CALL LES_MEAN_SUBGRID( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)*MXF(ZFLX),&
- X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
+ TLES%X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
IF (KRR>=1) THEN
CALL LES_MEAN_SUBGRID( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX), &
- X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
+ TLES%X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
END IF
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!* 3. < U' R'np >
@@ -363,7 +298,7 @@ IF (KRR/=0) THEN
!
! Add this source to the conservative mixing ratio sources
!
- IF (.NOT. LFLAT) THEN
+ IF (.NOT. OFLAT) THEN
PRRS(:,:,:,1) = PRRS(:,:,:,1) &
- DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX ) &
+ DZF( PMZM_PRHODJ *MXF(PDZX*(MZM(ZFLX * PINV_PDXX))) * PINV_PDZZ )
@@ -374,7 +309,7 @@ IF (KRR/=0) THEN
! Compute the equivalent tendancy for Rc and Ri
!
IF ( KRRL >= 1 ) THEN
- IF (.NOT. LFLAT) THEN
+ IF (.NOT. OFLAT) THEN
ZFLXC = ZFLXC &
+ 2.*( MXF( MXM( PRHODJ*PAMOIST*PSRCM )*ZFLX ) &
+MZF( MZM( PRHODJ*PAMOIST*PSRCM )*MXF( &
@@ -413,7 +348,7 @@ IF (KRR/=0) THEN
END IF
!
! stores the horizontal <U Rnp>
- IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UR_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UR_FLX'
@@ -424,28 +359,28 @@ IF (KRR/=0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
- IF (KSPLT==1 .AND. LLES_CALL) THEN
+ IF (KSPLT==1 .AND. TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_URt )
+ CALL LES_MEAN_SUBGRID( MXF(ZFLX), TLES%X_LES_SUBGRID_URt )
CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,PDZZ,PDZX)*MZM(ZFLX))),&
- X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
+ TLES%X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
CALL LES_MEAN_SUBGRID( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)*MXF(ZFLX),&
- X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
+ TLES%X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
CALL LES_MEAN_SUBGRID( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX),&
- X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
+ TLES%X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!
- IF (KRRL>0 .AND. KSPLT==1 .AND. LLES_CALL) THEN
+ IF (KRRL>0 .AND. KSPLT==1 .AND. TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(MXF(ZFLXC), X_LES_SUBGRID_URc )
+ CALL LES_MEAN_SUBGRID(MXF(ZFLXC), TLES%X_LES_SUBGRID_URc )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END IF
@@ -462,7 +397,7 @@ END IF
!! ZFLX(:,:,:)*MXM(EMOIST(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM))
!! !
!! ! stores the horizontal <U VPT>
-!! IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+!! IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
!! TZFIELD%CMNHNAME = 'UVPT_FLX'
!! TZFIELD%CSTDNAME = ''
!! TZFIELD%CLONGNAME = 'UVPT_FLX'
@@ -473,7 +408,7 @@ END IF
!! TZFIELD%NTYPE = TYPEREAL
!! TZFIELD%NDIMS = 3
!! TZFIELD%LTIMEDEP = .TRUE.
-!! CALL IO_Field_write(TPFILE,TZFIELD,ZVPTU)
+!! CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZVPTU)
!! END IF
!!!
!!ELSE
@@ -485,7 +420,7 @@ END IF
! --------------
!
!
-IF (.NOT. L2D) THEN
+IF (.NOT. O2D) THEN
ZFLX(:,:,:) = -XCSHF * MYM( PK ) * GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
ELSE
@@ -510,8 +445,8 @@ ZFLX(:,:,IKB-1:IKB-1) = 2. * MYM( SPREAD( PSFTHM(:,:)* PDIRCOSYW(:,:), 3,1) ) &
!
! Add this source to the Theta_l sources
!
-IF (.NOT. L2D) THEN
- IF (.NOT. LFLAT) THEN
+IF (.NOT. O2D) THEN
+ IF (.NOT. OFLAT) THEN
PRTHLS(:,:,:) = PRTHLS &
- DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
+ DZF( PMZM_PRHODJ *MYF(PDZY*(MZM(ZFLX * PINV_PDYY))) * PINV_PDZZ )
@@ -522,9 +457,9 @@ END IF
!
! Compute the equivalent tendancy for Rc and Ri
!
-!IF ( OSUBG_COND .AND. KRRL > 0 .AND. .NOT. L2D) THEN
-IF ( KRRL >= 1 .AND. .NOT. L2D) THEN
- IF (.NOT. LFLAT) THEN
+!IF ( TURBN%LSUBG_COND .AND. KRRL > 0 .AND. .NOT. O2D) THEN
+IF ( KRRL >= 1 .AND. .NOT. O2D) THEN
+ IF (.NOT. OFLAT) THEN
ZFLXC = 2.*( MYF( MYM( PRHODJ*PATHETA*PSRCM )*ZFLX ) &
+MZF( MZM( PRHODJ*PATHETA*PSRCM )*MYF( &
PDZY*(MZM( ZFLX*PINV_PDYY )) ) )&
@@ -565,7 +500,7 @@ END IF
!!ZWORK(:,:,:) = ZFLX(:,:,:)
!
! stores the horizontal <V THl>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VTHL_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VTHL_FLX'
@@ -576,22 +511,22 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
-IF (KSPLT==1 .AND. LLES_CALL) THEN
+IF (KSPLT==1 .AND. TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MYF(ZFLX), X_LES_SUBGRID_VThl )
+ CALL LES_MEAN_SUBGRID( MYF(ZFLX), TLES%X_LES_SUBGRID_VThl )
CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLX))),&
- X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
+ TLES%X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
CALL LES_MEAN_SUBGRID( GY_M_M(PTHLM,PDYY,PDZZ,PDZY)*MYF(ZFLX),&
- X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
+ TLES%X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
IF (KRR>=1) THEN
CALL LES_MEAN_SUBGRID( GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MYF(ZFLX),&
- X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
+ TLES%X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
END IF
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!
@@ -600,7 +535,7 @@ END IF
!
IF (KRR/=0) THEN
!
- IF (.NOT. L2D) THEN
+ IF (.NOT. O2D) THEN
ZFLX(:,:,:) = -XCHF * MYM( PK ) * GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
ELSE
@@ -624,8 +559,8 @@ IF (KRR/=0) THEN
!
! Add this source to the conservative mixing ratio sources
!
- IF (.NOT. L2D) THEN
- IF (.NOT. LFLAT) THEN
+ IF (.NOT. O2D) THEN
+ IF (.NOT. OFLAT) THEN
PRRS(:,:,:,1) = PRRS(:,:,:,1) &
- DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
@@ -637,8 +572,8 @@ IF (KRR/=0) THEN
!
! Compute the equivalent tendancy for Rc and Ri
!
- IF ( KRRL >= 1 .AND. .NOT. L2D) THEN ! Sub-grid condensation
- IF (.NOT. LFLAT) THEN
+ IF ( KRRL >= 1 .AND. .NOT. O2D) THEN ! Sub-grid condensation
+ IF (.NOT. OFLAT) THEN
ZFLXC = ZFLXC &
+ 2.*( MXF( MYM( PRHODJ*PAMOIST*PSRCM )*ZFLX ) &
+ MZF( MZM( PRHODJ*PAMOIST*PSRCM )*MYF( &
@@ -677,7 +612,7 @@ IF (KRR/=0) THEN
END IF
!
! stores the horizontal <V Rnp>
- IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VR_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VR_FLX'
@@ -688,28 +623,28 @@ IF (KRR/=0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
- IF (KSPLT==1 .AND. LLES_CALL) THEN
+ IF (KSPLT==1 .AND. TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MYF(ZFLX), X_LES_SUBGRID_VRt )
+ CALL LES_MEAN_SUBGRID( MYF(ZFLX), TLES%X_LES_SUBGRID_VRt )
CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*MZM(ZFLX))),&
- X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
+ TLES%X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
CALL LES_MEAN_SUBGRID( GY_M_M(PTHLM,PDYY,PDZZ,PDZY)*MYF(ZFLX), &
- X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
+ TLES%X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
CALL LES_MEAN_SUBGRID( GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MYF(ZFLX), &
- X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
+ TLES%X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!
- IF (KRRL>0 .AND. KSPLT==1 .AND. LLES_CALL) THEN
+ IF (KRRL>0 .AND. KSPLT==1 .AND. TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(MYF(ZFLXC), X_LES_SUBGRID_VRc )
+ CALL LES_MEAN_SUBGRID(MYF(ZFLXC), TLES%X_LES_SUBGRID_VRc )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END IF
@@ -721,7 +656,7 @@ END IF
!!IF (KRR/=0) THEN
!! ! here ZFLX= <V'R'np> and ZWORK= <V'Theta'l>
!! !
-!! IF (.NOT. L2D) THEN &
+!! IF (.NOT. O2D) THEN &
!! ZVPTV(:,:,:) = &
!! ZWORK(:,:,:)*MYM(ETHETA(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM)) + &
!! ZFLX(:,:,:)*MYM(EMOIST(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM))
@@ -730,7 +665,7 @@ END IF
!! END IF
!! !
!! ! stores the horizontal <V VPT>
-!! IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+!! IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
!! TZFIELD%CMNHNAME = 'VVPT_FLX'
!! TZFIELD%CSTDNAME = ''
!! TZFIELD%CLONGNAME = 'VVPT_FLX'
@@ -741,7 +676,7 @@ END IF
!! TZFIELD%NTYPE = TYPEREAL
!! TZFIELD%NDIMS = 3
!! TZFIELD%LTIMEDEP = .TRUE.
-!! CALL IO_Field_write(TPFILE,TZFIELD,ZVPTV)
+!! CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZVPTV)
!! END IF
!!!
!!ELSE
@@ -750,3 +685,4 @@ END IF
!
!
END SUBROUTINE TURB_HOR_THERMO_FLUX
+END MODULE MODE_TURB_HOR_THERMO_FLUX
diff --git a/src/PHYEX/turb/mode_turb_hor_tke.f90 b/src/PHYEX/turb/mode_turb_hor_tke.f90
index ec8e9e2b63953f2eb38ebfad15f72c6837337fab..4c4006d546d34baf3d5640a4c1b515437fa7bc62 100644
--- a/src/PHYEX/turb/mode_turb_hor_tke.f90
+++ b/src/PHYEX/turb/mode_turb_hor_tke.f90
@@ -3,44 +3,10 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ####################
- MODULE MODI_TURB_HOR_TKE
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_TKE(KSPLT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
- PK, PRHODJ, PTKEM, &
- PTRH )
-
-!
-INTEGER, INTENT(IN) :: KSPLT ! current split index
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH ! horizontal transport of Tke
-!
-!
-!
-END SUBROUTINE TURB_HOR_TKE
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_TKE
-! ################################################################
- SUBROUTINE TURB_HOR_TKE(KSPLT, &
+MODULE MODE_TURB_HOR_TKE
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_TKE(KSPLT,TLES,OFLAT,O2D, &
PDXX, PDYY, PDZZ,PDZX,PDZY, &
PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
PK, PRHODJ, PTKEM, &
@@ -82,11 +48,10 @@ END MODULE MODI_TURB_HOR_TKE
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
USE MODD_PARAMETERS
-USE MODD_LES
+USE MODD_LES, ONLY: TLES_t
!
!
USE MODI_SHUMAN
@@ -101,8 +66,10 @@ IMPLICIT NONE
!* 0.1 declaration of arguments
!
!
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! current split index
-!
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
@@ -176,7 +143,7 @@ ZFLX(:,:,IKB-1) = - ZFLX(:,:,IKB)
!
ZFLX(:,:,IKU) = ZFLX(:,:,IKU-1)
!
-IF (.NOT. LFLAT) THEN
+IF (.NOT. OFLAT) THEN
PTRH =-( DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX)&
- DZF( PMZM_PRHODJ * MXF( PDZX * MZM(ZFLX*PINV_PDXX)) * PINV_PDZZ)&
) /PRHODJ
@@ -185,11 +152,11 @@ ELSE
) /PRHODJ
END IF
!
-IF (LLES_CALL .AND. KSPLT==1) THEN
+IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_UTke )
+ CALL LES_MEAN_SUBGRID( MXF(ZFLX), TLES%X_LES_SUBGRID_UTke )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!
@@ -198,7 +165,7 @@ END IF
!* 3. horizontal transport of Tke v'e
! -------------------------------
!
-IF (.NOT. L2D) THEN
+IF (.NOT. O2D) THEN
ZFLX =-XCET * MYM(PK) * GY_M_V(1,IKU,1,PTKEM,PDYY,PDZZ,PDZY) ! < v'e >
!
! special case near the ground ( uncentred gradient )
@@ -223,7 +190,7 @@ IF (.NOT. L2D) THEN
!
! complete the explicit turbulent transport
!
- IF (.NOT. LFLAT) THEN
+ IF (.NOT. OFLAT) THEN
PTRH = PTRH - ( DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
- DZF( PMZM_PRHODJ * MYF( PDZY * MZM(ZFLX*PINV_PDYY) ) * PINV_PDZZ ) &
) /PRHODJ
@@ -232,11 +199,11 @@ IF (.NOT. L2D) THEN
) /PRHODJ
END IF
!
- IF (LLES_CALL .AND. KSPLT==1) THEN
+ IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MYF(ZFLX), X_LES_SUBGRID_VTke )
+ CALL LES_MEAN_SUBGRID( MYF(ZFLX), TLES%X_LES_SUBGRID_VTke )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END IF
@@ -244,3 +211,4 @@ END IF
!----------------------------------------------------------------------------
!
END SUBROUTINE TURB_HOR_TKE
+END MODULE MODE_TURB_HOR_TKE
diff --git a/src/PHYEX/turb/mode_turb_hor_uv.f90 b/src/PHYEX/turb/mode_turb_hor_uv.f90
index 3fcecc20e2d98fa1844db2631a0c1e10256cd7f3..cd9a3f32a3147c77477cbd5c035ad92d62a56d75 100644
--- a/src/PHYEX/turb/mode_turb_hor_uv.f90
+++ b/src/PHYEX/turb/mode_turb_hor_uv.f90
@@ -3,76 +3,11 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! #######################
- MODULE MODI_TURB_HOR_UV
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_UV(KSPLT, &
- OTURB_FLX, &
- TPFILE, &
- PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
- PUM,PVM,PUSLOPEM,PVSLOPEM, &
- PDP, &
- PRUS,PRVS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
-! Director Cosinus along z directions at surface w-point
-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 ! density * grid volume
-!
-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) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM
-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(INOUT) :: PRUS, PRVS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
-!
-!
-END SUBROUTINE TURB_HOR_UV
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_UV
+MODULE MODE_TURB_HOR_UV
+IMPLICIT NONE
+CONTAINS
! ################################################################
- SUBROUTINE TURB_HOR_UV(KSPLT, &
- OTURB_FLX, &
+ SUBROUTINE TURB_HOR_UV(TURBN,TLES,KSPLT,OFLAT,O2D, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -115,7 +50,7 @@ END MODULE MODI_TURB_HOR_UV
!! -------------
!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
!! Nov 27, 1997 (V. Masson) clearing of the routine
-!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Oct 18, 2000 (V. Masson) LES computations + OFLAT switch
!! Nov 06, 2002 (V. Masson) LES budgets
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! --------------------------------------------------------------------------
@@ -123,22 +58,23 @@ END MODULE MODI_TURB_HOR_UV
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TURB_n, ONLY: TURB_t
+!
USE MODD_CST
-USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_LES
+USE MODD_LES, ONLY: TLES_t
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -150,10 +86,12 @@ IMPLICIT NONE
!
!
!
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
! PK = PLM * SQRT(PTKEM)
@@ -220,14 +158,14 @@ IKE = SIZE(PUM,3)-JPVEXT
ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
!
GX_V_UV_PVM = GX_V_UV(PVM,PDXX,PDZZ,PDZX)
-IF (.NOT. L2D) GY_U_UV_PUM = GY_U_UV(PUM,PDYY,PDZZ,PDZY)
+IF (.NOT. O2D) GY_U_UV_PUM = GY_U_UV(PUM,PDYY,PDZZ,PDZY)
!
!
!* 12. < U'V'>
! -------
!
!
-IF (.NOT. L2D) THEN
+IF (.NOT. O2D) THEN
ZFLX(:,:,:)= - XCMFS * MYM(MXM(PK)) * &
(GY_U_UV_PUM + GX_V_UV_PVM)
ELSE
@@ -269,7 +207,7 @@ ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( MYM( ZFLX(:,:,IKB-1:IKB-1) ) ) &
- ZFLX(:,:,IKB:IKB)
!
! stores <U V>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UV_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UV_FLX'
@@ -280,13 +218,13 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
!
!
!computation of the source for rho*V due to this flux
-IF (.NOT. LFLAT) THEN
+IF (.NOT. OFLAT) THEN
PRUS(:,:,:) = PRUS(:,:,:) &
- DYF(ZFLX * MXM(MYM(PRHODJ) * PINV_PDYY) ) &
+ DZF( MYF( MZM(ZFLX)*MXM(PDZY/MZM(PDYY))) &
@@ -296,7 +234,7 @@ ELSE
END IF
!
!computation of the source for rho*V due to this flux
-IF (.NOT. LFLAT) THEN
+IF (.NOT. OFLAT) THEN
PRVS(:,:,:) = PRVS(:,:,:) &
- DXF(ZFLX * MYM(MXM(PRHODJ) * PINV_PDXX) ) &
+ DZF( MXF( MZM(ZFLX)*MYM(PDZX/MZM(PDXX))) &
@@ -309,7 +247,7 @@ IF (KSPLT==1) THEN
!
!Contribution to the dynamic production of TKE:
!
- IF (.NOT. L2D) THEN
+ IF (.NOT. O2D) THEN
ZWORK(:,:,:) = - MXF( MYF( ZFLX * &
(GY_U_UV_PUM + GX_V_UV_PVM) ) )
ELSE
@@ -342,14 +280,15 @@ END IF
!
! Storage in the LES configuration
!
-IF (LLES_CALL .AND. KSPLT==1) THEN
+IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MXF(MYF(ZFLX)), X_LES_SUBGRID_UV )
- CALL LES_MEAN_SUBGRID( MXF(MYF(GY_U_UV(PUM,PDYY,PDZZ,PDZY)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
- CALL LES_MEAN_SUBGRID( MXF(MYF(GX_V_UV(PVM,PDXX,PDZZ,PDZX)*ZFLX)), X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(MYF(ZFLX)), TLES%X_LES_SUBGRID_UV )
+ CALL LES_MEAN_SUBGRID( MXF(MYF(GY_U_UV(PUM,PDYY,PDZZ,PDZY)*ZFLX)), TLES%X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(MYF(GX_V_UV(PVM,PDXX,PDZZ,PDZX)*ZFLX)), TLES%X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!
END SUBROUTINE TURB_HOR_UV
+END MODULE MODE_TURB_HOR_UV
diff --git a/src/PHYEX/turb/mode_turb_hor_uw.f90 b/src/PHYEX/turb/mode_turb_hor_uw.f90
index d19c68bae6607c4805871d5e4169380917ccdb80..b13acfaa287d3038bec942634f4c1b85dcde385a 100644
--- a/src/PHYEX/turb/mode_turb_hor_uw.f90
+++ b/src/PHYEX/turb/mode_turb_hor_uw.f90
@@ -3,64 +3,12 @@
!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_HOR_UW
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_UW(KSPLT, &
- OTURB_FLX,KRR, &
- TPFILE, &
- PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDZZ,PDZX, &
- PRHODJ,PTHVREF, &
- PUM,PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM, &
- PDP, &
- PRUS,PRWS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDZZ, PDZX
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRWS
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
-!
-!
-!
-!
-END SUBROUTINE TURB_HOR_UW
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_UW
+MODULE MODE_TURB_HOR_UW
+IMPLICIT NONE
+CONTAINS
! ################################################################
- SUBROUTINE TURB_HOR_UW(KSPLT, &
- OTURB_FLX,KRR, &
+ SUBROUTINE TURB_HOR_UW(TURBN,TLES,KSPLT, &
+ KRR,KSV,OFLAT, &
TPFILE, &
PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDZZ,PDZX, &
@@ -101,7 +49,7 @@ END MODULE MODI_TURB_HOR_UW
!! -------------
!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
!! Nov 27, 1997 (V. Masson) clearing of the routine
-!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Oct 18, 2000 (V. Masson) LES computations + OFLAT switch
!! Feb 14, 2001 (V. Masson and J. Stein) DZF bug on PRWS
!! + remove the use of W=0 at the ground
!! + extrapolation under the ground
@@ -114,23 +62,23 @@ END MODULE MODI_TURB_HOR_UW
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TURB_n, ONLY: TURB_t
+!
USE MODD_CST
-USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_NSV
+USE MODD_LES, ONLY: TLES_t
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -142,10 +90,12 @@ IMPLICIT NONE
!
!
!
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KSV ! number of sv var.
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
@@ -219,7 +169,7 @@ ZFLX(:,:,IKB) = 0.
ZFLX(:,:,IKB-1)=2.*ZFLX(:,:,IKB)- ZFLX(:,:,IKB+1)
!
! stores <U W>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UW_HFLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UW_HFLX'
@@ -230,7 +180,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
!
@@ -239,7 +189,7 @@ END IF
PRUS(:,:,:) = PRUS(:,:,:) - DZF( ZFLX* MXM( PMZM_PRHODJ ) / MXM( PDZZ ) )
!
!computation of the source for rho*W due to this flux
-IF (.NOT. LFLAT) THEN
+IF (.NOT. OFLAT) THEN
PRWS(:,:,:) = PRWS(:,:,:) &
-DXF( MZM( MXM(PRHODJ) * PINV_PDXX) * ZFLX) &
+DZM( PRHODJ * MXF( MZF( ZFLX*PDZX ) * PINV_PDXX ) / MZF(PDZZ) )
@@ -276,24 +226,25 @@ END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
!
-IF (LLES_CALL .AND. KSPLT==1) THEN
+IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MXF(ZFLX)), X_LES_SUBGRID_WU , .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(MXF(GZ_U_UW(PUM,PDZZ)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
- CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW_PWM*ZFLX)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MZF(MXF(ZFLX)), TLES%X_LES_SUBGRID_WU , .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GZ_U_UW(PUM,PDZZ)*ZFLX)), TLES%X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW_PWM*ZFLX)), TLES%X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)*MZF(ZFLX)),&
- X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ TLES%X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
IF (KRR>=1) THEN
CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MZF(ZFLX)), &
- X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ TLES%X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
END IF
- DO JSV=1,NSV
+ DO JSV=1,KSV
CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MZF(ZFLX)), &
- X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
+ TLES%X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
END DO
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END SUBROUTINE TURB_HOR_UW
+END MODULE MODE_TURB_HOR_UW
diff --git a/src/PHYEX/turb/mode_turb_hor_vw.f90 b/src/PHYEX/turb/mode_turb_hor_vw.f90
index df888c2c7ba810d520a842ae57584710b2708359..196734ea63a19cd4b31ef7e735e9fc2a50c89104 100644
--- a/src/PHYEX/turb/mode_turb_hor_vw.f90
+++ b/src/PHYEX/turb/mode_turb_hor_vw.f90
@@ -3,60 +3,11 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! #######################
- MODULE MODI_TURB_HOR_VW
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_VW(KSPLT, &
- OTURB_FLX,KRR, &
- TPFILE, &
- PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDYY,PDZZ,PDZY, &
- PRHODJ,PTHVREF, &
- PVM,PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM, &
- PDP, &
- PRVS,PRWS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY, PDZZ, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS, PRWS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
-!
-END SUBROUTINE TURB_HOR_VW
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_VW
-! ################################################################
- SUBROUTINE TURB_HOR_VW(KSPLT, &
- OTURB_FLX,KRR, &
+MODULE MODE_TURB_HOR_VW
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_VW(TURBN,TLES,KSPLT, &
+ KRR,KSV,OFLAT,O2D, &
TPFILE, &
PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDYY,PDZZ,PDZY, &
@@ -97,7 +48,7 @@ END MODULE MODI_TURB_HOR_VW
!! -------------
!! Aug , 1997 (V. Saravane) spliting of TURB_HOR
!! Nov 27, 1997 (V. Masson) clearing of the routine
-!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
+!! Oct 18, 2000 (V. Masson) LES computations + OFLAT switch
!! Feb 14, 2001 (V. Masson and J. Stein) DZF bug on PRWS
!! + remove the use of W=0 at the ground
!! + extrapolataion under the ground
@@ -110,23 +61,23 @@ END MODULE MODI_TURB_HOR_VW
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TURB_n, ONLY: TURB_t
+!
USE MODD_CST
-USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_NSV
+USE MODD_LES, ONLY: TLES_t
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -138,10 +89,13 @@ IMPLICIT NONE
!
!
!
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KSV ! number of sv var.
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
@@ -193,7 +147,7 @@ IKE = SIZE(PWM,3)-JPVEXT
IKU = SIZE(PWM,3)
!
!
-IF (.NOT. L2D) GY_W_VW_PWM = GY_W_VW(PWM,PDYY,PDZZ,PDZY)
+IF (.NOT. O2D) GY_W_VW_PWM = GY_W_VW(PWM,PDYY,PDZZ,PDZY)
!
!
!* 14. < V'W'>
@@ -201,7 +155,7 @@ IF (.NOT. L2D) GY_W_VW_PWM = GY_W_VW(PWM,PDYY,PDZZ,PDZY)
!
! residual part of < V'W'> depending on dw/dy
!
-IF (.NOT. L2D) THEN
+IF (.NOT. O2D) THEN
ZFLX(:,:,:) = &
- XCMFS * MYM(MZM(PK)) * GY_W_VW_PWM
!! & to be tested
@@ -221,7 +175,7 @@ ZFLX(:,:,IKB) = 0.
ZFLX(:,:,IKB-1)= 2.*ZFLX(:,:,IKB) - ZFLX(:,:,IKB+1)
!
! stores <V W>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. TURBN%LTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VW_HFLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VW_HFLX'
@@ -232,17 +186,17 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! compute the source for rho*V due to this residual flux ( the other part is
! taken into account in TURB_VER)
-IF (.NOT. L2D) &
+IF (.NOT. O2D) &
PRVS(:,:,:) = PRVS(:,:,:) - DZF( ZFLX* MYM( PMZM_PRHODJ ) / MYM ( PDZZ ) )
!
!computation of the source for rho*W due to this flux
-IF (.NOT. L2D) THEN
- IF (.NOT. LFLAT) THEN
+IF (.NOT. O2D) THEN
+ IF (.NOT. OFLAT) THEN
PRWS(:,:,:) = PRWS(:,:,:) &
-DYF( MZM( MYM(PRHODJ) * PINV_PDYY) * ZFLX) &
+DZM( PRHODJ * MYF( MZF( ZFLX*PDZY ) * PINV_PDYY ) / MZF(PDZZ) )
@@ -255,7 +209,7 @@ IF (KSPLT==1) THEN
!
!Contribution to the dynamic production of TKE:
!
- IF (.NOT. L2D) THEN
+ IF (.NOT. O2D) THEN
ZWORK(:,:,:) =-MZF( MYF( ZFLX *( GZ_V_VW(PVM,PDZZ) + GY_W_VW_PWM ) ) )
!
!
@@ -274,34 +228,35 @@ IF (KSPLT==1) THEN
ENDIF
!
! dynamic production computation
- IF (.NOT. L2D) &
+ IF (.NOT. O2D) &
PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
!
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
!
-IF (LLES_CALL .AND. KSPLT==1) THEN
+IF (TLES%LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MYF(ZFLX)), X_LES_SUBGRID_WV , .TRUE. )
+ CALL LES_MEAN_SUBGRID( MZF(MYF(ZFLX)), TLES%X_LES_SUBGRID_WV , .TRUE. )
CALL LES_MEAN_SUBGRID( MZF(MYF(GZ_V_VW(PVM,PDZZ)*ZFLX)),&
- X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ TLES%X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,PDZZ,PDZY)*ZFLX)),&
- X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ TLES%X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)*MZF(ZFLX)),&
- X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ TLES%X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
IF (KRR>=1) THEN
CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MZF(ZFLX)), &
- X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ TLES%X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
END IF
- DO JSV=1,NSV
+ DO JSV=1,KSV
CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MZF(ZFLX)), &
- X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV), .TRUE.)
+ TLES%X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV), .TRUE.)
END DO
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!
!
END SUBROUTINE TURB_HOR_VW
+END MODULE MODE_TURB_HOR_VW
diff --git a/src/PHYEX/turb/mode_turb_ver.f90 b/src/PHYEX/turb/mode_turb_ver.f90
index 4117d8191eb9def704b654e606eba90307fe65ec..ddc28851ffc77d70ccf07113d61a243b2297a583 100644
--- a/src/PHYEX/turb/mode_turb_ver.f90
+++ b/src/PHYEX/turb/mode_turb_ver.f90
@@ -1,138 +1,30 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_TURB_VER
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,PEXPL, &
- PTSTEP, TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
- PSBL_DEPTH,PLMO, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
-
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-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 ! timestep
-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 ! altitudes at 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) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-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 and potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-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(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner 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) :: PFWTH ! d(w'2th' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:), INTENT(INOUT):: PSBL_DEPTH ! SBL depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP,PTP ! Dynamic and thermal
- ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
-END SUBROUTINE TURB_VER
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,PEXPL, &
+MODULE MODE_TURB_VER
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER(D,CST,CSTURB,TURBN,TLES,KRR,KRRL,KRRI,KGRADIENTS,&
+ OOCEAN,ODEEPOC,OCOMPUTE_SRC, &
+ KSV,KSV_LGBEG,KSV_LGEND, &
+ PEXPL, HPROGRAM, O2D, ONOMIXLG, OFLAT, &
+ OCOUPLES,OBLOWSNOW,PRSNOW, &
PTSTEP, TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
+ PRHODJ,PTHVREF,PSFUM,PSFVM, &
PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
+ PTKEM,PLM,PLENGTHM,PLENGTHH,PLEPS,MFMOIST, &
PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
- PSBL_DEPTH,PLMO, &
+ PSBL_DEPTH,PLMO,PHGRAD,PZS, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
+ PDP,PTP,PSIGS,PWTH,PWRC,PWSV, &
+ PSSTFL,PSSTFL_C,PSSRFL_C,PSSUFL_C,PSSVFL_C, &
+ PSSUFL,PSSVFL )
! ###############################################################
!
!
@@ -244,20 +136,19 @@ END MODULE MODI_TURB_VER
!! ------------------
!! Module MODD_CST : contains physical constants
!!
-!! XG : gravity constant
+!! CST%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
+!! CSTURB%XCMFS,XCMFB : cts for the momentum flux
+!! CSTURB%XCSHF : ct for the sensible heat flux
+!! CSTURB%XCHF : ct for the moisture flux
+!! CSTURB%XCTV,CSTURB%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
@@ -310,6 +201,7 @@ END MODULE MODI_TURB_VER
!! reversed vertical levels
!! 10/2012 (J.Escobar) Bypass PGI bug , redefine some allocatable array inplace of automatic
!! 08/2014 (J.Escobar) Bypass PGI memory leak bug , replace IF statement with IF THEN ENDIF
+!! Modifications: July, 2015 (Wim de Rooy) switch for HARATU (Racmo turbulence scheme)
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! JL Redelsperger 03/2021 : add Ocean LES case
!!--------------------------------------------------------------------------
@@ -317,130 +209,149 @@ END MODULE MODI_TURB_VER
!* 0. DECLARATIONS
! ------------
!
-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_PARAMETERS
-USE MODD_LES
-USE MODD_NSV, ONLY: NSV
-!
-USE MODI_PRANDTL
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_W
-USE MODI_TURB
-USE MODI_TURB_VER_THERMO_FLUX
-USE MODI_TURB_VER_THERMO_CORR
-USE MODI_TURB_VER_DYN_FLUX
-USE MODI_TURB_VER_SV_FLUX
-USE MODI_TURB_VER_SV_CORR
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_SBL_DEPTH
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_PRANDTL
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_LES, ONLY: TLES_t
+USE MODD_TURB_n, ONLY: TURB_t
+!
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
+USE MODE_GRADIENT_M_PHY, ONLY : GZ_M_W_PHY
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_PRANDTL, ONLY: PSI_SV, PSI3, PHI3, PRANDTL
+USE MODE_SBL_DEPTH, ONLY: SBL_DEPTH
+USE MODE_TURB_VER_THERMO_FLUX, ONLY: TURB_VER_THERMO_FLUX
+USE MODE_TURB_VER_THERMO_CORR, ONLY: TURB_VER_THERMO_CORR
+USE MODE_TURB_VER_DYN_FLUX, ONLY: TURB_VER_DYN_FLUX
+USE MODE_TURB_VER_SV_FLUX, ONLY: TURB_VER_SV_FLUX
+USE MODE_TURB_VER_SV_CORR, ONLY: TURB_VER_SV_CORR
+!
+USE MODI_LES_MEAN_SUBGRID_PHY
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
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
+INTEGER, INTENT(IN) :: KGRADIENTS ! Number of stored horizontal gradients
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.
+INTEGER, INTENT(IN) :: KSV, KSV_LGBEG, KSV_LGEND ! number of scalar variables
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: ODEEPOC ! activates sfc forcing for ideal ocean deep conv
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! HPROGRAM is the program currently running
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version
+REAL, INTENT(IN) :: PEXPL ! Coef. for temporal disc.
REAL, INTENT(IN) :: PTSTEP ! timestep
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes at flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitudes at flux points
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+REAL, DIMENSION(D%NIJT), 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) :: PTHVREF ! ref. state Virtual
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PZS ! orography (for LEONARD terms)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * grid volum
+! MFMOIST used in case of TURBN%LHARATU
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVREF ! ref. state Virtual
! Potential Temperature
+REAL, DIMENSION(D%NIJT,D%NKT,KGRADIENTS),INTENT(IN) :: PHGRAD ! horizontal gradients
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFUM,PSFVM ! surface fluxes
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+REAL, DIMENSION(D%NIJT,KSV), INTENT(IN) :: PSFSVM ! t - deltat
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+REAL, DIMENSION(D%NIJT,KSV), INTENT(IN) :: PSFSVP ! t + deltat
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(D%NIJT), 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(D%NIJT), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM,PVM,PWM,PTHLM
! Wind and potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PRM ! Mixing ratios
! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PUSLOPEM ! wind component along the
! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+REAL, DIMENSION(D%NIJT), 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(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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM ! Turb. mixing length
+! PLENGTHM PLENGTHH used in case of TURBN%LHARATU
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLENGTHM ! Turb. mixing length momentum
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLENGTHH ! Turb. mixing length heat/moisture
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), 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) :: PFWTH ! d(w'2th' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:), INTENT(INOUT):: PSBL_DEPTH ! SBL depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFWTH ! d(w'2th' )/dz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFWR ! d(w'2r' )/dz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
+REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%CTOM=='TM06')),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
+REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%LRMC01)),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PLMO ! Monin-Obukhov length
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(INOUT) :: PRSVS
! cumulated sources for the prognostic variables
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP,PTP ! Dynamic and thermal
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDP,PTP ! Dynamic and thermal
! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
-!
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(OUT) :: PSIGS
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(D%NIJT,D%NKT,KSV),INTENT(OUT) :: PWSV ! scalar flux
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSTFL ! Time evol Flux of T at sea surface (LOCEAN)!
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSTFL_C ! O-A interface flux for theta(LOCEAN and LCOUPLES)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSRFL_C ! O-A interface flux for vapor (LOCEAN and LCOUPLES)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSUFL_C ! Time evol Flux of U at sea surface (LOCEAN)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSVFL_C !
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSUFL
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSVFL !
!
!* 0.2 declaration of local variables
!
-!JUAN BUG PGI
-!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZBETA, & ! buoyancy coefficient
ZSQRT_TKE,& ! sqrt(e)
ZDTH_DZ, & ! d(th)/dz
@@ -461,64 +372,43 @@ REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
ZWV, & ! (v'w')
ZTHLP, & ! guess of potential temperature due to vert. turbulent flux
ZRP ! guess of total water due to vert. turbulent flux
-
-!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) :: &
-REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+!
+REAL, DIMENSION(D%NIJT,D%NKT,KSV) :: &
ZPSI_SV, & ! Prandtl number for scalars
ZREDS1, & ! 1D Redelsperger number R_sv
ZRED2THS, & ! 3D Redelsperger number R*2_thsv
ZRED2RS ! 3D Redelsperger number R*2_rsv
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZLM
!
LOGICAL :: GUSERV ! flag to use water vapor
-INTEGER :: IKB,IKE ! index value for the Beginning
- ! and the End of the physical domain for the mass points
-INTEGER :: JSV ! loop counter on scalar variables
+INTEGER :: IKB,IKE,IIJE,IIJB,IKT ! index value for the Beginning
+ ! and the End of the physical domain for the mass points
+INTEGER :: JSV,JIJ,JK ! loop counter
REAL :: ZTIME1
REAL :: ZTIME2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
TYPE(TFIELDDATA) :: TZFIELD
!----------------------------------------------------------------------------
-ALLOCATE ( ZBETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZSQRT_TKE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
- ZDTH_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZDR_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2TH3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2R3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2THR3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
- ZBLL_O_E(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZETHETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZEMOIST(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZREDTH1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZREDR1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZPHI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZPSI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZD(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWTHV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWU(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZTHLP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) )
-
-ALLOCATE ( &
- ZPSI_SV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZREDS1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZRED2THS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZRED2RS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) )
-
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
! -------------
!
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
+IF (LHOOK) CALL DR_HOOK('TURB_VER',0,ZHOOK_HANDLE)
+!
+IKB=D%NKTB
+IKE=D%NKTE
+IKT=D%NKT
+IIJE=D%NIJE
+IIJB=D%NIJB
!
!
! 3D Redelsperger numbers
!
!
-CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_FLX, &
- HTURBDIM, &
- TPFILE, &
+CALL PRANDTL(D,CST,CSTURB,KRR,KSV,KRRI,TURBN%LTURB_FLX, &
+ TURBN%CTURBDIM,OOCEAN,TURBN%LHARAT,O2D,OCOMPUTE_SRC,&
+ TPFILE, OFLAT, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
@@ -530,52 +420,64 @@ CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_FLX, &
!
! Buoyancy coefficient
!
-IF (LOCEAN) THEN
- ZBETA = XG*XALPHAOC
+IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZBETA(IIJB:IIJE,1:IKT) = CST%XG*CST%XALPHAOC
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- ZBETA = XG/PTHVREF
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZBETA(IIJB:IIJE,1:IKT) = CST%XG/PTHVREF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
! Square root of Tke
!
-ZSQRT_TKE = SQRT(PTKEM)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZSQRT_TKE(IIJB:IIJE,1:IKT) = SQRT(PTKEM(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! gradients of mean quantities at previous time-step
!
-ZDTH_DZ = GZ_M_W(KKA,KKU,KKL,PTHLM(:,:,:),PDZZ)
-ZDR_DZ = 0.
-IF (KRR>0) THEN
-ZDR_DZ = GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
-ENDIF
+CALL GZ_M_W_PHY(D,PTHLM,PDZZ,ZDTH_DZ)
+ZDR_DZ(:,:) = 0.
+IF (KRR>0) CALL GZ_M_W_PHY(D,PRM(:,:,1),PDZZ,ZDR_DZ)
!
!
! Denominator factor in 3rd order terms
!
-ZD(:,:,:) = (1.+ZREDTH1+ZREDR1) * (1.+0.5*(ZREDTH1+ZREDR1))
+IF (.NOT. TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZD(IIJB:IIJE,1:IKT) = (1.+ZREDTH1(IIJB:IIJE,1:IKT)+ZREDR1(IIJB:IIJE,1:IKT)) * &
+ &(1.+0.5*(ZREDTH1(IIJB:IIJE,1:IKT)+ZREDR1(IIJB:IIJE,1:IKT)))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZD(IIJB:IIJE,1:IKT) = 1.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ENDIF
!
! Phi3 and Psi3 Prandtl numbers
!
GUSERV = KRR/=0
!
-ZPHI3 = PHI3(ZREDTH1,ZREDR1,ZRED2TH3,ZRED2R3,ZRED2THR3,HTURBDIM,GUSERV)
-IF(KRR/=0) THEN
-ZPSI3 = PSI3(ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,HTURBDIM,GUSERV)
-ENDIF
+CALL PHI3(D,CSTURB,ZREDTH1,ZREDR1,ZRED2TH3,ZRED2R3,ZRED2THR3,TURBN%CTURBDIM,GUSERV,ZPHI3)
+IF(KRR/=0) &
+CALL PSI3(D,CSTURB,ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,TURBN%CTURBDIM,GUSERV,ZPSI3)
!
! Prandtl numbers for scalars
!
-ZPSI_SV = PSI_SV(ZREDTH1,ZREDR1,ZREDS1,ZRED2THS,ZRED2RS,ZPHI3,ZPSI3)
+CALL PSI_SV(D,CSTURB,KSV,ZREDTH1,ZREDR1,ZREDS1,ZRED2THS,ZRED2RS,ZPHI3,ZPSI3,ZPSI_SV)
!
! LES diagnostics
!
-IF (LLES_CALL) THEN
+IF (TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(ZPHI3,X_LES_SUBGRID_PHI3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZPHI3,TLES%X_LES_SUBGRID_PHI3)
IF(KRR/=0) THEN
- CALL LES_MEAN_SUBGRID(ZPSI3,X_LES_SUBGRID_PSI3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZPSI3,TLES%X_LES_SUBGRID_PSI3)
END IF
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!----------------------------------------------------------------------------
!
@@ -591,38 +493,48 @@ END IF
!* 4. TURBULENT CORRELATIONS : <w Rc>, <THl THl>, <THl Rnp>, <Rnp Rnp>
! ----------------------------------------------------------------
!
+
+IF (TURBN%LHARAT) THEN
+ ZLM(:,:)=PLENGTHH(:,:)
+ELSE
+ ZLM(:,:)=PLM(:,:)
+ENDIF
!
- CALL TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL,PTSTEP, &
- TPFILE, &
+ CALL TURB_VER_THERMO_FLUX(D,CST,CSTURB,TURBN,TLES, &
+ KRR,KRRL,KRRI,KSV,KGRADIENTS, &
+ OOCEAN,ODEEPOC, &
+ OCOUPLES,OCOMPUTE_SRC, &
+ PEXPL,PTSTEP,HPROGRAM,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PRHODJ,PTHVREF, &
+ PRHODJ,PTHVREF,PHGRAD,PZS, &
PSFTHM,PSFRM,PSFTHP,PSFRP, &
PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
+ PTKEM,ZLM,PLEPS, &
PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
ZBETA, ZSQRT_TKE, ZDTH_DZ, ZDR_DZ, ZRED2TH3, &
ZRED2R3, ZRED2THR3, ZBLL_O_E, ZETHETA, &
ZEMOIST, ZREDTH1, ZREDR1, ZPHI3, ZPSI3, ZD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH,ZWTHV, &
- PRTHLS,PRRS,ZTHLP,ZRP,PTP,PWTH,PWRC )
-!
- CALL TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- TPFILE, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
+ MFMOIST,PBL_DEPTH,ZWTHV, &
+ PRTHLS,PRRS,ZTHLP,ZRP,PTP,PWTH,PWRC, &
+ PSSTFL, PSSTFL_C, PSSRFL_C )
+!
+ CALL TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,TLES, &
+ KRR,KRRL,KRRI,KSV, &
+ OCOMPUTE_SRC, &
+ OCOUPLES, &
+ 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, &
+ PTKEM,ZLM,PLEPS, &
+ PLOCPEXNM,PATHETA,PAMOIST, &
ZBETA, ZSQRT_TKE, ZDTH_DZ, ZDR_DZ, ZRED2TH3, &
ZRED2R3, ZRED2THR3, ZBLL_O_E, ZETHETA, &
ZEMOIST, ZREDTH1, ZREDR1, ZPHI3, ZPSI3, ZD, &
PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
- ZTHLP,ZRP,PSIGS )
+ ZTHLP,ZRP,MFMOIST,PSIGS )
!
!----------------------------------------------------------------------------
!
@@ -637,18 +549,20 @@ END IF
!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
! -----------------------------------------------
!
-CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL,PTSTEP, &
- TPFILE, &
+!
+IF (TURBN%LHARAT) ZLM(:,:)=PLENGTHM(:,:)
+!
+CALL TURB_VER_DYN_FLUX(D,CST,CSTURB,TURBN,TLES,KSV,O2D,OFLAT, &
+ KRR,OOCEAN,OCOUPLES, &
+ PEXPL,PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
+ PRHODJ,PSFUM,PSFVM, &
PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,ZWU,ZWV, &
+ PTKEM,ZLM,MFMOIST,ZWU,ZWV, &
PRUS,PRVS,PRWS, &
- PDP,PTP )
+ PDP,PTP,PSSUFL_C,PSSVFL_C,PSSUFL,PSSVFL )
!
!----------------------------------------------------------------------------
!
@@ -656,26 +570,29 @@ CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
! -----------------------------------
!
-IF (SIZE(PSVM,4)>0) &
-CALL TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL,PTSTEP, &
- TPFILE, &
+IF (TURBN%LHARAT) ZLM(:,:)=PLENGTHH(:,:)
+!
+IF (KSV>0) &
+CALL TURB_VER_SV_FLUX(D,CST,CSTURB,TURBN,TLES,ONOMIXLG, &
+ KSV,KSV_LGBEG,KSV_LGEND, &
+ OBLOWSNOW, &
+ PEXPL,PTSTEP,TPFILE,PRSNOW, &
PDZZ,PDIRCOSZW, &
PRHODJ,PWM, &
PSFSVM,PSFSVP, &
PSVM, &
- PTKEM,PLM,ZPSI_SV, &
+ PTKEM,ZLM,MFMOIST,ZPSI_SV, &
PRSVS,PWSV )
!
!
-IF (SIZE(PSVM,4)>0 .AND. LLES_CALL) &
-CALL TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- PDZZ, &
+IF (KSV>0 .AND. TLES%LLES_CALL) &
+CALL TURB_VER_SV_CORR(D,CST,CSTURB,TLES,KRR,KRRL,KRRI,OOCEAN, &
+ PDZZ,KSV,KSV_LGBEG,KSV_LGEND,ONOMIXLG, &
+ OBLOWSNOW,OCOMPUTE_SRC,PRSNOW, &
PTHLM,PRM,PTHVREF, &
PLOCPEXNM,PATHETA,PAMOIST,PSRCM,ZPHI3,ZPSI3, &
PWM,PSVM, &
- PTKEM,PLM,PLEPS,ZPSI_SV )
+ PTKEM,ZLM,PLEPS,ZPSI_SV )
!
!
!----------------------------------------------------------------------------
@@ -683,7 +600,7 @@ CALL TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
!* 9. DIAGNOSTIC OF Surface Boundary Layer Depth
! ------------------------------------------
!
-IF (SIZE(PSBL_DEPTH)>0) CALL SBL_DEPTH(IKB,IKE,PZZ,ZWU,ZWV,ZWTHV,PLMO,PSBL_DEPTH)
+IF (TURBN%LRMC01) CALL SBL_DEPTH(D,CSTURB,PZZ,ZWU,ZWV,ZWTHV,PLMO,PSBL_DEPTH)
!
!----------------------------------------------------------------------------
!
@@ -692,7 +609,7 @@ IF (SIZE(PSBL_DEPTH)>0) CALL SBL_DEPTH(IKB,IKE,PZZ,ZWU,ZWV,ZWTHV,PLMO,PSBL_DEPTH
! ------
!
!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED .AND. .NOT. TURBN%LHARAT) THEN
!
! stores the Turbulent Prandtl number
!
@@ -706,7 +623,7 @@ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZPHI3)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZPHI3)
!
! stores the Turbulent Schmidt number
!
@@ -720,7 +637,7 @@ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZPSI3)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZPSI3)
!
!
! stores the Turbulent Schmidt number for the scalar variables
@@ -732,15 +649,17 @@ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- DO JSV=1,NSV
+ DO JSV=1,KSV
WRITE(TZFIELD%CMNHNAME, '("PSI_SV_",I3.3)') JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_Field_write(TPFILE,TZFIELD,ZPSI_SV(:,:,:,JSV))
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZPSI_SV(:,:,JSV))
END DO
!
END IF
!
!
!----------------------------------------------------------------------------
-END SUBROUTINE TURB_VER
+IF (LHOOK) CALL DR_HOOK('TURB_VER',1,ZHOOK_HANDLE)
+END SUBROUTINE TURB_VER
+END MODULE MODE_TURB_VER
diff --git a/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90 b/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
index 51bc4e7e1b868799b038e1e56b089bd2cb88ae22..f68fc2d2377fd6263dac088a2fc9570162bf782f 100644
--- a/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
@@ -2,103 +2,21 @@
!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,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, &
+MODULE MODE_TURB_VER_DYN_FLUX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_DYN_FLUX(D,CST,CSTURB,TURBN,TLES,KSV,O2D,OFLAT, &
+ KRR,OOCEAN,OCOUPLES, &
+ PEXPL,PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ, &
+ PSFUM,PSFVM, &
PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,PWU,PWV, &
+ PTKEM,PLM,MFMOIST,PWU,PWV, &
PRUS,PRVS,PRWS, &
- PDP,PTP )
+ PDP,PTP,PSSUFL_C,PSSVFL_C,PSSUFL,PSSVFL )
! ###############################################################
!
!
@@ -108,13 +26,13 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! PURPOSE
!! -------
! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
+! 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
+! 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
@@ -122,8 +40,8 @@ END MODULE MODI_TURB_VER_DYN_FLUX
! * 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.
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
!
!!** METHOD
!! ------
@@ -132,27 +50,27 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! 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
+!! 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
+!! (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
+!! ( 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.
-!!
+!! 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
+!! 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
+!! 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.
@@ -163,68 +81,65 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! 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
+!! 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
+!! 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
+!! 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
+!! and in section 7, a diagnostic computation of the W variance is
!! performed.
!!
-!! In section 8, the turbulent fluxes for the scalar variables are
+!! 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_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
+!! _(M,U,...)_ represent the localization of the
!! field to be derivated
-!! _(M,UW,...) represent the localization of the
+!! _(M,UW,...) represent the localization of the
!! field derivated
-!!
+!!
!!
!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
+!! : 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
+!! : Shuman functions (difference operators)
!!
!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
!! of a variable located at a wind point
!!
-!! FUNCTIONs ETHETA and EMOIST :
+!! 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
+!! 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'
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : contains physical constants
!!
-!! XG : gravity constant
+!! CST%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
+!! CSTURB%XCMFS,XCMFB : cts for the momentum flux
+!! CSTURB%XCSHF : ct for the sensible heat flux
+!! CSTURB%XCHF : ct for the moisture flux
+!! CSTURB%XCTV,CSTURB%XCHV : cts for the T and moisture variances
!!
!! Module MODD_PARAMETERS
!!
@@ -243,74 +158,76 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! MODIFICATIONS
!! -------------
!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Modifications: March 21, 1995 (J.M. Carriere)
!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! 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)
+!! 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)
+!! 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
+!! 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
+!! 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)
+!! 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: 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
+!! Modifications: Oct 18, 2000 (V. Masson) LES computations + OFLAT 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
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Modifications July 2015 (Wim de Rooy) TURBN%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
+!! Modification June 2019 (Wim de Rooy) 50*MF term can be removed with
+!! inclusion of energy cascade
!! JL Redelsperger 03/2021 : Add Ocean & O-A Autocoupling LES Cases
!!--------------------------------------------------------------------------
-!
+!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
-use modd_field, only: tfielddata, TYPEREAL
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+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 MODD_LES, ONLY: TLES_t
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
+USE MODD_TURB_n, ONLY: TURB_t
+!
+USE SHUMAN_PHY
+USE MODE_GRADIENT_U_PHY, ONLY : GZ_U_UW_PHY, GX_U_M_PHY
+USE MODE_GRADIENT_V_PHY, ONLY : GZ_V_VW_PHY, GY_V_M_PHY
+USE MODE_GRADIENT_W_PHY, ONLY : GX_W_UW_PHY, GY_W_VW_PHY, GZ_W_M_PHY
+USE MODE_GRADIENT_M_PHY, ONLY : GX_M_U_PHY, GY_M_V_PHY
+!
USE MODI_SECOND_MNH
-USE MODI_SHUMAN
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODI_LES_MEAN_SUBGRID
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_TRIDIAG_WIND, ONLY: TRIDIAG_WIND
+USE MODI_LES_MEAN_SUBGRID_PHY
+!
+USE MODE_IO_FIELD_WRITE, only: IO_FIELD_WRITE_PHY
USE MODE_ll
!
IMPLICIT NONE
@@ -319,56 +236,66 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
+INTEGER, INTENT(IN) :: KSV ! number of scalar variables
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
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) :: 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+REAL, DIMENSION(D%NIJT), 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSINSLOPE ! sinus of the angle
! between i and the slope vector
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(D%NIJT,D%NKT), 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
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFUM,PSFVM ! normal momentum sfc flux
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
+REAL, DIMENSION(D%NIJT), 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(D%NIJT), INTENT(IN) :: PTAU12M ! <uv> in the same axes
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM, PTHLM
+REAL, DIMENSION(D%NIJT,D%NKT), 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
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PRM
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PUSLOPEM ! wind component along the
! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
+REAL, DIMENSION(D%NIJT), 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(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWU ! momentum flux u'w'
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWV ! momentum flux v'w'
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
+REAL, DIMENSION(D%NIJT,D%NKT), 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDP ! Dynamic TKE production term
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTP ! Thermal TKE production term
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSUFL_C ! Time evol Flux of U at sea surface (LOCEAN)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSVFL_C !
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSUFL
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSVFL !
!
!
!
@@ -376,170 +303,218 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Thermal TKE production t
!* 0.2 declaration of local variables
!
!
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2)) :: ZDIRSINZW ! sinus of the angle
+REAL, DIMENSION(D%NIJT) :: 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)) :: &
+REAL, DIMENSION(D%NIJT):: ZCOEFS, & ! coeff. for the implicit scheme for the wind at the surface
+ ZWORK11D,ZWORK21D,ZWORK31D,ZWORK41D,ZWORK51D,ZWORK61D
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
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
+ ! 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 !
+ ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
+ ZWORK1,ZWORK2,&
+ ZWORK3,ZWORK4,&
+ ZWORK5,ZWORK6! working var. for shuman operators (array syntax)
+!
+INTEGER :: IIJE,IIJB,IKB,IKE,IKA,IKU ! index value for the mass points of the domain
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
+INTEGER :: JSV,JIJ,JK ! scalar loop counter
+INTEGER :: IKL
+REAL, DIMENSION(D%NIJT) :: ZCOEFFLXU, &
+ ZCOEFFLXV, ZUSLOPEM, ZVSLOPEM, &
+ ZFLUXSFCU,ZFLUXSFCV
! 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
+ ! PVSLOPEM in local 3D arrays
!
-REAL :: ZTIME1, ZTIME2
+REAL :: ZTIME1, ZTIME2, ZCMFS
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
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB_VER_DYN_FLUX',0,ZHOOK_HANDLE)
+!
+ZA(:,:)=XUNDEF
+PDP(:,:)=XUNDEF
+!
+IKT=D%NKT
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
+IIJE=D%NIJE
+IIJB=D%NIJB
+!
+ZSOURCE(:,:) = 0.
+ZFLXZ(:,:) = 0.
+ZCMFS = CSTURB%XCMFS
+IF (TURBN%LHARAT) ZCMFS=1.
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZDIRSINZW(IIJB:IIJE) = SQRT(1.-PDIRCOSZW(IIJB:IIJE)**2)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+! compute the coefficients for the uncentred gradient computation near the
! ground
!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+! With TURBN%LHARATU length scale and TKE are at half levels so remove MZM
!
-ZUSLOPEM(:,:,1)=PUSLOPEM(:,:)
-ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
+IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZKEFF(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZKEFF)
+ENDIF
+!
+ZUSLOPEM(IIJB:IIJE)=PUSLOPEM(IIJB:IIJE)
+ZVSLOPEM(IIJB:IIJE)=PVSLOPEM(IIJB:IIJE)
+ZFLUXSFCU(IIJB:IIJE)=PSFUM(IIJB:IIJE)
+ZFLUXSFCV(IIJB:IIJE)=PSFVM(IIJB:IIJE)
!
!----------------------------------------------------------------------------
!
!
-!* 5. SOURCES OF U,W WIND COMPONENTS AND PARTIAL DYNAMIC PRODUCTION
+!* 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
+! Preparation of the arguments for TRIDIAG_WIND
!
-ZA(:,:,:) = -PTSTEP * XCMFS * &
- MXM( ZKEFF ) * MXM(MZM( PRHODJ )) / &
- MXM( PDZZ )**2
+CALL MXM_PHY(D,ZKEFF,ZWORK1)
+CALL MXM_PHY(D,PDZZ,ZWORK2)
+CALL MZM_PHY(D,PRHODJ,ZWORK3)
+CALL MXM_PHY(D,ZWORK3,ZWORK4)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZA(IIJB:IIJE,1:IKT) = -PTSTEP * ZCMFS * ZWORK1(IIJB:IIJE,1:IKT)* ZWORK4(IIJB:IIJE,1:IKT) &
+ / ZWORK2(IIJB:IIJE,1:IKT)**2
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
-! Compute the source of U wind component
+! Compute the source of U wind component
!
-! compute the coefficient between the vertical flux and the 2 components of the
+! 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(:,:)
-
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZCOEFFLXU(IIJB:IIJE) = PCDUEFF(IIJB:IIJE) * (PDIRCOSZW(IIJB:IIJE)**2 - ZDIRSINZW(IIJB:IIJE)**2) &
+ * PCOSSLOPE(IIJB:IIJE)
+ZCOEFFLXV(IIJB:IIJE) = PCDUEFF(IIJB:IIJE) * PDIRCOSZW(IIJB:IIJE) * PSINSLOPE(IIJB:IIJE)
+!
! prepare the implicit scheme coefficients for the surface flux
-ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) &
- +ZCOEFFLXV(:,:,1) * PSINSLOPE(:,:)
+ZCOEFS(IIJB:IIJE)= ZCOEFFLXU(IIJB:IIJE) * PCOSSLOPE(IIJB:IIJE) * PDIRCOSZW(IIJB:IIJE) &
+ +ZCOEFFLXV(IIJB:IIJE) * PSINSLOPE(IIJB:IIJE)
!
! average this flux to be located at the U,W vorticity point
-ZCOEFS(:,:,1:1)=MXM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ZWORK11D(IIJB:IIJE)=ZCOEFS(IIJB:IIJE) / PDZZ(IIJB:IIJE,IKB)
+CALL MXM2D_PHY(D,ZWORK11D,ZCOEFS)
!
!
-! 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
+ZSOURCE(IIJB:IIJE,IKTB+1:IKTE-1) = 0.
+! ZSOURCE= sfc FLUX /DZ
+! Sfx flux assumed to be in SI & at vorticity point
+CALL MXM_PHY(D,PRHODJ,ZWORK1)
!
+IF (OOCEAN) THEN ! Ocean model
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK21D(IIJB:IIJE) = ZFLUXSFCU(IIJB:IIJE)/PDZZ(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MXM2D_PHY(D,ZWORK21D,ZWORK31D)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE(IIJB:IIJE,IKE) = ZWORK31D(IIJB:IIJE) &
+ *0.5 * ( 1. + ZWORK1(IIJB:IIJE,IKU) / ZWORK1(IIJB:IIJE,IKE))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !
+ ! Zero flux at the ocean domain bottom
+ ZSOURCE(IIJB:IIJE,IKB) = 0.
+ !
+ELSE ! Atmosphere
+ ! Compute the explicit tangential flux at the W point
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE(IIJB:IIJE,IKB) = &
+ PTAU11M(IIJB:IIJE) * PCOSSLOPE(IIJB:IIJE) * PDIRCOSZW(IIJB:IIJE) * ZDIRSINZW(IIJB:IIJE) &
+ -PTAU12M(IIJB:IIJE) * PSINSLOPE(IIJB:IIJE) * ZDIRSINZW(IIJB:IIJE) &
+ -PTAU33M(IIJB:IIJE) * PCOSSLOPE(IIJB:IIJE) * ZDIRSINZW(IIJB:IIJE) * PDIRCOSZW(IIJB:IIJE)
+!
+ ! add the vertical part or the surface flux at the U,W vorticity point
+!
+ ZWORK31D(IIJB:IIJE) = ZSOURCE(IIJB:IIJE,IKB)/PDZZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MXM2D_PHY(D,ZWORK31D,ZWORK41D)
+ ZWORK51D(IIJB:IIJE)= ZCOEFFLXU(IIJB:IIJE) / PDZZ(IIJB:IIJE,IKB) &
+ *ZUSLOPEM(IIJB:IIJE) &
+ -ZCOEFFLXV(IIJB:IIJE) / PDZZ(IIJB:IIJE,IKB) &
+ *ZVSLOPEM(IIJB:IIJE)
+ CALL MXM2D_PHY(D,ZWORK51D,ZWORK61D)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE(IIJB:IIJE,IKB) = &
+ ( ZWORK41D(IIJB:IIJE) &
+ + ZWORK61D(IIJB:IIJE) &
+ - ZCOEFS(IIJB:IIJE) * PUM(IIJB:IIJE,IKB) * TURBN%XIMPL &
+ ) * 0.5 * ( 1. + ZWORK1(IIJB:IIJE,IKA) / ZWORK1(IIJB:IIJE,IKB) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+ ZSOURCE(IIJB:IIJE,IKE) = 0.
+ENDIF
+!
+! Obtention of the split U at t+ deltat
+!
+CALL TRIDIAG_WIND(D,PUM,ZA,ZCOEFS,PTSTEP,PEXPL,TURBN%XIMPL, &
+ ZWORK1,ZSOURCE,ZRES)
!
-!* 5.2 Partial Dynamic Production
+! Compute the equivalent tendency for the U wind component
!
-! vertical flux of the U wind component
+CALL MXM_PHY(D,PRHODJ,ZWORK1)
+CALL MXM_PHY(D,ZKEFF,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK3(IIJB:IIJE,1:IKT)=TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT) + PEXPL*PUM(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL DZM_PHY(D,ZWORK3,ZWORK4)
+CALL MXM_PHY(D,PDZZ,ZWORK5)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PRUS(IIJB:IIJE,1:IKT)= PRUS(IIJB:IIJE,1:IKT)+ZWORK1(IIJB:IIJE,1:IKT)*(ZRES(IIJB:IIJE,1:IKT) &
+ - PUM(IIJB:IIJE,1:IKT))/PTSTEP
!
-ZFLXZ(:,:,:) = -XCMFS * MXM(ZKEFF) * &
- DZM (PIMPL*ZRES + PEXPL*PUM) / MXM(PDZZ)
+!* 5.2 Partial TKE Dynamic Production
!
-! 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)) )
+! vertical flux of the U wind component
!
-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)
+ZFLXZ(IIJB:IIJE,1:IKT) = -ZCMFS * ZWORK2(IIJB:IIJE,1:IKT) * ZWORK4(IIJB:IIJE,1:IKT) &
+ / ZWORK5(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+IF (OOCEAN) THEN
+ ZFLXZ(IIJB:IIJE,IKE+1) = ZFLUXSFCU(IIJB:IIJE)
+ELSE
+ ! surface flux
+ CALL MXM_PHY(D,PDZZ,ZWORK1)
+ CALL MXM_PHY(D,PRHODJ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = ZWORK1(IIJB:IIJE,IKB) * &
+ ( ZSOURCE(IIJB:IIJE,IKB) &
+ +ZCOEFS(IIJB:IIJE) * ZRES(IIJB:IIJE,IKB) * TURBN%XIMPL &
+ ) / 0.5 / ( 1. + ZWORK2(IIJB:IIJE,IKA)/ ZWORK2(IIJB:IIJE,IKB) )
+ !
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
! stores the U wind component vertical flux
TZFIELD%CMNHNAME = 'UW_VFLX'
TZFIELD%CSTDNAME = ''
@@ -551,223 +526,361 @@ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,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)) &
- )
+PWU(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT)
+!
+! Contribution to the TKE dynamic production of TKE
+! (computed at mass point)
+!
+CALL GZ_U_UW_PHY(D,PUM,PDZZ,ZWORK1)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MXF_PHY(D,ZWORK2,ZWORK3)
+CALL MZF_PHY(D,ZWORK3,ZWORK4)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PDP(IIJB:IIJE,1:IKT) = -ZWORK4(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+! Special cases near surface
+CALL MXM_PHY(D,PDZZ,ZWORK1)
+IF (OOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE) and store in PDP(IKE)
+ ! before to be extrapolated in tke_eps routine
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK2(IIJB:IIJE,IKE) = ZFLXZ(IIJB:IIJE,IKE) * (PUM(IIJB:IIJE,IKE)-PUM(IIJB:IIJE,IKE-IKL)) &
+ / ZWORK1(IIJB:IIJE,IKE-IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MXF_PHY(D,ZWORK2,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PDP(IIJB:IIJE,IKE) = -ZWORK3(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ELSE ! Atmosphere
+ ! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK2(IIJB:IIJE,IKB) = ZFLXZ(IIJB:IIJE,IKB+IKL) * (PUM(IIJB:IIJE,IKB+IKL)-PUM(IIJB:IIJE,IKB)) &
+ / ZWORK1(IIJB:IIJE,IKB+IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MXF_PHY(D,ZWORK2,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PDP(IIJB:IIJE,IKB) = -ZWORK3(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
-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
+!
+IF (TLES%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 MXF_PHY(D,ZFLXZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_WU )
+ !
+ CALL GZ_U_UW_PHY(D,PUM,PDZZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MXF_PHY(D,ZWORK1,ZWORK2)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_U_SBG_UaU )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZCMFS * ZKEFF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK1, TLES%X_LES_SUBGRID_Km )
+ !
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!* 5.3 Source of W wind component
!
!
-IF(HTURBDIM=='3DIM') THEN
+IF(TURBN%CTURBDIM=='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
-
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = 2 * ZFLXZ(IIJB:IIJE,IKB) - ZFLXZ(IIJB:IIJE,IKB+IKL) ! extrapolation
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKU) = 2 * ZFLXZ(IIJB:IIJE,IKE) - ZFLXZ(IIJB:IIJE,IKE-IKL) ! extrapolation
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END IF
+ !
+ CALL MXM_PHY(D,PRHODJ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) / PDXX(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DXF_PHY(D,ZWORK2,ZWORK1)
!
- IF (.NOT. LFLAT) THEN
- PRWS(:,:,:)= PRWS &
- -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ ) &
- +DZM( PRHODJ / MZF(PDZZ ) * &
- MXF( MZF( ZFLXZ*PDZX ) / PDXX ) &
- )
+ IF (.NOT. OFLAT) THEN
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT)*PDZX(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = ZWORK3(IIJB:IIJE,1:IKT) / PDXX(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MXF_PHY(D,ZWORK3,ZWORK2)
+ CALL MZF_PHY(D,PDZZ,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = PRHODJ(IIJB:IIJE,1:IKT) &
+ / ZWORK3(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZM_PHY(D,ZWORK3,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRWS(IIJB:IIJE,1:IKT) = PRWS(IIJB:IIJE,1:IKT) - ZWORK1(IIJB:IIJE,1:IKT) &
+ + ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- PRWS(:,:,:)= PRWS -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRWS(IIJB:IIJE,1:IKT)= PRWS(IIJB:IIJE,1:IKT) - ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
- ! Complete the Dynamical production with the W wind component
- !
- ZA(:,:,:)=-MZF( MXF ( ZFLXZ * GX_W_UW( PWM,PDXX,PDZZ,PDZX) ) )
+ ! Complete the TKE dynamical production with the W wind contribution
!
+ CALL GX_W_UW_PHY(D,OFLAT,PWM,PDXX,PDZZ,PDZX, ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MXF_PHY(D,ZWORK1,ZWORK2)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,1:IKT) = -ZWORK3(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
- ! 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))) &
- )
+ ! Special cases near surface
+ CALL DXM_PHY(D,PWM,ZWORK1)
+ IF (OOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE) in PDP(IKE)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK31D(IIJB:IIJE) = - ZFLXZ(IIJB:IIJE,IKE) * ZWORK1(IIJB:IIJE,IKE) &
+ / (0.5*(PDXX(IIJB:IIJE,IKE-IKL)+PDXX(IIJB:IIJE,IKE)))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MXF2D_PHY(D,ZWORK31D,ZWORK41D)
+ ZA(IIJB:IIJE,IKE) = ZWORK41D(IIJB:IIJE)
!
-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
+ ELSE !Atmosphere
+ ! evaluate the dynamic production at w(IKB+IKL) in PDP(IKB)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK21D(IIJB:IIJE) = (PWM(IIJB:IIJE,IKB+2*IKL)-PWM(IIJB:IIJE,IKB+IKL)) &
+ / (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) &
+ + (PWM(IIJB:IIJE,IKB+IKL)-PWM(IIJB:IIJE,IKB)) &
+ / (PDZZ(IIJB:IIJE,IKB+IKL)+PDZZ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !
+ CALL MXM2D_PHY(D,ZWORK21D,ZWORK51D)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK31D(IIJB:IIJE) = - ZFLXZ(IIJB:IIJE,IKB+IKL) &
+ * ( ZWORK1(IIJB:IIJE,IKB+IKL) - ZWORK51D(IIJB:IIJE) &
+ * PDZX(IIJB:IIJE,IKB+IKL) ) &
+ / (0.5*(PDXX(IIJB:IIJE,IKB+IKL)+PDXX(IIJB:IIJE,IKB)))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MXF2D_PHY(D,ZWORK31D,ZWORK41D)
+ ZA(IIJB:IIJE,IKB) = ZWORK41D(IIJB:IIJE)
+ !
+ END IF
!
- PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PDP(IIJB:IIJE,1:IKT)=PDP(IIJB:IIJE,1:IKT)+ZA(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! Storage in the LES configuration
- !
- IF (LLES_CALL) THEN
+ !
+ IF (TLES%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 )
+ !
+ CALL GX_W_UW_PHY(D,OFLAT,PWM,PDXX,PDZZ,PDZX,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MXF_PHY(D,ZWORK1,ZWORK2)
+ CALL MZF_PHY(D,ZWORK2,ZWORK1)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_RES_ddxa_W_SBG_UaW )
+ !
+ CALL GX_M_U_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZWORK1)
+ CALL MZF_PHY(D,ZFLXZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MXF_PHY(D,ZWORK2,ZWORK1)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%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 )
+ CALL GX_U_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZWORK1)
+ CALL MZF_PHY(D,ZFLXZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MXF_PHY(D,ZWORK1,ZWORK2)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%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) )
+ DO JSV=1,KSV
+ CALL GX_U_M_PHY(D,OFLAT,PSVM(:,:,JSV),PDXX,PDZZ,PDZX,ZWORK1)
+ CALL MZF_PHY(D,ZFLXZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MXF_PHY(D,ZWORK1,ZWORK2)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
END DO
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
END IF
!
!----------------------------------------------------------------------------
!
!
-!* 6. SOURCES OF V,W WIND COMPONENTS AND COMPLETE 1D DYNAMIC PRODUCTION
+!* 6. SOURCES OF V,W WIND COMPONENTS AND COMPLETE 1D TKE 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
+CALL MYM_PHY(D,ZKEFF,ZWORK1)
+CALL MYM_PHY(D,PDZZ,ZWORK2)
+CALL MZM_PHY(D,PRHODJ,ZWORK3)
+CALL MYM_PHY(D,ZWORK3,ZWORK4)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZA(IIJB:IIJE,1:IKT) = -PTSTEP * ZCMFS * ZWORK1(IIJB:IIJE,1:IKT)* ZWORK4(IIJB:IIJE,1:IKT) &
+ / ZWORK2(IIJB:IIJE,1:IKT)**2
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
!
! Compute the source of V wind component
-! compute the coefficient between the vertical flux and the 2 components of the
+! 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(:,:)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZCOEFFLXU(IIJB:IIJE) = PCDUEFF(IIJB:IIJE) * (PDIRCOSZW(IIJB:IIJE)**2 - ZDIRSINZW(IIJB:IIJE)**2) &
+ * PSINSLOPE(IIJB:IIJE)
+ZCOEFFLXV(IIJB:IIJE) = PCDUEFF(IIJB:IIJE) * PDIRCOSZW(IIJB:IIJE) * PCOSSLOPE(IIJB:IIJE)
! prepare the implicit scheme coefficients for the surface flux
-ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
- +ZCOEFFLXV(:,:,1) * PCOSSLOPE(:,:)
+ZCOEFS(IIJB:IIJE)= ZCOEFFLXU(IIJB:IIJE) * PSINSLOPE(IIJB:IIJE) * PDIRCOSZW(IIJB:IIJE) &
+ +ZCOEFFLXV(IIJB:IIJE) * PCOSSLOPE(IIJB:IIJE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
! 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
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZWORK11D(IIJB:IIJE)=ZCOEFS(IIJB:IIJE) / PDZZ(IIJB:IIJE,IKB)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+CALL MYM2D_PHY(D,ZWORK11D,ZCOEFS)
+!
+! No flux in SOURCE TERM NULL OUTSIDE BC
+ZSOURCE(IIJB:IIJE,IKB+1:IKE-1) = 0.
+! Surface case
+CALL MYM_PHY(D,PRHODJ,ZWORK1)
+IF (OOCEAN) THEN ! Ocean case
+ ZCOEFFLXU(IIJB:IIJE) = PCDUEFF(IIJB:IIJE)
+ ZCOEFFLXV(IIJB:IIJE) = PCDUEFF(IIJB:IIJE)
+ ZCOEFS(IIJB:IIJE)=ZCOEFFLXU(IIJB:IIJE)
+ ! average this flux to be located at the U,W vorticity point
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK11D(IIJB:IIJE) = ZCOEFS(IIJB:IIJE) / PDZZ(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MYM2D_PHY(D,ZWORK11D,ZCOEFS)
+ !
+ ZWORK11D(IIJB:IIJE) = ZFLUXSFCV(IIJB:IIJE) / PDZZ(IIJB:IIJE,IKE)
+ CALL MYM2D_PHY(D,ZWORK11D,ZWORK21D)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE(IIJB:IIJE,IKE) = ZWORK21D(IIJB:IIJE) &
+ *0.5 * ( 1. + ZWORK1(IIJB:IIJE,IKU) / ZWORK1(IIJB:IIJE,IKE))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!No flux at the ocean domain bottom
- ZSOURCE(:,:,IKB) = 0.
+ ZSOURCE(IIJB:IIJE,IKB) = 0.
+!
ELSE ! Atmos case
- IF (.NOT.LCOUPLES) THEN ! only atmosp without coupling
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK31D(IIJB:IIJE) = ZCOEFFLXU(IIJB:IIJE) / PDZZ(IIJB:IIJE,IKB) &
+ *ZUSLOPEM(IIJB:IIJE) &
+ +ZCOEFFLXV(IIJB:IIJE) / PDZZ(IIJB:IIJE,IKB) &
+ *ZVSLOPEM(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MYM2D_PHY(D,ZWORK31D,ZWORK61D)
+ !
! compute the explicit tangential flux at the W point
- ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- +PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE(IIJB:IIJE,IKB) = &
+ PTAU11M(IIJB:IIJE) * PSINSLOPE(IIJB:IIJE) * PDIRCOSZW(IIJB:IIJE) * ZDIRSINZW(IIJB:IIJE) &
+ +PTAU12M(IIJB:IIJE) * PCOSSLOPE(IIJB:IIJE) * ZDIRSINZW(IIJB:IIJE) &
+ -PTAU33M(IIJB:IIJE) * PSINSLOPE(IIJB:IIJE) * ZDIRSINZW(IIJB:IIJE) * PDIRCOSZW(IIJB:IIJE)
+ !
+ ZWORK31D(IIJB:IIJE) = ZSOURCE(IIJB:IIJE,IKB)/PDZZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MYM2D_PHY(D,ZWORK31D,ZWORK51D)
!
! 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
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE(IIJB:IIJE,IKB) = &
+ ( ZWORK51D(IIJB:IIJE) &
+ + ZWORK61D(IIJB:IIJE) &
+ - ZCOEFS(IIJB:IIJE) * PVM(IIJB:IIJE,IKB) * TURBN%XIMPL &
+ ) * 0.5 * ( 1. + ZWORK1(IIJB:IIJE,IKA) / ZWORK1(IIJB:IIJE,IKB) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
!No flux at the atmosphere top
- ZSOURCE(:,:,IKE) = 0.
+ ZSOURCE(IIJB:IIJE,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)
+CALL TRIDIAG_WIND(D,PVM,ZA,ZCOEFS,PTSTEP,PEXPL,TURBN%XIMPL, &
+ ZWORK1,ZSOURCE,ZRES)
!
! Compute the equivalent tendency for the V wind component
!
-PRVS(:,:,:)=PRVS(:,:,:)+MYM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PVM(:,:,:))/PTSTEP
+CALL MYM_PHY(D,PRHODJ,ZWORK1)
+CALL MYM_PHY(D,ZKEFF,ZWORK2)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK3(IIJB:IIJE,1:IKT)=TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT) + PEXPL*PVM(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL DZM_PHY(D,ZWORK3,ZWORK4)
+CALL MYM_PHY(D,PDZZ,ZWORK5)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PRVS(IIJB:IIJE,1:IKT) = PRVS(IIJB:IIJE,1:IKT)+ZWORK1(IIJB:IIJE,1:IKT)*(ZRES(IIJB:IIJE,1:IKT)&
+ - PVM(IIJB:IIJE,1:IKT))/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)
+ZFLXZ(IIJB:IIJE,1:IKT) = -ZCMFS * ZWORK2(IIJB:IIJE,1:IKT) * ZWORK4(IIJB:IIJE,1:IKT) &
+ / ZWORK5(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+IF (OOCEAN) THEN
+ ZFLXZ(IIJB:IIJE,IKE+1) = ZFLUXSFCV(IIJB:IIJE)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = ZWORK5(IIJB:IIJE,IKB) * &
+ ( ZSOURCE(IIJB:IIJE,IKB) &
+ +ZCOEFS(IIJB:IIJE) * ZRES(IIJB:IIJE,IKB) * TURBN%XIMPL &
+ ) / 0.5 / ( 1. + ZWORK1(IIJB:IIJE,IKA) / ZWORK1(IIJB:IIJE,IKB) )
+ !
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
! stores the V wind component vertical flux
TZFIELD%CMNHNAME = 'VW_VFLX'
TZFIELD%CSTDNAME = ''
@@ -779,117 +892,214 @@ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,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)) &
- )
+PWV(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT)
+!
+! Contribution to the TKE dynamical production
+! computed at mass point
+!
+CALL GZ_V_VW_PHY(D,PVM,PDZZ,ZWORK1)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL MYF_PHY(D,ZWORK2,ZWORK3)
+CALL MZF_PHY(D,ZWORK3,ZWORK4)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZA(IIJB:IIJE,1:IKT) = -ZWORK4(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+! Special cases at surface
+CALL MYM_PHY(D,PDZZ,ZWORK1)
+IF (OOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE) in PDP(IKE)
+ ! before extrapolation done in routine tke_eps_source
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK2(IIJB:IIJE,IKE) = ZFLXZ(IIJB:IIJE,IKE) * (PVM(IIJB:IIJE,IKE)-PVM(IIJB:IIJE,IKE-IKL)) &
+ / ZWORK1(IIJB:IIJE,IKE-IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MYF_PHY(D,ZWORK2,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,IKE) = -ZWORK3(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+ELSE ! Atmosphere
+ ! evaluate the dynamic production at w(IKB+IKL) in PDP(IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK2(IIJB:IIJE,IKB) = ZFLXZ(IIJB:IIJE,IKB+IKL) * (PVM(IIJB:IIJE,IKB+IKL)-PVM(IIJB:IIJE,IKB)) &
+ / ZWORK1(IIJB:IIJE,IKB+IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MYF_PHY(D,ZWORK2,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,IKB) = -ZWORK3(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
!
-PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PDP(IIJB:IIJE,1:IKT)=PDP(IIJB:IIJE,1:IKT)+ZA(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! Storage in the LES configuration
!
-IF (LLES_CALL) THEN
+IF (TLES%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 MYF_PHY(D,ZFLXZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_WV )
+ !
+ CALL GZ_V_VW_PHY(D,PVM,PDZZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MYF_PHY(D,ZWORK1,ZWORK2)
+ CALL MZF_PHY(D,ZWORK2,ZWORK1)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_RES_ddxa_V_SBG_UaV )
+ !
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
!
-!* 6.3 Source of W wind component
+!* 6.3 Source of W wind component
!
-IF(HTURBDIM=='3DIM') THEN
+IF(TURBN%CTURBDIM=='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
+ IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKE+IKL) = 2 * ZFLXZ(IIJB:IIJE,IKE) - ZFLXZ(IIJB:IIJE,IKE-IKL) ! extrapolation
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = 2 * ZFLXZ(IIJB:IIJE,IKB) - ZFLXZ(IIJB:IIJE,IKB+IKL) ! extrapolation
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
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 ) &
- )
+ IF (.NOT. O2D) THEN
+ CALL MYM_PHY(D,PRHODJ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) / PDYY(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DYF_PHY(D,ZWORK2,ZWORK1)
+ !
+ !ZWORK1 = DYF( MZM(MYM(PRHODJ) /PDYY, IKA, IKU, IKL) * ZFLXZ )
+ IF (.NOT. OFLAT) THEN
+ CALL MZF_PHY(D,PDZZ,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) * PDZY(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK4)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK4(IIJB:IIJE,1:IKT) = ZWORK4(IIJB:IIJE,1:IKT) / PDYY(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MYF_PHY(D,ZWORK4,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = PRHODJ(IIJB:IIJE,1:IKT) / ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZM_PHY(D,ZWORK3,ZWORK2)
+ !ZWORK2 = DZM(PRHODJ / MZF(PDZZ) * MYF(MZF(ZFLXZ*PDZY) / PDYY ) )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRWS(IIJB:IIJE,1:IKT) = PRWS(IIJB:IIJE,1:IKT) - ZWORK1(IIJB:IIJE,1:IKT) &
+ + ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- PRWS(:,:,:)= PRWS(:,:,:) -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRWS(IIJB:IIJE,1:IKT)= PRWS(IIJB:IIJE,1:IKT) - ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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))) &
- )
+ IF (.NOT. O2D) THEN
+ CALL GY_W_VW_PHY(D,OFLAT,PWM,PDYY,PDZZ,PDZY, ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MYF_PHY(D,ZWORK1,ZWORK2)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,1:IKT) = -ZWORK3(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !
+ CALL DYM_PHY(D,PWM,ZWORK1)
+ ! Special case near surface
+ IF (OOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE) and stored in PDP(IKE)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK31D(IIJB:IIJE) = - ZFLXZ(IIJB:IIJE,IKE) * ZWORK1(IIJB:IIJE,IKE) &
+ / (0.5*(PDYY(IIJB:IIJE,IKE-IKL)+PDYY(IIJB:IIJE,IKE)))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MYF2D_PHY(D,ZWORK31D,ZWORK41D)
+ ZA(IIJB:IIJE,IKE) = ZWORK41D(IIJB:IIJE)
+ ELSE ! Atmosphere
+ ! evaluate the dynamic production at w(IKB+KKL) and stored in PDP(IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK21D(IIJB:IIJE) = (PWM(IIJB:IIJE,IKB+2*IKL )-PWM(IIJB:IIJE,IKB+IKL)) &
+ / (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) &
+ + (PWM(IIJB:IIJE,IKB+IKL)-PWM(IIJB:IIJE,IKB)) &
+ / (PDZZ(IIJB:IIJE,IKB+IKL)+PDZZ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !
+ CALL MYM2D_PHY(D,ZWORK21D,ZWORK51D)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK31D(IIJB:IIJE ) = - ZFLXZ(IIJB:IIJE,IKB+IKL) &
+ * ( ZWORK1(IIJB:IIJE,IKB+IKL) - ZWORK51D(IIJB:IIJE ) &
+ * PDZY(IIJB:IIJE,IKB+IKL) ) &
+ / (0.5*(PDYY(IIJB:IIJE,IKB+IKL)+PDYY(IIJB:IIJE,IKB)))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MYF2D_PHY(D,ZWORK31D,ZWORK41D)
+ ZA(IIJB:IIJE,IKB) = ZWORK41D(IIJB:IIJE)
+ !
END IF
-!
- PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PDP(IIJB:IIJE,1:IKT)=PDP(IIJB:IIJE,1:IKT)+ZA(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
END IF
!
! Storage in the LES configuration
!
- IF (LLES_CALL) THEN
+ IF (TLES%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. )
+ !
+ CALL GY_W_VW_PHY(D,OFLAT,PWM,PDYY,PDZZ,PDZY,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MYF_PHY(D,ZWORK1,ZWORK2)
+ CALL MZF_PHY(D,ZWORK2,ZWORK1)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1,TLES%X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
+ !
+ CALL GY_M_V_PHY(D,OFLAT,PTHLM,PDYY,PDZZ,PDZY,ZWORK1)
+ CALL MZF_PHY(D,ZFLXZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MYF_PHY(D,ZWORK2,ZWORK1)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1,TLES%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. )
+ CALL GY_V_M_PHY(D,OFLAT,PRM(:,:,1),PDYY,PDZZ,PDZY,ZWORK1)
+ CALL MZF_PHY(D,ZFLXZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MYF_PHY(D,ZWORK1,ZWORK2)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
END IF
+ !
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END IF
@@ -900,11 +1110,14 @@ 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)
+IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED .AND. TURBN%CTURBDIM == '1DIM') THEN
+ CALL GZ_W_M_PHY(D,PWM,PDZZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT)= (2./3.) * PTKEM(IIJB:IIJE,1:IKT) &
+ -ZCMFS*PLM(IIJB:IIJE,1:IKT)*SQRT(PTKEM(IIJB:IIJE,1:IKT))*ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! to be tested &
- ! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:)
+ ! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:)
! stores the W variance
TZFIELD%CMNHNAME = 'W_VVAR'
TZFIELD%CSTDNAME = ''
@@ -916,9 +1129,11 @@ IF ( OTURB_FLX .AND. tpfile%lopened .AND. HTURBDIM == '1DIM') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZFLXZ)
END IF
!
!----------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TURB_VER_DYN_FLUX',1,ZHOOK_HANDLE)
END SUBROUTINE TURB_VER_DYN_FLUX
+END MODULE MODE_TURB_VER_DYN_FLUX
diff --git a/src/PHYEX/turb/mode_turb_ver_sv_corr.f90 b/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
index b62268e7e82a28d876844fb7abbbcaa02f3e87d0..2a1915b221dabe682ce5f2e6cf85e163a2941ff9 100644
--- a/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
+++ b/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
@@ -2,56 +2,12 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_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, &
+MODULE MODE_TURB_VER_SV_CORR
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_SV_CORR(D,CST,CSTURB,TLES,KRR,KRRL,KRRI,OOCEAN, &
+ PDZZ,KSV,KSV_LGBEG,KSV_LGEND,ONOMIXLG, &
+ OBLOWSNOW,OCOMPUTE_SRC,PRSNOW, &
PTHLM,PRM,PTHVREF, &
PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
PWM,PSVM, &
@@ -97,23 +53,20 @@ END MODULE MODI_TURB_VER_SV_CORR
!* 0. DECLARATIONS
! ------------
!
-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 PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_LES, ONLY: TLES_t
!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_LES_MEAN_SUBGRID
+USE SHUMAN_PHY, ONLY: MZF_PHY
+USE MODE_GRADIENT_M_PHY, ONLY : GZ_M_W_PHY
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
+USE MODI_LES_MEAN_SUBGRID_PHY
!
USE MODI_SECOND_MNH
!
@@ -123,29 +76,38 @@ IMPLICIT NONE
!
!
!
-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
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
+INTEGER, INTENT(IN) :: KSV, KSV_LGBEG, KSV_LGEND ! number of scalar variables
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
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
+REAL, DIMENSION(D%NIJT,D%NKT), 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVREF ! reference Thv
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3 ! Inv.Turb.Sch.for temperature
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPSI3 ! Inv.Turb.Sch.for humidity
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PWM ! w at time t
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
! cumulated sources for the prognostic variables
!
!
@@ -154,12 +116,13 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
!* 0.2 declaration of local variables
!
!
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
- ZA, ZFLXZ
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZA, ZFLXZ, &
+ ZWORK1,ZWORK2,ZWORK3! working var. for shuman operators (array syntax)
!
REAL :: ZCSV !constant for the scalar flux
!
-INTEGER :: JSV ! loop counters
+INTEGER :: JIJ,JK,JSV ! loop counters
+INTEGER :: IIJB, IIJE, IKT
!
REAL :: ZTIME1, ZTIME2
!
@@ -168,56 +131,92 @@ 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)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
CALL SECOND_MNH(ZTIME1)
!
-IF(LBLOWSNOW) THEN
+IF(OBLOWSNOW) THEN
! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
- ZCSV= XCHF/XRSNOW
+ ZCSV= CSTURB%XCHF/PRSNOW
ELSE
- ZCSV= XCHF
+ ZCSV= CSTURB%XCHF
ENDIF
!
-DO JSV=1,NSV
+DO JSV=1,KSV
!
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
!
! variance Sv2
!
- IF (LLES_CALL) THEN
+ IF (TLES%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) )
+ CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK1)
+ CALL MZF_PHY(D,ZFLXZ,ZWORK2)
+ CALL MZF_PHY(D,PWM,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = PPSI_SV(IIJB:IIJE,1:IKT,JSV)*ZWORK1(IIJB:IIJE,1:IKT)**2
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZCSV / ZCSVD * PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = -2.*ZCSVD*SQRT(PTKEM(IIJB:IIJE,1:IKT))*ZFLXZ(IIJB:IIJE,1:IKT)/PLEPS(IIJB:IIJE,1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK3(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_Sv2(:,:,:,JSV) )
END IF
!
! covariance ThvSv
!
- IF (LLES_CALL) THEN
+ IF (TLES%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.)
+ CALL ETHETA(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN,OCOMPUTE_SRC,ZA)
+ !
+ CALL GZ_M_W_PHY(D,PTHLM,PDZZ,ZWORK1)
+ CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT)= ( CSTURB%XCSHF * PPHI3(IIJB:IIJE,1:IKT) + ZCSV * PPSI_SV(IIJB:IIJE,1:IKT,JSV) ) &
+ * ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !
+ CALL MZF_PHY(D,ZFLXZ,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT)= PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) / (2.*ZCTSVD) * ZWORK3(IIJB:IIJE,1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = -CST%XG/PTHVREF(IIJB:IIJE,1:IKT)/3.*ZA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK1, TLES%X_LES_SUBGRID_SvThv(:,:,:,JSV) )
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK2, TLES%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.)
+ CALL EMOIST(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN,ZA)
+ !
+ CALL GZ_M_W_PHY(D,PRM(:,:,1),PDZZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT)= ( ZCSV * PPSI3(IIJB:IIJE,1:IKT) + ZCSV * PPSI_SV(IIJB:IIJE,1:IKT,JSV) ) &
+ * ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZFLXZ,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT)= PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) / (2.*ZCQSVD) * ZWORK3(IIJB:IIJE,1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = -CST%XG/PTHVREF(IIJB:IIJE,1:IKT)/3.*ZA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK1, TLES%X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK2, TLES%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(TLES%LLES_CALL) TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
!----------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_CORR',1,ZHOOK_HANDLE)
END SUBROUTINE TURB_VER_SV_CORR
+END MODULE MODE_TURB_VER_SV_CORR
diff --git a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90 b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
index 23d8bee0342d4fc3a6f28f73733d8f35c27308bc..e1bc59249485149a8d7189f5fd8c4801ae66b5a8 100644
--- a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
@@ -2,83 +2,20 @@
!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,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, &
+MODULE MODE_TURB_VER_SV_FLUX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_SV_FLUX(D,CST,CSTURB,TURBN,TLES,ONOMIXLG, &
+ KSV,KSV_LGBEG,KSV_LGEND, &
+ OBLOWSNOW, &
+ PEXPL,PTSTEP,TPFILE,PRSNOW, &
PDZZ,PDIRCOSZW, &
PRHODJ,PWM, &
PSFSVM,PSFSVP, &
PSVM, &
- PTKEM,PLM,PPSI_SV, &
+ PTKEM,PLM,MFMOIST,PPSI_SV, &
PRSVS,PWSV )
!
-
!
!
!!**** *TURB_VER_SV_FLUX* -compute the source terms due to the vertical turbulent
@@ -87,13 +24,13 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! PURPOSE
!! -------
! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
+! 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
+! 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
@@ -101,8 +38,8 @@ END MODULE MODI_TURB_VER_SV_FLUX
! * 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.
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
!
!!** METHOD
!! ------
@@ -111,27 +48,27 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! 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
+!! 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
+!! (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
+!! ( 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.
-!!
+!! 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
+!! 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
+!! 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.
@@ -142,68 +79,68 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! 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
+!! 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
+!! 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
+!! 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
+!! and in section 7, a diagnostic computation of the W variance is
!! performed.
!!
-!! In section 8, the turbulent fluxes for the scalar variables are
+!! 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_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
+!! _(M,U,...)_ represent the localization of the
!! field to be derivated
-!! _(M,UW,...) represent the localization of the
+!! _(M,UW,...) represent the localization of the
!! field derivated
-!!
+!!
!!
!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
+!! : Shuman functions (mean operators)
!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
+!! : 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 :
+!! 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
+!! 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'
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : contains physical constants
!!
-!! XG : gravity constant
+!! CST%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
+!! CSTURB%XCMFS,XCMFB : cts for the momentum flux
+!! CSTURB%XCSHF : ct for the sensible heat flux
+!! CSTURB%XCHF : ct for the moisture flux
+!! CSTURB%XCTV,CSTURB%XCHV : cts for the T and moisture variances
!!
!! Module MODD_PARAMETERS
!!
@@ -222,34 +159,34 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! MODIFICATIONS
!! -------------
!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Modifications: March 21, 1995 (J.M. Carriere)
!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! 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)
+!! 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)
+!! 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
+!! 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
+!! 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)
+!! 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: 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
@@ -257,38 +194,41 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! 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
+!! Feb 2012(Y. Seity) add possibility to run with reversed
!! vertical levels
+!! Modifications: July 2015 (Wim de Rooy) TURBN%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
+!! Modifications: June 2019 (Wim de Rooy) with energycascade, 50MF nog
+!! longer necessary
!!--------------------------------------------------------------------------
-!
+!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_TURB_n, ONLY: TURB_t
+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
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_LES_MEAN_SUBGRID
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_LES, ONLY: TLES_t
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+!
+
+USE SHUMAN_PHY , ONLY : DZM_PHY, MZM_PHY, MZF_PHY
+USE MODE_GRADIENT_W_PHY, ONLY: GZ_W_M_PHY
+USE MODE_GRADIENT_M_PHY, ONLY: GZ_M_W_PHY
+USE MODE_TRIDIAG, ONLY: TRIDIAG
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
+USE MODI_LES_MEAN_SUBGRID_PHY
!
USE MODI_SECOND_MNH
!
@@ -297,62 +237,65 @@ 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.
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
+INTEGER, INTENT(IN) :: KSV, &
+ KSV_LGBEG, KSV_LGEND ! number of scalar variables
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
+REAL, INTENT(IN) :: PEXPL ! Coef. for temporal disc.
REAL, INTENT(IN) :: PTSTEP ! Double Time Step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ
! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
! normal to the ground surface
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: MFMOIST ! moist mf dual scheme
+
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
+REAL, DIMENSION(D%NIJT,KSV), INTENT(IN) :: PSFSVM ! t - deltat
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
+REAL, DIMENSION(D%NIJT,KSV), INTENT(IN) :: PSFSVP ! t + deltat
!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), 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(D%NIJT,D%NKT), INTENT(IN) :: PWM ! vertical wind
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(INOUT) :: PRSVS
! cumulated sources for the prognostic variables
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PWSV ! scalar flux
-!
-!
-!
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT) :: PWSV ! scalar flux
!
!* 0.2 declaration of local variables
!
!
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
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
+ ! 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.
+ ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
+ ZWORK1,ZWORK2,&
+ ZWORK3,ZWORK4! working var. for shuman operators (array syntax)
INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IIJB,IIJE,IKB,IKE,IKA ! index value for the mass points of the domain
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IKL
INTEGER :: JSV ! loop counters
-INTEGER :: JK ! loop
-INTEGER :: ISV ! number of scalar var.
+INTEGER :: JIJ,JK ! loop
!
REAL :: ZTIME1, ZTIME2
@@ -365,36 +308,59 @@ TYPE(TFIELDDATA) :: TZFIELD
!* 1. PRELIMINARIES
! -------------
!
-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(:,:,:)) )
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_FLUX',0,ZHOOK_HANDLE)
+!
+IKT=D%NKT
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKA=D%NKA
+IKL=D%NKL
+IIJE=D%NIJE
+IIJB=D%NIJB
+!
+IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZKEFF(IIJB:IIJE,IKB:IKE) = PLM(IIJB:IIJE,IKB:IKE) * SQRT(PTKEM(IIJB:IIJE,IKB:IKE))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT)*SQRT(PTKEM(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZKEFF)
+ENDIF
!
-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
+IF(OBLOWSNOW) THEN
+! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
+ ZCSV=CSTURB%XCHF/PRSNOW
ELSE
- ZCSV= XCHF
+ ZCSV=CSTURB%XCHF
ENDIF
!----------------------------------------------------------------------------
!
!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
! -----------------------------------
!
-DO JSV=1,ISV
+CALL MZM_PHY(D,PRHODJ,ZWORK1)
+DO JSV=1,KSV
!
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
!
-! Preparation of the arguments for TRIDIAG
- ZA(:,:,:) = -PTSTEP*ZCSV*PPSI_SV(:,:,:,JSV) * &
- ZKEFF * MZM(PRHODJ) / &
- PDZZ**2
- ZSOURCE(:,:,:) = 0.
+! Preparation of the arguments for TRIDIAG
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,IKB:IKE) = -PTSTEP * ZKEFF(IIJB:IIJE,IKB:IKE) * ZWORK1(IIJB:IIJE,IKB:IKE) &
+ / PDZZ(IIJB:IIJE,IKB:IKE)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,IKB:IKE) = -PTSTEP*ZCSV*PPSI_SV(IIJB:IIJE,IKB:IKE,JSV) * &
+ ZKEFF(IIJB:IIJE,IKB:IKE) * ZWORK1(IIJB:IIJE,IKB:IKE) / PDZZ(IIJB:IIJE,IKB:IKE)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
+ ZSOURCE(IIJB:IIJE,IKB:IKE) = 0.
!
! Compute the sources for the JSVth scalar variable
@@ -402,56 +368,79 @@ DO JSV=1,ISV
! (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))
+ IF (TURBN%CTURBDIM=='3DIM') THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE(IIJB:IIJE,IKB) = (TURBN%XIMPL*PSFSVP(IIJB:IIJE,JSV) + PEXPL*PSFSVM(IIJB:IIJE,JSV)) / &
+ PDZZ(IIJB:IIJE,IKB) * PDIRCOSZW(IIJB:IIJE) &
+ * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
-
- ZSOURCE(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) / &
- PDZZ(:,:,IKB) / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZSOURCE(IIJB:IIJE,IKB) = (TURBN%XIMPL*PSFSVP(IIJB:IIJE,JSV) + PEXPL*PSFSVM(IIJB:IIJE,JSV)) / &
+ PDZZ(IIJB:IIJE,IKB) / PDIRCOSZW(IIJB:IIJE) &
+ * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
- ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
- ZSOURCE(:,:,IKE) = 0.
+ ZSOURCE(IIJB:IIJE,IKTB+1:IKTE-1) = 0.
+ ZSOURCE(IIJB:IIJE,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)
+! Obtention of the split JSV scalar variable at t+ deltat
+ CALL TRIDIAG(D,PSVM(:,:,JSV),ZA,PTSTEP,PEXPL,TURBN%XIMPL,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))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRSVS(IIJB:IIJE,IKB:IKE,JSV)= PRSVS(IIJB:IIJE,IKB:IKE,JSV)+ &
+ PRHODJ(IIJB:IIJE,IKB:IKE)*(ZRES(IIJB:IIJE,IKB:IKE)-PSVM(IIJB:IIJE,IKB:IKE,JSV))/PTSTEP
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
- IF ( (OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL ) THEN
+ IF ( (TURBN%LTURB_FLX .AND. TPFILE%LOPENED) .OR. TLES%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) )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT)*SQRT(PTKEM(IIJB:IIJE,1:IKT))
+ ZWORK2(IIJB:IIJE,1:IKT) = TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT) + PEXPL*PSVM(IIJB:IIJE,1:IKT,JSV)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK3)
+ CALL DZM_PHY(D,ZWORK2,ZWORK4)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,IKB:IKE) = -ZCSV * PPSI_SV(IIJB:IIJE,IKB:IKE,JSV) * ZWORK3(IIJB:IIJE,IKB:IKE) &
+ / PDZZ(IIJB:IIJE,IKB:IKE) * &
+ ZWORK4(IIJB:IIJE,IKB:IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! 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(:,:)
+ IF (TURBN%CTURBDIM=='3DIM') THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = (TURBN%XIMPL*PSFSVP(IIJB:IIJE,JSV) + PEXPL*PSFSVM(IIJB:IIJE,JSV)) &
+ * PDIRCOSZW(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
- ZFLXZ(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) &
- / PDIRCOSZW(:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = (TURBN%XIMPL*PSFSVP(IIJB:IIJE,JSV) + PEXPL*PSFSVM(IIJB:IIJE,JSV)) &
+ / PDIRCOSZW(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
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)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
DO JK=IKTB+1,IKTE-1
- PWSV(:,:,JK,JSV)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWSV(IIJB:IIJE,JK,JSV)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+IKL))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
- PWSV(:,:,IKB,JSV)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWSV(:,:,IKE,JSV)=PWSV(:,:,IKE-KKL,JSV)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWSV(IIJB:IIJE,IKB,JSV)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+IKL))
+ PWSV(IIJB:IIJE,IKE,JSV)=PWSV(IIJB:IIJE,IKE-IKL,JSV)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
!
- IF (OTURB_FLX .AND. tpfile%lopened) THEN
+ IF (TURBN%LTURB_FLX .AND. TPFILE%LOPENED) THEN
! stores the JSVth vertical flux
WRITE(TZFIELD%CMNHNAME,'("WSV_FLX_",I3.3)') JSV
TZFIELD%CSTDNAME = ''
@@ -465,26 +454,50 @@ DO JSV=1,ISV
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZFLXZ)
END IF
!
! Storage in the LES configuration
!
- IF (LLES_CALL) THEN
+ IF (TLES%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 MZF_PHY(D,ZFLXZ,ZWORK1)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_WSv(:,:,:,JSV) )
+ !
+ CALL GZ_W_M_PHY(D,PWM,PDZZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) )
+ !
+ CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) )
+ !
+ CALL MZF_PHY(D,ZFLXZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = -ZCSVP*SQRT(PTKEM(IIJB:IIJE,1:IKT))/PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_SvPz(:,:,:,JSV) )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PWM(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_WSv(:,:,:,JSV) )
+ !
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
-END DO ! end of scalar loop
+END DO ! end of scalar loop
!
!----------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_FLUX',1,ZHOOK_HANDLE)
END SUBROUTINE TURB_VER_SV_FLUX
+END MODULE MODE_TURB_VER_SV_FLUX
diff --git a/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90 b/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
index bdd074e5c52af78809d84b8fa5077d56e12a76d5..6d71d9196a2fb302dd634267dfcd024065342357 100644
--- a/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
+++ b/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
@@ -2,127 +2,24 @@
!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,PSIGS )
-!
-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
-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) :: 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) :: 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
-!
-!
-!
-END SUBROUTINE TURB_VER_THERMO_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_THERMO_CORR
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- TPFILE, &
+MODULE MODE_TURB_VER_THERMO_CORR
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,TLES, &
+ KRR,KRRL,KRRI,KSV, &
+ OCOMPUTE_SRC,OCOUPLES, &
+ 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, &
+ PLOCPEXNM,PATHETA,PAMOIST, &
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,PSIGS )
+ PTHLP,PRP,MFMOIST,PSIGS )
! ###############################################################
!
!
@@ -132,13 +29,13 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!! PURPOSE
!! -------
! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
+! 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
+! 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
@@ -146,8 +43,8 @@ END MODULE MODI_TURB_VER_THERMO_CORR
! * 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.
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
!
!!** METHOD
!! ------
@@ -156,27 +53,27 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!! 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
+!! 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
+!! (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
+!! ( 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.
-!!
+!! 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
+!! 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
+!! 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.
@@ -187,68 +84,62 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!! 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
+!! 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
+!! 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
+!! 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
+!! and in section 7, a diagnostic computation of the W variance is
!! performed.
!!
-!! In section 8, the turbulent fluxes for the scalar variables are
+!! 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_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
+!! _(M,U,...)_ represent the localization of the
!! field to be derivated
-!! _(M,UW,...) represent the localization of the
+!! _(M,UW,...) represent the localization of the
!! field derivated
-!!
+!!
!!
!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
+!! : 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
+!! : Shuman functions (difference operators)
!!
-!! FUNCTIONs ETHETA and EMOIST :
+!! 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
+!! 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'
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : contains physical constants
!!
-!! XG : gravity constant
+!! CST%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
+!! CSTURB%XCMFS,XCMFB : cts for the momentum flux
+!! CSTURB%XCSHF : ct for the sensible heat flux
+!! CSTURB%XCHF : ct for the moisture flux
+!! CSTURB%XCTV,CSTURB%XCHV : cts for the T and moisture variances
!!
!! Module MODD_PARAMETERS
!!
@@ -267,34 +158,34 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!! MODIFICATIONS
!! -------------
!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Modifications: March 21, 1995 (J.M. Carriere)
!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! 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)
+!! 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)
+!! 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
+!! 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
+!! 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)
+!! 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: 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
@@ -302,34 +193,32 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!! 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
+!! 2012-02 (Y. Seity) add possibility to run with reversed
!! vertical levels
+!! Modifications July 2015 (Wim de Rooy) TURBN%LHARAT switch
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Modifications June 2019 (Wim de Rooy) New set up cloud scheme
!!--------------------------------------------------------------------------
-!
+!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+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
-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 MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_LES, ONLY: TLES_t
+!
+USE MODI_LES_MEAN_SUBGRID_PHY
+!
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
USE MODE_PRANDTL
+USE SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZM_PHY
!
USE MODI_SECOND_MNH
!
@@ -339,83 +228,86 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KSV ! number of scalar 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.
+LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and version
+REAL, INTENT(IN) :: PEXPL ! Coef. for temporal disc.
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+REAL, DIMENSION(D%NIJT), 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) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+! ! t - deltat
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+! ! t + deltat
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PWM
! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM
! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), 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
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! Mixing ratios
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at time t
+! In case TURBN%LHARATU=TRUE, PLM already includes all stability corrections
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
! 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA ! buoyancy coefficient
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTH_DZ ! d(th)/dz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDR_DZ ! d(rt)/dz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD ! Denominator in Prandtl numbers
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLP ! guess of thl at t+ deltat
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRP ! guess of r at t+ deltat
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), 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)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZA, & ! work variable for wrc
ZFLXZ, & ! vertical flux of the treated variable
ZSOURCE, & ! source of evolution for the treated variable
@@ -423,13 +315,28 @@ REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
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
+ Z3RDMOMENT, & ! 3 order term in flux or variance equation
+! Estimate of full level length and dissipation length scale in case TURBN%LHARATU
+ PLMF, & ! estimate full level length scale from half levels (sub optimal)
+ PLEPSF, & ! estimate full level diss length scale from half levels (sub optimal)
+ ZWORK1,ZWORK2,&
+ ZWORK3,ZWORK4,&
+ ZWORK5,ZWORK6,&
+ ZWORK7,ZWORK8,&
+ ZWKPHIPSI1,ZWKPHIPSI2,&
+ ZWKPHIPSI3,ZWKPHIPSI4 ! working var. for shuman operators (array syntax)
+
+INTEGER :: IIJB, IIJE, IKB,IKE,IKT,IKA ! index value for the mass points of the domain
+INTEGER :: IKU ! array sizes
+INTEGER :: IKL
+INTEGER :: JIJ, JK ! loop indexes
+
+REAL, DIMENSION(D%NIJT,MIN(D%NKA+JPVEXT_TURB*D%NKL,D%NKA+JPVEXT_TURB*D%NKL+2*D%NKL):&
+ MAX(D%NKA+JPVEXT_TURB*D%NKL,D%NKA+JPVEXT_TURB*D%NKL+2*D%NKL))&
+ :: ZCOEFF
+ ! coefficients for the uncentred gradient
+ ! computation near the ground, defined in
! 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
!
@@ -445,25 +352,56 @@ 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))
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_CORR',0,ZHOOK_HANDLE)
+!
+IKB=D%NKB
+IKE=D%NKE
+IKT=D%NKT
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
+IIJE=D%NIJE
+IIJB=D%NIJB
!
GUSERV = (KRR/=0)
!
-! compute the coefficients for the uncentred gradient computation near the
+! 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(:,:,:)) )
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZCOEFF(IIJB:IIJE,IKB+2*IKL)= - PDZZ(IIJB:IIJE,IKB+IKL) / &
+ ( (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) * PDZZ(IIJB:IIJE,IKB+2*IKL) )
+ZCOEFF(IIJB:IIJE,IKB+IKL)= (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) / &
+ ( PDZZ(IIJB:IIJE,IKB+IKL) * PDZZ(IIJB:IIJE,IKB+2*IKL) )
+ZCOEFF(IIJB:IIJE,IKB)= - (PDZZ(IIJB:IIJE,IKB+2*IKL)+2.*PDZZ(IIJB:IIJE,IKB+IKL)) / &
+ ( (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) * PDZZ(IIJB:IIJE,IKB+IKL) )
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+!
+IF (TURBN%LHARAT) THEN
+ CALL MZF_PHY(D,PLM,PLMF)
+ !wc Part of the new statistical cloud scheme set up
+ IF (TURBN%LSTATNW) THEN
+ CALL MZF_PHY(D,PLEPS,PLEPSF)
+ ELSE
+ PLEPSF(:,:)=PLMF(:,:)
+ END IF
+ ! function MZF produces -999 for level IKU (82 for 80 levels)
+ ! so put these to normal value as this level (82) is indeed calculated
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PLMF(IIJB:IIJE,IKT)=0.001
+ PLEPSF(IIJB:IIJE,IKT)=0.001
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ ! with energy cascade contribution 50MF term can be omitted
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZKEFF(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZKEFF)
+ENDIF
!
! Flags for 3rd order quantities
!
@@ -473,7 +411,7 @@ GFTHR = .FALSE.
GFWTH = .FALSE.
GFWR = .FALSE.
!
-IF (HTOM/='NONE') THEN
+IF (TURBN%CTOM/='NONE') THEN
GFTH2 = ANY(PFTH2/=0.)
GFR2 = ANY(PFR2 /=0.) .AND. GUSERV
GFTHR = ANY(PFTHR/=0.) .AND. GUSERV
@@ -487,87 +425,195 @@ END IF
! --------------------------------------------------------
!
!
-!* 4.2 <THl THl>
+!* 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
+!
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT)=PDTH_DZ(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ IF (TURBN%LSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV * &
+ PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT)=PPHI3(IIJB:IIJE,1:IKT)*PDTH_DZ(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)&
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
+ 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
+ CALL M3_TH2_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,ZWORK1)
+ CALL D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * PFTH2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFTH2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL M3_TH2_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PDTH_DZ,&
+ & PLM,PLEPS,PTKEM,ZWORK1)
+ CALL MZF_PHY(D,PFWTH,ZWORK2)
+ CALL D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,&
+ & PLM,PLEPS,PTKEM,GUSERV,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_TH2_WR2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
+ & PEMOIST,PDTH_DZ,ZWORK1)
+ CALL D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * PFR2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFR2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL M3_TH2_W2R(D,CSTURB,PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
+ & PEMOIST,PDTH_DZ,ZWORK1)
+ CALL MZF_PHY(D,PFWR,ZWORK2)
+ CALL D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,&
+ & PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_TH2_WTHR(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK1)
+ CALL D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * PFTHR(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFTHR(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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 )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PTHLP(IIJB:IIJE,1:IKT) - PTHLM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZM_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK3,ZWORK4)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:IKT) &
+ * ZWORK4(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! 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 &
- )
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = PLMF(IIJB:IIJE,IKB) &
+ * PLEPSF(IIJB:IIJE,IKB) &
+ *( PEXPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLM(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLM(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PTHLM(IIJB:IIJE,IKB ) )**2 &
+ +TURBN%XIMPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLP(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLP(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PTHLP(IIJB:IIJE,IKB ) )**2 &
+ )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ IF (TURBN%LSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = CSTURB%XCTV * ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END IF
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = CSTURB%XCTV * PPHI3(IIJB:IIJE,IKB+IKL) * PLM(IIJB:IIJE,IKB) &
+ * PLEPS(IIJB:IIJE,IKB) &
+ *( PEXPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLM(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLM(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PTHLM(IIJB:IIJE,IKB ) )**2 &
+ +TURBN%XIMPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLP(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLP(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PTHLP(IIJB:IIJE,IKB ) )**2 &
+ )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ ENDIF
!
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- ZFLXZ = MAX(0., ZFLXZ)
+ IF (TURBN%LSTATNW) THEN
+ !wc The variance from the budget eq should be multiplied by 2 here
+ ! thl'2=2*L*LEPS*(dthl/dz**2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = MAX(0., 2.*ZFLXZ(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = MAX(0., ZFLXZ(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
!
IF (KRRL > 0) THEN
- PSIGS(:,:,:) = ZFLXZ(:,:,:) * PATHETA(:,:,:)**2
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PSIGS(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) * PATHETA(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ PSIGS(:,:) = 0.
END IF
!
!
- ! stores <THl THl>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ ! stores <THl THl>
+ IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'THL_VVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THL_VVAR'
@@ -578,123 +624,309 @@ END IF
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
!
- IF (LLES_CALL) THEN
+ IF (TLES%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 LES_MEAN_SUBGRID_PHY(D,TLES,ZFLXZ, TLES%X_LES_SUBGRID_Thl2 )
+ !
+ CALL MZF_PHY(D,PWM,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_Thl2 )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) &
+ / PLEPS(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_DISS_Thl2 )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PETHETA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_ThlThv )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) &
+ * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_ThlPz, .TRUE. )
+ !
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
IF ( KRR /= 0 ) THEN
!
-!* 4.3 <THl Rnp>
+!* 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
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PDTH_DZ(IIJB:IIJE,1:IKT)*PDR_DZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ IF (TURBN%LSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV * &
+ PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = 0.5*(PPHI3(IIJB:IIJE,1:IKT)+PPSI3(IIJB:IIJE,1:IKT))&
+ *PDTH_DZ(IIJB:IIJE,1:IKT)*PDR_DZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)&
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
+ 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
+ CALL M3_THR_WTH2(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
+ CALL D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK2)
+ CALL D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFTH2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFTH2(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * PFTH2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL MZF_PHY(D,PFWTH,ZWORK1)
+ CALL M3_THR_W2TH(D,CSTURB,PREDR1,PD,PLM,PLEPS,PTKEM,&
+ & PDR_DZ,ZWORK2)
+ CALL D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PDR_DZ,PETHETA,ZWORK3)
+ CALL D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,&
+ & PD,PLM,PLEPS,PTKEM,ZWORK4)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK4(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_THR_WR2(D,CSTURB,PREDTH1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK1)
+ CALL D_M3_THR_WR2_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZWORK2)
+ CALL D_M3_THR_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFR2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFR2(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * PFR2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL MZF_PHY(D,PFWR,ZWORK1)
+ CALL M3_THR_W2R(D,CSTURB,PREDTH1,PD,PLM,PLEPS,PTKEM,&
+ & PDTH_DZ,ZWORK2)
+ CALL D_M3_THR_W2R_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ & PLM,PLEPS,PTKEM,ZWORK3)
+ CALL D_M3_THR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ & PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST,ZWORK4)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK4(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_THR_WTHR(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,&
+ & PSQRT_TKE,ZWORK1)
+ CALL D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZWORK2)
+ CALL D_M3_THR_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFTHR(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFTHR(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * PFTHR(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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 )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PTHLP(IIJB:IIJE,1:IKT) - PTHLM(IIJB:IIJE,1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = PRP(IIJB:IIJE,1:IKT) - PRM(IIJB:IIJE,1:IKT,1)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZM_PHY(D,ZWORK1,ZWORK3)
+ CALL DZM_PHY(D,ZWORK2,ZWORK4)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK3(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK4(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK7)
+ CALL MZF_PHY(D,ZWORK2,ZWORK8)
+ !
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK5(IIJB:IIJE,1:IKT) = 2. *PDR_DZ(IIJB:IIJE,1:IKT) *ZWORK3(IIJB:IIJE,1:IKT) &
+ / PDZZ(IIJB:IIJE,1:IKT) &
+ + 2. *PDTH_DZ(IIJB:IIJE,1:IKT) *ZWORK4(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !
+ CALL MZF_PHY(D,ZWORK5,ZWORK6)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*0.5 &
+ * ZWORK5(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:IKT) * ZWORK7(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK8(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ IF (TURBN%LSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = CSTURB%XCTV * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ ELSE
+ CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI1)
+ ! d(phi3*dthdz)/ddthdz term
+ CALL D_PSI3DTDZ_O_DDTDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI2)
+ ! d(psi3*dthdz)/ddthdz term
+ CALL D_PHI3DRDZ_O_DDRDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI3)
+ ! d(phi3*drdz )/ddrdz term
+ CALL D_PSI3DRDZ_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI4)
+ ! d(psi3*drdz )/ddrdz term
+
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK5(IIJB:IIJE,1:IKT) = (ZWKPHIPSI1(IIJB:IIJE,1:IKT)+ZWKPHIPSI2(IIJB:IIJE,1:IKT))&
+ *PDR_DZ(IIJB:IIJE,1:IKT)*ZWORK3(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) &
+ + (ZWKPHIPSI3(IIJB:IIJE,1:IKT) + ZWKPHIPSI4(IIJB:IIJE,1:IKT)) &
+ *PDTH_DZ(IIJB:IIJE,1:IKT)*ZWORK4(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK5,ZWORK6)
+
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)*0.5 &
+ * ZWORK6(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:IKT) * ZWORK7(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK8(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
!
! 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 )) &
- )
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = &
+ (1. ) &
+ *( PEXPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLM(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLM(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PTHLM(IIJB:IIJE,IKB )) &
+ *( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRM(IIJB:IIJE,IKB+2*IKL,1) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRM(IIJB:IIJE,IKB+IKL,1 ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PRM(IIJB:IIJE,IKB ,1 )) &
+ +TURBN%XIMPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLP(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLP(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PTHLP(IIJB:IIJE,IKB )) &
+ *( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRP(IIJB:IIJE,IKB+2*IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRP(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PRP(IIJB:IIJE,IKB )) &
+ )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ IF (TURBN%LSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = (CSTURB%XCHT1 + CSTURB%XCHT2) * ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END IF
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = &
+ (CSTURB%XCHT1 * PPHI3(IIJB:IIJE,IKB+IKL) + CSTURB%XCHT2 * PPSI3(IIJB:IIJE,IKB+IKL)) &
+ *( PEXPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLM(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLM(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PTHLM(IIJB:IIJE,IKB )) &
+ *( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRM(IIJB:IIJE,IKB+2*IKL,1) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRM(IIJB:IIJE,IKB+IKL,1 ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PRM(IIJB:IIJE,IKB ,1 )) &
+ +TURBN%XIMPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLP(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLP(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PTHLP(IIJB:IIJE,IKB )) &
+ *( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRP(IIJB:IIJE,IKB+2*IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRP(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PRP(IIJB:IIJE,IKB )) &
+ )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ ENDIF
!
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- IF ( KRRL > 0 ) THEN
- PSIGS(:,:,:) = PSIGS(:,:,:) + &
- 2. * PATHETA(:,:,:) * PAMOIST(:,:,:) * ZFLXZ(:,:,:)
+ IF (TURBN%LSTATNW) THEN
+ !wc The variance from the budget eq should be multiplied by 2 here
+ ! e.g. thl'2=2*L*LEPS*(cab)^-1 *(dthl/dz**2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = MIN(0., 2.*ZFLXZ(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
+ IF ( KRRL > 0 ) THEN
+ IF (TURBN%LSTATNW) THEN
+ !wc Part of the new statistical cloud scheme set up. Normal notation so - sign
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PSIGS(IIJB:IIJE,1:IKT) = PSIGS(IIJB:IIJE,1:IKT) - &
+ 2. * PATHETA(IIJB:IIJE,1:IKT) * PAMOIST(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ ! NB PATHETA is -b in Chaboureau Bechtold 2002 which explains the + sign here
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PSIGS(IIJB:IIJE,1:IKT) = PSIGS(IIJB:IIJE,1:IKT) + &
+ 2. * PATHETA(IIJB:IIJE,1:IKT) * PAMOIST(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
END IF
- ! stores <THl Rnp>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ ! stores <THl Rnp>
+ IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'THLRCONS_VCOR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THLRCONS_VCOR'
@@ -705,103 +937,261 @@ END IF
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
!
- IF (LLES_CALL) THEN
+IF (TLES%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 LES_MEAN_SUBGRID_PHY(D,TLES,ZFLXZ, TLES%X_LES_SUBGRID_THlRt )
+ !
+ CALL MZF_PHY(D,PWM,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_ThlRt )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) &
+ / PLEPS(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_DISS_ThlRt )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PETHETA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_RtThv )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) &
+ * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_RtPz, .TRUE. )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PEMOIST(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_ThlThv , .TRUE. )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT) &
+ * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_ThlPz, .TRUE. )
+ !
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
+ TLES%XTIME_LES = TLES%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
+IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PDR_DZ(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ IF (TURBN%LSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV * ZF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PPSI3(IIJB:IIJE,1:IKT)*PDR_DZ(IIJB:IIJE,1:IKT)**2
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)&
+ *ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ENDIF
+ 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
+ CALL M3_R2_WR2(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,&
+ & PSQRT_TKE,ZWORK1)
+ CALL D_M3_R2_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFR2(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFR2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL MZF_PHY(D,PFWR,ZWORK1)
+ CALL M3_R2_W2R(D,CSTURB,PREDR1,PREDTH1,PD,PDR_DZ,&
+ & PLM,PLEPS,PTKEM,ZWORK2)
+ CALL D_M3_R2_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ & PD,PLM,PLEPS,PTKEM,GUSERV,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_R2_WTH2(D,CSTURB,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
+ CALL D_M3_R2_WTH2_O_DDRDZ(D,CSTURB,PREDR1,&
+ & PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT)*PFTH2(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFTH2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL MZF_PHY(D,PFWTH,ZWORK1)
+ CALL M3_R2_W2TH(D,CSTURB,PD,PLM,PLEPS,PTKEM,&
+ & PBLL_O_E,PETHETA,PDR_DZ,ZWORK2)
+ CALL D_M3_R2_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT)+ZWORK2(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_R2_WTHR(D,CSTURB,PREDTH1,PD,PLEPS,&
+ & PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
+ CALL D_M3_R2_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * PFTHR(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFTHR(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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 )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PRP(IIJB:IIJE,1:IKT) - PRM(IIJB:IIJE,1:IKT,1)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZM_PHY(D,ZWORK1,ZWORK2)
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK5(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = 2.*PDR_DZ(IIJB:IIJE,1:IKT)* ZWORK5(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK3,ZWORK4)
+ CALL MZF_PHY(D,ZWORK5,ZWORK6)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * PLMF(IIJB:IIJE,1:IKT) *PLEPSF(IIJB:IIJE,1:IKT) &
+ * ZWORK4(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK6(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ IF (TURBN%LSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = CSTURB%XCTV * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ ELSE
+ CALL D_PSI3DRDZ2_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWKPHIPSI1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) &
+ / PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK4(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK4,ZWORK5)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT) *PLEPS(IIJB:IIJE,1:IKT) &
+ * ZWORK3(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK5(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
!
! special case near the ground ( uncentred gradient )
- ZFLXZ(:,:,IKB) = XCHV * PPSI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
- * PLEPS(:,:,IKB) &
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = PLMF(IIJB:IIJE,IKB) &
+ * PLEPSF(IIJB:IIJE,IKB) &
+ *( PEXPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRM(IIJB:IIJE,IKB+2*IKL,1) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRM(IIJB:IIJE,IKB+IKL,1 ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PRM(IIJB:IIJE,IKB ,1 ))**2 &
+ +TURBN%XIMPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRP(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRP(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PRP(IIJB:IIJE,IKB ))**2 &
+ )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ IF (TURBN%LSTATNW) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = CSTURB%XCHV * ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ END IF
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKB) = CSTURB%XCHV * PPSI3(IIJB:IIJE,IKB+IKL) * PLM(IIJB:IIJE,IKB) &
+ * PLEPS(IIJB:IIJE,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 &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRM(IIJB:IIJE,IKB+2*IKL,1) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRM(IIJB:IIJE,IKB+IKL,1 ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PRM(IIJB:IIJE,IKB ,1 ))**2 &
+ +TURBN%XIMPL * &
+ ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRP(IIJB:IIJE,IKB+2*IKL) &
+ +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRP(IIJB:IIJE,IKB+IKL ) &
+ +ZCOEFF(IIJB:IIJE,IKB )*PRP(IIJB:IIJE,IKB ))**2 &
)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ ENDIF
!
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ IF (TURBN%LSTATNW) THEN
+ !wc The variance from the budget eq should be multiplied by 2 here
+ ! thl'2=2*L*LEPS*(dthl/dz**2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = MAX(0., 2.*ZFLXZ(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
!
IF ( KRRL > 0 ) THEN
- PSIGS(:,:,:) = PSIGS(:,:,:) + PAMOIST(:,:,:) **2 * ZFLXZ(:,:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PSIGS(IIJB:IIJE,1:IKT) = PSIGS(IIJB:IIJE,1:IKT) + PAMOIST(IIJB:IIJE,1:IKT) **2 &
+ * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
- ! stores <Rnp Rnp>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ ! stores <Rnp Rnp>
+ IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'RTOT_VVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'RTOT_VVAR'
@@ -812,20 +1202,41 @@ END IF
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
!
- IF (LLES_CALL) THEN
+ IF (TLES%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 LES_MEAN_SUBGRID_PHY(D,TLES,ZFLXZ, TLES%X_LES_SUBGRID_Rt2 )
+ !
+ CALL MZF_PHY(D,PWM,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_Rt2 )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PEMOIST(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_RtThv , .TRUE. )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT) &
+ * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_RtPz, .TRUE. )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) &
+ / PLEPS(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_DISS_Rt2 )
+ !
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END IF ! end if KRR ne 0
@@ -835,14 +1246,24 @@ END IF
!
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) )
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PSIGS(IIJB:IIJE,IKA) = PSIGS(IIJB:IIJE,IKB)
+ PSIGS(IIJB:IIJE,IKU) = PSIGS(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+#ifdef REPRO48
+ PSIGS(IIJB:IIJE,1:IKT) = MAX (PSIGS(IIJB:IIJE,1:IKT) , 0.)
+ PSIGS(IIJB:IIJE,1:IKT) = SQRT(PSIGS(IIJB:IIJE,1:IKT))
+#else
+ PSIGS(IIJB:IIJE,1:IKT) = SQRT( MAX (PSIGS(IIJB:IIJE,1:IKT) , 1.E-12) )
+#endif
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+END MODULE MODE_TURB_VER_THERMO_CORR
diff --git a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90 b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
index cf539984e7751f862a6251a3e80b048274740073..97366b22aef729e9d8007ddaf0108e881367d009 100644
--- a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
@@ -2,130 +2,17 @@
!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,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, &
+MODULE MODE_TURB_VER_THERMO_FLUX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_THERMO_FLUX(D,CST,CSTURB,TURBN,TLES, &
+ KRR,KRRL,KRRI,KSV,KGRADIENTS, &
+ OOCEAN,ODEEPOC, &
+ OCOUPLES, OCOMPUTE_SRC, &
+ PEXPL,PTSTEP,HPROGRAM, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PRHODJ,PTHVREF, &
+ PRHODJ,PTHVREF,PHGRAD,PZS, &
PSFTHM,PSFRM,PSFTHP,PSFRP, &
PWM,PTHLM,PRM,PSVM, &
PTKEM,PLM,PLEPS, &
@@ -133,8 +20,9 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
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 )
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR,MFMOIST,PBL_DEPTH,&
+ PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC, &
+ PSSTFL, PSSTFL_C, PSSRFL_C )
! ###############################################################
!
!
@@ -144,13 +32,13 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! PURPOSE
!! -------
! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
+! 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
+! 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
@@ -158,8 +46,8 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
! * 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.
+! the subgrid variance of a statistical variable s indicating the presence
+! or not of condensation in a given mesh.
!
!!** METHOD
!! ------
@@ -168,27 +56,27 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! 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
+!! 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
+!! (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
+!! ( 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.
-!!
+!! 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
+!! 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
+!! 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.
@@ -199,68 +87,68 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! 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
+!! 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
+!! 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
+!! 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
+!! and in section 7, a diagnostic computation of the W variance is
!! performed.
!!
-!! In section 8, the turbulent fluxes for the scalar variables are
+!! 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_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
+!! _(M,U,...)_ represent the localization of the
!! field to be derivated
-!! _(M,UW,...) represent the localization of the
+!! _(M,UW,...) represent the localization of the
!! field derivated
-!!
+!!
!!
!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
+!! : Shuman functions (mean operators)
!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
+!! : Shuman functions (difference operators)
+!!
+!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
!! of a variable located at a mass point
!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
+!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
!! of a variable located at a wind point
!!
-!! FUNCTIONs ETHETA and EMOIST :
+!! 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
+!! 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'
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST : contains physical constants
!!
-!! XG : gravity constant
+!! CST%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
+!! CSTURB%XCMFS,XCMFB : cts for the momentum flux
+!! CSTURB%XCSHF : ct for the sensible heat flux
+!! CSTURB%XCHF : ct for the moisture flux
+!! CSTURB%XCTV,CSTURB%XCHV : cts for the T and moisture variances
!!
!! Module MODD_PARAMETERS
!!
@@ -279,34 +167,34 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! MODIFICATIONS
!! -------------
!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
+!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Modifications: March 21, 1995 (J.M. Carriere)
!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
+!! 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)
+!! 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)
+!! 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
+!! 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
+!! 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)
+!! 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: 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
@@ -322,57 +210,47 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! change of YCOMMENT
!! 2012-02 (Y. Seity) add possibility to run with reversed
!! vertical levels
+!! Modifications July 2015 (Wim de Rooy) TURBN%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
+!! Modifications: June 2019 (Wim de Rooy) with energycascade, 50MF nog
+!! longer necessary
!! 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 MODD_CST
-USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_GRID_n, ONLY: XZS, XXHAT, XYHAT
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
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 MODD_PARAMETERS, ONLY: JPVEXT_TURB, JPHEXT
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_LES, ONLY: TLES_t
+USE MODD_TURB_n, ONLY: TURB_t
+!
+USE MODI_LES_MEAN_SUBGRID_PHY
+USE MODE_TRIDIAG_THERMO, ONLY: TRIDIAG_THERMO
+USE MODE_TM06_H, ONLY: TM06_H
+!
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
USE MODE_PRANDTL
+USE SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZM_PHY, DZF_PHY, &
+ MXF_PHY,MYF_PHY
+USE MODE_GRADIENT_W_PHY, ONLY: GZ_W_M_PHY
!
USE MODI_SECOND_MNH
-USE MODE_ll
-USE MODE_GATHER_ll
!
IMPLICIT NONE
!
@@ -380,93 +258,107 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
+INTEGER, INTENT(IN) :: KGRADIENTS ! Number of stored horizontal gradients
INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KSV ! number of scalar 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.
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: ODEEPOC ! activates sfc forcing for ideal ocean deep conv
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! CPROGRAM is the program currently running (modd_conf)
+REAL, INTENT(IN) :: PEXPL ! Coef. for temporal disc.
REAL, INTENT(IN) :: PTSTEP ! Double Time Step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
+REAL, DIMENSION(D%NIJT,D%NKT), 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(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVREF ! ref. state Virtual
+ ! Potential Temperature
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
+! ! t - deltat
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
+! ! t + deltat
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PZS ! orography (for LEONARD terms)
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PWM
! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM
! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), 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
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! Mixing ratios
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at time t
+!
+! In case TURBN%LHARAT=TRUE, PLM already includes all stability corrections
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM ! Turb. mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS ! dissipative length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+REAL, DIMENSION(MERGE(D%NIT,0,OCOMPUTE_SRC)*MERGE(D%NJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), 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
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA ! buoyancy coefficient
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTH_DZ ! d(th)/dz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDR_DZ ! d(rt)/dz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD ! Denominator in Prandtl numbers
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
+REAL, DIMENSION(D%NIJT,D%NKT,KGRADIENTS),INTENT(IN) :: PHGRAD ! horizontal gradients
+REAL, DIMENSION(MERGE(D%NIT,0,TURBN%CTOM=='TM06'),&
+ MERGE(D%NJT,0,TURBN%CTOM=='TM06')), INTENT(INOUT):: PBL_DEPTH ! BL depth
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWTHV ! buoyancy flux
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT) :: PRRS ! cumulated source for rt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTHLP ! guess of thl at t+ deltat
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRP ! guess of r at t+ deltat
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTP ! Dynamic and thermal
! TKE production terms
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSTFL ! Time evol Flux of T at sea surface (LOCEAN and LCOUPLES)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSTFL_C ! O-A interface flux for theta(LOCEAN and LCOUPLES)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSRFL_C ! O-A interface flux for vapor (LOCEAN and LCOUPLES)
!
!
!* 0.2 declaration of local variables
!
!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZA, & ! work variable for wrc or LES computation
ZFLXZ, & ! vertical flux of the treated variable
ZSOURCE, & ! source of evolution for the treated variable
@@ -475,47 +367,29 @@ REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
ZDFDDTDZ, & ! dF/d(dTh/dz)
ZDFDDRDZ, & ! dF/d(dr/dz)
Z3RDMOMENT,& ! 3 order term in flux or variance equation
- ZF_NEW, &
+ ZF_LEONARD,& ! Leonard terms
ZRWTHL, &
ZRWRNP, &
- ZCLD_THOLD
-!
-REAL,DIMENSION(SIZE(XZS,1),SIZE(XZS,2),KKU) :: ZALT
+ ZCLD_THOLD,&
+ ZALT, &
+ ZWORK1,ZWORK2, &
+ ZWORK3,ZWORK4 ! working var. for shuman operators (array syntax)
!
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
+INTEGER :: IKT,IKA,IKU ! array size in k direction
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: JIJ, JK ! loop indexes
+INTEGER :: IIJB, IIJE
+INTEGER :: IKL
!
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
+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'
@@ -527,58 +401,53 @@ 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
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_FLUX',0,ZHOOK_HANDLE)
+!
+! Size for a given proc & a given model
+IIU=D%NIT
+IJU=D%NJT
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+IKA=D%NKA
+IKU=D%NKU
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKL=D%NKL
!
GUSERV = (KRR/=0)
!
-! compute the coefficients for the uncentred gradient computation near the
-! ground
+! compute the coefficients for the uncentred gradient computation near the ground
!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+IF (TURBN%LHARAT) THEN
+ ! LHARAT so TKE and length scales at half levels!
+ !wc 50MF can be omitted with energy cascade included
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZKEFF(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZKEFF)
+ENDIF
!
-! define a cloud mask with ri and rc (used after with a threshold) for Leonard terms
+! Define a cloud mask with ri and rc (used after with a threshold) for Leonard terms
!
-IF(LHGRAD) THEN
+IF(TURBN%LLEONARD) THEN
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
- ZCLD_THOLD(:,:,:) = PRM(:,:,:,2) + PRM(:,:,:,4)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZCLD_THOLD(IIJB:IIJE,1:IKT) = PRM(IIJB:IIJE,1:IKT,2) + PRM(IIJB:IIJE,1:IKT,4)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- ZCLD_THOLD(:,:,:) = PRM(:,:,:,2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZCLD_THOLD(IIJB:IIJE,1:IKT) = PRM(IIJB:IIJE,1:IKT,2)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
END IF
END IF
@@ -591,7 +460,7 @@ GFTHR = .FALSE.
GFWTH = .FALSE.
GFWR = .FALSE.
!
-IF (HTOM/='NONE') THEN
+IF (TURBN%CTOM/='NONE') THEN
GFTH2 = ANY(PFTH2/=0.)
GFR2 = ANY(PFR2 /=0.) .AND. GUSERV
GFTHR = ANY(PFTHR/=0.) .AND. GUSERV
@@ -600,158 +469,234 @@ IF (HTOM/='NONE') THEN
END IF
!----------------------------------------------------------------------------
!
-!* 2. SOURCES OF CONSERVATIVE POTENTIAL TEMPERATURE AND
-! PARTIAL THERMAL PRODUCTION
+!* 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)) )
+CALL DZM_PHY(D,PTHLM,ZWORK1)
+CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWORK2)
+IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = -ZKEFF(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = -ZKEFF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = -CSTURB%XCSHF*PPHI3(IIJB:IIJE,1:IKT)*ZKEFF(IIJB:IIJE,1:IKT)&
+ *ZWORK1(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = -CSTURB%XCSHF*ZKEFF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
+!
+IF (TURBN%LLEONARD) THEN
+! ! Compute the Leonard terms for thl
+ CALL MXF_PHY(D,PHGRAD(:,:,1),ZWORK1) ! GX_W_UW(XWT)
+ CALL MZM_PHY(D,PHGRAD(:,:,3),ZWORK2) ! GX_M_M(PTHLM
+ CALL MYF_PHY(D,PHGRAD(:,:,2),ZWORK3) ! GY_W_VW(PWM)
+ CALL MZM_PHY(D,PHGRAD(:,:,4),ZWORK4) ! GY_M_M(PTHLM)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF_LEONARD (IIJB:IIJE,1:IKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:IKT)*PDYY(IIJB:IIJE,1:IKT)/12.0*( &
+ ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) &
+ + ZWORK3(IIJB:IIJE,1:IKT)*ZWORK4(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_WTH_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
+ CALL D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ & PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM,ZWORK1)
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT)= ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) * PFWTH(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * PFWTH(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL M3_WTH_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,Z3RDMOMENT)
+ CALL D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,Z3RDMOMENT,PREDTH1,PREDR1,&
+ & PD,PBLL_O_E,PETHETA,ZWORK1)
+ CALL MZM_PHY(D,PFTH2,ZWORK2)
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_WTH_W2R(D,CSTURB,PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK1)
+ CALL D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,ZWORK2)
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFWR(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFWR(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL M3_WTH_WR2(D,CSTURB,PD,ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ,ZWORK1)
+ CALL MZM_PHY(D,PFR2,ZWORK2)
+ CALL D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,&
+ & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,ZWORK3)
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL M3_WTH_WTHR(D,CSTURB,PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ & PLEPS,PEMOIST,Z3RDMOMENT)
+ CALL D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,Z3RDMOMENT,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,ZWORK1)
+ CALL MZM_PHY(D,PFTHR, ZWORK2)
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+! specialcase for surface
+IF (OOCEAN) THEN ! ocean model in coupled case
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZF(IIJB:IIJE,IKE+1) = PSFTHM(IIJB:IIJE) &
+ *0.5* ( 1. + PRHODJ(IIJB:IIJE,IKU)/PRHODJ(IIJB:IIJE,IKE) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ELSE ! 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))
+ IF (TURBN%CTURBDIM=='3DIM') THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZF(IIJB:IIJE,IKB) = ( TURBN%XIMPL*PSFTHP(IIJB:IIJE) + PEXPL*PSFTHM(IIJB:IIJE) ) &
+ * PDIRCOSZW(IIJB:IIJE) &
+ * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZF(IIJB:IIJE,IKB) = ( TURBN%XIMPL*PSFTHP(IIJB:IIJE) + PEXPL*PSFTHM(IIJB:IIJE) ) &
+ / PDIRCOSZW(IIJB:IIJE) &
+ * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
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
+#ifdef REPRO48
+#else
+ ZF(IIJB:IIJE,IKE+1)=0.
+#endif
+END IF
!
! Compute the split conservative potential temperature at t+deltat
-CALL TRIDIAG_THERMO(KKA,KKU,KKL,PTHLM,ZF,ZDFDDTDZ,PTSTEP,PIMPL,PDZZ,&
+CALL TRIDIAG_THERMO(D,PTHLM,ZF,ZDFDDTDZ,PTSTEP,TURBN%XIMPL,PDZZ,&
PRHODJ,PTHLP)
!
! Compute the equivalent tendency for the conservative potential temperature
!
-ZRWTHL(:,:,:)= PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZRWTHL(IIJB:IIJE,1:IKT)= PRHODJ(IIJB:IIJE,1:IKT)*(PTHLP(IIJB:IIJE,1:IKT)-PTHLM(IIJB:IIJE,1:IKT))&
+ /PTSTEP
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
-IF (LHGRAD) THEN
- DO JK=1,KKU
- ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
+IF (TURBN%LLEONARD) THEN
+ DO JK=1,IKT
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZALT(IIJB:IIJE,JK) = PZZ(IIJB:IIJE,JK)-PZS(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
- WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
- ZRWTHL(:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ CALL MZM_PHY(D,PRHODJ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT)*ZF_LEONARD(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL GZ_W_M_PHY(D,ZWORK2,PDZZ,ZWORK3)
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:IKT) >= TURBN%XCLDTHOLD) .AND. ( ZALT(IIJB:IIJE,1:IKT) >= TURBN%XALTHGRAD) )
+ ZRWTHL(IIJB:IIJE,1:IKT) = -ZWORK3(IIJB:IIJE,1:IKT)
+ PTHLP(IIJB:IIJE,1:IKT)=PTHLM(IIJB:IIJE,1:IKT)+PTSTEP*ZRWTHL(IIJB:IIJE,1:IKT)/PRHODJ(IIJB:IIJE,1:IKT)
END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
-PRTHLS(:,:,:)= PRTHLS(:,:,:) + ZRWTHL(:,:,:)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWORK1(IIJB:IIJE,1:IKT) = PTHLP(IIJB:IIJE,1:IKT) - PTHLM(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL DZM_PHY(D,ZWORK1,ZWORK2)
+!
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PRTHLS(IIJB:IIJE,1:IKT)= PRTHLS(IIJB:IIJE,1:IKT) + ZRWTHL(IIJB:IIJE,1:IKT)
!
!* 2.2 Partial Thermal Production
!
-! Conservative potential temperature flux :
+! Conservative potential temperature flux :
+!
+!
+ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:IKT) * &
+ ZWORK2(IIJB:IIJE,1:IKT)/ PDZZ(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-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(:,:,:)
+IF (TURBN%LLEONARD) THEN
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:IKT) >= TURBN%XCLDTHOLD) .AND. ( ZALT(IIJB:IIJE,1:IKT) >= TURBN%XALTHGRAD) )
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZF_LEONARD(IIJB:IIJE,1:IKT)
END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
-ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-IF (LOCEAN) THEN
- ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKE+1) = ZFLXZ(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
-!
+!
DO JK=IKTB+1,IKTE-1
- PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWTH(IIJB:IIJE,JK)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+IKL))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
-PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PWTH(IIJB:IIJE,IKB)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+IKL))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
-IF (LOCEAN) THEN
- PWTH(:,:,IKE)=0.5*(ZFLXZ(:,:,IKE)+ZFLXZ(:,:,IKE+KKL))
- PWTH(:,:,KKA)=0.
- PWTH(:,:,KKU)=ZFLXZ(:,:,KKU)
+IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWTH(IIJB:IIJE,IKE)=0.5*(ZFLXZ(IIJB:IIJE,IKE)+ZFLXZ(IIJB:IIJE,IKE+IKL))
+ PWTH(IIJB:IIJE,IKA)=0.
+ PWTH(IIJB:IIJE,IKU)=PWTH(IIJB:IIJE,IKE)! not used
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
- PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
- PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWTH(IIJB:IIJE,IKA)=0.5*(ZFLXZ(IIJB:IIJE,IKA)+ZFLXZ(IIJB:IIJE,IKA+IKL))
+ PWTH(IIJB:IIJE,IKE)=PWTH(IIJB:IIJE,IKE-IKL)
+ PWTH(IIJB:IIJE,IKU)=0.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
! stores the conservative potential temperature vertical flux
TZFIELD%CMNHNAME = 'THW_FLX'
TZFIELD%CSTDNAME = ''
@@ -763,83 +708,159 @@ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZFLXZ)
END IF
!
! Contribution of the conservative temperature flux to the buoyancy flux
-IF (LOCEAN) THEN
- PTP(:,:,:)= XG*XALPHAOC * MZF(ZFLXZ )
+IF (OOCEAN) THEN
+ CALL MZF_PHY(D,ZFLXZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PTP(IIJB:IIJE,1:IKT)= CST%XG*CST%XALPHAOC * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
IF (KRR /= 0) THEN
- PTP(:,:,:) = PBETA * MZF( MZM(PETHETA) * ZFLXZ )
- PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
+ CALL MZM_PHY(D,PETHETA,ZWORK1)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !ZWORK1 = MZF( MZM(PETHETA,IKA, IKU, IKL) * ZFLXZ,IKA, IKU, IKL )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PTP(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PTP(IIJB:IIJE,IKB)= PBETA(IIJB:IIJE,IKB) * PETHETA(IIJB:IIJE,IKB) * &
+ 0.5 * ( ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKB+IKL) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
- PTP(:,:,:)= PBETA * MZF( ZFLXZ )
+ CALL MZF_PHY(D,ZFLXZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PTP(IIJB:IIJE,1:IKT)= PBETA(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
-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)
+CALL MZM_PHY(D,PETHETA,ZWORK1)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PWTHV(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PWTHV(IIJB:IIJE,IKB) = PETHETA(IIJB:IIJE,IKB) * ZFLXZ(IIJB:IIJE,IKB)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+IF (OOCEAN) THEN
+ ! temperature contribution to Buy flux
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWTHV(IIJB:IIJE,IKE) = PETHETA(IIJB:IIJE,IKE) * ZFLXZ(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
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
+! Correction for qc and qi negative in AROME
+IF(HPROGRAM/='AROME ') THEN
+ IF ( KRRL >= 1 ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZF_PHY(D,ZWORK1,ZWORK2)
+ IF ( KRRI >= 1 ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRRS(IIJB:IIJE,1:IKT,2) = PRRS(IIJB:IIJE,1:IKT,2) - &
+ PRHODJ(IIJB:IIJE,1:IKT)*PATHETA(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)&
+ *ZWORK2(IIJB:IIJE,1:IKT) *(1.0-PFRAC_ICE(IIJB:IIJE,1:IKT))
+ PRRS(IIJB:IIJE,1:IKT,4) = PRRS(IIJB:IIJE,1:IKT,4) - &
+ PRHODJ(IIJB:IIJE,1:IKT)*PATHETA(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)&
+ * ZWORK2(IIJB:IIJE,1:IKT)*PFRAC_ICE(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRRS(IIJB:IIJE,1:IKT,2) = PRRS(IIJB:IIJE,1:IKT,2) - &
+ PRHODJ(IIJB:IIJE,1:IKT)*PATHETA(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)&
+ *ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ END IF
END IF
!
!* 2.4 Storage in LES configuration
-!
-IF (LLES_CALL) THEN
+!
+IF (TLES%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 )
+ !
+ CALL MZF_PHY(D,ZFLXZ,ZWORK1)
+ !
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_WThl )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = PWM(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_W_SBG_WThl )
+ !
+ CALL GZ_W_M_PHY(D,PWM,PDZZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_W_SBG_UaThl )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = PDTH_DZ(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Thl_SBG_UaThl )
+ !
+ CALL MZM_PHY(D,PETHETA,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK3,ZWORK4)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK4, TLES%X_LES_SUBGRID_WThv , .TRUE. )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = -CSTURB%XCTP*PSQRT_TKE(IIJB:IIJE,1:IKT)/PLM(IIJB:IIJE,1:IKT) &
+ *ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_ThlPz )
+ !
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaThl )
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = PDR_DZ(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%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 DZM_PHY(D,PTHLP,ZA)
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE (ZA(IIJB:IIJE,1:IKT)==0.)
+ ZA(IIJB:IIJE,1:IKT)=1.E-6
+ END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,1:IKT) = - ZFLXZ(IIJB:IIJE,1:IKT) / ZA(IIJB:IIJE,1:IKT) * PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,IKB) = CSTURB%XCSHF*PPHI3(IIJB:IIJE,IKB)*ZKEFF(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL MZF_PHY(D,ZA,ZA)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,1:IKT) = MIN(MAX(ZA(IIJB:IIJE,1:IKT),-1000.),1000.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZA, TLES%X_LES_SUBGRID_Kh )
!
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%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)
+!
+IF (TURBN%CTOM=='TM06') CALL TM06_H(D,PTSTEP,PZZ,ZFLXZ,PBL_DEPTH)
!
!----------------------------------------------------------------------------
!
!
-!* 3. SOURCES OF CONSERVATIVE AND CLOUD MIXING RATIO AND
-! COMPLETE THERMAL PRODUCTION
+!* 3. SOURCES OF CONSERVATIVE AND CLOUD MIXING RATIO AND
+! COMPLETE THERMAL PRODUCTION
! ------------------------------------------------------
!
!* 3.1 Splitted value for cons. mixing ratio at t+deltat
@@ -848,146 +869,222 @@ IF (HTOM=='TM06') CALL TM06_H(IKB,IKTB,IKTE,PTSTEP,PZZ,ZFLXZ,PBL_DEPTH)
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)
+ CALL DZM_PHY(D,PRM(:,:,1),ZWORK1)
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = -ZKEFF(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = -ZKEFF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ CALL D_PSI3DRDZ_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = -CSTURB%XCSHF*PPSI3(IIJB:IIJE,1:IKT)*ZKEFF(IIJB:IIJE,1:IKT)&
+ *ZWORK1(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = -CSTURB%XCSHF*ZKEFF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
!
! 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
+ IF (TURBN%LLEONARD) THEN
+ CALL MXF_PHY(D,PHGRAD(:,:,1),ZWORK1) ! GX_W_UW(PWM)
+ CALL MZM_PHY(D,PHGRAD(:,:,5),ZWORK2) ! GX_M_M(PRM)
+ CALL MYF_PHY(D,PHGRAD(:,:,2),ZWORK3) ! GY_W_VW(PWM)
+ CALL MZM_PHY(D,PHGRAD(:,:,6),ZWORK4) ! GY_M_M(PRM)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF_LEONARD (IIJB:IIJE,1:IKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:IKT)*PDYY(IIJB:IIJE,1:IKT)/12.0*( &
+ ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) &
+ + ZWORK3(IIJB:IIJE,1:IKT)*ZWORK4(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ 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)
+ CALL M3_WR_W2R(D,CSTURB,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
+ CALL D_M3_WR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ & PBLL_O_E,PEMOIST,ZKEFF,PTKEM,ZWORK1)
!
- ZF = ZF + Z3RDMOMENT * PFWR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
- & PBLL_O_E,PEMOIST,ZKEFF,PTKEM) * PFWR
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT)= ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) * PFWR(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) &
+ * PFWR(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
! d(w'r'2)/dz
IF (GFR2) THEN
- Z3RDMOMENT= M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+ CALL M3_WR_WR2(D,CSTURB,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,Z3RDMOMENT)
+ CALL MZM_PHY(D,PFR2,ZWORK1)
+ CALL D_M3_WR_WR2_O_DDRDZ(D,CSTURB,Z3RDMOMENT,PREDR1,&
+ & PREDTH1,PD,PBLL_O_E,PEMOIST,ZWORK2)
!
- ZF = ZF + Z3RDMOMENT * MZM(PFR2)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WR2_O_DDRDZ(Z3RDMOMENT,PREDR1,&
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFR2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ CALL M3_WR_W2TH(D,CSTURB,PD,ZKEFF,&
+ & PTKEM,PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
+ CALL D_M3_WR_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ & PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFWTH(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * PFWTH(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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)
+ CALL MZM_PHY(D,PFTH2,ZWORK1)
+ CALL M3_WR_WTH2(D,CSTURB,PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ,ZWORK2)
+ CALL D_M3_WR_WTH2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,ZWORK3)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- Z3RDMOMENT= M3_WR_WTHR(PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
- & PLEPS,PETHETA)
+ CALL M3_WR_WTHR(D,CSTURB,PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ & PLEPS,PETHETA,Z3RDMOMENT)
+ CALL MZM_PHY(D,PFTHR,ZWORK1)
+ CALL D_M3_WR_WTHR_O_DDRDZ(D,CSTURB,Z3RDMOMENT,PREDR1, &
+ & PREDTH1,PD,PBLL_O_E,PEMOIST,ZWORK2)
!
- ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(Z3RDMOMENT,PREDR1, &
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFTHR)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) &
+ * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ !special case at sfc
+ IF (OOCEAN) THEN
+ ! General ocean case
+ ! salinity/evap effect to be added later !!!!!
+ ZF(IIJB:IIJE,IKE) = 0.
+ ELSE ! atmosp 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))
+ IF (TURBN%CTURBDIM=='3DIM') THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZF(IIJB:IIJE,IKB) = ( TURBN%XIMPL*PSFRP(IIJB:IIJE) + PEXPL*PSFRM(IIJB:IIJE) ) &
+ * PDIRCOSZW(IIJB:IIJE) &
+ * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZF(IIJB:IIJE,IKB) = ( TURBN%XIMPL*PSFRP(IIJB:IIJE) + PEXPL*PSFRM(IIJB:IIJE) ) &
+ / PDIRCOSZW(IIJB:IIJE) &
+ * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
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.
+#ifdef REPRO48
+#else
+ ZF(IIJB:IIJE,IKE+1)=0.
+#endif
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,&
+ CALL TRIDIAG_THERMO(D,PRM(:,:,1),ZF,ZDFDDRDZ,PTSTEP,TURBN%XIMPL,&
PDZZ,PRHODJ,PRP)
!
! Compute the equivalent tendency for the conservative mixing ratio
!
- ZRWRNP (:,:,:) = PRHODJ(:,:,:)*(PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZRWRNP(IIJB:IIJE,1:IKT) = PRHODJ(IIJB:IIJE,1:IKT)*(PRP(IIJB:IIJE,1:IKT)-PRM(IIJB:IIJE,1:IKT,1))&
+ /PTSTEP
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! 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)
+ IF (TURBN%LLEONARD) THEN
+ CALL MZM_PHY(D,PRHODJ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT)*ZF_LEONARD(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL GZ_W_M_PHY(D,ZWORK2,PDZZ,ZWORK3)
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:IKT) >= TURBN%XCLDTHOLD ) .AND. ( ZALT(IIJB:IIJE,1:IKT) >= TURBN%XALTHGRAD ) )
+ ZRWRNP(IIJB:IIJE,1:IKT) = -ZWORK3(IIJB:IIJE,1:IKT)
+ PRP(IIJB:IIJE,1:IKT)=PRM(IIJB:IIJE,1:IKT,1)+PTSTEP*ZRWTHL(IIJB:IIJE,1:IKT)/PRHODJ(IIJB:IIJE,1:IKT)
END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + ZRWRNP (:,:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PRP(IIJB:IIJE,1:IKT) - PRM(IIJB:IIJE,1:IKT,1)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZM_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) + ZRWRNP(IIJB:IIJE,1:IKT)
!
!* 3.2 Complete thermal production
!
! cons. mixing ratio flux :
!
- ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDRDZ * DZM(PRP - PRM(:,:,:,1)) / PDZZ
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) &
+ + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
! 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(:,:,:)
+ IF (TURBN%LLEONARD) THEN
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:IKT) >= TURBN%XCLDTHOLD ) .AND. ( ZALT(IIJB:IIJE,1:IKT) >= TURBN%XALTHGRAD ) )
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZF_LEONARD(IIJB:IIJE,1:IKT)
END WHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !
+ IF (OOCEAN) THEN
+ ZFLXZ(IIJB:IIJE,IKU) = ZFLXZ(IIJB:IIJE,IKE)
+ END IF
!
DO JK=IKTB+1,IKTE-1
- PWRC(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWRC(IIJB:IIJE,JK)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+IKL))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
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)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWRC(IIJB:IIJE,IKB)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+IKL))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
+ IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWRC(IIJB:IIJE,IKE)=0.5*(ZFLXZ(IIJB:IIJE,IKE)+ZFLXZ(IIJB:IIJE,IKE+IKL))
+ PWRC(IIJB:IIJE,IKA)=0.
+ PWRC(IIJB:IIJE,IKE+1)=ZFLXZ(IIJB:IIJE,IKE+1)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWRC(IIJB:IIJE,IKA)=0.5*(ZFLXZ(IIJB:IIJE,IKA)+ZFLXZ(IIJB:IIJE,IKA+IKL))
+ PWRC(IIJB:IIJE,IKE)=PWRC(IIJB:IIJE,IKE-IKL)
+ PWRC(IIJB:IIJE,IKU)=0.
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ ENDIF
!
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
! stores the conservative mixing ratio vertical flux
TZFIELD%CMNHNAME = 'RCONSW_FLX'
TZFIELD%CSTDNAME = ''
@@ -999,57 +1096,125 @@ IF (KRR /= 0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZFLXZ)
END IF
!
! Contribution of the conservative water flux to the Buoyancy flux
- IF (LOCEAN) THEN
- ZA(:,:,:)= -XG*XBETAOC * MZF(ZFLXZ )
+ IF (OOCEAN) THEN
+ CALL MZF_PHY(D,ZFLXZ,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,1:IKT)= -CST%XG*CST%XBETAOC * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST) * ZFLXZ )
- ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
- PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
+ CALL MZM_PHY(D,PEMOIST,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,IKB) = PBETA(IIJB:IIJE,IKB) * PEMOIST(IIJB:IIJE,IKB) * &
+ 0.5 * ( ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKB+IKL) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PTP(IIJB:IIJE,1:IKT) = PTP(IIJB:IIJE,1:IKT) + ZA(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
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
+ !
+ CALL MZM_PHY(D,PEMOIST,ZWORK1)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PWTHV(IIJB:IIJE,1:IKT)=PWTHV(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWTHV(IIJB:IIJE,IKB) = PWTHV(IIJB:IIJE,IKB) + PEMOIST(IIJB:IIJE,IKB) * ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PWTHV(IIJB:IIJE,IKE) = PWTHV(IIJB:IIJE,IKE) + PEMOIST(IIJB:IIJE,IKE)* ZFLXZ(IIJB:IIJE,IKE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ 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
+! Correction of qc and qi negative for AROME
+IF(HPROGRAM/='AROME ') THEN
+ IF ( KRRL >= 1 ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) / &
+ PDZZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZF_PHY(D,ZWORK2,ZWORK1)
+ !
+ IF ( KRRI >= 1 ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRRS(IIJB:IIJE,1:IKT,2) = PRRS(IIJB:IIJE,1:IKT,2) - &
+ PRHODJ(IIJB:IIJE,1:IKT)*PAMOIST(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)&
+ *ZWORK1(IIJB:IIJE,1:IKT) *(1.0-PFRAC_ICE(IIJB:IIJE,1:IKT))
+ PRRS(IIJB:IIJE,1:IKT,4) = PRRS(IIJB:IIJE,1:IKT,4) - &
+ PRHODJ(IIJB:IIJE,1:IKT)*PAMOIST(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)&
+ *ZWORK1(IIJB:IIJE,1:IKT) *PFRAC_ICE(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRRS(IIJB:IIJE,1:IKT,2) = PRRS(IIJB:IIJE,1:IKT,2) - &
+ PRHODJ(IIJB:IIJE,1:IKT)*PAMOIST(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)&
+ *ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ END IF
+END IF
!
!* 3.4 Storage in LES configuration
-!
- IF (LLES_CALL) THEN
+!
+ IF (TLES%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 MZF_PHY(D,ZFLXZ,ZWORK1)
+ !
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_WRt )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = PWM(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_W_SBG_WRt )
+ !
+ CALL GZ_W_M_PHY(D,PWM,PDZZ,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_W_SBG_UaRt )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = PDTH_DZ(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Thl_SBG_UaRt )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = PDR_DZ(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK2,ZWORK3)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Rt_SBG_UaRt )
+ !
+ CALL MZM_PHY(D,PEMOIST,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZF_PHY(D,ZWORK3,ZWORK4)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK4, TLES%X_LES_SUBGRID_WThv , .TRUE. )
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = -CSTURB%XCTP*PSQRT_TKE(IIJB:IIJE,1:IKT)/PLM(IIJB:IIJE,1:IKT) &
+ *ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_RtPz )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END IF
@@ -1061,23 +1226,53 @@ END IF
! -------------------------------
!
!
-!* 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(:,:)
+!* 4.1 <w Rc>
+!
+IF ( ((TURBN%LTURB_FLX .AND. TPFILE%LOPENED) .OR. TLES%LLES_CALL) .AND. (KRRL > 0) ) THEN
+!
+! recover the Conservative potential temperature flux :
+! With TURBN%LHARAT is true tke and length scales at half levels
+! yet modify to use length scale and tke at half levels from vdfexcuhl
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = TURBN%XIMPL * PTHLP(IIJB:IIJE,1:IKT) + PEXPL * PTHLM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL DZM_PHY(D,ZWORK1,ZWORK2)
+ IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT)/ PDZZ(IIJB:IIJE,1:IKT) * &
+ (-PLM(IIJB:IIJE,1:IKT)*PSQRT_TKE(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT)*PSQRT_TKE(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK3)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZA(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT)/ PDZZ(IIJB:IIJE,1:IKT) * &
+ (-PPHI3(IIJB:IIJE,1:IKT)*ZWORK3(IIJB:IIJE,1:IKT)) * CSTURB%XCSHF
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ENDIF
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZA(IIJB:IIJE,IKB) = (TURBN%XIMPL*PSFTHP(IIJB:IIJE) + PEXPL*PSFTHM(IIJB:IIJE)) * PDIRCOSZW(IIJB:IIJE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
! compute <w Rc>
- ZFLXZ(:,:,:) = MZM( PAMOIST * 2.* PSRCM ) * ZFLXZ(:,:,:) + &
- MZM( PATHETA * 2.* PSRCM ) * ZA(:,:,:)
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = PAMOIST(IIJB:IIJE,1:IKT) * 2.* PSRCM(IIJB:IIJE,1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = PATHETA(IIJB:IIJE,1:IKT) * 2.* PSRCM(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MZM_PHY(D,ZWORK1,ZWORK3)
+ CALL MZM_PHY(D,ZWORK2,ZWORK4)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFLXZ(IIJB:IIJE,1:IKT) = ZWORK3(IIJB:IIJE,1:IKT)* ZFLXZ(IIJB:IIJE,1:IKT) &
+ + ZWORK4(IIJB:IIJE,1:IKT)* ZA(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ !
! store the liquid water mixing ratio vertical flux
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'RCW_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'RCW_FLX'
@@ -1088,22 +1283,22 @@ IF ( ((OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZFLXZ)
END IF
- !
+ !
! and we store in LES configuration this subgrid flux <w'rc'>
!
- IF (LLES_CALL) THEN
+ IF (TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRc )
+ CALL MZF_PHY(D,ZFLXZ,ZWORK1)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_WRc )
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%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
+END MODULE MODE_TURB_VER_THERMO_FLUX
diff --git a/src/PHYEX/turb/mode_update_iiju_phy.f90 b/src/PHYEX/turb/mode_update_iiju_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c67545befe1ec9fba984d2ea008431bb8692963c
--- /dev/null
+++ b/src/PHYEX/turb/mode_update_iiju_phy.f90
@@ -0,0 +1,72 @@
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+MODULE MODE_UPDATE_IIJU_PHY
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE UPDATE_IIJU_PHY(D,PVAR)
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! ##############################################################
+!
+!!**** *MODE_UPDATE_IIJU_PHY* -
+!!
+!! PURPOSE
+!! -------
+!! This routine update IIU-1 and IJU-1 values to (IIU,IJU) values in the PHYEX
+!! package where all arrays have a single dimension for the horizontal coordinates
+!! i.e. ni*nj
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! Q. Rodier - Meteo-France -
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/08/22
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PVAR ! working variable
+!
+INTEGER :: IIE,IIB,IJE,IJB,IIU,IJU,IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('UPDATE_IIJU_PHY',0,ZHOOK_HANDLE)
+IIE=D%NIEC
+IIB=D%NIBC
+IJE=D%NJEC
+IJB=D%NJBC
+IIU=D%NIT
+IJU=D%NJT
+IKT=D%NKT
+!
+PVAR(IIU,IJB:IJE,1:IKT) = PVAR(IIU-1,IJB:IJE,1:IKT)
+PVAR(IIB:IIE,IJU,1:IKT) = PVAR(IIB:IIE,IJU-1,1:IKT)
+!
+IF (LHOOK) CALL DR_HOOK('UPDATE_IIJU_PHY',1,ZHOOK_HANDLE)
+END SUBROUTINE UPDATE_IIJU_PHY
+END MODULE MODE_UPDATE_IIJU_PHY
diff --git a/src/PHYEX/turb/mode_update_lm.f90 b/src/PHYEX/turb/mode_update_lm.f90
index f11bbcf681209aa8b8f288c9119e9d6df889cf86..5f3509398aa633335d26156660f8107ccbf351e1 100644
--- a/src/PHYEX/turb/mode_update_lm.f90
+++ b/src/PHYEX/turb/mode_update_lm.f90
@@ -3,29 +3,10 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ###################
- MODULE MODI_UPDATE_LM
-! ###################
-INTERFACE
-!
-SUBROUTINE UPDATE_LM(HLBCX,HLBCY,PLM,PLEPS)
-!
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X boundary type
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y boundary type
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! dissipative length
-!
-END SUBROUTINE UPDATE_LM
-!
-END INTERFACE
-!
-END MODULE MODI_UPDATE_LM
-!
-!
-!
-! #################################################################
- SUBROUTINE UPDATE_LM(HLBCX,HLBCY,PLM,PLEPS)
+ MODULE MODE_UPDATE_LM
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE UPDATE_LM(D,HLBCX,HLBCY,PLM,PLEPS)
! #################################################################
!
!!**** *UPDATE_LM* - routine to set external points for mixing length
@@ -60,8 +41,8 @@ END MODULE MODI_UPDATE_LM
!
!* 0. DECLARATIONS
!
-USE MODD_CONF
USE MODD_PARAMETERS
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
@@ -71,11 +52,12 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X boundary type
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y boundary type
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! dissipative length
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PLM ! mixing length
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PLEPS ! dissipative length
!
!* 0.2 declarations of local variables
!
@@ -92,7 +74,10 @@ INTEGER :: IINFO_ll ! return code of parallel routine
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS :
! ----------------------------
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IIB = D%NIB
+IIE = D%NIE
+IJB = D%NJB
+IJE = D%NJE
NULLIFY(TZLM_ll)
!
!-------------------------------------------------------------------------------
@@ -135,3 +120,4 @@ IF ( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
END IF
!-----------------------------------------------------------------------------
END SUBROUTINE UPDATE_LM
+END MODULE MODE_UPDATE_LM
diff --git a/src/PHYEX/turb/modi_shallow_mf.f90 b/src/PHYEX/turb/modi_shallow_mf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..564fdaa0927adf939bf8dc0a2066d54dc7b24d42
--- /dev/null
+++ b/src/PHYEX/turb/modi_shallow_mf.f90
@@ -0,0 +1,107 @@
+! ######spl
+ MODULE MODI_SHALLOW_MF
+! ######################
+!
+INTERFACE
+! #################################################################
+ SUBROUTINE SHALLOW_MF(D, CST, NEB, PARAMMF, TURBN, CSTURB, &
+ KRR, KRRL, KRRI, KSV, &
+ HFRAC_ICE,ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXNM, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PTKEM,PSVM, &
+ PDUDT_MF,PDVDT_MF, &
+ PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, &
+ PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, &
+ PFLXZTHMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
+ PU_UP, PV_UP, PTHV_UP, PW_UP, &
+ PFRAC_UP,PEMF,PDETR,PENTR, &
+ KKLCL,KKETL,KKCTL,PDX,PDY,PRSVS,PSVMIN, &
+ BUCONF, TBUDGETS, KBUDGETS )
+! #################################################################
+!!
+USE MODD_BUDGET, ONLY: TBUDGETCONF_t, TBUDGETDATA
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_PARAMETERS, ONLY: JPSVMAX
+!
+!* 1.1 Declaration of Arguments
+!
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D ! PHYEX variables dimensions structure
+TYPE(CST_t), INTENT(IN) :: CST ! modd_cst general constant structure
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+TYPE(TURB_t), INTENT(IN) :: TURBN ! modn_turbn (turb namelist) structure
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB ! modd_csturb turb constant structure
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+INTEGER, INTENT(IN) :: KSV ! number of scalar var.
+CHARACTER*1, INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
+LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
+INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
+INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNM ! Exner function at t-dt
+
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(D%NIJT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM,PVM ! wind components at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! tke at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar variable a t-dt
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZTHMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZRMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZUMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZVMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRV_UP ! Vapor updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PEMF ! updraft mass flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDETR ! updraft detrainment
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PENTR ! updraft entrainment
+INTEGER,DIMENSION(D%NIJT), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
+REAL, INTENT(IN) :: PDX, PDY
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN),OPTIONAL :: PRSVS ! sources of sv (for Budgets with lagrangian tracer)
+TYPE(TBUDGETCONF_t), INTENT(IN),OPTIONAL :: BUCONF ! budget structure
+INTEGER, INTENT(IN) :: KBUDGETS ! option. because not used in arpifs
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT),OPTIONAL :: TBUDGETS
+REAL,DIMENSION(JPSVMAX),INTENT(IN),OPTIONAL :: PSVMIN ! minimum value for SV variables
+
+END SUBROUTINE SHALLOW_MF
+
+END INTERFACE
+!
+END MODULE MODI_SHALLOW_MF
diff --git a/src/PHYEX/turb/modi_turb.f90 b/src/PHYEX/turb/modi_turb.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3694890aeed0689c5cfd322fe6b39c9dfdb739b5
--- /dev/null
+++ b/src/PHYEX/turb/modi_turb.f90
@@ -0,0 +1,189 @@
+! ######spl
+ MODULE MODI_TURB
+! ################
+!
+INTERFACE
+!
+ SUBROUTINE TURB(CST,CSTURB,BUCONF,TURBN,D,TLES, &
+ & KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KGRADIENTS,KHALO, &
+ & KSPLIT,KMODEL_CL,KSV,KSV_LGBEG,KSV_LGEND,HPROGRAM, &
+ & KSV_LIMA_NR, KSV_LIMA_NS, KSV_LIMA_NG, KSV_LIMA_NH, &
+ & O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM, &
+ & OCOMPUTE_SRC, PRSNOW, &
+ & OOCEAN,ODEEPOC,ODIAG_IN_RUN, &
+ & HTURBLEN_CL,HCLOUD, &
+ & PTSTEP,TPFILE, &
+ & PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
+ & PRHODJ,PTHVREF,PHGRAD,PZS, &
+ & 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, &
+ & PSIGS, &
+ & PFLXZTHVMF,PWTH,PWRC,PWSV,PDP,PTP,PTDIFF,PTDISS, &
+ & TBUDGETS, KBUDGETS, &
+ & PEDR,PLEM,PRTKEMS,PTPMF, &
+ & PDRUS_TURB,PDRVS_TURB, &
+ & PDRTHLS_TURB,PDRRTS_TURB,PDRSVS_TURB,PTR,PDISS, &
+ & PIBM_LS, PIBM_XMUT, &
+ & PCURRENT_TKE_DISS, PSSTFL, PSSTFL_C, PSSRFL_C, &
+ & PSSUFL_C, PSSVFL_C,PSSUFL,PSSVFL )
+!
+USE MODD_BUDGET, ONLY : TBUDGETDATA,TBUDGETCONF_t
+USE MODD_IO, ONLY : TFILEDATA
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_LES, ONLY: TLES_t
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D ! PHYEX variables dimensions structure
+TYPE(CST_t), INTENT(IN) :: CST ! modd_cst general constant structure
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB ! modd_csturb turb constant structure
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF ! budget structure
+TYPE(TURB_t), INTENT(IN) :: TURBN ! modn_turbn (turb namelist) structure
+TYPE(TLES_t), INTENT(IN) :: TLES ! modd_les structure
+INTEGER, INTENT(IN) :: KGRADIENTS ! Number of stored horizontal gradients
+INTEGER, INTENT(IN) :: KMI ! model index number
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
+INTEGER, INTENT(IN) :: KSV, KSV_LGBEG, KSV_LGEND ! number of scalar variables
+INTEGER, INTENT(IN) :: KSV_LIMA_NR,KSV_LIMA_NS,KSV_LIMA_NG,KSV_LIMA_NH
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
+INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
+INTEGER, INTENT(IN) :: KHALO ! Size of the halo for parallel distribution
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: ODEEPOC ! activates sfc forcing for ideal ocean deep conv
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+LOGICAL, INTENT(IN) :: ODIAG_IN_RUN ! switch to activate online diagnostics (mesonh)
+LOGICAL, INTENT(IN) :: OIBM ! switch to modity mixing length near building with IBM
+CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
+REAL, INTENT(IN) :: PTSTEP ! timestep
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! physical distance
+! between 2 succesive grid points along the K direction
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PZS ! orography (for LEONARD terms)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVREF ! Virtual Potential
+ ! Temperature of the reference state
+REAL, DIMENSION(D%NIJT,D%NKT,KGRADIENTS), INTENT(IN) :: PHGRAD ! horizontal gradients
+!
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV, &
+! normal surface fluxes of theta and Rv
+ PSFU,PSFV
+! normal surface fluxes of (u,v) parallel to the orography
+REAL, DIMENSION(D%NIJT,KSV), INTENT(IN) :: PSFSV
+! normal surface fluxes of Scalar var.
+!
+! prognostic variables at t- deltat
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! Pressure at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUT,PVT,PWT ! wind components
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKET ! TKE
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVT ! passive scal. var.
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(IN) :: PSRCT ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
+REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%CTOM=='TM06')),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
+REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%LRMC01)),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
+!
+! variables for cloud mixing length
+REAL, DIMENSION(MERGE(D%NIJT,0,KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE'),&
+ MERGE(D%NKT,0,KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE')),INTENT(IN) :: PCEI
+ ! Cloud Entrainment instability
+ ! index to emphasize localy
+ ! turbulent fluxes
+REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index CEI
+REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
+REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
+!
+! thermodynamical variables which are transformed in conservative var.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT) :: PRT ! water var. where
+ ! PRT(:,:,:,1) is the conservative mixing ratio
+!
+! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
+! TKE dissipation
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
+! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
+! mixing ratio
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN),OPTIONAL :: PRTKEMS
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT) :: PRRS
+! Source terms for all passive scalar variables
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(INOUT) :: PRSVS
+! Sigma_s at time t+1 : square root of the variance of the deviation to the
+! saturation
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(OUT) :: PSIGS
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PDRUS_TURB ! evolution of rhoJ*U by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PDRVS_TURB ! evolution of rhoJ*V by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PDRTHLS_TURB ! evolution of rhoJ*thl by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PDRRTS_TURB ! evolution of rhoJ*rt by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT),OPTIONAL :: PDRSVS_TURB ! evolution of rhoJ*Sv by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLXZTHVMF
+! MF contribution for vert. turb. transport
+! used in the buoy. prod. of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(D%NIJT,D%NKT,KSV),INTENT(OUT) :: PWSV ! scalar flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTP ! Thermal TKE production
+ ! MassFlux + turb
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PTPMF ! Thermal TKE production
+ ! MassFlux Only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDP ! Dynamic TKE production
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTDISS ! Dissipation TKE term
+!
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! CPROGRAM is the program currently running (modd_conf)
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
+!
+! length scale from vdfexcu
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLENGTHM, PLENGTHH
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PEDR ! EDR
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PLEM ! Mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PTR ! Transport prod. of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PDISS ! Dissipation of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT), OPTIONAL :: PCURRENT_TKE_DISS ! if ODIAG_IN_RUN in mesonh
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSTFL ! Time evol Flux of T at sea surface (LOCEAN)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSTFL_C ! O-A interface flux for theta(LOCEAN and LCOUPLES)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSRFL_C ! O-A interface flux for vapor (LOCEAN and LCOUPLES)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSUFL_C ! Time evol Flux of U at sea surface (LOCEAN)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSVFL_C !
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSUFL
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSVFL !
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN), OPTIONAL :: PIBM_XMUT ! IBM turbulent viscosity
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN), OPTIONAL :: PIBM_LS ! IBM Level-set function
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TURB
+!
+END INTERFACE
+!
+END MODULE MODI_TURB
diff --git a/src/PHYEX/turb/shallow_mf.f90 b/src/PHYEX/turb/shallow_mf.f90
index 2ae315ad50a14bfbde7b9d63aa515abfd3646b0a..ec3a76764d15e02c60fa00531c59a39a99fb6bad 100644
--- a/src/PHYEX/turb/shallow_mf.f90
+++ b/src/PHYEX/turb/shallow_mf.f90
@@ -3,129 +3,25 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_SHALLOW_MF
-! ######################
-!
-INTERFACE
-! #################################################################
- SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, &
- PDZZ, PZZ, &
- PRHODJ, PRHODREF, &
- PPABSM, PEXNM, &
- PSFTH,PSFRV, &
- PTHM,PRM,PUM,PVM,PWM,PTKEM,PSVM, &
- PDUDT_MF,PDVDT_MF, &
- PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, &
- PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, &
- PFLXZTHMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
- PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
- PU_UP, PV_UP, PTHV_UP, PW_UP, &
- PTHL_DO,PTHV_DO,PRT_DO,PU_DO, PV_DO, &
- PFRAC_UP,PEMF,PDETR,PENTR, &
- KKLCL,KKETL,KKCTL )
-! #################################################################
-!!
-!
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
- ! 'NONE' if no parameterization
-CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
- ! scheme
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
-REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
-
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! Theta at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! tke at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZRMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
-
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_DO ! Thl environment characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_DO ! Thv environment characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_DO ! Rt environment characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_DO ! U wind environment characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_DO ! V wind environment characteristics
-
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment
-REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment
-INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
-
-
-END SUBROUTINE SHALLOW_MF
-
-END INTERFACE
-!
-END MODULE MODI_SHALLOW_MF
! ################################################################
- SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ SUBROUTINE SHALLOW_MF(D, CST, NEB, PARAMMF, TURBN, CSTURB, &
+ KRR, KRRL, KRRI, KSV, &
+ HFRAC_ICE,ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PIMPL_MF, PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
PPABSM, PEXNM, &
PSFTH,PSFRV, &
- PTHM,PRM,PUM,PVM,PWM,PTKEM,PSVM, &
+ PTHM,PRM,PUM,PVM,PTKEM,PSVM, &
PDUDT_MF,PDVDT_MF, &
PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, &
PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, &
PFLXZTHMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
PU_UP, PV_UP, PTHV_UP, PW_UP, &
- PTHL_DO,PTHV_DO,PRT_DO,PU_DO, PV_DO, &
PFRAC_UP,PEMF,PDETR,PENTR, &
- KKLCL,KKETL,KKCTL )
+ KKLCL,KKETL,KKCTL,PDX,PDY,PRSVS,PSVMIN, &
+ BUCONF, TBUDGETS, KBUDGETS )
! #################################################################
!!
@@ -165,6 +61,7 @@ END MODULE MODI_SHALLOW_MF
!! R.Honnert 07/2012 : MF gray zone
!! R.Honnert 10/2016 : SURF=gray zone initilisation + EDKF
!! R.Honnert 10/2016 : Update with Arome
+!! S. Riette Nov 2016: HFRAC_ICE support
!! Philippe Wautelet 28/05/2018: corrected truncated integer division (2/3 -> 2./3.)
!! Q.Rodier 01/2019 : support RM17 mixing length
!! R.Honnert 1/2019 : remove SURF
@@ -175,26 +72,28 @@ END MODULE MODI_SHALLOW_MF
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_PARAM_MFSHALL_n
-USE MODD_TURB_n, ONLY: CTURBLEN
-
-USE MODI_THL_RT_FROM_TH_R_MF
-USE MODI_COMPUTE_UPDRAFT
-USE MODI_COMPUTE_UPDRAFT_RHCJ10
-USE MODI_COMPUTE_UPDRAFT_RAHA
-USE MODI_MF_TURB
-USE MODI_MF_TURB_EXPL
-USE MODI_MF_TURB_GREYZONE
-USE MODI_COMPUTE_MF_CLOUD
-USE MODI_COMPUTE_FRAC_ICE
-USE MODI_SHUMAN_MF
+USE MODD_BUDGET, ONLY: TBUDGETCONF_t, TBUDGETDATA, NBUDGET_U, NBUDGET_V, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_SV1
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_NEB, ONLY: NEB_t
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
+USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_PARAMETERS, ONLY: JPSVMAX
!
-USE MODI_COMPUTE_BL89_ML
-USE MODD_GRID_n, ONLY : XDXHAT, XDYHAT
-USE MODD_REF_n, ONLY : XTHVREF
-USE MODE_MSG
+USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD_PHY
+USE MODE_THL_RT_FROM_TH_R_MF, ONLY: THL_RT_FROM_TH_R_MF
+USE MODE_COMPUTE_UPDRAFT, ONLY: COMPUTE_UPDRAFT
+USE MODE_COMPUTE_UPDRAFT_RHCJ10, ONLY: COMPUTE_UPDRAFT_RHCJ10
+USE MODE_COMPUTE_UPDRAFT_RAHA, ONLY: COMPUTE_UPDRAFT_RAHA
+USE MODE_MF_TURB, ONLY: MF_TURB
+USE MODE_MF_TURB_EXPL, ONLY: MF_TURB_EXPL
+USE MODE_COMPUTE_MF_CLOUD, ONLY: COMPUTE_MF_CLOUD
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE SHUMAN_PHY, ONLY: MXM_PHY, MYM_PHY
!
IMPLICIT NONE
@@ -202,113 +101,108 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+TYPE(DIMPHYEX_t), INTENT(IN) :: D ! PHYEX variables dimensions structure
+TYPE(CST_t), INTENT(IN) :: CST ! modd_cst general constant structure
+TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
+TYPE(TURB_t), INTENT(IN) :: TURBN ! modn_turbn (turb namelist) structure
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB ! modd_csturb turb constant structure
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
- ! 'NONE' if no parameterization
-CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
- ! scheme
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+INTEGER, INTENT(IN) :: KSV ! number of scalar var.
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNM ! Exner function at t-dt
+
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(IN) :: PRM ! water var. at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM,PVM ! wind components at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! tke at t-dt
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar variable a t-dt
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
+
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZTHMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZRMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZUMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PFLXZVMF
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PEMF ! updraft mass flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDETR ! updraft detrainment
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PENTR ! updraft entrainment
+INTEGER,DIMENSION(D%NIJT), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
+REAL, INTENT(IN) :: PDX, PDY
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN),OPTIONAL :: PRSVS ! sources of sv (for Budgets with lagrangian tracer)
+TYPE(TBUDGETCONF_t), INTENT(IN),OPTIONAL :: BUCONF ! budget structure
+INTEGER, INTENT(IN) :: KBUDGETS ! option. because not used in arpifs
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT),OPTIONAL :: TBUDGETS
+REAL,DIMENSION(JPSVMAX),INTENT(IN),OPTIONAL :: PSVMIN ! minimum value for SV variables (for Budgets)
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! Theta at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! tke at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT):: PDUDT_MF ! tendency of U by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZRMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
-
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_DO ! Thl environment characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_DO ! Thv environment characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_DO ! Rt environment characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_DO ! U wind environment characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_DO ! V wind environment characteristics
-
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment
-REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment
-INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
!
! 0.2 Declaration of local variables
!
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZTHLM, & !
ZRTM, & !
ZTHVM, & !
+ ZWORK,ZWORK2, &
ZEMF_O_RHODREF, & ! entrainment/detrainment
ZBUO_INTEG ! integrated buoyancy
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZFRAC_ICE
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
+REAL, DIMENSION(D%NIJT,D%NKT,KSV) :: &
ZSV_UP,& ! updraft scalar var.
- ZSV_DO,& ! updraft scalar var.
ZFLXZSVMF ! Flux
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness of cloud
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRSAT_UP ! Rsat in updraft
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ !vertical wind shear
+REAL, DIMENSION(D%NIJT) :: ZDEPTH ! Deepness of cloud
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZFRAC_ICE_UP ! liquid/solid fraction in updraft
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZRSAT_UP ! Rsat in updraft
LOGICAL :: GENTR_DETR ! flag to recompute entrainment, detrainment and mass flux
-INTEGER :: IKB ! near ground physical index
-INTEGER :: IKE ! uppest atmosphere physical index
-! pour bouttle et al.
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF,PTHVREF
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRESOL_NORM, ZRESOL_GRID,& ! normalized grid
- ZLUP, ZPLAW
-! Test if the ascent continue, if LCL or ETL is reached
-LOGICAL :: GLMIX
- INTEGER :: JI,JJ,JK ! loop counter
+INTEGER, DIMENSION(D%NIJT,D%NKT) :: IERR
+INTEGER :: JIJ, JK, JSV
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKT
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------
!!! 1. Initialisation
-
-! vertical boundaries
-IKB=KKA+KKL*JPVEXT
-IKE=KKU-KKL*JPVEXT
-
+IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',0,ZHOOK_HANDLE)
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKT=D%NKT
+!
! updraft governing variables
-IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN
+IF (PARAMMF%CMF_UPDRAFT == 'EDKF' .OR. PARAMMF%CMF_UPDRAFT == 'RHCJ') THEN
PENTR = 1.E20
PDETR = 1.E20
PEMF = 1.E20
@@ -317,28 +211,36 @@ ENDIF
! Thermodynamics functions
ZFRAC_ICE(:,:) = 0.
-IF (SIZE(PRM,3).GE.4) THEN
- WHERE(PRM(:,:,2)+PRM(:,:,4) > 1.E-20)
- ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4))
+IF (KRR.GE.4) THEN
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE(PRM(IIJB:IIJE,1:IKT,2)+PRM(IIJB:IIJE,1:IKT,4) > 1.E-20)
+ ZFRAC_ICE(IIJB:IIJE,1:IKT) = PRM(IIJB:IIJE,1:IKT,4) / (PRM(IIJB:IIJE,1:IKT,2)+PRM(IIJB:IIJE,1:IKT,4))
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
ENDIF
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZWK(IIJB:IIJE,1:IKT)=PTHM(IIJB:IIJE,1:IKT)*PEXNM(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,ZFRAC_ICE(:,:),ZWK(:,:), IERR(:,:))
! Conservative variables at t-dt
-CALL THL_RT_FROM_TH_R_MF(KRR,KRRL,KRRI, &
+CALL THL_RT_FROM_TH_R_MF(D, CST, KRR,KRRL,KRRI, &
PTHM, PRM, PEXNM, &
ZTHLM, ZRTM )
! Virtual potential temperature at t-dt
-ZTHVM(:,:) = PTHM(:,:)*((1.+XRV / XRD *PRM(:,:,1))/(1.+ZRTM(:,:)))
-
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZTHVM(IIJB:IIJE,1:IKT) = PTHM(IIJB:IIJE,1:IKT)*&
+ & ((1.+CST%XRV / CST%XRD *PRM(IIJB:IIJE,1:IKT,1))/(1.+ZRTM(IIJB:IIJE,1:IKT)))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!!! 2. Compute updraft
!!! ---------------
!
-IF (HMF_UPDRAFT == 'EDKF') THEN
+IF (PARAMMF%CMF_UPDRAFT == 'EDKF') THEN
GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
+ CALL COMPUTE_UPDRAFT(D, CST, NEB, PARAMMF, TURBN, CSTURB, &
+ KSV, HFRAC_ICE, GENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV,PPABSM,PRHODREF, &
@@ -347,10 +249,12 @@ IF (HMF_UPDRAFT == 'EDKF') THEN
PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, &
PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
- PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
-ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN
+ PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH,&
+ PDX,PDY)
+ELSEIF (PARAMMF%CMF_UPDRAFT == 'RHCJ') THEN
GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT_RHCJ10(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
+ CALL COMPUTE_UPDRAFT_RHCJ10(D, CST, NEB, PARAMMF, TURBN, CSTURB,&
+ KSV, HFRAC_ICE, GENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV,PPABSM,PRHODREF, &
@@ -360,9 +264,9 @@ ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN
PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, &
PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
-ELSEIF (HMF_UPDRAFT == 'RAHA') THEN
- CALL COMPUTE_UPDRAFT_RAHA(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE, &
- GENTR_DETR,OMIXUV, &
+ELSEIF (PARAMMF%CMF_UPDRAFT == 'RAHA') THEN
+ CALL COMPUTE_UPDRAFT_RAHA(D, CST, NEB, PARAMMF, &
+ KSV, HFRAC_ICE, GENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
@@ -375,17 +279,18 @@ ELSEIF (HMF_UPDRAFT == 'RAHA') THEN
PEMF,PDETR,PENTR, &
ZBUO_INTEG,KKLCL,KKETL,KKCTL, &
ZDEPTH )
-ELSEIF (HMF_UPDRAFT == 'DUAL') THEN
+ELSEIF (PARAMMF%CMF_UPDRAFT == 'DUAL') THEN
!Updraft characteristics are already computed and received by interface
ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//TRIM(PARAMMF%CMF_UPDRAFT) )
ENDIF
!!! 5. Compute diagnostic convective cloud fraction and content
!!! --------------------------------------------------------
!
-CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
- HMF_CLOUD,ZFRAC_ICE, &
+CALL COMPUTE_MF_CLOUD(D,CST,CSTURB,PARAMMF,TURBN%LSTATNW,&
+ KRR, KRRL, KRRI, &
+ ZFRAC_ICE, &
PRC_UP,PRI_UP,PEMF, &
PTHL_UP,PRT_UP,PFRAC_UP, &
PTHV_UP,ZFRAC_ICE_UP, &
@@ -399,34 +304,32 @@ CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
!!! 3. Compute fluxes of conservative variables and their divergence = tendency
!!! ------------------------------------------------------------------------
!
-ZEMF_O_RHODREF=PEMF/PRHODREF
-IF(HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN
- IF ( PIMPL_MF > 1.E-10 ) THEN
- CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, &
- PDZZ, &
- PRHODJ, &
- ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, &
- PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF,PDSVDT_MF, &
- ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,&
- PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
- ZFLXZSVMF )
- ELSE
- CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
- PRHODJ, &
- ZTHLM,ZTHVM,ZRTM,PUM,PVM, &
- PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, &
- ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
- PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
- ENDIF
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZEMF_O_RHODREF(IIJB:IIJE,1:IKT)=PEMF(IIJB:IIJE,1:IKT)/PRHODREF(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+
+IF ( PIMPL_MF > 1.E-10 ) THEN
+ CALL MF_TURB(D, KSV, PARAMMF%LMIXUV, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, &
+ PRHODJ, &
+ ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, &
+ PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF,PDSVDT_MF, &
+ ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,&
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
+ ZFLXZSVMF )
ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
-END IF
-
-! security in the case HMF_UPDRAFT = 'DUAL'
+ CALL MF_TURB_EXPL(D, PARAMMF, &
+ PRHODJ,ZTHLM,ZTHVM,ZRTM,PUM,PVM, &
+ PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, &
+ ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
+ PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
+ENDIF
+
+! security in the case PARAMMF%CMF_UPDRAFT = 'DUAL'
! to be modified if 'DUAL' is evolving (momentum mixing for example)
-IF( HMF_UPDRAFT == 'DUAL') THEN
+IF( PARAMMF%CMF_UPDRAFT == 'DUAL') THEN
! Now thetav_up from vdfhghtnn is used!
PFLXZTHVMF=0.
! Yes/No UV mixing!
@@ -434,4 +337,61 @@ IF( HMF_UPDRAFT == 'DUAL') THEN
! PDVDT_MF=0.
ENDIF
!
+#ifdef REPRO48
+#else
+IF(PRESENT(BUCONF)) THEN
+ IF( BUCONF%LBUDGET_U ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK(IIJB:IIJE,1:IKT)=PRHODJ(IIJB:IIJE,1:IKT)*PDUDT_MF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MXM_PHY(D, ZWORK, ZWORK2)
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_U ), 'MAFL', ZWORK2)
+ END IF
+!
+ IF( BUCONF%LBUDGET_V ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK(IIJB:IIJE,1:IKT)=PRHODJ(IIJB:IIJE,1:IKT)*PDVDT_MF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL MYM_PHY(D, ZWORK, ZWORK2)
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_V ), 'MAFL', ZWORK2)
+ END IF
+!
+ IF( BUCONF%LBUDGET_TH ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK(IIJB:IIJE,1:IKT)=PRHODJ(IIJB:IIJE,1:IKT)*PDTHLDT_MF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'MAFL', ZWORK)
+ END IF
+!
+ IF( BUCONF%LBUDGET_RV ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK(IIJB:IIJE,1:IKT)=PRHODJ(IIJB:IIJE,1:IKT)*PDRTDT_MF(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'MAFL', ZWORK)
+ END IF
+!
+ IF( BUCONF%LBUDGET_SV ) THEN
+ DO JSV=1,KSV
+ IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK(IIJB:IIJE,1:IKT)=MAX(PRSVS(IIJB:IIJE,1:IKT,JSV) + PRHODJ(IIJB:IIJE,1:IKT)* &
+ PDSVDT_MF(IIJB:IIJE,1:IKT,JSV),PSVMIN(JSV))
+ ZWORK(IIJB:IIJE,1:IKT)=PRSVS(IIJB:IIJE,1:IKT,JSV) - ZWORK(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK(IIJB:IIJE,1:IKT)=PRHODJ(IIJB:IIJE,1:IKT)*PDSVDT_MF(IIJB:IIJE,1:IKT,JSV)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ END IF
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'MAFL', ZWORK )
+ END DO
+ END IF
+END IF
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',1,ZHOOK_HANDLE)
+!
+CONTAINS
+INCLUDE "compute_frac_ice.func.h"
+!
END SUBROUTINE SHALLOW_MF
diff --git a/src/PHYEX/turb/shuman_mf.f90 b/src/PHYEX/turb/shuman_mf.f90
index ce9cde0512e4e7c8ebec82d323448dc1dd2e3c6e..2c6dabccddf3662dc7daa62f9ac64b73912600ad 100644
--- a/src/PHYEX/turb/shuman_mf.f90
+++ b/src/PHYEX/turb/shuman_mf.f90
@@ -8,70 +8,72 @@
!
INTERFACE
!
-FUNCTION DZF_MF(KKA,KKU,KKL,PA) RESULT(PDZF)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZF ! result at mass
- ! localization
-END FUNCTION DZF_MF
-!
-FUNCTION DZM_MF(KKA,KKU,KKL,PA) RESULT(PDZM)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass
+SUBROUTINE DZF_MF(D, PA, PDZF)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDZF ! result at mass
! localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZM ! result at flux
+END SUBROUTINE DZF_MF
+!
+SUBROUTINE DZM_MF(D, PA, PDZM)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDZM ! result at flux
! side
-END FUNCTION DZM_MF
-!
-FUNCTION MZF_MF(KKA,KKU,KKL,PA) RESULT(PMZF)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZF ! result at mass
- ! localization
-END FUNCTION MZF_MF
-!
-FUNCTION MZM_MF(KKA,KKU,KKL,PA) RESULT(PMZM)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZM ! result at flux localization
-END FUNCTION MZM_MF
-!
-FUNCTION GZ_M_W_MF(KKA,KKU,KKL,PY,PDZZ) RESULT(PGZ_M_W)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
-REAL, DIMENSION(:,:), INTENT(IN) :: PY ! variable at mass localization
-REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2)) :: PGZ_M_W ! result at flux side
-END FUNCTION GZ_M_W_MF
+END SUBROUTINE DZM_MF
+!
+SUBROUTINE MZF_MF(D, PA, PMZF)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PMZF ! result at mass
+ ! localization
+END SUBROUTINE MZF_MF
+!
+SUBROUTINE MZM_MF(D, PA, PMZM)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PMZM ! result at flux localization
+END SUBROUTINE MZM_MF
+!
+SUBROUTINE GZ_M_W_MF(D, PY, PDZZ, PGZ_M_W)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PY ! variable at mass localization
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PGZ_M_W ! result at flux side
+END SUBROUTINE GZ_M_W_MF
!
END INTERFACE
!
END MODULE MODI_SHUMAN_MF
!
! ###############################
- FUNCTION MZF_MF(KKA,KKU,KKL,PA) RESULT(PMZF)
+ SUBROUTINE MZF_MF(D, PA, PMZF)
! ###############################
!
-!!**** *MZF* - SHUMAN_MF operator : mean operator in z direction for a
+!!**** *MZF* - SHUMAN_MF operator : mean operator in z direction for a
!! variable at a flux side
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute a mean
+! The purpose of this function is to compute a mean
! along the z direction (K index) for a field PA localized at a z-flux
! point (w point). The result is localized at a mass point.
!
!!** METHOD
-!! ------
+!! ------
!! The result PMZF(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k+1))
!! At k=size(PA,3), PMZF(:,:,k) is defined by PA(:,:,k).
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -89,11 +91,11 @@ END MODULE MODI_SHUMAN_MF
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 04/07/94
+!! Original 04/07/94
!! optimisation 20/08/00 J. Escobar
!! S. Riette, Jan 2012: Simplification and suppression of array overflow
!-------------------------------------------------------------------------------
@@ -101,44 +103,57 @@ END MODULE MODI_SHUMAN_MF
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZF ! result at mass
- ! localization
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PMZF ! result at mass
+ ! localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JK ! Loop index in z direction
-!
+INTEGER :: JK, JIJ
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKA,IKU,IKT
+INTEGER :: IKL
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKA=D%NKA
+IKU=D%NKU
+IKT=D%NKT
+IKL=D%NKL
+!
!
!-------------------------------------------------------------------------------
!
!* 1. DEFINITION OF MZF
! ------------------
!
-DO JK=2,SIZE(PA,2)-1
- PMZF(:,JK) = 0.5*( PA(:,JK)+PA(:,JK+KKL) )
+DO JK=2,IKT-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PMZF(IIJB:IIJE,JK) = 0.5*( PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-PMZF(:,KKA) = 0.5*( PA(:,KKA)+PA(:,KKA+KKL) )
-PMZF(:,KKU) = PA(:,KKU)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PMZF(IIJB:IIJE,IKA) = 0.5*( PA(IIJB:IIJE,IKA)+PA(IIJB:IIJE,IKA+IKL) )
+PMZF(IIJB:IIJE,IKU) = PA(IIJB:IIJE,IKU)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION MZF_MF
+END SUBROUTINE MZF_MF
! ###############################
- FUNCTION MZM_MF(KKA,KKU,KKL,PA) RESULT(PMZM)
+ SUBROUTINE MZM_MF(D, PA, PMZM)
! ###############################
!
-!!**** *MZM* - SHUMAN_MF operator : mean operator in z direction for a
-!! mass variable
+!!**** *MZM* - SHUMAN_MF operator : mean operator in z direction for a
+!! mass variable
!!
!! PURPOSE
!! -------
@@ -147,10 +162,10 @@ END FUNCTION MZF_MF
! point. The result is localized at a z-flux point (w point).
!
!!** METHOD
-!! ------
+!! ------
!! The result PMZM(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k-1))
!! At k=1, PMZM(:,:,1) is defined by PA(:,:,1).
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -163,16 +178,16 @@ END FUNCTION MZF_MF
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (SHUMAN_MF operators)
-!! Technical specifications Report of The Meso-NH (chapters 3)
+!! Technical specifications Report of The Meso-NH (chapters 3)
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 04/07/94
+!! Original 04/07/94
!! optimisation 20/08/00 J. Escobar
!! S. Riette, Jan 2012: Simplification and suppression of array overflow
!-------------------------------------------------------------------------------
@@ -180,38 +195,51 @@ END FUNCTION MZF_MF
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PMZM ! result at flux localization
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PMZM ! result at flux localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JK ! Loop index in z direction
-!
+INTEGER :: JK, JIJ
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKA,IKU,IKT,IKL
+!
+!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKA=D%NKA
+IKU=D%NKU
+IKT=D%NKT
+IKL=D%NKL
!
!-------------------------------------------------------------------------------
!
!* 1. DEFINITION OF MZM
! ------------------
!
-DO JK=2,SIZE(PA,2)-1
- PMZM(:,JK) = 0.5*( PA(:,JK)+PA(:,JK-KKL) )
+DO JK=2,IKT-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PMZM(IIJB:IIJE,JK) = 0.5*( PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK-IKL) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-PMZM(:,KKA) = PA(:,KKA)
-PMZM(:,KKU) = 0.5*( PA(:,KKU)+PA(:,KKU-KKL) )
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PMZM(IIJB:IIJE,IKA) = PA(IIJB:IIJE,IKA)
+PMZM(IIJB:IIJE,IKU) = 0.5*( PA(IIJB:IIJE,IKU)+PA(IIJB:IIJE,IKU-IKL) )
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION MZM_MF
+END SUBROUTINE MZM_MF
! ###############################
- FUNCTION DZF_MF(KKA,KKU,KKL,PA) RESULT(PDZF)
+ SUBROUTINE DZF_MF(D, PA, PDZF)
! ###############################
!
!!**** *DZF* - SHUMAN_MF operator : finite difference operator in z direction
@@ -219,15 +247,15 @@ END FUNCTION MZM_MF
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute a finite difference
+! The purpose of this function is to compute a finite difference
! along the z direction (K index) for a field PA localized at a z-flux
! point (w point). The result is localized at a mass point.
!
!!** METHOD
-!! ------
+!! ------
!! The result PDZF(:,:,k) is defined by (PA(:,:,k+1)-PA(:,:,k))
!! At k=size(PA,3), PDZF(:,:,k) is defined by 0.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -240,16 +268,16 @@ END FUNCTION MZM_MF
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (SHUMAN_MF operators)
-!! Technical specifications Report of The Meso-NH (chapters 3)
+!! Technical specifications Report of The Meso-NH (chapters 3)
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 05/07/94
+!! Original 05/07/94
!! optimisation 20/08/00 J. Escobar
!! S. Riette, Jan 2012: Simplification and suppression of array overflow
!-------------------------------------------------------------------------------
@@ -257,39 +285,51 @@ END FUNCTION MZM_MF
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZF ! result at mass
- ! localization
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDZF ! result at mass
+ ! localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JK ! Loop index in z direction
-!
+INTEGER :: JK, JIJ
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKA,IKU,IKT,IKL
+!
!-------------------------------------------------------------------------------
!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKA=D%NKA
+IKU=D%NKU
+IKT=D%NKT
+IKL=D%NKL
+!
!* 1. DEFINITION OF DZF
! ------------------
!
-DO JK=2,SIZE(PA,2)-1
- PDZF(:,JK) = PA(:,JK+KKL) - PA(:,JK)
+DO JK=2,IKT-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PDZF(IIJB:IIJE,JK) = PA(IIJB:IIJE,JK+IKL) - PA(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-PDZF(:,KKA) = PA(:,KKA+KKL) - PA(:,KKA)
-PDZF(:,KKU) = 0.
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PDZF(IIJB:IIJE,IKA) = PA(IIJB:IIJE,IKA+IKL) - PA(IIJB:IIJE,IKA)
+PDZF(IIJB:IIJE,IKU) = 0.
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION DZF_MF
+END SUBROUTINE DZF_MF
! ###############################
- FUNCTION DZM_MF(KKA,KKU,KKL,PA) RESULT(PDZM)
+ SUBROUTINE DZM_MF(D, PA, PDZM)
! ###############################
!
!!**** *DZM* - SHUMAN_MF operator : finite difference operator in z direction
@@ -297,15 +337,15 @@ END FUNCTION DZF_MF
!!
!! PURPOSE
!! -------
-! The purpose of this function is to compute a finite difference
+! The purpose of this function is to compute a finite difference
! along the z direction (K index) for a field PA localized at a mass
! point. The result is localized at a z-flux point (w point).
!
!!** METHOD
-!! ------
+!! ------
!! The result PDZM(:,j,:) is defined by (PA(:,:,k)-PA(:,:,k-1))
!! At k=1, PDZM(:,:,k) is defined by 0.
-!!
+!!
!!
!! EXTERNAL
!! --------
@@ -318,16 +358,16 @@ END FUNCTION DZF_MF
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (SHUMAN_MF operators)
-!! Technical specifications Report of The Meso-NH (chapters 3)
+!! Technical specifications Report of The Meso-NH (chapters 3)
!!
!!
!! AUTHOR
!! ------
-!! V. Ducrocq * Meteo France *
+!! V. Ducrocq * Meteo France *
!!
!! MODIFICATIONS
!! -------------
-!! Original 05/07/94
+!! Original 05/07/94
!! optimisation 20/08/00 J. Escobar
!! S. Riette, Jan 2012: Simplification and suppression of array overflow
!-------------------------------------------------------------------------------
@@ -335,40 +375,52 @@ END FUNCTION DZF_MF
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PA ! variable at mass
- ! localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2)) :: PDZM ! result at flux
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDZM ! result at flux
! side
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JK ! Loop index in z direction
-!
+INTEGER :: JK, JIJ
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKA,IKU,IKT,IKL
+!
!-------------------------------------------------------------------------------
!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKA=D%NKA
+IKU=D%NKU
+IKT=D%NKT
+IKL=D%NKL
+!
!* 1. DEFINITION OF DZM
! ------------------
!
-DO JK=2,SIZE(PA,2)-1
- PDZM(:,JK) = PA(:,JK) - PA(:,JK-KKL)
+DO JK=2,IKT-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PDZM(IIJB:IIJE,JK) = PA(IIJB:IIJE,JK) - PA(IIJB:IIJE,JK-IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-PDZM(:,KKA) = 0.
-PDZM(:,KKU) = PA(:,KKU) - PA(:,KKU-KKL)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PDZM(IIJB:IIJE,IKA) = 0.
+PDZM(IIJB:IIJE,IKU) = PA(IIJB:IIJE,IKU) - PA(IIJB:IIJE,IKU-IKL)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION DZM_MF
+END SUBROUTINE DZM_MF
! ###############################
- FUNCTION GZ_M_W_MF(KKA,KKU,KKL,PY,PDZZ) RESULT(PGZ_M_W)
+ SUBROUTINE GZ_M_W_MF(D, PY, PDZZ, PGZ_M_W)
! ###############################
!
!!**** *GZ_M_W * - Compute the gradient along z direction for a
@@ -414,32 +466,45 @@ END FUNCTION DZM_MF
!
!-------------------------------------------------------------------------------
!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
-REAL, DIMENSION(:,:), INTENT(IN) :: PY ! variable at mass localization
-REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2)) :: PGZ_M_W ! result at flux side
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficient d*zz
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PY ! variable at mass localization
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PGZ_M_W ! result at flux side
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER JK
+INTEGER JK, JIJ
+INTEGER :: IIJB,IIJE ! physical horizontal domain indices
+INTEGER :: IKA,IKU,IKT,IKL
!-------------------------------------------------------------------------------
!
+IIJE=D%NIJE
+IIJB=D%NIJB
+IKA=D%NKA
+IKU=D%NKU
+IKT=D%NKT
+IKL=D%NKL
+!
!* 1. COMPUTE THE GRADIENT ALONG Z
! -----------------------------
!
-DO JK=2,SIZE(PY,2)-1
- PGZ_M_W(:,JK) = (PY(:,JK) - PY(:,JK-KKL)) / PDZZ(:,JK)
+DO JK=2,IKT-1
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PGZ_M_W(IIJB:IIJE,JK) = (PY(IIJB:IIJE,JK) - PY(IIJB:IIJE,JK-IKL)) / PDZZ(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
-PGZ_M_W(:,KKA) = 0.
-PGZ_M_W(:,KKU) = (PY(:,KKU) - PY(:,KKU-KKL)) / PDZZ(:,KKU)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PGZ_M_W(IIJB:IIJE,IKA) = 0.
+PGZ_M_W(IIJB:IIJE,IKU) = (PY(IIJB:IIJE,IKU) - PY(IIJB:IIJE,IKU-IKL)) / PDZZ(IIJB:IIJE,IKU)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!-------------------------------------------------------------------------------
!
-END FUNCTION GZ_M_W_MF
+END SUBROUTINE GZ_M_W_MF
diff --git a/src/PHYEX/turb/th_r_from_thl_rt.func.h b/src/PHYEX/turb/th_r_from_thl_rt.func.h
new file mode 100644
index 0000000000000000000000000000000000000000..5a571b688d6ca46c05818bd43cc87947491f043a
--- /dev/null
+++ b/src/PHYEX/turb/th_r_from_thl_rt.func.h
@@ -0,0 +1,201 @@
+!MNH_LIC Copyright 2006-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+ SUBROUTINE TH_R_FROM_THL_RT(CST, NEB, KT, HFRAC_ICE,PFRAC_ICE,PP, &
+ PTHL, PRT, PTH, PRV, PRL, PRI, &
+ PRSATW, PRSATI, PRR, PRS, PRG, PRH, OOCEAN,&
+ PBUF, KB, KE)
+! ******* TO BE INCLUDED IN THE *CONTAINS* OF A SUBROUTINE, IN ORDER TO EASE AUTOMATIC INLINING ******
+! => Don't use drHook !!!
+! "compute_frac_ice.func.h" must be included at the same time
+! #################################################################
+!
+!
+!!**** *TH_R_FROM_THL_RT* - computes the non-conservative variables
+!! from conservative variables
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Julien PERGAUD * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/03/06
+!! S. Riette April 2011 : ice added, allow ZRLTEMP to be negative
+!! we use dQsat/dT to help convergence
+!! use of optional PRR, PRS, PRG, PRH
+!! S. Riette Nov 2016: support for HFRAC_ICE='S'
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : CST_t
+USE MODD_NEB, ONLY : NEB_t
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(NEB_t), INTENT(IN) :: NEB
+INTEGER, INTENT(IN) :: KT
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+REAL, DIMENSION(KT), INTENT(INOUT) :: PFRAC_ICE
+REAL, DIMENSION(KT), INTENT(IN) :: PP ! Pressure
+REAL, DIMENSION(KT), INTENT(IN) :: PTHL ! thetal to transform into th
+REAL, DIMENSION(KT),INTENT(IN) :: PRT ! Total mixing ratios to transform into rv,rc and ri
+REAL, DIMENSION(KT),OPTIONAL,INTENT(IN) :: PRR, PRS, PRG, PRH
+REAL, DIMENSION(KT), INTENT(OUT):: PTH ! th
+REAL, DIMENSION(KT), INTENT(OUT):: PRV ! vapor mixing ratio
+REAL, DIMENSION(KT), INTENT(INOUT):: PRL ! vapor mixing ratio
+REAL, DIMENSION(KT), INTENT(INOUT):: PRI ! vapor mixing ratio
+REAL, DIMENSION(KT), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
+REAL, DIMENSION(KT), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
+REAL, DIMENSION(KT, 16), INTENT(OUT) :: PBUF ! buffer to replace automatic arrays
+INTEGER, OPTIONAL :: KB !first index to deal with (default is 1)
+INTEGER, OPTIONAL :: KE !last index to deal with (default if KT)
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+INTEGER :: II ! Loop control
+INTEGER :: JITER ! number of iterations
+INTEGER :: J, IB, IE
+INTEGER, PARAMETER :: IEXN=1, IRVSAT=2, ICPH=3, IRLTEMP=4, ICPH2=5, IT=6, ILVOCPEXN=7, ILSOCPEXN=8, &
+ & IDRSATODT=9, IDRSATODTW=10, IDRSATODTI=11, IFOESW=12, IFOESI=13, &
+ & ILOGT=14, I99PP=15, I1PRT=16
+REAL :: ZVAR1, ZVAR2, ZTPOW2, ZDELT
+
+!----------------------------------------------------------------------------
+!
+!* 1 Initialisation
+! --------------
+!
+!
+!
+IB=MERGE(KB, 1, PRESENT(KB))
+IE=MERGE(KE, KT, PRESENT(KE))
+!Number of iterations
+JITER=2
+!
+!Computation of PBUF(IB:IE, ICPH2) depending on dummy arguments received
+PBUF(IB:IE, ICPH2)=0
+IF(PRESENT(PRR)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCL*PRR(IB:IE)
+IF(PRESENT(PRS)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRS(IB:IE)
+IF(PRESENT(PRG)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRG(IB:IE)
+IF(PRESENT(PRH)) PBUF(IB:IE, ICPH2)=PBUF(IB:IE, ICPH2) + CST%XCI*PRH(IB:IE)
+!
+!Computation of an approximate state thanks to PRL and PRI guess
+PBUF(IB:IE, IEXN)=(PP(IB:IE)/CST%XP00) ** CST%RDSCPD
+
+DO J=IB,IE
+ PBUF(J, I99PP)=0.99*PP(J)
+ PRV(J)=PRT(J)-PRL(J)-PRI(J)
+ PBUF(J, ICPH)=CST%XCPD+ CST%XCPV * PRV(J)+ CST%XCL * PRL(J) + CST%XCI * PRI(J) + PBUF(J, ICPH2)
+ ZVAR2=PBUF(J, ICPH)*PBUF(J, IEXN)
+ ZDELT=(PTHL(J)*PBUF(J, IEXN))-CST%XTT
+ PBUF(J, ILVOCPEXN) = (CST%XLVTT + (CST%XCPV-CST%XCL) * ZDELT) /ZVAR2
+ PBUF(J, ILSOCPEXN) = (CST%XLSTT + (CST%XCPV-CST%XCI) * ZDELT) /ZVAR2
+ PTH(J)=PTHL(J)+PBUF(J, ILVOCPEXN)*PRL(J)+PBUF(J, ILSOCPEXN)*PRI(J)
+ PBUF(J, I1PRT)=1+PRT(J)
+ENDDO
+!
+!
+! 2 Iteration
+! ---------
+
+DO II=1,JITER
+ IF (OOCEAN) THEN
+ PBUF(IB:IE, IT)=PTH(IB:IE)
+ ELSE
+ PBUF(IB:IE, IT)=PTH(IB:IE)*PBUF(IB:IE, IEXN)
+ END IF
+ !Computation of liquid/ice fractions
+ PFRAC_ICE(IB:IE) = 0.
+ DO J=IB, IE
+ IF(PRL(J)+PRI(J) > 1.E-20) THEN
+ PFRAC_ICE(J) = PRI(J) / (PRL(J)+PRI(J))
+ ENDIF
+ ENDDO
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,PFRAC_ICE(IB:IE),PBUF(IB:IE, IT))
+
+ !Computation of Rvsat and dRsat/dT
+ !In this version QSAT, QSATI, DQSAT and DQASATI functions are not used
+ !due to performance issue
+
+ ! Log does not vectorize on all compilers:
+ PBUF(IB:IE, ILOGT)=LOG(PBUF(IB:IE, IT))
+
+ DO J=IB, IE
+ PBUF(J, IFOESW) = MIN(EXP( CST%XALPW - CST%XBETAW/PBUF(J, IT) - CST%XGAMW*PBUF(J, ILOGT) ), PBUF(J, I99PP))
+ PBUF(J, IFOESI) = MIN(EXP( CST%XALPI - CST%XBETAI/PBUF(J, IT) - CST%XGAMI*PBUF(J, ILOGT) ), PBUF(J, I99PP))
+ PRSATW(J) = CST%XRD/CST%XRV*PBUF(J, IFOESW)/PP(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESW)/PP(J))
+ PRSATI(J) = CST%XRD/CST%XRV*PBUF(J, IFOESI)/PP(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESI)/PP(J))
+ ZTPOW2=PBUF(J, IT)**2
+ PBUF(J, IDRSATODTW) = PRSATW(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESW)/PP(J) ) &
+ * (CST%XBETAW/ZTPOW2 - CST%XGAMW/PBUF(J, IT))*PBUF(J, I1PRT)
+ PBUF(J, IDRSATODTI) = PRSATI(J) / (1.+(CST%XRD/CST%XRV-1.)*PBUF(J, IFOESI)/PP(J) ) &
+ * (CST%XBETAI/ZTPOW2 - CST%XGAMI/PBUF(J, IT))*PBUF(J, I1PRT)
+ !PRSATW(J) = QSAT(PBUF(J, IT),PP(J)) !qsatw
+ !PRSATI(J) = QSATI(PBUF(J, IT),PP(J)) !qsati
+ !PBUF(J, IDRSATODTW) = DQSAT(PBUF(J, IT),PP(J),PRSATW(J))*PBUF(J, I1PRT)
+ !PBUF(J, IDRSATODTI) = DQSATI(PBUF(J, IT),PP(J),PRSATI(J))*PBUF(J, I1PRT)
+ PRSATW(J) = PRSATW(J)*PBUF(J, I1PRT)
+ PRSATI(J) = PRSATI(J)*PBUF(J, I1PRT)
+ PBUF(J, IRVSAT) = PRSATW(J)*(1-PFRAC_ICE(J)) + PRSATI(J)*PFRAC_ICE(J)
+ PBUF(J, IDRSATODT) = (PBUF(J, IDRSATODTW)*(1-PFRAC_ICE(J))+ &
+ & PBUF(J, IDRSATODTI)*PFRAC_ICE(J))
+
+ !Computation of new PRL, PRI and PRV
+ !Correction term applied to (PRV(J)-PBUF(J, IRVSAT)) is computed assuming that
+ !PBUF(J, ILVOCPEXN), PBUF(J, ILSOCPEXN) and PBUF(J, ICPH) don't vary to much with T. It takes into account
+ !the variation (estimated linear) of Qsat with T
+ PBUF(J, IRLTEMP)=(PRV(J)-PBUF(J, IRVSAT))/ &
+ &(1 + PBUF(J, IDRSATODT)*PBUF(J, IEXN)* &
+ & (PBUF(J, ILVOCPEXN)*(1-PFRAC_ICE(J))+PBUF(J, ILSOCPEXN)*PFRAC_ICE(J)))
+ PBUF(J, IRLTEMP)=MIN(MAX(-PRL(J)-PRI(J), PBUF(J, IRLTEMP)),PRV(J))
+ PRV(J)=PRV(J)-PBUF(J, IRLTEMP)
+ PRL(J)=PRL(J)+PRI(J)+PBUF(J, IRLTEMP)
+ PRI(J)=PFRAC_ICE(J) * (PRL(J))
+ PRL(J)=(1-PFRAC_ICE(J)) * (PRT(J) - PRV(J))
+
+ !Computation of Cph (as defined in Meso-NH doc, equation 2.2, to be used with mixing ratios)
+ PBUF(J, ICPH)=CST%XCPD+ CST%XCPV * PRV(J)+ CST%XCL * PRL(J) + CST%XCI * PRI(J) + PBUF(J, ICPH2)
+
+ !Computation of L/Cph/EXN, then new PTH
+ ZVAR2=PBUF(J, ICPH)*PBUF(J, IEXN)
+ PBUF(J, ILVOCPEXN) = (CST%XLVTT + (CST%XCPV-CST%XCL) * (PBUF(J, IT)-CST%XTT)) /ZVAR2
+ PBUF(J, ILSOCPEXN) = (CST%XLSTT + (CST%XCPV-CST%XCI) * (PBUF(J, IT)-CST%XTT)) /ZVAR2
+ PTH(J)=PTHL(J)+PBUF(J, ILVOCPEXN)*PRL(J)+PBUF(J, ILSOCPEXN)*PRI(J)
+
+ !Computation of estimated mixing ration at saturation
+ !To compute the adjustement a first order development was used
+ ZVAR1=PTH(J)*PBUF(J, IEXN)-PBUF(J, IT)
+ PRSATW(J)=PRSATW(J) + PBUF(J, IDRSATODTW)*ZVAR1
+ PRSATI(J)=PRSATI(J) + PBUF(J, IDRSATODTI)*ZVAR1
+ ENDDO
+ENDDO
+
+END SUBROUTINE TH_R_FROM_THL_RT
diff --git a/src/PHYEX/turb/turb.f90 b/src/PHYEX/turb/turb.f90
index 974bbcbaa18b8da5eafcb17b415b82b6f4d7257c..e0713fcd3a642d3f4888df1f9548d6769958e08a 100644
--- a/src/PHYEX/turb/turb.f90
+++ b/src/PHYEX/turb/turb.f90
@@ -3,220 +3,104 @@
!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
-! ################
-!
-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 )
-
-!
-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
-INTEGER, INTENT(IN) :: KMI ! model index number
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-CHARACTER(LEN=*),DIMENSION(:),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
-INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! switch for SUBGrid
- ! CONDensation
-LOGICAL, INTENT(IN) :: ORMC01 ! switch for RMC01 lengths in SBL
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
-CHARACTER(len=4), INTENT(IN) :: HTOM ! kind of Third Order Moment
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
- ! surface friction flux
-REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
-REAL, INTENT(IN) :: PTSTEP ! timestep
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical distance
-! between 2 succesive grid points along the K direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
-! Director Cosinus along x, y and z directions at surface w-point
-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 size
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
-! normal surface fluxes of theta and Rv
- PSFU,PSFV
-! normal surface fluxes of (u,v) parallel to the orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
-! normal surface fluxes of Scalar var.
-!
-! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! wind components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! passive scal. var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCT ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL depth for TOMS
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
-!
-!
-! variables for cloud mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
- ! index to emphasize localy
- ! turbulent fluxes
-REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index CEI
-REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
-REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
-! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
- ! PRT(:,:,:,1) is the conservative mixing ratio
-!
-! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
-! TKE dissipation
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
-! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
-! mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-! Source terms for all passive scalar variables
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
-! Sigma_s at time t+1 : square root of the variance of the deviation to the
-! saturation
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
-! MF contribution for vert. turb. transport
-! used in the buoy. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-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) :: PLEM ! Mixing length
-
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE TURB
-!
-END INTERFACE
-!
-END MODULE MODI_TURB
-!
-! #################################################################
- 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(CST,CSTURB,BUCONF,TURBN,D,TLES, &
+ & KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KGRADIENTS,KHALO, &
+ & KSPLIT,KMODEL_CL,KSV,KSV_LGBEG,KSV_LGEND,HPROGRAM, &
+ & KSV_LIMA_NR, KSV_LIMA_NS, KSV_LIMA_NG, KSV_LIMA_NH, &
+ & O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM, &
+ & OCOMPUTE_SRC, PRSNOW, &
+ & OOCEAN,ODEEPOC,ODIAG_IN_RUN, &
+ & HTURBLEN_CL,HCLOUD, &
+ & PTSTEP,TPFILE, &
+ & PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
+ & PRHODJ,PTHVREF,PHGRAD,PZS, &
+ & 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, &
+ & PSIGS, &
+ & PFLXZTHVMF,PWTH,PWRC,PWSV,PDP,PTP,PTDIFF,PTDISS, &
+ & TBUDGETS, KBUDGETS, &
+ & PEDR,PLEM,PRTKEMS,PTPMF, &
+ & PDRUS_TURB,PDRVS_TURB, &
+ & PDRTHLS_TURB,PDRRTS_TURB,PDRSVS_TURB,PTR,PDISS, &
+ & PIBM_LS, PIBM_XMUT, &
+ & PCURRENT_TKE_DISS, PSSTFL, PSSTFL_C, PSSRFL_C, &
+ & PSSUFL_C, PSSVFL_C,PSSUFL,PSSVFL )
! #################################################################
!
!
!!**** *TURB* - computes the turbulent source terms for the prognostic
-!! variables.
+!! variables.
!!
!! PURPOSE
!! -------
-!!**** The purpose of this routine is to compute the source terms in
-!! the evolution equations due to the turbulent mixing.
+!!**** The purpose of this routine is to compute the source terms in
+!! the evolution equations due to the turbulent mixing.
!! The source term is computed as the divergence of the turbulent fluxes.
!! The cartesian fluxes are obtained by a one and a half order closure, based
-!! on a prognostic equation for the Turbulence Kinetic Energy( TKE ). The
-!! system is closed by prescribing a turbulent mixing length. Different
-!! choices are available for this length.
+!! on a prognostic equation for the Turbulence Kinetic Energy( TKE ). The
+!! system is closed by prescribing a turbulent mixing length. Different
+!! choices are available for this length.
!
!!** METHOD
!! ------
-!!
+!!
!! The dimensionality of the turbulence parameterization can be chosen by
-!! means of the parameter HTURBDIM:
-!! * HTURBDIM='1DIM' the parameterization is 1D but can be used in
+!! means of the parameter TURBN%CTURBDIM:
+!! * TURBN%CTURBDIM='1DIM' the parameterization is 1D but can be used in
!! 3D , 2D or 1D simulations. Only the sources associated to the vertical
!! turbulent fluxes are taken into account.
-!! * HTURBDIM='3DIM' the parameterization is fully 2D or 3D depending
+!! * TURBN%CTURBDIM='3DIM' the parameterization is fully 2D or 3D depending
!! on the model dimensionality. Of course, it does not make any sense to
-!! activate this option with a 1D model.
+!! activate this option with a 1D model.
!!
!! The following steps are made:
!! 1- Preliminary computations.
!! 2- The metric coefficients are recovered from the grid knowledge.
!! 3- The mixing length is computed according to its choice:
-!! * HTURBLEN='BL89' the Bougeault and Lacarrere algorithm is used.
+!! * TURBN%CTURBLEN='BL89' the Bougeault and Lacarrere algorithm is used.
!! The mixing length is given by the vertical displacement from its
!! original level of an air particule having an initial internal
!! energy equal to its TKE and stopped by the buoyancy forces.
!! The discrete formulation is second order accurate.
-!! * HTURBLEN='DELT' the mixing length is given by the mesh size
-!! depending on the model dimensionality, this length is limited
+!! * TURBN%CTURBLEN='DELT' the mixing length is given by the mesh size
+!! depending on the model dimensionality, this length is limited
!! with the ground distance.
-!! * HTURBLEN='DEAR' the mixing length is given by the mesh size
-!! depending on the model dimensionality, this length is limited
+!! * TURBN%CTURBLEN='DEAR' the mixing length is given by the mesh size
+!! depending on the model dimensionality, this length is limited
!! with the ground distance and also by the Deardorff mixing length
!! pertinent in the stable cases.
-!! * HTURBLEN='KEPS' the mixing length is deduced from the TKE
+!! * TURBN%CTURBLEN='KEPS' the mixing length is deduced from the TKE
!! dissipation, which becomes a prognostic variable of the model (
-!! Duynkerke formulation).
+!! Duynkerke formulation).
!! 3'- The cloud mixing length is computed according to HTURBLEN_CLOUD
!! and emphasized following the CEI index
!! 4- The conservative variables are computed along with Lv/Cp.
!! 5- The turbulent Prandtl numbers are computed from the resolved fields
-!! and TKE
+!! and TKE
!! 6- The sources associated to the vertical turbulent fluxes are computed
-!! with a temporal scheme allowing a degree of implicitness given by
-!! PIMPL, varying from PIMPL=0. ( purely explicit scheme) to PIMPL=1.
+!! with a temporal scheme allowing a degree of implicitness given by
+!! TURBN%XIMPL, varying from TURBN%XIMPL=0. ( purely explicit scheme) to TURBN%XIMPL=1.
!! ( purely implicit scheme)
!! The sources associated to the horizontal fluxes are computed with a
!! purely explicit temporal scheme. These sources are only computed when
-!! the turbulence parameterization is 2D or 3D( HTURBDIM='3DIM' ).
-!! 7- The sources for TKE are computed, along with the dissipation of TKE
-!! if HTURBLEN='KEPS'.
-!! 8- Some turbulence-related quantities are stored in the synchronous
+!! the turbulence parameterization is 2D or 3D( TURBN%CTURBDIM='3DIM' ).
+!! 7- The sources for TKE are computed, along with the dissipation of TKE
+!! if TURBN%CTURBLEN='KEPS'.
+!! 8- Some turbulence-related quantities are stored in the synchronous
!! FM-file.
-!! 9- The non-conservative variables are retrieved.
-!!
-!!
+!! 9- The non-conservative variables are retrieved.
+!!
+!!
!! The saving of the fields in the synchronous FM-file is controlled by:
-!! * OTURB_FLX => saves all the turbulent fluxes and correlations
-!! * OTURB_DIAG=> saves the turbulent Prandtl and Schmidt numbers, the
-!! source terms of TKE and dissipation of TKE
+!! * TURBN%LTURB_FLX => saves all the turbulent fluxes and correlations
+!! * TURBN%LTURB_DIAG=> saves the turbulent Prandtl and Schmidt numbers, the
+!! source terms of TKE and dissipation of TKE
!!
!! EXTERNAL
!! --------
@@ -230,37 +114,37 @@ END MODULE MODI_TURB
!! IMPLICIT ARGUMENTS
!! ------------------
!!
-!! MODD_PARAMETERS : JPVEXT number of marginal vertical points
+!! MODD_PARAMETERS : JPVEXT_TURB number of marginal vertical points
!!
!! MODD_CONF : CCONF model configuration (start/restart)
!! L1D switch for 1D model version
!! L2D switch for 2D model version
!!
!! MODD_CST : contains physical constants
-!! XG gravity constant
-!! XRD Gas constant for dry air
-!! XRV Gas constant for vapor
+!! CST%XG gravity constant
+!! CST%XRD Gas constant for dry air
+!! CST%XRV Gas constant for vapor
!!
!! MODD_CTURB : contains turbulence scheme constants
!! XCMFS,XCED to compute the dissipation mixing length
-!! XTKEMIN minimum values for the TKE
-!! XLINI,XLINF to compute Bougeault-Lacarrere mixing
+!! XTKEMIN minimum values for the TKE
+!! CST%XLINI,CST%XLINF to compute Bougeault-Lacarrere mixing
!! length
!! Module MODD_BUDGET:
-!! NBUMOD
-!! CBUTYPE
-!! LBU_RU
-!! LBU_RV
-!! LBU_RW
-!! LBU_RTH
-!! LBU_RSV1
-!! LBU_RRV
-!! LBU_RRC
-!! LBU_RRR
-!! LBU_RRI
-!! LBU_RRS
-!! LBU_RRG
-!! LBU_RRH
+!! NBUMOD
+!! CBUTYPE
+!! LBU_RU
+!! LBU_RV
+!! LBU_RW
+!! LBU_RTH
+!! LBU_RSV1
+!! LBU_RRV
+!! LBU_RRC
+!! LBU_RRR
+!! LBU_RRI
+!! LBU_RRS
+!! LBU_RRG
+!! LBU_RRH
!!
!! REFERENCE
!! ---------
@@ -274,11 +158,11 @@ END MODULE MODI_TURB
!! MODIFICATIONS
!! -------------
!! Original 05/10/94
-!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Modifications: March 21, 1995 (J.M. Carriere)
!! Introduction of cloud water
-!! Modifications: June 1, 1995 (J.Cuxart )
+!! Modifications: June 1, 1995 (J.Cuxart )
!! take min(Kz,delta)
!! Modifications: June 1, 1995 (J.Stein J.Cuxart)
!! remove unnecessary arrays and change Prandtl
@@ -286,18 +170,18 @@ END MODULE MODI_TURB
!! Modifications: July 20, 1995 (J.Stein) remove MODI_ground_ocean +
!! TZDTCUR + MODD_TIME because they are not used
!! change RW in RNP for the outputs
-!! Modifications: August 21, 1995 (Ph. Bougeault)
+!! Modifications: August 21, 1995 (Ph. Bougeault)
!! take min(K(z-zsol),delta)
!! Modifications: Sept 14, 1995 (Ph Bougeault, J. Cuxart)
-!! second order BL89 mixing length computations + add Deardorff length
+!! second order BL89 mixing length computations + add Deardorff length
!! in the Delta case for stable cases
!! Modifications: Sept 19, 1995 (J. Stein, J. Cuxart)
!! define a DEAR case for the mixing length, add MODI_BUDGET and change
!! some BUDGET calls, add LES tools
!! Modifications: Oct 16, 1995 (J. Stein) change the budget calls
-!! Modifications: Feb 28, 1996 (J. Stein) optimization +
+!! Modifications: Feb 28, 1996 (J. Stein) optimization +
!! remove min(K(z-zsol),delta)+
-!! bug in the tangential fluxes
+!! bug in the tangential fluxes
!! Modifications: Oct 16, 1996 (J. Stein) change the subgrid condensation
!! scheme + temporal discretization
!! Modifications: Dec 19, 1996 (J.-P. Pinty) update the budget calls
@@ -320,7 +204,7 @@ END MODULE MODI_TURB
!! Feb 20, 2003 (J.-P. Pinty) Add reversible ice processes
!! May,26 2004 (P Jabouille) coef for computing dissipative heating
!! Sept 2004 (M.Tomasini) Cloud Mixing length modification
-!! following the instability
+!! following the instability
!! criterium CEI calculated in modeln
!! May 2006 Remove KEPS
!! Sept.2006 (I.Sandu): Modification of the stability criterion for
@@ -335,10 +219,14 @@ END MODULE MODI_TURB
!! vertical levels
!! 10/2012 (J. Colin) Correct bug in DearDoff for dry simulations
!! 10/2012 J.Escobar Bypass PGI bug , redefine some allocatable array inplace of automatic
+!! 2014-11 Y. Seity, add output terms for TKE DDHs budgets
+!! July 2015 (Wim de Rooy) modifications to run with RACMO
+!! turbulence (TURBN%LHARAT=TRUE)
!! 04/2016 (C.Lac) correction of negativity for KHKO
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! Q. Rodier 01/2018: introduction of RM17
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! June 2019 (Wim de Rooy) update statistical cloud scheme
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
@@ -351,52 +239,45 @@ END MODULE MODI_TURB
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
- lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB, XUNDEF
+USE MODD_CST, ONLY: CST_t
+USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_BUDGET, ONLY: 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
-USE MODD_CONF
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_DYN_n, ONLY : LOCEAN
-use modd_field, only: tfielddata, TYPEREAL
+ TBUDGETDATA, TBUDGETCONF_t
+USE MODD_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_NSV
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
-USE MODD_PARAM_LIMA
-USE MODD_TURB_n, ONLY: XCADAP
-!
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_BL89
-USE MODI_TURB_VER
-USE MODI_ROTATE_WIND
-USE MODI_TURB_HOR_SPLT
-USE MODI_TKE_EPS_SOURCES
-USE MODI_SHUMAN
-USE MODI_GRADIENT_M
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_RMC01
-USE MODI_GRADIENT_W
-USE MODI_TM06
-USE MODI_UPDATE_LM
-USE MODI_GET_HALO
-!
-use mode_budget, only: Budget_store_init, Budget_store_end
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_SBL
-use mode_sources_neg_correct, only: Sources_neg_correct
-!
-USE MODI_EMOIST
-USE MODI_ETHETA
-!
-USE MODI_SECOND_MNH
-!
-USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS, XIBM_XMUT
-USE MODI_IBM_MIXINGLENGTH
+!
+USE MODD_LES, ONLY : TLES_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_TURB_n, ONLY: TURB_t
+!
+USE MODE_BL89, ONLY: BL89
+USE MODE_TURB_VER, ONLY : TURB_VER
+USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND, UPDATE_ROTATE_WIND
+USE MODE_TURB_HOR_SPLT, ONLY: TURB_HOR_SPLT
+USE MODE_TKE_EPS_SOURCES, ONLY: TKE_EPS_SOURCES
+USE MODE_RMC01, ONLY: RMC01
+USE MODE_TM06, ONLY: TM06
+USE MODE_UPDATE_LM, ONLY: UPDATE_LM
+USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE_PHY
+USE MODE_SBL_PHY, ONLY: LMO
+USE MODE_SOURCES_NEG_CORRECT, ONLY: SOURCES_NEG_CORRECT_PHY
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
+USE MODE_IBM_MIXINGLENGTH, ONLY: IBM_MIXINGLENGTH
+!
+USE MODI_LES_MEAN_SUBGRID_PHY
+!
+USE SHUMAN_PHY, ONLY : MZF_PHY,MXF_PHY,MYF_PHY
+USE MODE_GRADIENT_U_PHY, ONLY : GZ_U_UW_PHY
+USE MODE_GRADIENT_V_PHY, ONLY : GZ_V_VW_PHY
+USE MODE_GRADIENT_W_PHY, ONLY : GZ_W_M_PHY
+USE MODE_GRADIENT_M_PHY, ONLY : GZ_M_W_PHY
!
IMPLICIT NONE
!
@@ -405,229 +286,260 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-INTEGER, INTENT(IN) :: KMI ! model index number
+TYPE(DIMPHYEX_t), INTENT(IN) :: D ! PHYEX variables dimensions structure
+TYPE(CST_t), INTENT(IN) :: CST ! modd_cst general constant structure
+TYPE(CSTURB_t), INTENT(IN) :: CSTURB ! modd_csturb turb constant structure
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF ! budget structure
+TYPE(TURB_t), INTENT(IN) :: TURBN ! modn_turbn (turb namelist) structure
+TYPE(TLES_t), INTENT(INOUT) :: TLES ! modd_les structure
+INTEGER, INTENT(IN) :: KGRADIENTS ! Number of stored horizontal gradients
+INTEGER, INTENT(IN) :: KMI ! model index number
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-CHARACTER(LEN=*),DIMENSION(:),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+INTEGER, INTENT(IN) :: KSV, KSV_LGBEG, KSV_LGEND ! number of scalar variables
+INTEGER, INTENT(IN) :: KSV_LIMA_NR,KSV_LIMA_NS,KSV_LIMA_NG,KSV_LIMA_NH
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! switch for SUBGrid
- ! CONDensation
-LOGICAL, INTENT(IN) :: ORMC01 ! switch for RMC01 lengths in SBL
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
-CHARACTER(len=4), INTENT(IN) :: HTOM ! kind of Third Order Moment
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
-REAL, INTENT(IN) :: PIMPL ! degree of implicitness
+LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+LOGICAL, INTENT(IN) :: ODEEPOC ! activates sfc forcing for ideal ocean deep conv
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororography
+LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos-ocean LES version
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! switch to activate pronostic blowing snow
+LOGICAL, INTENT(IN) :: ODIAG_IN_RUN ! switch to activate online diagnostics (mesonh)
+LOGICAL, INTENT(IN) :: OIBM ! switch to modity mixing length near building with IBM
+CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
-REAL, INTENT(IN) :: PTSTEP ! timestep
+INTEGER, INTENT(IN) :: KHALO ! Size of the halo for parallel distribution
+
+REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
+REAL, INTENT(IN) :: PTSTEP ! timestep
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical distance
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! physical distance
! between 2 succesive grid points along the K direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+REAL, DIMENSION(D%NIJT), 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) :: PTHVREF ! Virtual Potential
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PZS ! orography (for LEONARD terms)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHVREF ! Virtual Potential
! Temperature of the reference state
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
-! normal surface fluxes of theta and Rv
+REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV, &
+! normal surface fluxes of theta and Rv
PSFU,PSFV
! normal surface fluxes of (u,v) parallel to the orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
-! normal surface fluxes of Scalar var.
+REAL, DIMENSION(D%NIJT,KSV), INTENT(IN) :: PSFSV
+! normal surface fluxes of Scalar var.
+REAL, DIMENSION(D%NIJT,D%NKT,KGRADIENTS), INTENT(IN) :: PHGRAD ! horizontal gradients
!
! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! wind components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! passive scal. var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCT ! Second-order flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! Pressure at time t
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUT,PVT,PWT ! wind components
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKET ! TKE
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVT ! passive scal. var.
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(IN) :: PSRCT ! Second-order flux
! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
+REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%CTOM=='TM06')),INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
+REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%LRMC01)),INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
!
! variables for cloud mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
- ! index to emphasize localy
+REAL, DIMENSION(MERGE(D%NIJT,0,KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE'),&
+ MERGE(D%NKT,0,KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE')),INTENT(IN) :: PCEI
+ ! Cloud Entrainment instability
+ ! index to emphasize localy
! turbulent fluxes
REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index CEI
REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
!
! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
- ! PRT(:,:,:,1) is the conservative mixing ratio
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT) :: PRT ! water var. where
+ ! PRT(:,:,:,1) is the conservative mixing ratio
!
-! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
+! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
! TKE dissipation
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
! mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN),OPTIONAL :: PRTKEMS
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT) :: PRRS
! Source terms for all passive scalar variables
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
-! Sigma_s at time t+1 : square root of the variance of the deviation to the
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(INOUT) :: PRSVS
+! Sigma_s at time t+1 : square root of the variance of the deviation to the
! saturation
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
+REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
+ MERGE(D%NKT,0,OCOMPUTE_SRC)), INTENT(OUT) :: PSIGS
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PDRUS_TURB ! evolution of rhoJ*U by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PDRVS_TURB ! evolution of rhoJ*V by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PDRTHLS_TURB ! evolution of rhoJ*thl by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PDRRTS_TURB ! evolution of rhoJ*rt by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT),OPTIONAL :: PDRSVS_TURB ! evolution of rhoJ*Sv by turbulence only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLXZTHVMF
! MF contribution for vert. turb. transport
! used in the buoy. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-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) :: PLEM ! Mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWTH ! heat flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PWRC ! cloud water flux
+REAL, DIMENSION(D%NIJT,D%NKT,KSV),INTENT(OUT) :: PWSV ! scalar flux
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTP ! Thermal TKE production
+ ! MassFlux + turb
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT),OPTIONAL :: PTPMF ! Thermal TKE production
+ ! MassFlux Only
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDP ! Dynamic TKE production
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTDISS ! Dissipation TKE term
+!
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! CPROGRAM is the program currently running (modd_conf)
+LOGICAL, INTENT(IN) :: ONOMIXLG ! to use turbulence for lagrangian variables (modd_conf)
+LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model version (modd_conf)
+!
+! length scale from vdfexcu
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLENGTHM, PLENGTHH
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PEDR ! EDR
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PLEM ! Mixing length
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PTR ! Transport prod. of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PDISS ! Dissipation of TKE
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT), OPTIONAL :: PCURRENT_TKE_DISS ! if ODIAG_IN_RUN in mesonh
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSTFL ! Time evol Flux of T at sea surface (LOCEAN)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSTFL_C ! O-A interface flux for theta(LOCEAN and LCOUPLES)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSRFL_C ! O-A interface flux for vapor (LOCEAN and LCOUPLES)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSUFL_C ! Time evol Flux of U at sea surface (LOCEAN)
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSVFL_C !
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSUFL
+REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSVFL !
+!
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT), OPTIONAL :: PIBM_XMUT ! IBM turbulent viscosity
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN), OPTIONAL :: PIBM_LS ! IBM Level-set function
!
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
-REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
+REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZCP, & ! Cp at t-1
ZEXN, & ! EXN at t-1
ZT, & ! T at t-1
ZLOCPEXNM, & ! Lv/Cp/EXNREF at t-1
- ZLMW, & ! Turbulent mixing length (work array)
+ ZLM,ZLMW, & ! Turbulent mixing length (+ work array)
ZLEPS, & ! Dissipative length
- ZTRH, & ! Dynamic and Thermal Production of TKE
+ ZTRH, & !
ZATHETA,ZAMOIST, & ! coefficients for s = f (Thetal,Rnp)
ZCOEF_DISS, & ! 1/(Cph*Exner) for dissipative heating
ZFRAC_ICE, & ! ri fraction of rc+ri
ZMWTH,ZMWR,ZMTH2,ZMR2,ZMTHR,& ! 3rd order moments
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,& ! opposite of verticale derivate of 3rd order moments
- ZTHLM, ZTR, ZDISS ! initial potential temp.
-REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
- ZRM ! initial mixing ratio
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTAU11M,ZTAU12M, &
+ ZTHLM,ZRTKEMS, & ! initial potential temp; TKE advective source
+ ZSHEAR, ZDUDZ, ZDVDZ, & ! horizontal-wind vertical gradient
+ ZLVOCPEXNM,ZLSOCPEXNM, & ! Lv/Cp/EXNREF and Ls/Cp/EXNREF at t-1
+ ZATHETA_ICE,ZAMOIST_ICE, & ! coefficients for s = f (Thetal,Rnp)
+ ZRVSAT, ZDRVSATDT, & ! local array for routine compute_function_thermo
+ ZWORK1,ZWORK2, & ! working array syntax
+ ZETHETA,ZEMOIST, & ! coef ETHETA and EMOIST (for DEAR routine)
+ ZDTHLDZ,ZDRTDZ, & ! dtheta_l/dz, drt_dz used for computing the stablity criterion
+ ZCOEF_AMPL, & ! Amplification coefficient of the mixing length
+ ! when the instability criterium is verified (routine CLOUD_MODIF_LM)
+ ZLM_CLOUD ! Turbulent mixing length in the clouds (routine CLOUD_MODIF_LM)
+!
+!
+REAL, DIMENSION(D%NIJT,D%NKT,KRR) :: ZRM ! initial mixing ratio
+REAL, DIMENSION(D%NIJT) :: ZTAU11M,ZTAU12M, &
ZTAU22M,ZTAU33M, &
! tangential surface fluxes in the axes following the orography
ZUSLOPE,ZVSLOPE, &
- ! wind components at the first mass level parallel
- ! to the orography
+ ! wind components at the first mass level parallel
+ ! to the orography
ZCDUEFF, &
- ! - Cd*||u|| where ||u|| is the module of the wind tangential to
+ ! - Cd*||u|| where ||u|| is the module of the wind tangential to
! orography (ZUSLOPE,ZVSLOPE) at the surface.
ZUSTAR, ZLMO, &
- ZRVM, ZSFRV
+ ZRVM, ZSFRV,ZWORK2D
! friction velocity, Monin Obuhkov length, work arrays for vapor
!
! Virtual Potential Temp. used
! in the Deardorff mixing length computation
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
- ZLVOCPEXNM,ZLSOCPEXNM, & ! Lv/Cp/EXNREF and Ls/Cp/EXNREF at t-1
- ZATHETA_ICE,ZAMOIST_ICE ! coefficients for s = f (Thetal,Rnp)
!
-REAL :: ZEXPL ! 1-PIMPL deg of expl.
-REAL :: ZRVORD ! RV/RD
+!with LIMA, do not change rain, snow, graupel and hail concentrations (mixing ratio is not changed)
+REAL, DIMENSION(D%NIJT,D%NKT,KSV) :: ZRSVS
!
-INTEGER :: IKB,IKE ! index value for the
+REAL :: ZEXPL ! 1-TURBN%XIMPL deg of expl.
+REAL :: ZRVORD ! RV/RD
+REAL :: ZEPS ! XMV / XMD
+REAL :: ZD ! distance to the surface (for routine DELT)
+REAL :: ZVAR ! Intermediary variable (for routine DEAR)
+REAL :: ZPENTE ! Slope of the amplification straight line (for routine CLOUD_MODIF_LM)
+REAL :: ZCOEF_AMPL_CEI_NUL! Ordonnate at the origin of the
+ ! amplification straight line (for routine CLOUD_MODIF_LM)
+!
+INTEGER :: IIJB,IIJE,IKB,IKE ! index value for the
+INTEGER :: IINFO_ll ! return code of parallel routine
! Beginning and the End of the physical domain for the mass points
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: IKT,IKA,IKU ! array size in k direction
+INTEGER :: IKL
+INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
INTEGER :: JRR,JK,JSV ! loop counters
-INTEGER :: JI,JJ ! loop counters
+INTEGER :: JIJ ! loop counters
REAL :: ZL0 ! Max. Mixing Length in Blakadar formula
-REAL :: ZALPHA ! work coefficient :
- ! - proportionnality constant between Dz/2 and
+REAL :: ZALPHA ! work coefficient :
+ ! - proportionnality constant between Dz/2 and
! ! BL89 mixing length near the surface
!
REAL :: ZTIME1, ZTIME2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH,ZCOR
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZSHEAR, ZDUDZ, ZDVDZ
TYPE(TFIELDDATA) :: TZFIELD
!
-!Do not change rain, snow, graupel and hail concentrations (mixing ratio is not changed)
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)):: ZRSVS
-!
-!------------------------------------------------------------------------------------------
-ALLOCATE ( &
- ZCP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZEXN(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZT(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLMW(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLEPS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZTRH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZATHETA(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZAMOIST(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZCOEF_DISS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFRAC_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZTHLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
-
-ALLOCATE ( ZRM(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) )
-
-ALLOCATE ( &
- ZTAU11M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZTAU12M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZTAU22M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZTAU33M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZUSLOPE(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZVSLOPE(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZCDUEFF(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZUSTAR(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZLMO(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZRVM(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZSFRV(SIZE(PTHLT,1),SIZE(PTHLT,2)) )
-
-!------------------------------------------------------------------------------------------
-!
!* 1.PRELIMINARIES
! -------------
!
-!* 1.1 Set the internal domains, ZEXPL
+!* 1.1 Set the internal domains, ZEXPL
+!
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE,ZHOOK_HANDLE2
+IF (LHOOK) CALL DR_HOOK('TURB',0,ZHOOK_HANDLE)
!
-IKT=SIZE(PTHLT,3)
-IKTB=1+JPVEXT_TURB
-IKTE=IKT-JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
+IF (TURBN%LHARAT .AND. TURBN%CTURBDIM /= '1DIM') THEN
+ CALL ABOR1('TURBN%LHARATU only implemented for option TURBN%CTURBDIM=1DIM!')
+ENDIF
+IF (TURBN%LHARAT .AND. TLES%LLES_CALL) THEN
+ CALL ABOR1('TURBN%LHARATU not implemented for option LLES_CALL')
+ENDIF
!
-ZEXPL = 1.- PIMPL
-ZRVORD= XRV / XRD
+IKT=D%NKT
+IKTB=D%NKTB
+IKTE=D%NKTE
+IKB=D%NKB
+IKE=D%NKE
+IKA=D%NKA
+IKU=D%NKU
+IKL=D%NKL
+IIJE=D%NIJE
+IIJB=D%NIJB
!
+ZEXPL = 1.- TURBN%XIMPL
+ZRVORD= CST%XRV / CST%XRD
!
!Copy data into ZTHLM and ZRM only if needed
-IF (HTURBLEN=='BL89' .OR. HTURBLEN=='RM17' .OR. HTURBLEN=='ADAP' .OR. ORMC01) THEN
- ZTHLM(:,:,:) = PTHLT(:,:,:)
- ZRM(:,:,:,:) = PRT(:,:,:,:)
+IF (TURBN%CTURBLEN=='BL89' .OR. TURBN%CTURBLEN=='RM17' .OR. TURBN%CTURBLEN=='ADAP' .OR. TURBN%LRMC01) THEN
+ ZTHLM(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT)
+ ZRM(IIJB:IIJE,1:IKT,:) = PRT(IIJB:IIJE,1:IKT,:)
END IF
!
!Save LIMA scalar variables sources
-ZRSVS(:,:,:,:)=PRSVS(:,:,:,:)
+ZRSVS(IIJB:IIJE,1:IKT,1:KSV)=PRSVS(IIJB:IIJE,1:IKT,1:KSV)
!
!
!----------------------------------------------------------------------------
@@ -637,73 +549,98 @@ ZRSVS(:,:,:,:)=PRSVS(:,:,:,:)
!
!* 2.1 Cph at t
!
-ZCP(:,:,:)=XCPD
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZCP(IIJB:IIJE,1:IKT)=CST%XCPD
!
-IF (KRR > 0) ZCP(:,:,:) = ZCP(:,:,:) + XCPV * PRT(:,:,:,1)
-DO JRR = 2,1+KRRL ! loop on the liquid components
- ZCP(:,:,:) = ZCP(:,:,:) + XCL * PRT(:,:,:,JRR)
+IF (KRR > 0) ZCP(IIJB:IIJE,1:IKT) = ZCP(IIJB:IIJE,1:IKT) + CST%XCPV * PRT(IIJB:IIJE,1:IKT,1)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+DO JRR = 2,1+KRRL ! loop on the liquid components
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZCP(IIJB:IIJE,1:IKT) = ZCP(IIJB:IIJE,1:IKT) + CST%XCL * PRT(IIJB:IIJE,1:IKT,JRR)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
!
DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * PRT(:,:,:,JRR)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZCP(IIJB:IIJE,1:IKT) = ZCP(IIJB:IIJE,1:IKT) + CST%XCI * PRT(IIJB:IIJE,1:IKT,JRR)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
!
!* 2.2 Exner function at t
!
-IF (LOCEAN) THEN
- ZEXN(:,:,:) = 1.
+IF (OOCEAN) THEN
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZEXN(IIJB:IIJE,1:IKT) = 1.
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZEXN(IIJB:IIJE,1:IKT) = (PPABST(IIJB:IIJE,1:IKT)/CST%XP00) ** (CST%XRD/CST%XCPD)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
!* 2.3 dissipative heating coeff a t
!
-ZCOEF_DISS(:,:,:) = 1/(ZCP(:,:,:) * ZEXN(:,:,:))
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZCOEF_DISS(IIJB:IIJE,1:IKT) = 1/(ZCP(IIJB:IIJE,1:IKT) * ZEXN(IIJB:IIJE,1:IKT))
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
-ZFRAC_ICE(:,:,:) = 0.0
-ZATHETA(:,:,:) = 0.0
-ZAMOIST(:,:,:) = 0.0
+ZFRAC_ICE(IIJB:IIJE,1:IKT) = 0.0
+ZATHETA(IIJB:IIJE,1:IKT) = 0.0
+ZAMOIST(IIJB:IIJE,1:IKT) = 0.0
!
IF (KRRL >=1) THEN
!
!* 2.4 Temperature at t
!
- ZT(:,:,:) = PTHLT(:,:,:) * ZEXN(:,:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) * ZEXN(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!* 2.5 Lv/Cph/Exn
!
- IF ( KRRI >= 1 ) THEN
- ALLOCATE(ZLVOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
- ALLOCATE(ZLSOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
- ALLOCATE(ZAMOIST_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
- ALLOCATE(ZATHETA_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
-!
- CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
+ IF ( KRRI >= 1 ) THEN
+ IF (TURBN%LSTATNW) THEN
+ !wc call new functions depending on statnew
+ CALL COMPUTE_FUNCTION_THERMO_NEW_STAT(CST%XALPW,CST%XBETAW,CST%XGAMW,CST%XLVTT,CST%XCL,ZT,ZEXN,ZCP, &
ZLVOCPEXNM,ZAMOIST,ZATHETA)
- CALL COMPUTE_FUNCTION_THERMO(XALPI,XBETAI,XGAMI,XLSTT,XCI,ZT,ZEXN,ZCP, &
+ CALL COMPUTE_FUNCTION_THERMO_NEW_STAT(CST%XALPI,CST%XBETAI,CST%XGAMI,CST%XLSTT,CST%XCI,ZT,ZEXN,ZCP, &
ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE)
+ ELSE
+ CALL COMPUTE_FUNCTION_THERMO(CST%XALPW,CST%XBETAW,CST%XGAMW,CST%XLVTT,CST%XCL,ZT,ZEXN,ZCP, &
+ ZLVOCPEXNM,ZAMOIST,ZATHETA)
+ CALL COMPUTE_FUNCTION_THERMO(CST%XALPI,CST%XBETAI,CST%XGAMI,CST%XLSTT,CST%XCI,ZT,ZEXN,ZCP, &
+ ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE)
+ ENDIF
!
- WHERE(PRT(:,:,:,2)+PRT(:,:,:,4)>0.0)
- ZFRAC_ICE(:,:,:) = PRT(:,:,:,4) / ( PRT(:,:,:,2)+PRT(:,:,:,4) )
+ !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+ WHERE(PRT(IIJB:IIJE,1:IKT,2)+PRT(IIJB:IIJE,1:IKT,4)>0.0)
+ ZFRAC_ICE(IIJB:IIJE,1:IKT) = PRT(IIJB:IIJE,1:IKT,4) / ( PRT(IIJB:IIJE,1:IKT,2) &
+ +PRT(IIJB:IIJE,1:IKT,4) )
END WHERE
-!
- ZLOCPEXNM(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZLVOCPEXNM(:,:,:) &
- +ZFRAC_ICE(:,:,:) *ZLSOCPEXNM(:,:,:)
- ZAMOIST(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZAMOIST(:,:,:) &
- +ZFRAC_ICE(:,:,:) *ZAMOIST_ICE(:,:,:)
- ZATHETA(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZATHETA(:,:,:) &
- +ZFRAC_ICE(:,:,:) *ZATHETA_ICE(:,:,:)
-
- DEALLOCATE(ZAMOIST_ICE)
- DEALLOCATE(ZATHETA_ICE)
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZLOCPEXNM(IIJB:IIJE,1:IKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:IKT))*ZLVOCPEXNM(IIJB:IIJE,1:IKT) &
+ +ZFRAC_ICE(IIJB:IIJE,1:IKT) *ZLSOCPEXNM(IIJB:IIJE,1:IKT)
+ ZAMOIST(IIJB:IIJE,1:IKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:IKT))*ZAMOIST(IIJB:IIJE,1:IKT) &
+ +ZFRAC_ICE(IIJB:IIJE,1:IKT) *ZAMOIST_ICE(IIJB:IIJE,1:IKT)
+ ZATHETA(IIJB:IIJE,1:IKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:IKT))*ZATHETA(IIJB:IIJE,1:IKT) &
+ +ZFRAC_ICE(IIJB:IIJE,1:IKT) *ZATHETA_ICE(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
+ !wc call new stat functions or not
+ IF (TURBN%LSTATNW) THEN
+ CALL COMPUTE_FUNCTION_THERMO_NEW_STAT(CST%XALPW,CST%XBETAW,CST%XGAMW,CST%XLVTT,CST%XCL,ZT,ZEXN,ZCP, &
ZLOCPEXNM,ZAMOIST,ZATHETA)
+ ELSE
+ CALL COMPUTE_FUNCTION_THERMO(CST%XALPW,CST%XBETAW,CST%XGAMW,CST%XLVTT,CST%XCL,ZT,ZEXN,ZCP, &
+ ZLOCPEXNM,ZAMOIST,ZATHETA)
+ ENDIF
END IF
!
!
- IF ( tpfile%lopened .AND. OTURB_DIAG ) THEN
+ IF ( TPFILE%LOPENED .AND. TURBN%LTURB_DIAG ) THEN
TZFIELD%CMNHNAME = 'ATHETA'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'ATHETA'
@@ -714,8 +651,8 @@ IF (KRRL >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZATHETA)
-!
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZATHETA)
+!
TZFIELD%CMNHNAME = 'AMOIST'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'AMOIST'
@@ -726,153 +663,213 @@ IF (KRRL >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZAMOIST)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZAMOIST)
END IF
!
ELSE
- ZLOCPEXNM=0.
+ ZLOCPEXNM(IIJB:IIJE,1:IKT)=0.
END IF ! loop end on KRRL >= 1
!
! computes conservative variables
!
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! Rnp at t
- PRT(:,:,:,1) = PRT(:,:,:,1) + PRT(:,:,:,2) + PRT(:,:,:,4)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2) + PRRS(:,:,:,4)
+ PRT(IIJB:IIJE,1:IKT,1) = PRT(IIJB:IIJE,1:IKT,1) + PRT(IIJB:IIJE,1:IKT,2) &
+ + PRT(IIJB:IIJE,1:IKT,4)
+ PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) + PRRS(IIJB:IIJE,1:IKT,2) &
+ + PRRS(IIJB:IIJE,1:IKT,4)
! Theta_l at t
- PTHLT(:,:,:) = PTHLT(:,:,:) - ZLVOCPEXNM(:,:,:) * PRT(:,:,:,2) &
- - ZLSOCPEXNM(:,:,:) * PRT(:,:,:,4)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
- - ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
+ PTHLT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) - ZLVOCPEXNM(IIJB:IIJE,1:IKT) &
+ * PRT(IIJB:IIJE,1:IKT,2) &
+ - ZLSOCPEXNM(IIJB:IIJE,1:IKT) * PRT(IIJB:IIJE,1:IKT,4)
+ PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) - ZLVOCPEXNM(IIJB:IIJE,1:IKT) &
+ * PRRS(IIJB:IIJE,1:IKT,2) &
+ - ZLSOCPEXNM(IIJB:IIJE,1:IKT) * PRRS(IIJB:IIJE,1:IKT,4)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! Rnp at t
- PRT(:,:,:,1) = PRT(:,:,:,1) + PRT(:,:,:,2)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
+ PRT(IIJB:IIJE,1:IKT,1) = PRT(IIJB:IIJE,1:IKT,1) + PRT(IIJB:IIJE,1:IKT,2)
+ PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) + PRRS(IIJB:IIJE,1:IKT,2)
! Theta_l at t
- PTHLT(:,:,:) = PTHLT(:,:,:) - ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
+ PTHLT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) - ZLOCPEXNM(IIJB:IIJE,1:IKT) &
+ * PRT(IIJB:IIJE,1:IKT,2)
+ PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) - ZLOCPEXNM(IIJB:IIJE,1:IKT) &
+ * PRRS(IIJB:IIJE,1:IKT,2)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
END IF
!
+!* stores value of conservative variables & wind before turbulence tendency (AROME diag)
+IF(PRESENT(PDRUS_TURB)) THEN
+ PDRUS_TURB(:,:) = PRUS(:,:)
+ PDRVS_TURB(:,:) = PRVS(:,:)
+ PDRTHLS_TURB(:,:) = PRTHLS(:,:)
+ PDRRTS_TURB(:,:) = PRRS(:,:,1)
+ PDRSVS_TURB(:,:,:) = PRSVS(:,:,:)
+END IF
!----------------------------------------------------------------------------
!
!* 3. MIXING LENGTH : SELECTION AND COMPUTATION
! -----------------------------------------
!
!
-SELECT CASE (HTURBLEN)
+IF (.NOT. TURBN%LHARAT) THEN
+
+SELECT CASE (TURBN%CTURBLEN)
!
!* 3.1 BL89 mixing length
! ------------------
CASE ('BL89')
- ZSHEAR=0.
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+ ZSHEAR(:,:)=0.
+ CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN,HPROGRAM)
!
!* 3.2 RM17 mixing length
! ------------------
CASE ('RM17')
- ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ)))
- ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ)))
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
-!
-!* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths
+ CALL GZ_U_UW_PHY(D,PUT,PDZZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ CALL MXF_PHY(D,ZWORK2,ZDUDZ)
+ !
+ CALL GZ_V_VW_PHY(D,PVT,PDZZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ CALL MYF_PHY(D,ZWORK2,ZDVDZ)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)*ZDUDZ(IIJB:IIJE,1:IKT) &
+ + ZDVDZ(IIJB:IIJE,1:IKT)*ZDVDZ(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN,HPROGRAM)
+!
+!* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths
! --------------------------------------------------
CASE ('ADAP')
- ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ)))
- ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ)))
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+ CALL GZ_U_UW_PHY(D,PUT,PDZZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ CALL MXF_PHY(D,ZWORK2,ZDUDZ)
+ !
+ CALL GZ_V_VW_PHY(D,PVT,PDZZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ CALL MYF_PHY(D,ZWORK2,ZDVDZ)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)*ZDUDZ(IIJB:IIJE,1:IKT) &
+ + ZDVDZ(IIJB:IIJE,1:IKT)*ZDVDZ(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN,HPROGRAM)
CALL DELT(ZLMW,ODZ=.FALSE.)
! The minimum mixing length is chosen between Horizontal grid mesh (not taking into account the vertical grid mesh) and RM17.
! For large horizontal grid meshes, this is equal to RM17
- ! For LES grid meshes, this is equivalent to Deardorff : the base mixing lentgh is the horizontal grid mesh,
- ! and it is limited by a stability-based length (RM17), as was done in Deardorff length (but taking into account shear as well)
+ ! For LES grid meshes, this is equivalent to Deardorff : the base mixing lentgh is the horizontal grid mesh,
+ !and it is limited by a stability-based length (RM17), as was done in Deardorff length (but taking into account shear as well)
! For grid meshes in the grey zone, then this is the smaller of the two.
- PLEM = MIN(PLEM,XCADAP*ZLMW)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZLM(IIJB:IIJE,1:IKT) = MIN(ZLM(IIJB:IIJE,1:IKT),TURBN%XCADAP*ZLMW(IIJB:IIJE,1:IKT))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!* 3.4 Delta mixing length
! -------------------
!
CASE ('DELT')
- CALL DELT(PLEM,ODZ=.TRUE.)
+ CALL DELT(ZLM,ODZ=.TRUE.)
!
!* 3.5 Deardorff mixing length
! -----------------------
!
CASE ('DEAR')
- CALL DEAR(PLEM)
+ CALL DEAR(ZLM)
!
!* 3.6 Blackadar mixing length
! -----------------------
!
CASE ('BLKR')
ZL0 = 100.
- PLEM(:,:,:) = ZL0
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZLM(IIJB:IIJE,1:IKT) = ZL0
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZALPHA=0.5**(-1.5)
!
DO JK=IKTB,IKTE
- PLEM(:,:,JK) = ( 0.5*(PZZ(:,:,JK)+PZZ(:,:,JK+KKL)) - &
- & PZZ(:,:,KKA+JPVEXT_TURB*KKL) ) * PDIRCOSZW(:,:)
- PLEM(:,:,JK) = ZALPHA * PLEM(:,:,JK) * ZL0 / ( ZL0 + ZALPHA*PLEM(:,:,JK) )
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZLM(IIJB:IIJE,JK) = ( 0.5*(PZZ(IIJB:IIJE,JK)+PZZ(IIJB:IIJE,JK+IKL)) - &
+ & PZZ(IIJB:IIJE,IKA+JPVEXT_TURB*IKL) ) * PDIRCOSZW(IIJB:IIJE)
+ ZLM(IIJB:IIJE,JK) = ZALPHA * ZLM(IIJB:IIJE,JK) * ZL0 / ( ZL0 + ZALPHA*ZLM(IIJB:IIJE,JK) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
!
- PLEM(:,:,IKTB-1) = PLEM(:,:,IKTB)
- PLEM(:,:,IKTE+1) = PLEM(:,:,IKTE)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZLM(IIJB:IIJE,IKTB-1) = ZLM(IIJB:IIJE,IKTB)
+ ZLM(IIJB:IIJE,IKTE+1) = ZLM(IIJB:IIJE,IKTE)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!
!
END SELECT
!
-!
-!
!* 3.5 Mixing length modification for cloud
! -----------------------
IF (KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE') CALL CLOUD_MODIF_LM
+ENDIF ! end LHARRAT
!
!* 3.6 Dissipative length
! ------------------
-!
-ZLEPS(:,:,:)=PLEM(:,:,:)
+
+IF (TURBN%LHARAT) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZLEPS(IIJB:IIJE,1:IKT)=PLENGTHM(IIJB:IIJE,1:IKT)*(3.75**2.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ELSE
+ ZLEPS(IIJB:IIJE,1:IKT)=ZLM(IIJB:IIJE,1:IKT)
+ENDIF
!
!* 3.7 Correction in the Surface Boundary Layer (Redelsperger 2001)
! ----------------------------------------
!
-ZLMO=XUNDEF
-IF (ORMC01) THEN
- ZUSTAR=(PSFU**2+PSFV**2)**(0.25)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZLMO(IIJB:IIJE)=XUNDEF
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+IF (TURBN%LRMC01) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZUSTAR(IIJB:IIJE)=(PSFU(IIJB:IIJE)**2+PSFV(IIJB:IIJE)**2)**(0.25)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
IF (KRR>0) THEN
- ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRM(:,:,IKB,1),PSFTH,PSFRV)
+ CALL LMO(D,CST,ZUSTAR,ZTHLM(:,IKB),ZRM(:,IKB,1),PSFTH,PSFRV,ZLMO)
ELSE
- ZRVM=0.
- ZSFRV=0.
- ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRVM,PSFTH,ZSFRV)
+ ZRVM(:)=0.
+ ZSFRV(:)=0.
+ CALL LMO(D,CST,ZUSTAR,ZTHLM(:,IKB),ZRVM,PSFTH,ZSFRV,ZLMO)
END IF
- CALL RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,PLEM,ZLEPS)
+ CALL RMC01(D,CST,CSTURB,TURBN%CTURBLEN,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,ZLM,ZLEPS)
END IF
!
!RMC01 is only applied on RM17 in ADAP
-IF (HTURBLEN=='ADAP') ZLEPS = MIN(ZLEPS,ZLMW*XCADAP)
+IF (TURBN%CTURBLEN=='ADAP') THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZLEPS(IIJB:IIJE,1:IKT) = MIN(ZLEPS(IIJB:IIJE,1:IKT),ZLMW(IIJB:IIJE,1:IKT)*TURBN%XCADAP)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
!
-!* 3.8 Mixing length in external points (used if HTURBDIM="3DIM")
+!* 3.8 Mixing length in external points (used if TURBN%CTURBDIM="3DIM")
! ----------------------------------------------------------
!
-IF (HTURBDIM=="3DIM") THEN
- CALL UPDATE_LM(HLBCX,HLBCY,PLEM,ZLEPS)
+IF (TURBN%CTURBDIM=="3DIM") THEN
+ CALL UPDATE_LM(D,HLBCX,HLBCY,ZLM,ZLEPS)
END IF
!
-!* 3.9 Mixing length correction if immersed walls
+!* 3.9 Mixing length correction if immersed walls
! ------------------------------------------
!
-IF (LIBM) THEN
- CALL IBM_MIXINGLENGTH(PLEM,ZLEPS,XIBM_XMUT,XIBM_LS(:,:,:,1),PTKET)
+IF (OIBM) THEN
+ CALL IBM_MIXINGLENGTH(D,ZLM,ZLEPS,PIBM_XMUT,PIBM_LS,PTKET)
ENDIF
!----------------------------------------------------------------------------
!
@@ -884,74 +881,85 @@ ENDIF
!
!
!
- IF (CPROGRAM/='AROME ') THEN
- CALL ROTATE_WIND(PUT,PVT,PWT, &
+IF (HPROGRAM/='AROME ') THEN
+ CALL ROTATE_WIND(D,PUT,PVT,PWT, &
PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
PDXX,PDYY,PDZZ, &
ZUSLOPE,ZVSLOPE )
!
- CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
- ELSE
- ZUSLOPE=PUT(:,:,KKA)
- ZVSLOPE=PVT(:,:,KKA)
- END IF
+ CALL UPDATE_ROTATE_WIND(D,ZUSLOPE,ZVSLOPE,HLBCX,HLBCY)
+ELSE
+ ZUSLOPE(IIJB:IIJE)=PUT(IIJB:IIJE,IKA)
+ ZVSLOPE(IIJB:IIJE)=PVT(IIJB:IIJE,IKA)
+END IF
+IF (OOCEAN) THEN
+ ZUSLOPE(IIJB:IIJE)=PUT(IIJB:IIJE,IKU-1)
+ ZVSLOPE(IIJB:IIJE)=PVT(IIJB:IIJE,IKU-1)
+END IF
!
!
!* 4.2 compute the proportionality coefficient between wind and stress
!
- ZCDUEFF(:,:) =-SQRT ( (PSFU(:,:)**2 + PSFV(:,:)**2) / &
- (XMNH_TINY + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) )
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZCDUEFF(IIJB:IIJE) =-SQRT ( (PSFU(IIJB:IIJE)**2 + PSFV(IIJB:IIJE)**2) / &
+#ifdef REPRO48
+ (1.E-60 + ZUSLOPE(IIJB:IIJE)**2 + ZVSLOPE(IIJB:IIJE)**2 ) )
+#else
+ (CST%XMNH_TINY + ZUSLOPE(IIJB:IIJE)**2 + ZVSLOPE(IIJB:IIJE)**2 ) )
+#endif
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!* 4.6 compute the surface tangential fluxes
!
-ZTAU11M(:,:) =2./3.*( (1.+ (PZZ (:,:,IKB+KKL)-PZZ (:,:,IKB)) &
- /(PDZZ(:,:,IKB+KKL)+PDZZ(:,:,IKB)) &
- ) *PTKET(:,:,IKB) &
- -0.5 *PTKET(:,:,IKB+KKL) &
+IF (OOCEAN) THEN
+ ZTAU11M(IIJB:IIJE)=0.
+ELSE
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZTAU11M(IIJB:IIJE) =2./3.*( (1.+ (PZZ(IIJB:IIJE,IKB+IKL)-PZZ(IIJB:IIJE,IKB)) &
+ /(PDZZ(IIJB:IIJE,IKB+IKL)+PDZZ(IIJB:IIJE,IKB)) &
+ ) *PTKET(IIJB:IIJE,IKB) &
+ -0.5 *PTKET(IIJB:IIJE,IKB+IKL) &
)
-ZTAU12M(:,:) =0.0
-ZTAU22M(:,:) =ZTAU11M(:,:)
-ZTAU33M(:,:) =ZTAU11M(:,:)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+END IF
+ZTAU12M(IIJB:IIJE) =0.0
+ZTAU22M(IIJB:IIJE) =ZTAU11M(IIJB:IIJE)
+ZTAU33M(IIJB:IIJE) =ZTAU11M(IIJB:IIJE)
!
!* 4.7 third order terms in temperature and water fluxes and correlations
! ------------------------------------------------------------------
!
!
-ZMWTH = 0. ! w'2th'
-ZMWR = 0. ! w'2r'
-ZMTH2 = 0. ! w'th'2
-ZMR2 = 0. ! w'r'2
-ZMTHR = 0. ! w'th'r'
-
-IF (HTOM=='TM06') THEN
- CALL TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,ZMWTH,ZMTH2)
-!
- ZFWTH = -GZ_M_W(KKA,KKU,KKL,ZMWTH,PDZZ) ! -d(w'2th' )/dz
- !ZFWR = -GZ_M_W(KKA,KKU,KKL,ZMWR, PDZZ) ! -d(w'2r' )/dz
- ZFTH2 = -GZ_W_M(ZMTH2,PDZZ) ! -d(w'th'2 )/dz
- !ZFR2 = -GZ_W_M(ZMR2, PDZZ) ! -d(w'r'2 )/dz
- !ZFTHR = -GZ_W_M(ZMTHR,PDZZ) ! -d(w'th'r')/dz
-!
- ZFWTH(:,:,IKTE:) = 0.
- ZFWTH(:,:,:IKTB) = 0.
- !ZFWR (:,:,IKTE:) = 0.
- !ZFWR (:,:,:IKTB) = 0.
- ZFWR = 0.
- ZFTH2(:,:,IKTE:) = 0.
- ZFTH2(:,:,:IKTB) = 0.
- !ZFR2 (:,:,IKTE:) = 0.
- !ZFR2 (:,:,:IKTB) = 0.
- ZFR2 = 0.
- !ZFTHR(:,:,IKTE:) = 0.
- !ZFTHR(:,:,:IKTB) = 0.
- ZFTHR = 0.
+ZMWTH(:,:) = 0. ! w'2th'
+ZMWR(:,:) = 0. ! w'2r'
+ZMTH2(:,:) = 0. ! w'th'2
+ZMR2(:,:) = 0. ! w'r'2
+ZMTHR(:,:) = 0. ! w'th'r'
+!
+IF (TURBN%CTOM=='TM06') THEN
+ CALL TM06(D,CST,PTHVREF,PBL_DEPTH,PZZ,PSFTH,ZMWTH,ZMTH2)
+!
+ CALL GZ_M_W_PHY(D,ZMWTH,PDZZ,ZWORK1) ! -d(w'2th' )/dz
+ CALL GZ_W_M_PHY(D,ZMTH2,PDZZ,ZWORK2) ! -d(w'th'2 )/dz
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZFWTH(IIJB:IIJE,1:IKT) = -ZWORK1(IIJB:IIJE,1:IKT)
+ ZFTH2(IIJB:IIJE,1:IKT) = -ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+ ZFWTH(:,IKTE:) = 0.
+ ZFWTH(:,:IKTB) = 0.
+ ZFWR(:,:) = 0.
+ ZFTH2(:,IKTE:) = 0.
+ ZFTH2(:,:IKTB) = 0.
+ ZFR2(:,:) = 0.
+ ZFTHR(:,:) = 0.
ELSE
- ZFWTH = 0.
- ZFWR = 0.
- ZFTH2 = 0.
- ZFR2 = 0.
- ZFTHR = 0.
+ ZFWTH(:,:) = 0.
+ ZFWR(:,:) = 0.
+ ZFTH2(:,:) = 0.
+ ZFR2(:,:) = 0.
+ ZFTHR(:,:) = 0.
ENDIF
!
!----------------------------------------------------------------------------
@@ -959,136 +967,150 @@ ENDIF
!* 5. TURBULENT SOURCES
! -----------------
!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'VTURB', prus (:, :, :) )
-if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'VTURB', prvs (:, :, :) )
-if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'VTURB', prws (:, :, :) )
+IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_U ), 'VTURB', PRUS(:,:) )
+IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_V ), 'VTURB', PRVS(:,:) )
+IF( BUCONF%LBUDGET_W ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_W ), 'VTURB', PRWS(:,:) )
-if ( lbudget_th ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
- end if
-end if
+IF( BUCONF%LBUDGET_TH ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:,:) + ZLVOCPEXNM(:,:) * PRRS(:,:, 2) &
+ + ZLSOCPEXNM(:,:) * PRRS(:,:, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:,:) + ZLOCPEXNM(:,:) * PRRS(:,:, 2) )
+ ELSE
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:,:) )
+ END IF
+END IF
-if ( lbudget_rv ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
- end if
-end if
+IF( BUCONF%LBUDGET_RV ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:,:, 1) - PRRS(:,:, 2) - PRRS(:,:, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:,:, 1) - PRRS(:,:, 2) )
+ ELSE
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:,:, 1) )
+ END IF
+END IF
-if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'VTURB', prrs (:, :, :, 2) )
-if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'VTURB', prrs (:, :, :, 4) )
+IF( BUCONF%LBUDGET_RC ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'VTURB', PRRS (:,:, 2) )
+IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'VTURB', PRRS (:,:, 4) )
-if ( lbudget_sv ) then
- do jsv = 1, nsv
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
- end do
-end if
+IF( BUCONF%LBUDGET_SV ) THEN
+ DO JSV = 1, KSV
+ CALL BUDGET_STORE_INIT_PHY(D, 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, &
+CALL TURB_VER(D,CST,CSTURB,TURBN,TLES, &
+ KRR,KRRL,KRRI,KGRADIENTS, &
+ OOCEAN, ODEEPOC, OCOMPUTE_SRC, &
+ KSV,KSV_LGBEG,KSV_LGEND, &
+ ZEXPL,HPROGRAM, O2D, ONOMIXLG, OFLAT, &
+ OCOUPLES,OBLOWSNOW, PRSNOW, &
PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
+ PRHODJ,PTHVREF,PSFU,PSFV, &
PSFTH,PSFRV,PSFSV,PSFTH,PSFRV,PSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU33M, &
PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
- PTKET,PLEM,ZLEPS, &
+ PTKET,ZLM,PLENGTHM,PLENGTHH,ZLEPS,MFMOIST, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,PBL_DEPTH, &
- PSBL_DEPTH,ZLMO, &
+ PSBL_DEPTH,ZLMO,PHGRAD,PZS, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDYP,PTHP,PSIGS,PWTH,PWRC,PWSV )
+ PDP,PTP,PSIGS,PWTH,PWRC,PWSV, &
+ PSSTFL, PSSTFL_C, PSSRFL_C,PSSUFL_C,PSSVFL_C, &
+ PSSUFL,PSSVFL )
IF (HCLOUD == 'LIMA') THEN
- IF (NSV_LIMA_NR.GT.0) PRSVS(:,:,:,NSV_LIMA_NR) = ZRSVS(:,:,:,NSV_LIMA_NR)
- IF (NSV_LIMA_NS.GT.0) PRSVS(:,:,:,NSV_LIMA_NS) = ZRSVS(:,:,:,NSV_LIMA_NS)
- IF (NSV_LIMA_NG.GT.0) PRSVS(:,:,:,NSV_LIMA_NG) = ZRSVS(:,:,:,NSV_LIMA_NG)
- IF (NSV_LIMA_NH.GT.0) PRSVS(:,:,:,NSV_LIMA_NH) = ZRSVS(:,:,:,NSV_LIMA_NH)
+ IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
+ IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
+ IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
+ IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
END IF
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VTURB', prus(:, :, :) )
-if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'VTURB', prvs(:, :, :) )
-if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'VTURB', prws(:, :, :) )
-
-if ( lbudget_th ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
- end if
-end if
+IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'VTURB', PRUS(:,:) )
+IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'VTURB', PRVS(:,:) )
+IF( BUCONF%LBUDGET_W ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_W), 'VTURB', PRWS(:,:) )
-if ( lbudget_rv ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
- else
- call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
- end if
-end if
+IF( BUCONF%LBUDGET_TH ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:,:) + ZLVOCPEXNM(:,:) * PRRS(:,:, 2) &
+ + ZLSOCPEXNM(:,:) * PRRS(:,:, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:,:) + ZLOCPEXNM(:,:) * PRRS(:,:, 2) )
+ ELSE
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:,:) )
+ END IF
+END IF
-if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'VTURB', prrs(:, :, :, 2) )
-if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'VTURB', prrs(:, :, :, 4) )
+IF( BUCONF%LBUDGET_RV ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:,:, 1) - PRRS(:,:, 2) - PRRS(:,:, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:,:, 1) - PRRS(:,:, 2) )
+ ELSE
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:,:, 1) )
+ END IF
+END IF
-if ( lbudget_sv ) then
- do jsv = 1, nsv
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
- end do
-end if
-!
-if ( hturbdim == '3DIM' ) then
- if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'HTURB', prus (:, :, :) )
- if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'HTURB', prvs (:, :, :) )
- if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'HTURB', prws (:, :, :) )
+IF( BUCONF%LBUDGET_RC ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'VTURB', PRRS(:,:, 2) )
+IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'VTURB', PRRS(:,:, 4) )
- if (lbudget_th) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
- end if
- end if
+IF( BUCONF%LBUDGET_SV ) THEN
+ DO JSV = 1, KSV
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', PRSVS(:,:, JSV) )
+ END DO
+END IF
+!
+!Les budgets des termes horizontaux de la turb sont présents dans AROME
+! alors que ces termes ne sont pas calculés
+#ifdef REPRO48
+#else
+IF( TURBN%CTURBDIM == '3DIM' ) THEN
+#endif
+ IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_U ), 'HTURB', PRUS (:,:) )
+ IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_V ), 'HTURB', PRVS (:,:) )
+ IF( BUCONF%LBUDGET_W ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_W ), 'HTURB', PRWS (:,:) )
- if ( lbudget_rv ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
- end if
- end if
+ IF(BUCONF%LBUDGET_TH) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:,:) + ZLVOCPEXNM(:,:) * PRRS(:,:, 2) &
+ + ZLSOCPEXNM(:,:) * PRRS(:,:, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:,:) + ZLOCPEXNM(:,:) * PRRS(:,:, 2) )
+ ELSE
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:,:) )
+ END IF
+ END IF
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+ IF( BUCONF%LBUDGET_RV ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:,:, 1) - PRRS(:,:, 2) - PRRS(:,:, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:,:, 1) - PRRS(:,:, 2) )
+ ELSE
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:,:, 1) )
+ END IF
+ END IF
- if ( lbudget_sv ) then
- do jsv = 1, nsv
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
- end do
- end if
+ IF( BUCONF%LBUDGET_RC ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'HTURB', PRRS(:,:, 2) )
+ IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'HTURB', PRRS(:,:, 4) )
- CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
- TPFILE, &
+ IF( BUCONF%LBUDGET_SV ) THEN
+ DO JSV = 1, KSV
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', PRSVS(:,:, JSV) )
+ END DO
+ END IF
+!à supprimer une fois le précédent ifdef REPRO48 validé
+#ifdef REPRO48
+#else
+ CALL TURB_HOR_SPLT(D,CST,CSTURB, TURBN, TLES, &
+ KSPLIT, KRR, KRRL, KRRI, KSV,KSV_LGBEG,KSV_LGEND, &
+ PTSTEP,HLBCX,HLBCY, OFLAT,O2D, ONOMIXLG, &
+ OOCEAN,OCOMPUTE_SRC,OBLOWSNOW,PRSNOW, &
+ TPFILE, HPROGRAM, KHALO, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
@@ -1096,81 +1118,127 @@ if ( hturbdim == '3DIM' ) then
PSFTH,PSFRV,PSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU22M,ZTAU33M, &
PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
- PTKET,PLEM,ZLEPS, &
+ PTKET,ZLM,ZLEPS, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
- PDYP,PTHP,PSIGS, &
+ PDP,PTP,PSIGS, &
ZTRH, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+#endif
+ !
+ IF (HCLOUD == 'LIMA') THEN
+ IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
+ IF (KSV_LIMA_NS.GT.0) PRSVS(:,:,KSV_LIMA_NS) = ZRSVS(:,:,KSV_LIMA_NS)
+ IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
+ IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
+ END IF
+ !
+ IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'HTURB', PRUS(:,:) )
+ IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'HTURB', PRVS(:,:) )
+ IF( BUCONF%LBUDGET_W ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_W), 'HTURB', PRWS(:,:) )
-IF (HCLOUD == 'LIMA') THEN
- IF (NSV_LIMA_NR.GT.0) PRSVS(:,:,:,NSV_LIMA_NR) = ZRSVS(:,:,:,NSV_LIMA_NR)
- IF (NSV_LIMA_NS.GT.0) PRSVS(:,:,:,NSV_LIMA_NS) = ZRSVS(:,:,:,NSV_LIMA_NS)
- IF (NSV_LIMA_NG.GT.0) PRSVS(:,:,:,NSV_LIMA_NG) = ZRSVS(:,:,:,NSV_LIMA_NG)
- IF (NSV_LIMA_NH.GT.0) PRSVS(:,:,:,NSV_LIMA_NH) = ZRSVS(:,:,:,NSV_LIMA_NH)
-END IF
-
- if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'HTURB', prus(:, :, :) )
- if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'HTURB', prvs(:, :, :) )
- if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'HTURB', prws(:, :, :) )
-
- if ( lbudget_th ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
- end if
- end if
+ IF( BUCONF%LBUDGET_TH ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:,:) + ZLVOCPEXNM(:,:) * PRRS(:,:, 2) &
+ + ZLSOCPEXNM(:,:) * PRRS(:,:, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:,:) + ZLOCPEXNM(:,:) * PRRS(:,:, 2) )
+ ELSE
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:,:) )
+ END IF
+ END IF
- if ( lbudget_rv ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
- else
- call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
- end if
- end if
+ IF( BUCONF%LBUDGET_RV ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:,:, 1) - PRRS(:,:, 2) - PRRS(:,:, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:,:, 1) - PRRS(:,:, 2) )
+ ELSE
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:,:, 1) )
+ END IF
+ END IF
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+ IF( BUCONF%LBUDGET_RC ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'HTURB', PRRS(:,:, 2) )
+ IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'HTURB', PRRS(:,:, 4) )
- if ( lbudget_sv ) then
- do jsv = 1, nsv
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
- end do
- end if
-end if
+ IF( BUCONF%LBUDGET_SV ) THEN
+ DO JSV = 1, KSV
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', PRSVS(:,:, JSV) )
+ END DO
+ END IF
+#ifdef REPRO48
+#else
+END IF
+#endif
!----------------------------------------------------------------------------
!
-!* 6. EVOLUTION OF THE TKE AND ITS DISSIPATION
+!* 6. EVOLUTION OF THE TKE AND ITS DISSIPATION
! ----------------------------------------
!
-! 6.1 Contribution of mass-flux in the TKE buoyancy production if
-! cloud computation is not statistical
-
- PTHP = PTHP + XG / PTHVREF * MZF( PFLXZTHVMF )
+! 6.1 Contribution of mass-flux in the TKE buoyancy production if
+! cloud computation is not statistical
+CALL MZF_PHY(D,PFLXZTHVMF,ZWORK1)
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+PTP(IIJB:IIJE,1:IKT) = PTP(IIJB:IIJE,1:IKT) &
+ + CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+IF(PRESENT(PTPMF)) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PTPMF(IIJB:IIJE,1:IKT)=CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+END IF
! 6.2 TKE evolution equation
-CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,PLEM,ZLEPS,PDYP,ZTRH, &
- PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- PTSTEP,PIMPL,ZEXPL, &
- HTURBLEN,HTURBDIM, &
- TPFILE,OTURB_DIAG, &
- PTHP,PRTKES,PRTKEMS,PRTHLS,ZCOEF_DISS,PTR,PDISS )
-
+IF (.NOT. TURBN%LHARAT) THEN
+!
+IF (BUCONF%LBUDGET_TH) THEN
+ IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS(:,:)+ ZLVOCPEXNM(:,:) * PRRS(:,:,2) &
+ & + ZLSOCPEXNM(:,:) * PRRS(:,:,4) )
+ ELSE IF ( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS(:,:) + ZLOCPEXNM(:,:) * PRRS(:,:,2) )
+ ELSE
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS(:,:) )
+ END IF
+END IF
+!
+IF(PRESENT(PRTKEMS)) THEN
+ ZRTKEMS(:,:)=PRTKEMS(:,:)
+ELSE
+ ZRTKEMS(:,:)=0.
+END IF
+!
+CALL TKE_EPS_SOURCES(D,CST,CSTURB,BUCONF,TURBN,TLES,HPROGRAM, &
+ & KMI,PTKET,ZLM,ZLEPS,PDP,ZTRH, &
+ & PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+ & PTSTEP,ZEXPL, &
+ & TPFILE,ODIAG_IN_RUN,OOCEAN, &
+ & PSFU,PSFV, &
+ & PTP,PRTKES,PRTHLS,ZCOEF_DISS,PTDIFF,PTDISS,ZRTKEMS,&
+ & TBUDGETS,KBUDGETS, PEDR=PEDR, PTR=PTR,PDISS=PDISS, &
+ & PCURRENT_TKE_DISS=PCURRENT_TKE_DISS )
+IF (BUCONF%LBUDGET_TH) THEN
+ IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS(:,:)+ ZLVOCPEXNM(:,:) * PRRS(:,:,2) &
+ & + ZLSOCPEXNM(:,:) * PRRS(:,:,4) )
+ ELSE IF ( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS(:,:)+ ZLOCPEXNM(:,:) * PRRS(:,:,2) )
+ ELSE
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS(:,:) )
+ END IF
+END IF
+!
+ENDIF
+!
!----------------------------------------------------------------------------
!
!* 7. STORES SOME INFORMATIONS RELATED TO THE TURBULENCE SCHEME
! ---------------------------------------------------------
!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
-!
+IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
+!
! stores the mixing length
-!
+!
TZFIELD%CMNHNAME = 'LM'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'LM'
@@ -1181,7 +1249,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PLEM)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZLM)
!
IF (KRR /= 0) THEN
!
@@ -1197,7 +1265,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PTHLT)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PTHLT)
!
! stores the conservative mixing ratio
!
@@ -1211,10 +1279,22 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRT(:,:,:,1))
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,PRT(:,:,1))
END IF
END IF
!
+!* stores value of conservative variables & wind before turbulence tendency (AROME only)
+IF(PRESENT(PDRUS_TURB)) THEN
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PDRUS_TURB(IIJB:IIJE,1:IKT) = PRUS(IIJB:IIJE,1:IKT) - PDRUS_TURB(IIJB:IIJE,1:IKT)
+ PDRVS_TURB(IIJB:IIJE,1:IKT) = PRVS(IIJB:IIJE,1:IKT) - PDRVS_TURB(IIJB:IIJE,1:IKT)
+ PDRTHLS_TURB(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) - PDRTHLS_TURB(IIJB:IIJE,1:IKT)
+ PDRRTS_TURB(IIJB:IIJE,1:IKT) = PRRS(IIJB:IIJE,1:IKT,1) - PDRRTS_TURB(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV)
+ PDRSVS_TURB(IIJB:IIJE,1:IKT,:) = PRSVS(IIJB:IIJE,1:IKT,:) - PDRSVS_TURB(IIJB:IIJE,1:IKT,:)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV)
+END IF
!----------------------------------------------------------------------------
!
!* 8. RETRIEVE NON-CONSERVATIVE VARIABLES
@@ -1222,52 +1302,63 @@ END IF
!
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
- PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2) - PRT(:,:,:,4)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2) - PRRS(:,:,:,4)
- PTHLT(:,:,:) = PTHLT(:,:,:) + ZLVOCPEXNM(:,:,:) * PRT(:,:,:,2) &
- + ZLSOCPEXNM(:,:,:) * PRT(:,:,:,4)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
- + ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
-!
- DEALLOCATE(ZLVOCPEXNM)
- DEALLOCATE(ZLSOCPEXNM)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRT(IIJB:IIJE,1:IKT,1) = PRT(IIJB:IIJE,1:IKT,1) - PRT(IIJB:IIJE,1:IKT,2) &
+ - PRT(IIJB:IIJE,1:IKT,4)
+ PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) - PRRS(IIJB:IIJE,1:IKT,2) &
+ - PRRS(IIJB:IIJE,1:IKT,4)
+ PTHLT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) + ZLVOCPEXNM(IIJB:IIJE,1:IKT) &
+ * PRT(IIJB:IIJE,1:IKT,2) &
+ + ZLSOCPEXNM(IIJB:IIJE,1:IKT) * PRT(IIJB:IIJE,1:IKT,4)
+ PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) + ZLVOCPEXNM(IIJB:IIJE,1:IKT) &
+ * PRRS(IIJB:IIJE,1:IKT,2) &
+ + ZLSOCPEXNM(IIJB:IIJE,1:IKT) * PRRS(IIJB:IIJE,1:IKT,4)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
ELSE
- PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2)
- PTHLT(:,:,:) = PTHLT(:,:,:) + ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PRT(IIJB:IIJE,1:IKT,1) = PRT(IIJB:IIJE,1:IKT,1) - PRT(IIJB:IIJE,1:IKT,2)
+ PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) - PRRS(IIJB:IIJE,1:IKT,2)
+ PTHLT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) + ZLOCPEXNM(IIJB:IIJE,1:IKT) &
+ * PRT(IIJB:IIJE,1:IKT,2)
+ PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) + ZLOCPEXNM(IIJB:IIJE,1:IKT) &
+ * PRRS(IIJB:IIJE,1:IKT,2)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
END IF
! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-call Sources_neg_correct( hcloud, 'NETUR', krr, ptstep, ppabst, pthlt, prt, prthls, prrs, prsvs )
-
+CALL SOURCES_NEG_CORRECT_PHY(D,KSV,HCLOUD, 'NETUR',KRR,PTSTEP,PPABST,PTHLT,PRT,PRTHLS,PRRS,PRSVS)
!----------------------------------------------------------------------------
!
!* 9. LES averaged surface fluxes
! ---------------------------
!
-IF (LLES_CALL) THEN
+IF (TLES%LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(PSFTH,X_LES_Q0)
- CALL LES_MEAN_SUBGRID(PSFRV,X_LES_E0)
- DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID(PSFSV(:,:,JSV),X_LES_SV0(:,JSV))
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,PSFTH,TLES%X_LES_Q0)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,PSFRV,TLES%X_LES_E0)
+ DO JSV=1,KSV
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,PSFSV(:,JSV),TLES%X_LES_SV0(:,JSV))
END DO
- CALL LES_MEAN_SUBGRID(PSFU,X_LES_UW0)
- CALL LES_MEAN_SUBGRID(PSFV,X_LES_VW0)
- CALL LES_MEAN_SUBGRID((PSFU*PSFU+PSFV*PSFV)**0.25,X_LES_USTAR)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,PSFU,TLES%X_LES_UW0)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,PSFV,TLES%X_LES_VW0)
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK2D(IIJB:IIJE) = (PSFU(IIJB:IIJE)*PSFU(IIJB:IIJE)+PSFV(IIJB:IIJE)*PSFV(IIJB:IIJE))**0.25
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2D,TLES%X_LES_USTAR)
!----------------------------------------------------------------------------
!
!* 10. LES for 3rd order moments
! -------------------------
!
- CALL LES_MEAN_SUBGRID(ZMWTH,X_LES_SUBGRID_W2Thl)
- CALL LES_MEAN_SUBGRID(ZMTH2,X_LES_SUBGRID_WThl2)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMWTH,TLES%X_LES_SUBGRID_W2Thl)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMTH2,TLES%X_LES_SUBGRID_WThl2)
IF (KRR>0) THEN
- CALL LES_MEAN_SUBGRID(ZMWR,X_LES_SUBGRID_W2Rt)
- CALL LES_MEAN_SUBGRID(ZMTHR,X_LES_SUBGRID_WThlRt)
- CALL LES_MEAN_SUBGRID(ZMR2,X_LES_SUBGRID_WRt2)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMWR,TLES%X_LES_SUBGRID_W2Rt)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMTHR,TLES%X_LES_SUBGRID_WThlRt)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZMR2,TLES%X_LES_SUBGRID_WRt2)
END IF
!
!----------------------------------------------------------------------------
@@ -1275,18 +1366,37 @@ IF (LLES_CALL) THEN
!* 11. LES quantities depending on <w'2> in "1DIM" mode
! ------------------------------------------------
!
- IF (HTURBDIM=="1DIM") THEN
- CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_U2)
- X_LES_SUBGRID_V2 = X_LES_SUBGRID_U2
- X_LES_SUBGRID_W2 = X_LES_SUBGRID_U2
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
- & GZ_M_W(KKA,KKU,KKL,PTHLT,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
- IF (KRR>=1) &
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
- & GZ_M_W(KKA,KKU,KKL,PRT(:,:,:,1),PDZZ)),X_LES_RES_ddz_Rt_SBG_W2)
- DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
- & GZ_M_W(KKA,KKU,KKL,PSVT(:,:,:,JSV),PDZZ)),X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
+ IF (TURBN%CTURBDIM=="1DIM") THEN
+ !
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK1(IIJB:IIJE,1:IKT) = 2./3.*PTKET(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1,TLES%X_LES_SUBGRID_U2)
+ TLES%X_LES_SUBGRID_V2(:,:,:) = TLES%X_LES_SUBGRID_U2(:,:,:)
+ TLES%X_LES_SUBGRID_W2(:,:,:) = TLES%X_LES_SUBGRID_U2(:,:,:)
+ !
+ CALL GZ_M_W_PHY(D,PTHLT,PDZZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = 2./3.*PTKET(IIJB:IIJE,1:IKT) *ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddz_Thl_SBG_W2)
+ !
+ IF (KRR>=1) THEN
+ CALL GZ_M_W_PHY(D,PRT(:,:,1),PDZZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = 2./3.*PTKET(IIJB:IIJE,1:IKT) *ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddz_Rt_SBG_W2)
+ END IF
+ DO JSV=1,KSV
+ CALL GZ_M_W_PHY(D,PSVT(:,:,JSV),PDZZ,ZWORK1)
+ CALL MZF_PHY(D,ZWORK1,ZWORK2)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZWORK2(IIJB:IIJE,1:IKT) = 2./3.*PTKET(IIJB:IIJE,1:IKT) *ZWORK2(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
END DO
END IF
@@ -1295,101 +1405,108 @@ IF (LLES_CALL) THEN
!* 12. LES mixing end dissipative lengths, presso-correlations
! -------------------------------------------------------
!
- CALL LES_MEAN_SUBGRID(PLEM,X_LES_SUBGRID_LMix)
- CALL LES_MEAN_SUBGRID(ZLEPS,X_LES_SUBGRID_LDiss)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZLM,TLES%X_LES_SUBGRID_LMix)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZLEPS,TLES%X_LES_SUBGRID_LDiss)
!
!* presso-correlations for subgrid Tke are equal to zero.
!
- ZLEPS = 0. !ZLEPS is used as a work array (not used anymore)
- CALL LES_MEAN_SUBGRID(ZLEPS,X_LES_SUBGRID_WP)
+ ZLEPS(:,:) = 0. !ZLEPS is used as a work array (not used anymore)
+ CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZLEPS,TLES%X_LES_SUBGRID_WP)
!
CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1
END IF
-
-!
-
!
+IF(PRESENT(PLEM)) PLEM(IIJB:IIJE,IKTB:IKTE) = ZLM(IIJB:IIJE,IKTB:IKTE)
!----------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TURB',1,ZHOOK_HANDLE)
CONTAINS
!
-!
-! ##############################################
- SUBROUTINE UPDATE_ROTATE_WIND(PUSLOPE,PVSLOPE)
-! ##############################################
+! ########################################################################
+ SUBROUTINE COMPUTE_FUNCTION_THERMO(PALP,PBETA,PGAM,PLTT,PC,PT,PEXN,PCP,&
+ PLOCPEXN,PAMOIST,PATHETA )
+! ########################################################################
!!
-!!**** *UPDATE_ROTATE_WIND* routine to set rotate wind values at the border
+!!**** *COMPUTE_FUNCTION_THERMO* routine to compute several thermo functions
!
!! AUTHOR
!! ------
!!
-!! P Jabouille *CNRM METEO-FRANCE
+!! JP Pinty *LA*
!!
!! MODIFICATIONS
!! -------------
-!! Original 24/06/99
-!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!! Original 24/02/03
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_CONF
!
IMPLICIT NONE
!
-!* 0.1 Declarations of dummy arguments :
+!* 0.1 Declarations of dummy arguments
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PUSLOPE,PVSLOPE
-! tangential surface fluxes in the axes following the orography
+REAL, INTENT(IN) :: PALP,PBETA,PGAM,PLTT,PC
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT,PEXN,PCP
!
-!* 0.2 Declarations of local variables :
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PLOCPEXN
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA
!
-INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-INTEGER :: IINFO_ll ! return code of parallel routine
+!-------------------------------------------------------------------------------
!
-!* 1 PROLOGUE
+ IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO',0,ZHOOK_HANDLE2)
+ ZEPS = CST%XMV / CST%XMD
!
-NULLIFY(TZFIELDS_ll)
+!* 1.1 Lv/Cph at t
!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PLOCPEXN(IIJB:IIJE,1:IKT) = ( PLTT + (CST%XCPV-PC) * (PT(IIJB:IIJE,1:IKT)-CST%XTT) ) &
+ / PCP(IIJB:IIJE,1:IKT)
!
-! 2 Update halo if necessary
+!* 1.2 Saturation vapor pressure at t
!
-!!$IF (NHALO == 1) THEN
- CALL ADD2DFIELD_ll( TZFIELDS_ll, PUSLOPE, 'UPDATE_ROTATE_WIND::PUSLOPE' )
- CALL ADD2DFIELD_ll( TZFIELDS_ll, PVSLOPE, 'UPDATE_ROTATE_WIND::PVSLOPE' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!!$ENDIF
+ ZRVSAT(IIJB:IIJE,1:IKT) = EXP( PALP - PBETA/PT(IIJB:IIJE,1:IKT) - PGAM*ALOG( PT(IIJB:IIJE,1:IKT) ) )
!
-! 3 Boundary conditions for non cyclic case
+!* 1.3 saturation mixing ratio at t
!
-IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
- PUSLOPE(IIB-1,:)=PUSLOPE(IIB,:)
- PVSLOPE(IIB-1,:)=PVSLOPE(IIB,:)
-END IF
-IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
- PUSLOPE(IIE+1,:)=PUSLOPE(IIE,:)
- PVSLOPE(IIE+1,:)=PVSLOPE(IIE,:)
-END IF
-IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
- PUSLOPE(:,IJB-1)=PUSLOPE(:,IJB)
- PVSLOPE(:,IJB-1)=PVSLOPE(:,IJB)
-END IF
-IF( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
- PUSLOPE(:,IJE+1)=PUSLOPE(:,IJE)
- PVSLOPE(:,IJE+1)=PVSLOPE(:,IJE)
-END IF
+ ZRVSAT(IIJB:IIJE,1:IKT) = ZRVSAT(IIJB:IIJE,1:IKT) &
+ * ZEPS / ( PPABST(IIJB:IIJE,1:IKT) - ZRVSAT(IIJB:IIJE,1:IKT) )
+!
+!* 1.4 compute the saturation mixing ratio derivative (rvs')
!
-END SUBROUTINE UPDATE_ROTATE_WIND
+ ZDRVSATDT(IIJB:IIJE,1:IKT) = ( PBETA / PT(IIJB:IIJE,1:IKT) - PGAM ) / PT(IIJB:IIJE,1:IKT) &
+ * ZRVSAT(IIJB:IIJE,1:IKT) * ( 1. + ZRVSAT(IIJB:IIJE,1:IKT) / ZEPS )
!
+!* 1.5 compute Amoist
+!
+ PAMOIST(IIJB:IIJE,1:IKT)= 0.5 / ( 1.0 + ZDRVSATDT(IIJB:IIJE,1:IKT) * PLOCPEXN(IIJB:IIJE,1:IKT) )
+!
+!* 1.6 compute Atheta
+!
+ PATHETA(IIJB:IIJE,1:IKT)= PAMOIST(IIJB:IIJE,1:IKT) * PEXN(IIJB:IIJE,1:IKT) * &
+ ( ( ZRVSAT(IIJB:IIJE,1:IKT) - PRT(IIJB:IIJE,1:IKT,1) ) * PLOCPEXN(IIJB:IIJE,1:IKT) / &
+ ( 1. + ZDRVSATDT(IIJB:IIJE,1:IKT) * PLOCPEXN(IIJB:IIJE,1:IKT) ) * &
+ ( &
+ ZRVSAT(IIJB:IIJE,1:IKT) * (1. + ZRVSAT(IIJB:IIJE,1:IKT)/ZEPS) &
+ * ( -2.*PBETA/PT(IIJB:IIJE,1:IKT) + PGAM ) / PT(IIJB:IIJE,1:IKT)**2 &
+ +ZDRVSATDT(IIJB:IIJE,1:IKT) * (1. + 2. * ZRVSAT(IIJB:IIJE,1:IKT)/ZEPS) &
+ * ( PBETA/PT(IIJB:IIJE,1:IKT) - PGAM ) / PT(IIJB:IIJE,1:IKT) &
+ ) &
+ - ZDRVSATDT(IIJB:IIJE,1:IKT) &
+ )
+!
+!* 1.7 Lv/Cph/Exner at t-1
+!
+ PLOCPEXN(IIJB:IIJE,1:IKT) = PLOCPEXN(IIJB:IIJE,1:IKT) / PEXN(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+!
+IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO',1,ZHOOK_HANDLE2)
+END SUBROUTINE COMPUTE_FUNCTION_THERMO
+
! ########################################################################
- SUBROUTINE COMPUTE_FUNCTION_THERMO(PALP,PBETA,PGAM,PLTT,PC,PT,PEXN,PCP,&
+ SUBROUTINE COMPUTE_FUNCTION_THERMO_NEW_STAT(PALP,PBETA,PGAM,PLTT,PC,PT,PEXN,PCP,&
PLOCPEXN,PAMOIST,PATHETA )
! ########################################################################
!!
@@ -1403,6 +1520,7 @@ END SUBROUTINE UPDATE_ROTATE_WIND
!! MODIFICATIONS
!! -------------
!! Original 24/02/03
+!! Modified: Wim de Rooy 06-02-2019
!!
!-------------------------------------------------------------------------------
!
@@ -1412,64 +1530,53 @@ USE MODD_CST
!
IMPLICIT NONE
!
-!* 0.1 Declarations of dummy arguments
+!* 0.1 Declarations of dummy arguments
!
-REAL, INTENT(IN) :: PALP,PBETA,PGAM,PLTT,PC
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT,PEXN,PCP
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLOCPEXN
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PAMOIST,PATHETA
-!
-!* 0.2 Declarations of local variables
+REAL, INTENT(IN) :: PALP,PBETA,PGAM,PLTT,PC
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT,PEXN,PCP
!
-REAL :: ZEPS ! XMV / XMD
-REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZRVSAT
-REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PLOCPEXN
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA
!
!-------------------------------------------------------------------------------
!
- ZEPS = XMV / XMD
+ IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO_NEW_STAT',0,ZHOOK_HANDLE2)
+ ZEPS = CST%XMV / CST%XMD
!
!* 1.1 Lv/Cph at t
!
- PLOCPEXN(:,:,:) = ( PLTT + (XCPV-PC) * (PT(:,:,:)-XTT) ) / PCP(:,:,:)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PLOCPEXN(IIJB:IIJE,1:IKT) = ( PLTT + (CST%XCPV-PC) * (PT(IIJB:IIJE,1:IKT)-CST%XTT) ) / PCP(IIJB:IIJE,1:IKT)
!
!* 1.2 Saturation vapor pressure at t
!
- ZRVSAT(:,:,:) = EXP( PALP - PBETA/PT(:,:,:) - PGAM*ALOG( PT(:,:,:) ) )
+ ZRVSAT(IIJB:IIJE,1:IKT) = EXP( PALP - PBETA/PT(IIJB:IIJE,1:IKT) - PGAM*ALOG( PT(IIJB:IIJE,1:IKT) ) )
!
!* 1.3 saturation mixing ratio at t
!
- ZRVSAT(:,:,:) = ZRVSAT(:,:,:) * ZEPS / ( PPABST(:,:,:) - ZRVSAT(:,:,:) )
+ ZRVSAT(IIJB:IIJE,1:IKT) = ZRVSAT(IIJB:IIJE,1:IKT) * ZEPS / ( PPABST(IIJB:IIJE,1:IKT) - ZRVSAT(IIJB:IIJE,1:IKT) )
!
!* 1.4 compute the saturation mixing ratio derivative (rvs')
!
- ZDRVSATDT(:,:,:) = ( PBETA / PT(:,:,:) - PGAM ) / PT(:,:,:) &
- * ZRVSAT(:,:,:) * ( 1. + ZRVSAT(:,:,:) / ZEPS )
+ ZDRVSATDT(IIJB:IIJE,1:IKT) = ( PBETA / PT(IIJB:IIJE,1:IKT) - PGAM ) / PT(IIJB:IIJE,1:IKT) &
+ * ZRVSAT(IIJB:IIJE,1:IKT) * ( 1. + ZRVSAT(IIJB:IIJE,1:IKT) / ZEPS )
!
!* 1.5 compute Amoist
!
- PAMOIST(:,:,:)= 0.5 / ( 1.0 + ZDRVSATDT(:,:,:) * PLOCPEXN(:,:,:) )
+ PAMOIST(IIJB:IIJE,1:IKT)= 1.0 / ( 1.0 + ZDRVSATDT(IIJB:IIJE,1:IKT) * PLOCPEXN(IIJB:IIJE,1:IKT) )
!
!* 1.6 compute Atheta
!
- PATHETA(:,:,:)= PAMOIST(:,:,:) * PEXN(:,:,:) * &
- ( ( ZRVSAT(:,:,:) - PRT(:,:,:,1) ) * PLOCPEXN(:,:,:) / &
- ( 1. + ZDRVSATDT(:,:,:) * PLOCPEXN(:,:,:) ) * &
- ( &
- ZRVSAT(:,:,:) * (1. + ZRVSAT(:,:,:)/ZEPS) &
- * ( -2.*PBETA/PT(:,:,:) + PGAM ) / PT(:,:,:)**2 &
- +ZDRVSATDT(:,:,:) * (1. + 2. * ZRVSAT(:,:,:)/ZEPS) &
- * ( PBETA/PT(:,:,:) - PGAM ) / PT(:,:,:) &
- ) &
- - ZDRVSATDT(:,:,:) &
- )
+ PATHETA(IIJB:IIJE,1:IKT)= PAMOIST(IIJB:IIJE,1:IKT) * PEXN(IIJB:IIJE,1:IKT) * ZDRVSATDT(IIJB:IIJE,1:IKT)
!
!* 1.7 Lv/Cph/Exner at t-1
!
- PLOCPEXN(:,:,:) = PLOCPEXN(:,:,:) / PEXN(:,:,:)
+ PLOCPEXN(IIJB:IIJE,1:IKT) = PLOCPEXN(IIJB:IIJE,1:IKT) / PEXN(IIJB:IIJE,1:IKT)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-END SUBROUTINE COMPUTE_FUNCTION_THERMO
+IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO_NEW_STAT',1,ZHOOK_HANDLE2)
+END SUBROUTINE COMPUTE_FUNCTION_THERMO_NEW_STAT
+
!
! ####################
SUBROUTINE DELT(PLM,ODZ)
@@ -1491,79 +1598,94 @@ END SUBROUTINE COMPUTE_FUNCTION_THERMO
!* 0. DECLARATIONS
! ------------
!
-!* 0.1 Declarations of dummy arguments
+!* 0.1 Declarations of dummy arguments
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PLM
LOGICAL, INTENT(IN) :: ODZ
+!-------------------------------------------------------------------------------
!
-!* 0.2 Declarations of local variables
-!
-REAL :: ZD ! distance to the surface
+IF (LHOOK) CALL DR_HOOK('TURB:DELT',0,ZHOOK_HANDLE2)
!
-!-------------------------------------------------------------------------------
+CALL MXF_PHY(D,PDXX,ZWORK1)
+IF (.NOT. O2D) THEN
+ CALL MYF_PHY(D,PDYY,ZWORK2)
+END IF
!
IF (ODZ) THEN
! Dz is take into account in the computation
DO JK = IKTB,IKTE ! 1D turbulence scheme
- PLM(:,:,JK) = PZZ(:,:,JK+KKL) - PZZ(:,:,JK)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PLM(IIJB:IIJE,JK) = PZZ(IIJB:IIJE,JK+IKL) - PZZ(IIJB:IIJE,JK)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO
- PLM(:,:,KKU) = PLM(:,:,IKE)
- PLM(:,:,KKA) = PZZ(:,:,IKB) - PZZ(:,:,KKA)
- IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
- IF ( L2D) THEN
- PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ PLM(IIJB:IIJE,IKU) = PLM(IIJB:IIJE,IKE)
+ PLM(IIJB:IIJE,IKA) = PZZ(IIJB:IIJE,IKB) - PZZ(IIJB:IIJE,IKA)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
+ IF ( TURBN%CTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
+ IF ( O2D) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PLM(IIJB:IIJE,1:IKT) = SQRT( PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PLM(IIJB:IIJE,1:IKT) = (PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT) ) ** (1./3.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
END IF
ELSE
! Dz not taken into account in computation to assure invariability with vertical grid mesh
- PLM=1.E10
- IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
- IF ( L2D) THEN
- PLM(:,:,:) = MXF(PDXX(:,:,:))
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PLM(IIJB:IIJE,1:IKT)=1.E10
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ IF ( TURBN%CTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
+ IF ( O2D) THEN
+ PLM(:,:) = ZWORK1(:,:)
ELSE
- PLM(:,:,:) = (MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./2.)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PLM(IIJB:IIJE,1:IKT) = (ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) ) ** (1./2.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
END IF
END IF
-
!
-! mixing length limited by the distance normal to the surface
+! mixing length limited by the distance normal to the surface
! (with the same factor as for BL89)
!
-IF (.NOT. ORMC01) THEN
+IF (.NOT. TURBN%LRMC01) THEN
ZALPHA=0.5**(-1.5)
!
- DO JJ=1,SIZE(PUT,2)
- DO JI=1,SIZE(PUT,1)
- IF (LOCEAN) THEN
- DO JK=IKTE,IKTB,-1
- ZD=ZALPHA*(PZZ(JI,JJ,IKTE+1)-PZZ(JI,JJ,JK))
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
- ELSE
- DO JK=IKTB,IKTE
- ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))&
- -PZZ(JI,JJ,IKB)) *PDIRCOSZW(JI,JJ)
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
- ENDIF
- END DO
+ DO JIJ=IIJB,IIJE
+ IF (OOCEAN) THEN
+ DO JK=IKTE,IKTB,-1
+ ZD=ZALPHA*(PZZ(JIJ,IKTE+1)-PZZ(JIJ,JK))
+ IF ( PLM(JIJ,JK)>ZD) THEN
+ PLM(JIJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ELSE
+ DO JK=IKTB,IKTE
+ ZD=ZALPHA*(0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+IKL))&
+ -PZZ(JIJ,IKB)) *PDIRCOSZW(JIJ)
+ IF ( PLM(JIJ,JK)>ZD) THEN
+ PLM(JIJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
END DO
END IF
!
-PLM(:,:,KKA) = PLM(:,:,IKB )
-PLM(:,:,KKU ) = PLM(:,:,IKE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PLM(IIJB:IIJE,IKA) = PLM(IIJB:IIJE,IKB)
+PLM(IIJB:IIJE,IKU) = PLM(IIJB:IIJE,IKE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
+IF (LHOOK) CALL DR_HOOK('TURB:DELT',1,ZHOOK_HANDLE2)
END SUBROUTINE DELT
!
! ####################
@@ -1588,138 +1710,150 @@ END SUBROUTINE DELT
!* 0. DECLARATIONS
! ------------
!
-!* 0.1 Declarations of dummy arguments
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
+!* 0.1 Declarations of dummy arguments
!
-!* 0.2 Declarations of local variables
-!
-REAL :: ZD ! distance to the surface
-REAL :: ZVAR ! Intermediary variable
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: ZWORK2D
-!
-REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) :: &
- ZDTHLDZ,ZDRTDZ, &!dtheta_l/dz, drt_dz used for computing the stablity
-! ! criterion
- ZETHETA,ZEMOIST !coef ETHETA and EMOIST
-!----------------------------------------------------------------------------
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PLM
!
!-------------------------------------------------------------------------------
!
! initialize the mixing length with the mesh grid
+IF (LHOOK) CALL DR_HOOK('TURB:DEAR',0,ZHOOK_HANDLE2)
+IF ( TURBN%CTURBDIM /= '1DIM' ) THEN
+ CALL MXF_PHY(D,PDXX,ZWORK1)
+ IF (.NOT. O2D) THEN
+ CALL MYF_PHY(D,PDYY,ZWORK2)
+ END IF
+END IF
! 1D turbulence scheme
-PLM(:,:,IKTB:IKTE) = PZZ(:,:,IKTB+KKL:IKTE+KKL) - PZZ(:,:,IKTB:IKTE)
-PLM(:,:,KKU) = PLM(:,:,IKE)
-PLM(:,:,KKA) = PZZ(:,:,IKB) - PZZ(:,:,KKA)
-IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
- IF ( L2D) THEN
- PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+PLM(IIJB:IIJE,IKTB:IKTE) = PZZ(IIJB:IIJE,IKL+IKTB:IKTE+IKL) - PZZ(IIJB:IIJE,IKTB:IKTE)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PLM(IIJB:IIJE,IKU) = PLM(IIJB:IIJE,IKE)
+PLM(IIJB:IIJE,IKA) = PZZ(IIJB:IIJE,IKB) - PZZ(IIJB:IIJE,IKA)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
+!
+IF ( TURBN%CTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
+ IF ( O2D) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PLM(IIJB:IIJE,1:IKT) = SQRT( PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) )
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
- PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ PLM(IIJB:IIJE,1:IKT) = (PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) &
+ * ZWORK2(IIJB:IIJE,1:IKT) ) ** (1./3.)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
END IF
! compute a mixing length limited by the stability
!
-ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT)
-ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT)
+CALL ETHETA(D,CST,KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT,OOCEAN,OCOMPUTE_SRC,ZETHETA)
+CALL EMOIST(D,CST,KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT,OOCEAN,ZEMOIST)
!
IF (KRR>0) THEN
DO JK = IKTB+1,IKTE-1
- DO JJ=1,SIZE(PUT,2)
- DO JI=1,SIZE(PUT,1)
- ZDTHLDZ(JI,JJ,JK)= 0.5*((PTHLT(JI,JJ,JK+KKL)-PTHLT(JI,JJ,JK ))/PDZZ(JI,JJ,JK+KKL)+ &
- (PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
- ZDRTDZ(JI,JJ,JK) = 0.5*((PRT(JI,JJ,JK+KKL,1)-PRT(JI,JJ,JK ,1))/PDZZ(JI,JJ,JK+KKL)+ &
- (PRT(JI,JJ,JK ,1)-PRT(JI,JJ,JK-KKL,1))/PDZZ(JI,JJ,JK ))
- IF (LOCEAN) THEN
- ZVAR=XG*(XALPHAOC*ZDTHLDZ(JI,JJ,JK)-XBETAOC*ZDRTDZ(JI,JJ,JK))
- ELSE
- ZVAR=XG/PTHVREF(JI,JJ,JK)* &
- (ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)+ZEMOIST(JI,JJ,JK)*ZDRTDZ(JI,JJ,JK))
- END IF
- !
- IF (ZVAR>0.) THEN
- PLM(JI,JJ,JK)=MAX(XMNH_EPSILON,MIN(PLM(JI,JJ,JK), &
- 0.76* SQRT(PTKET(JI,JJ,JK)/ZVAR)))
- END IF
- END DO
+ DO JIJ=IIJB,IIJE
+ ZDTHLDZ(JIJ,JK)= 0.5*((PTHLT(JIJ,JK+IKL)-PTHLT(JIJ,JK ))/PDZZ(JIJ,JK+IKL)+ &
+ (PTHLT(JIJ,JK )-PTHLT(JIJ,JK-IKL))/PDZZ(JIJ,JK ))
+ ZDRTDZ(JIJ,JK) = 0.5*((PRT(JIJ,JK+IKL,1)-PRT(JIJ,JK ,1))/PDZZ(JIJ,JK+IKL)+ &
+ (PRT(JIJ,JK ,1)-PRT(JIJ,JK-IKL,1))/PDZZ(JIJ,JK ))
+ IF (OOCEAN) THEN
+ ZVAR=CST%XG*(CST%XALPHAOC*ZDTHLDZ(JIJ,JK)-CST%XBETAOC*ZDRTDZ(JIJ,JK))
+ ELSE
+ ZVAR=CST%XG/PTHVREF(JIJ,JK)* &
+ (ZETHETA(JIJ,JK)*ZDTHLDZ(JIJ,JK)+ZEMOIST(JIJ,JK)*ZDRTDZ(JIJ,JK))
+ END IF
+ !
+ IF (ZVAR>0.) THEN
+ PLM(JIJ,JK)=MAX(CST%XMNH_EPSILON,MIN(PLM(JIJ,JK), &
+ 0.76* SQRT(PTKET(JIJ,JK)/ZVAR)))
+ END IF
END DO
END DO
ELSE! For dry atmos or unsalted ocean runs
DO JK = IKTB+1,IKTE-1
- DO JJ=1,SIZE(PUT,2)
- DO JI=1,SIZE(PUT,1)
- ZDTHLDZ(JI,JJ,JK)= 0.5*((PTHLT(JI,JJ,JK+KKL)-PTHLT(JI,JJ,JK ))/PDZZ(JI,JJ,JK+KKL)+ &
- (PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
- IF (LOCEAN) THEN
- ZVAR= XG*XALPHAOC*ZDTHLDZ(JI,JJ,JK)
- ELSE
- ZVAR= XG/PTHVREF(JI,JJ,JK)*ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)
- END IF
+ DO JIJ=IIJB,IIJE
+ ZDTHLDZ(JIJ,JK)= 0.5*((PTHLT(JIJ,JK+IKL)-PTHLT(JIJ,JK ))/PDZZ(JIJ,JK+IKL)+ &
+ (PTHLT(JIJ,JK )-PTHLT(JIJ,JK-IKL))/PDZZ(JIJ,JK ))
+ IF (OOCEAN) THEN
+ ZVAR= CST%XG*CST%XALPHAOC*ZDTHLDZ(JIJ,JK)
+ ELSE
+ ZVAR= CST%XG/PTHVREF(JIJ,JK)*ZETHETA(JIJ,JK)*ZDTHLDZ(JIJ,JK)
+ END IF
!
- IF (ZVAR>0.) THEN
- PLM(JI,JJ,JK)=MAX(XMNH_EPSILON,MIN(PLM(JI,JJ,JK), &
- 0.76* SQRT(PTKET(JI,JJ,JK)/ZVAR)))
- END IF
- END DO
+ IF (ZVAR>0.) THEN
+ PLM(JIJ,JK)=MAX(CST%XMNH_EPSILON,MIN(PLM(JIJ,JK), &
+ 0.76* SQRT(PTKET(JIJ,JK)/ZVAR)))
+ END IF
END DO
END DO
END IF
-! special case near the surface
-ZDTHLDZ(:,:,IKB)=(PTHLT(:,:,IKB+KKL)-PTHLT(:,:,IKB))/PDZZ(:,:,IKB+KKL)
+! special case near the surface
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+ZDTHLDZ(IIJB:IIJE,IKB)=(PTHLT(IIJB:IIJE,IKB+IKL)-PTHLT(IIJB:IIJE,IKB))/PDZZ(IIJB:IIJE,IKB+IKL)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
! For dry simulations
IF (KRR>0) THEN
- ZDRTDZ(:,:,IKB)=(PRT(:,:,IKB+KKL,1)-PRT(:,:,IKB,1))/PDZZ(:,:,IKB+KKL)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZDRTDZ(IIJB:IIJE,IKB)=(PRT(IIJB:IIJE,IKB+IKL,1)-PRT(IIJB:IIJE,IKB,1))/PDZZ(IIJB:IIJE,IKB+IKL)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
- ZDRTDZ(:,:,IKB)=0
+ ZDRTDZ(:,IKB)=0
ENDIF
!
-IF (LOCEAN) THEN
- ZWORK2D(:,:)=XG*(XALPHAOC*ZDTHLDZ(:,:,IKB)-XBETAOC*ZDRTDZ(:,:,IKB))
+IF (OOCEAN) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK2D(IIJB:IIJE)=CST%XG*(CST%XALPHAOC*ZDTHLDZ(IIJB:IIJE,IKB)-CST%XBETAOC*ZDRTDZ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
- ZWORK2D(:,:)=XG/PTHVREF(:,:,IKB)* &
- (ZETHETA(:,:,IKB)*ZDTHLDZ(:,:,IKB)+ZEMOIST(:,:,IKB)*ZDRTDZ(:,:,IKB))
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
+ ZWORK2D(IIJB:IIJE)=CST%XG/PTHVREF(IIJB:IIJE,IKB)* &
+ (ZETHETA(IIJB:IIJE,IKB)*ZDTHLDZ(IIJB:IIJE,IKB)+ZEMOIST(IIJB:IIJE,IKB)*ZDRTDZ(IIJB:IIJE,IKB))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
-WHERE(ZWORK2D(:,:)>0.)
- PLM(:,:,IKB)=MAX(XMNH_EPSILON,MIN( PLM(:,:,IKB), &
- 0.76* SQRT(PTKET(:,:,IKB)/ZWORK2D(:,:))))
+!$mnh_expand_where(JIJ=IIJB:IIJE)
+WHERE(ZWORK2D(IIJB:IIJE)>0.)
+ PLM(IIJB:IIJE,IKB)=MAX(CST%XMNH_EPSILON,MIN( PLM(IIJB:IIJE,IKB), &
+ 0.76* SQRT(PTKET(IIJB:IIJE,IKB)/ZWORK2D(IIJB:IIJE))))
END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
! mixing length limited by the distance normal to the surface (with the same factor as for BL89)
!
-IF (.NOT. ORMC01) THEN
+IF (.NOT. TURBN%LRMC01) THEN
ZALPHA=0.5**(-1.5)
!
- DO JJ=1,SIZE(PUT,2)
- DO JI=1,SIZE(PUT,1)
- IF (LOCEAN) THEN
- DO JK=IKTE,IKTB,-1
- ZD=ZALPHA*(PZZ(JI,JJ,IKTE+1)-PZZ(JI,JJ,JK))
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
- ELSE
- DO JK=IKTB,IKTE
- ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))-PZZ(JI,JJ,IKB)) &
- *PDIRCOSZW(JI,JJ)
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
- ENDIF
- END DO
+ DO JIJ=IIJB,IIJE
+ IF (OOCEAN) THEN
+ DO JK=IKTE,IKTB,-1
+ ZD=ZALPHA*(PZZ(JIJ,IKTE+1)-PZZ(JIJ,JK))
+ IF ( PLM(JIJ,JK)>ZD) THEN
+ PLM(JIJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ELSE
+ DO JK=IKTB,IKTE
+ ZD=ZALPHA*(0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+IKL))-PZZ(JIJ,IKB)) &
+ *PDIRCOSZW(JIJ)
+ IF ( PLM(JIJ,JK)>ZD) THEN
+ PLM(JIJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
END DO
END IF
!
-PLM(:,:,KKA) = PLM(:,:,IKB )
-PLM(:,:,IKE ) = PLM(:,:,IKE-KKL)
-PLM(:,:,KKU ) = PLM(:,:,KKU-KKL)
+!$mnh_expand_array(JIJ=IIJB:IIJE)
+PLM(IIJB:IIJE,IKA) = PLM(IIJB:IIJE,IKB)
+PLM(IIJB:IIJE,IKE) = PLM(IIJB:IIJE,IKE-IKL)
+PLM(IIJB:IIJE,IKU) = PLM(IIJB:IIJE,IKU-IKL)
+!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
+IF (LHOOK) CALL DR_HOOK('TURB:DEAR',1,ZHOOK_HANDLE2)
END SUBROUTINE DEAR
!
! #########################
@@ -1773,53 +1907,53 @@ END SUBROUTINE DEAR
!
IMPLICIT NONE
!
-REAL :: ZPENTE ! Slope of the amplification straight line
-REAL :: ZCOEF_AMPL_CEI_NUL! Ordonnate at the origin of the
- ! amplification straight line
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCOEF_AMPL
- ! Amplification coefficient of the mixing length
- ! when the instability criterium is verified
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZLM_CLOUD
- ! Turbulent mixing length in the clouds
-!
!-------------------------------------------------------------------------------
!
!* 1. INITIALISATION
! --------------
!
-ZPENTE = ( PCOEF_AMPL_SAT - 1. ) / ( PCEI_MAX - PCEI_MIN )
+IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',0,ZHOOK_HANDLE2)
+ZPENTE = ( PCOEF_AMPL_SAT - 1. ) / ( PCEI_MAX - PCEI_MIN )
ZCOEF_AMPL_CEI_NUL = 1. - ZPENTE * PCEI_MIN
!
-ZCOEF_AMPL(:,:,:) = 1.
+!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ZCOEF_AMPL(IIJB:IIJE,1:IKT) = 1.
+!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
!* 2. CALCULATION OF THE AMPLIFICATION COEFFICIENT
! --------------------------------------------
!
! Saturation
!
-WHERE ( PCEI(:,:,:)>=PCEI_MAX ) ZCOEF_AMPL(:,:,:)=PCOEF_AMPL_SAT
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE ( PCEI(IIJB:IIJE,1:IKT)>=PCEI_MAX )
+ ZCOEF_AMPL(IIJB:IIJE,1:IKT)=PCOEF_AMPL_SAT
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!
! Between the min and max limits of CEI index, linear variation of the
! amplification coefficient ZCOEF_AMPL as a function of CEI
!
-WHERE ( PCEI(:,:,:) < PCEI_MAX .AND. &
- PCEI(:,:,:) > PCEI_MIN ) &
- ZCOEF_AMPL(:,:,:) = ZPENTE * PCEI(:,:,:) + ZCOEF_AMPL_CEI_NUL
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE ( PCEI(IIJB:IIJE,1:IKT) < PCEI_MAX .AND. PCEI(IIJB:IIJE,1:IKT) > PCEI_MIN)
+ ZCOEF_AMPL(IIJB:IIJE,1:IKT) = ZPENTE * PCEI(IIJB:IIJE,1:IKT) + ZCOEF_AMPL_CEI_NUL
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
!* 3. CALCULATION OF THE MIXING LENGTH IN CLOUDS
! ------------------------------------------
!
-IF (HTURBLEN_CL == HTURBLEN) THEN
- ZLM_CLOUD(:,:,:) = PLEM(:,:,:)
+IF (HTURBLEN_CL == TURBN%CTURBLEN) THEN
+ ZLM_CLOUD(:,:) = ZLM(:,:)
ELSE
SELECT CASE (HTURBLEN_CL)
!
!* 3.1 BL89 mixing length
! ------------------
CASE ('BL89','RM17','ADAP')
- ZSHEAR=0.
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD)
+ ZSHEAR(:,:)=0.
+ CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD,OOCEAN,HPROGRAM)
!
!* 3.2 Delta mixing length
! -------------------
@@ -1838,7 +1972,7 @@ ENDIF
! -----------------------------------------------
!
! Impression before modification of the mixing length
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'LM_CLEAR_SKY'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'LM_CLEAR_SKY'
@@ -1849,22 +1983,30 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PLEM)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZLM)
ENDIF
!
! Amplification of the mixing length when the criteria are verified
!
-WHERE (ZCOEF_AMPL(:,:,:) /= 1.) PLEM(:,:,:) = ZCOEF_AMPL(:,:,:)*ZLM_CLOUD(:,:,:)
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE (ZCOEF_AMPL(IIJB:IIJE,1:IKT) /= 1.)
+ ZLM(IIJB:IIJE,1:IKT) = ZCOEF_AMPL(IIJB:IIJE,1:IKT)*ZLM_CLOUD(IIJB:IIJE,1:IKT)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!
! Cloud mixing length in the clouds at the points which do not verified the CEI
!
-WHERE (PCEI(:,:,:) == -1.) PLEM(:,:,:) = ZLM_CLOUD(:,:,:)
+!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
+WHERE (PCEI(IIJB:IIJE,1:IKT) == -1.)
+ ZLM(IIJB:IIJE,1:IKT) = ZLM_CLOUD(IIJB:IIJE,1:IKT)
+END WHERE
+!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
!* 5. IMPRESSION
! ----------
!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'COEF_AMPL'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'COEF_AMPL'
@@ -1875,7 +2017,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZCOEF_AMPL)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZCOEF_AMPL)
!
TZFIELD%CMNHNAME = 'LM_CLOUD'
TZFIELD%CSTDNAME = ''
@@ -1886,10 +2028,11 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
- CALL IO_Field_write(TPFILE,TZFIELD,ZLM_CLOUD)
+ CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZLM_CLOUD)
!
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',1,ZHOOK_HANDLE2)
END SUBROUTINE CLOUD_MODIF_LM
!
-END SUBROUTINE TURB
+END SUBROUTINE TURB