diff --git a/src/PHYEX/aux/gamma.f90 b/src/PHYEX/aux/gamma.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6e3b9dd0916d63dfeece78666a25eb175d0d8bad
--- /dev/null
+++ b/src/PHYEX/aux/gamma.f90
@@ -0,0 +1,225 @@
+!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.
+!########################
+!
+!--------------------------------------------------------------------------
+!
+!
+!* 1. FUNCTION GAMMA FOR SCALAR VARIABLE
+!
+!
+! ######################################
+ FUNCTION GAMMA_X0D(PX) RESULT(PGAMMA)
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
+! ######################################
+!
+!
+!!**** *GAMMA * - Gamma function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the Generalized gamma
+! function of its argument.
+!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 206-207
+!!
+!! AUTHOR
+!! ------
+!! Jean-Pierre Pinty *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 7/11/95
+!! C. Barthe 9/11/09 add a function for 1D arguments
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(IN) :: PX
+REAL :: PGAMMA
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JJ ! Loop index
+REAL :: ZSER,ZSTP,ZTMP,ZX,ZY,ZCOEF(6)
+REAL :: ZPI
+!
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GAMMA_X0D',0,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+!* 1. SOME CONSTANTS
+! --------------
+!
+ZCOEF(1) = 76.18009172947146
+ZCOEF(2) =-86.50532032941677
+ZCOEF(3) = 24.01409824083091
+ZCOEF(4) = -1.231739572450155
+ZCOEF(5) = 0.1208650973866179E-2
+ZCOEF(6) = -0.5395239384953E-5
+ZSTP = 2.5066282746310005
+!
+ZPI = 3.141592654
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE GAMMA
+! -------------
+!
+IF (PX .LT. 0.) THEN
+ ZX = 1. - PX
+ELSE
+ ZX = PX
+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 .LT. 0.) THEN
+ PGAMMA = ZPI / SIN(ZPI*PX) / EXP(ZTMP + ALOG(ZSTP*ZSER/ZX))
+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
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. FUNCTION GAMMA FOR 1D ARRAY
+!
+!
+! ######################################
+ FUNCTION GAMMA_X1D(PX) RESULT(PGAMMA)
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
+! ######################################
+!
+!
+!!**** *GAMMA * - Gamma function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the Generalized gamma
+! function of its argument.
+!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 206-207
+!!
+!! AUTHOR
+!! ------
+!! Jean-Pierre Pinty *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 7/11/95
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, DIMENSION(:), INTENT(IN) :: PX
+REAL, DIMENSION(SIZE(PX)) :: PGAMMA
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JJ ! Loop index
+INTEGER :: JI ! Loop index
+REAL :: ZSER, ZSTP, ZTMP, ZX, ZY, ZCOEF(6)
+REAL :: ZPI
+!
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('GAMMA_X1D',0,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+!* 1. SOME CONSTANTS
+! --------------
+!
+ZCOEF(1) = 76.18009172947146
+ZCOEF(2) =-86.50532032941677
+ZCOEF(3) = 24.01409824083091
+ZCOEF(4) = -1.231739572450155
+ZCOEF(5) = 0.1208650973866179E-2
+ZCOEF(6) = -0.5395239384953E-5
+ZSTP = 2.5066282746310005
+!
+ZPI = 3.141592654
+!
+!-------------------------------------------------------------------------------
+!
+!* 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
new file mode 100644
index 0000000000000000000000000000000000000000..cff80e38169f0c45f7e0c18ece4a4ced3949fccc
--- /dev/null
+++ b/src/PHYEX/aux/gamma_inc.f90
@@ -0,0 +1,137 @@
+!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.
+ FUNCTION GAMMA_INC(PA,PX) RESULT(PGAMMA_INC)
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
+! #############################################
+!
+!
+!!**** *GAMMA_INC * - Generalized gamma function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the generalized
+!! incomplete Gamma function of its argument.
+!!
+!! /X
+!! 1 |
+!! GAMMA_INC(A,X)= -------- | Z**(A-1) EXP(-Z) dZ
+!! GAMMA(A) |
+!! /0
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODULE MODI_GAMMA : computation of the Gamma function
+!!
+!! REFERENCE
+!! ---------
+!! Press, Teukolsky, Vetterling and Flannery: Numerical Recipes, 209-213
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Pierre Pinty *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 7/12/95
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_MSG
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(IN) :: PA
+REAL, INTENT(IN) :: PX
+REAL :: PGAMMA_INC
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JN
+INTEGER :: ITMAX=100
+REAL :: ZEPS=3.E-7
+REAL :: ZFPMIN=1.E-30
+REAL :: ZAP,ZDEL,ZSUM
+REAL :: ZAN,ZB,ZC,ZD,ZH
+!
+REAL(KIND=JPHOOK) :: 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
+ ZSUM = 1.0/PA
+ ZDEL = ZSUM
+ JN = 1
+!
+ LOOP_SERIES: DO
+ ZAP = ZAP +1.0
+ ZDEL = ZDEL*PX/ZAP
+ ZSUM = ZSUM + ZDEL
+ 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,'// &
+ ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+ ' by the series method')
+ END IF
+ END DO LOOP_SERIES
+ PGAMMA_INC = ZSUM * EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
+!
+ ELSE
+!
+ ZB = PX + 1.0 - PA
+ ZC = 1.0/TINY(PX)
+ ZD = 1.0/ZB
+ ZH = ZD
+ JN = 1
+!
+ LOOP_FRACTION: DO
+ ZAN = -REAL(JN)*(REAL(JN)-PA)
+ ZB = ZB + 2.0
+ ZD = ZAN*ZD + ZB
+ IF( ABS(ZD).LT.TINY(PX) ) THEN
+ ZD = ZFPMIN
+ END IF
+ ZC = ZB + ZAN/ZC
+ IF( ABS(ZC).LT.TINY(PX) ) THEN
+ ZC = ZFPMIN
+ END IF
+ ZD = 1.0/ZD
+ ZDEL = ZD*ZC
+ ZH = ZH*ZDEL
+ 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,'// &
+ ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+ ' by the continuous fraction method')
+ END IF
+ END DO LOOP_FRACTION
+ PGAMMA_INC = 1.0 - ZH*EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
+!
+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
new file mode 100644
index 0000000000000000000000000000000000000000..c86a5fc1f3bd6a60f8c2b10af7f735aa6f0e3108
--- /dev/null
+++ b/src/PHYEX/aux/general_gamma.f90
@@ -0,0 +1,71 @@
+!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.
+ FUNCTION GENERAL_GAMMA(PALPHA,PNU,PLBDA,PX) RESULT(PGENERAL_GAMMA)
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
+! ###################################################################
+!
+!
+!!**** *GENERAL_GAMMA * - Generalized gamma function
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the Generalized gamma
+! function of its argument.
+!
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODULE MODI_GAMMA : computation of the Gamma function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine CONDENS)
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Pierre Pinty *LA/OMP*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 7/11/95
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(IN) :: PALPHA
+REAL, INTENT(IN) :: PNU
+REAL, INTENT(IN) :: PLBDA
+REAL, INTENT(IN) :: PX
+REAL :: PGENERAL_GAMMA
+!
+!* 0.2 declarations of local variables
+!
+REAL :: ZARG,ZPOWER
+!
+REAL(KIND=JPHOOK) :: 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
new file mode 100644
index 0000000000000000000000000000000000000000..21f55183e5e1c9b6cce33e60321fba4bfb72ab84
--- /dev/null
+++ b/src/PHYEX/aux/get_halo.f90
@@ -0,0 +1,203 @@
+!MNH_LIC Copyright 1994-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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_GET_HALO
+! ####################
+!
+IMPLICIT NONE
+INTERFACE
+!
+SUBROUTINE GET_HALO2(PSRC,TP_PSRC_HALO2_ll)
+!
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+TYPE(HALO2LIST_ll), POINTER, INTENT(INOUT) :: TP_PSRC_HALO2_ll ! halo2 for SRC
+!
+END SUBROUTINE GET_HALO2
+!
+SUBROUTINE GET_HALO(PSRC)
+!
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+!
+END SUBROUTINE GET_HALO
+!
+SUBROUTINE GET_HALO_PHY(D,PSRC)
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
+!
+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
+IMPLICIT NONE
+TYPE(HALO2LIST_ll), POINTER, INTENT(INOUT) :: TPHALO2LIST ! list of HALO2_lls
+!
+END SUBROUTINE DEL_HALO2_ll
+!
+END INTERFACE
+!
+END MODULE MODI_GET_HALO
+!
+! ###########################################
+ SUBROUTINE GET_HALO2(PSRC,TP_PSRC_HALO2_ll)
+! ###########################################
+!
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+TYPE(HALO2LIST_ll), POINTER, INTENT(INOUT) :: TP_PSRC_HALO2_ll ! halo2 for SRC
+!
+INTEGER :: IIU,IJU,IKU ! domain sizes
+TYPE(LIST_ll) , POINTER :: TZ_PSRC_ll ! halo
+INTEGER :: IERROR ! error return code
+!
+IIU = SIZE(PSRC,1)
+IJU = SIZE(PSRC,2)
+IKU = SIZE(PSRC,3)
+!
+NULLIFY( TZ_PSRC_ll,TP_PSRC_HALO2_ll)
+CALL INIT_HALO2_ll(TP_PSRC_HALO2_ll,1,IIU,IJU,IKU)
+!
+CALL ADD3DFIELD_ll( TZ_PSRC_ll, PSRC, 'GET_HALO2::PSRC' )
+CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR)
+CALL UPDATE_HALO2_ll(TZ_PSRC_ll,TP_PSRC_HALO2_ll,IERROR)
+!
+! clean local halo list
+!
+CALL CLEANLIST_ll(TZ_PSRC_ll)
+!
+END SUBROUTINE GET_HALO2
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+! #########################
+ SUBROUTINE GET_HALO(PSRC)
+! #########################
+!
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:,:), 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
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+! #########################
+ 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
+!-----------------------------------------------------------------------
+!
+! ####################################
+ SUBROUTINE DEL_HALO2_ll(TPHALO2LIST)
+! ####################################
+!
+!!**** *DEL_HALO2_ll* delete the second layer of the halo
+!!
+!!
+!! Purpose
+!! -------
+! The purpose of this routine is to deallocate the
+! TPHALO2LIST variable which contains the second layer of the
+! halo for each variable.
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_ARGSLIST_ll
+! type HALO2LIST_ll
+!!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! J. Escobar * LA - CNRS *
+!
+! Modification :
+! -------------
+! Juan 11/03/2010 : Memory Leak add DEALLOCATE(TZHALO2LIST%HALO2)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+ USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+ IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+ TYPE(HALO2LIST_ll), POINTER, INTENT(INOUT) :: TPHALO2LIST ! list of HALO2_lls
+!
+!
+!* 0.2 Declarations of local variables :
+!
+ TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Deallocate the list of HALO2_lls
+!
+ TZHALO2LIST => TPHALO2LIST
+!
+ DO WHILE(ASSOCIATED(TZHALO2LIST))
+!
+ TPHALO2LIST => TZHALO2LIST%NEXT
+ DEALLOCATE(TZHALO2LIST%HALO2%WEST)
+ DEALLOCATE(TZHALO2LIST%HALO2%EAST)
+ DEALLOCATE(TZHALO2LIST%HALO2%SOUTH)
+ DEALLOCATE(TZHALO2LIST%HALO2%NORTH)
+ DEALLOCATE(TZHALO2LIST%HALO2)
+ DEALLOCATE(TZHALO2LIST)
+ TZHALO2LIST => TPHALO2LIST
+!
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE DEL_HALO2_ll
diff --git a/src/PHYEX/aux/gradient_m.f90 b/src/PHYEX/aux/gradient_m.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6a9d2f033c5813a4f6469abc75af2af4b070701b
--- /dev/null
+++ b/src/PHYEX/aux/gradient_m.f90
@@ -0,0 +1,758 @@
+!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_M
+! ######################
+!
+IMPLICIT NONE
+INTERFACE
+!
+!
+FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX,KKA,KKU,KL) RESULT(PGX_M_M)
+IMPLICIT NONE
+!
+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,KKA,KKU,KL) RESULT(PGY_M_M)
+IMPLICIT NONE
+!
+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,KKA,KKU,KL) RESULT(PGZ_M_M)
+IMPLICIT NONE
+!
+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
+!
+ FUNCTION GX_M_U(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
+!
+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) :: PDZZ ! d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGX_M_U ! result at flux
+ ! side
+END FUNCTION GX_M_U
+!
+!
+ FUNCTION GY_M_V(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
+!
+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) :: PDYY !d*yy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY !d*zy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+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)
+!
+IMPLICIT NONE
+!
+ ! Metric coefficient:
+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) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGZ_M_W ! result at flux
+ ! side
+!
+END FUNCTION GZ_M_W
+!
+END INTERFACE
+!
+END MODULE MODI_GRADIENT_M
+!
+!
+!
+! #######################################################
+ FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX,KKA,KKU,KL) RESULT(PGX_M_M)
+! #######################################################
+!
+!!**** *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 MODI_SHUMAN, ONLY: DXF, MZF, DZM, MXF, MXM
+USE MODD_CONF, ONLY:LFLAT
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+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
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_M_M
+! --------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGX_M_M(:,:,:)= (DXF(MXM(PA(:,:,:))) - &
+ MZF(MXF(PDZX)*DZM(PA(:,:,:)) &
+ /PDZZ(:,:,:)) ) /MXF(PDXX(:,:,:))
+ELSE
+ PGX_M_M(:,:,:)=DXF(MXM(PA(:,:,:))) / MXF(PDXX(:,:,:))
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GX_M_M
+!
+!
+! #######################################################
+ FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY,KKA,KKU,KL) RESULT(PGY_M_M)
+! #######################################################
+!
+!!**** *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_CONF, ONLY:LFLAT
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+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
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_M_M
+! --------------------
+!
+!
+IF (.NOT. LFLAT) THEN
+ PGY_M_M(:,:,:)= (DYF(MYM(PA))-MZF(MYF(PDZY)*DZM(PA)&
+ /PDZZ) ) /MYF(PDYY)
+ELSE
+ PGY_M_M(:,:,:)= DYF(MYM(PA))/MYF(PDYY)
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GY_M_M
+
+!
+!
+!
+! #############################################
+ FUNCTION GZ_M_M(PA,PDZZ) RESULT(PGZ_M_M)
+! #############################################
+!
+!!**** *GZ_M_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Z
+!! 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 Z cartesian direction for a field PA placed at the
+! mass point. The result is placed at the mass point.
+!
+! _________z
+! (dzm(PA))
+! PGZ_M_M = (------ )
+! ( 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
+!! --------
+!! MZF : 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 18/07/94
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_M_M ! result mass point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_M_M
+! --------------------
+!
+PGZ_M_M(:,:,:)= MZF( DZM(PA(:,:,:))/PDZZ(:,:,:) )
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GZ_M_M
+!
+!
+! ##################################################
+ FUNCTION GX_M_U(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
+! ##################################################
+!
+!!**** *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 MODI_SHUMAN
+USE MODD_CONF, ONLY:LFLAT
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and result
+! ------------------------------------
+!
+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) :: PDZZ ! d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGX_M_U ! result at flux
+ ! side
+INTEGER IIU,IKU,JI,JK
+!
+INTEGER :: JJK,IJU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+INTEGER :: JI_1JK, JIJK_1, JI_1JK_1, JIJKP1, JI_1JKP1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG X
+! -----------------------------
+!
+IIU=SIZE(PY,1)
+IJU=SIZE(PY,2)
+IKU=SIZE(PY,3)
+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
+!! PGX_M_U(JI,:,JK)= &
+!! ( PY(JI,:,JK)-PY(JI-1,:,JK) &
+!! -( (PY(JI,:,JK)-PY(JI,:,JK-1)) / PDZZ(JI,:,JK) &
+!! +(PY(JI-1,:,JK)-PY(JI-1,:,JK-1)) / PDZZ(JI-1,:,JK) &
+!! ) * PDZX(JI,:,JK)* 0.25 &
+!! -( (PY(JI,:,JK+1)-PY(JI,:,JK)) / PDZZ(JI,:,JK+1) &
+!! +(PY(JI-1,:,JK+1)-PY(JI-1,:,JK)) / PDZZ(JI-1,:,JK+1) &
+!! ) * PDZX(JI,:,JK+1)* 0.25 &
+!! ) / PDXX(JI,:,JK)
+!! END DO
+!! END DO
+ 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*KL
+ JI_1JK_1 = JIJK - 1 - IIU*IJU*KL
+ JIJKP1 = JIJK + IIU*IJU*KL
+ JI_1JKP1 = JIJK - 1 + IIU*IJU*KL
+!
+ PGX_M_U(JIJK,1,1)= &
+ ( PY(JIJK,1,1)-PY(JI_1JK,1,1) &
+ -( (PY(JIJK,1,1)-PY(JIJK_1,1,1)) / PDZZ(JIJK,1,1) &
+ +(PY(JI_1JK,1,1)-PY(JI_1JK_1,1,1)) / PDZZ(JI_1JK,1,1) &
+ ) * PDZX(JIJK,1,1)* 0.25 &
+ -( (PY(JIJKP1,1,1)-PY(JIJK,1,1)) / PDZZ(JIJKP1,1,1) &
+ +(PY(JI_1JKP1,1,1)-PY(JI_1JK,1,1)) / PDZZ(JI_1JKP1,1,1) &
+ ) * PDZX(JIJKP1,1,1)* 0.25 &
+ ) / PDXX(JIJK,1,1)
+ END DO
+
+!
+ DO JI=1+JPHEXT,IIU
+ 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
+! PGX_M_U = DXM(PY) / PDXX
+ PGX_M_U(1+1:IIU,:,:) = ( PY(1+1:IIU,:,:)-PY(1:IIU-1,:,:) ) & ! +JPHEXT
+ / PDXX(1+1:IIU,:,:)
+ENDIF
+DO JI=1,JPHEXT
+ PGX_M_U(JI,:,:)=PGX_M_U(IIU-2*JPHEXT+JI,:,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION GX_M_U
+!
+!
+! ##################################################
+ FUNCTION GY_M_V(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
+! ##################################################
+!
+!!**** *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 MODI_SHUMAN
+USE MODD_CONF, ONLY:LFLAT
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+! -------------------------------------
+!
+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) :: PDYY !d*yy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY !d*zy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGY_M_V ! result at flux
+ ! side
+INTEGER IJU,IKU,JJ,JK
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Y
+! ----------------------------
+!
+IJU=SIZE(PY,2)
+IKU=SIZE(PY,3)
+IF (.NOT. LFLAT) 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-KL)) / PDZZ(:,JJ,JK) &
+ +(PY(:,JJ-1,JK)-PY(:,JJ-KL,JK-KL)) / PDZZ(:,JJ-1,JK) &
+ ) * PDZY(:,JJ,JK)* 0.25 &
+ -( (PY(:,JJ,JK+KL)-PY(:,JJ,JK)) / PDZZ(:,JJ,JK+KL) &
+ +(PY(:,JJ-1,JK+KL)-PY(:,JJ-1,JK)) / PDZZ(:,JJ-1,JK+KL) &
+ ) * PDZY(:,JJ,JK+KL)* 0.25 &
+ ) / PDYY(:,JJ,JK)
+ END DO
+ END DO
+!
+ DO JJ=1+JPHEXT,IJU
+ PGY_M_V(:,JJ,KKU)= ( PY(:,JJ,KKU)-PY(:,JJ-1,KKU) ) / PDYY(:,JJ,KKU)
+ PGY_M_V(:,JJ,KKA)= PGY_M_V(:,JJ,KKU) ! -999.
+ END DO
+ELSE
+! PGY_M_V = DYM(PY)/PDYY
+ PGY_M_V(:,1+1:IJU,:) = ( PY(:,1+1:IJU,:)-PY(:,1:IJU-1,:) ) & ! +JPHEXT
+ / PDYY(:,1+1:IJU,:)
+ENDIF
+DO JJ=1,JPHEXT
+ PGY_M_V(:,JJ,:)=PGY_M_V(:,IJU-2*JPHEXT+JJ,:)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION GY_M_V
+!
+!
+! #########################################
+ FUNCTION GZ_M_W(KKA,KKU,KL,PY,PDZZ) RESULT(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 MODI_SHUMAN
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+! -------------------------------------
+!
+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
+
+ ! Metric coefficient:
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGZ_M_W ! result at flux
+ ! side
+!
+INTEGER :: IKT,IKTB,IKTE
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Z
+! -----------------------------
+!
+IKT=SIZE(PY,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+
+PGZ_M_W(:,:,IKTB:IKTE) = (PY(:,:,IKTB:IKTE)-PY(:,:,IKTB-KL:IKTE-KL)) &
+ / PDZZ(:,:,IKTB:IKTE)
+PGZ_M_W(:,:,KKU)= (PY(:,:,KKU)-PY(:,:,KKU-KL)) &
+ / PDZZ(:,:,KKU)
+PGZ_M_W(:,:,KKA)= PGZ_M_W(:,:,KKU) ! -999.
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION GZ_M_W
+
diff --git a/src/PHYEX/aux/gradient_u.f90 b/src/PHYEX/aux/gradient_u.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e956012164590438e124e4ea1fdf153a63d86519
--- /dev/null
+++ b/src/PHYEX/aux/gradient_u.f90
@@ -0,0 +1,338 @@
+!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
+! ######################
+!
+IMPLICIT NONE
+INTERFACE
+!
+!
+FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
+IMPLICIT NONE
+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)
+IMPLICIT NONE
+!
+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)
+IMPLICIT NONE
+!
+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
+!
+!
+!
+!
+! #######################################################
+ FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
+! #######################################################
+!
+!!**** *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 MODI_SHUMAN
+USE MODD_CONF
+!
+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
+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
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_U_M
+! --------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGX_U_M(:,:,:)= ( DXF(PA) - &
+ MZF(MXF(PDZX*DZM(PA)) / PDZZ ) &
+ ) / MXF(PDXX)
+ELSE
+ PGX_U_M(:,:,:)= DXF(PA) / MXF(PDXX)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GX_U_M
+!
+!
+! #########################################################
+ FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_U_UV)
+! #########################################################
+!
+!!**** *GY_U_UV* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Y
+!! direction for a variable placed at the
+!! U point and the result is placed at
+!! the UV 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
+! U point. The result is placed at the UV vorticity point.
+!
+!
+!
+! ( _________________z )
+! ( (___x _________y ) )
+! 1 ( (d*zy (dzm(PA))) ) )
+! PGY_U_UV= ---- (dym(PA) - ( (------ ) ) )
+! ___x ( ( ( ___x ) ) )
+! 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
+!! --------
+!! MXM,MYM,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 MODI_SHUMAN
+USE MODD_CONF
+!
+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
+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
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_U_UV
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGY_U_UV(:,:,:)= (DYM(PA)- MZF( MYM( DZM(PA)/&
+ MXM(PDZZ) ) *MXM(PDZY) ) ) / MXM(PDYY)
+ELSE
+ PGY_U_UV(:,:,:)= DYM(PA) / MXM(PDYY)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GY_U_UV
+!
+!
+! #######################################################
+ FUNCTION GZ_U_UW(PA,PDZZ, KKA, KKU, KL) RESULT(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 MODI_SHUMAN
+!
+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
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_U_UW ! result UW point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_U_UW
+! ---------------------
+!
+PGZ_U_UW(:,:,:)= DZM(PA) / MXM(PDZZ)
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GZ_U_UW
diff --git a/src/PHYEX/aux/gradient_v.f90 b/src/PHYEX/aux/gradient_v.f90
new file mode 100644
index 0000000000000000000000000000000000000000..59cae056c54d6020df8288b3fb4e37487db59684
--- /dev/null
+++ b/src/PHYEX/aux/gradient_v.f90
@@ -0,0 +1,337 @@
+!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
+! ######################
+!
+IMPLICIT NONE
+INTERFACE
+!
+!
+FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
+IMPLICIT NONE
+!
+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)
+IMPLICIT NONE
+!
+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)
+IMPLICIT NONE
+!
+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
+!
+!
+!
+! #######################################################
+ FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
+! #######################################################
+!
+!!**** *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 MODI_SHUMAN
+USE MODD_CONF
+!
+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
+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
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_V_M
+! --------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGY_V_M(:,:,:)= (DYF(PA) - &
+ MZF( MYF(PDZY*DZM(PA))/PDZZ ) &
+ ) / MYF(PDYY)
+ELSE
+ PGY_V_M(:,:,:)= DYF(PA) / MYF(PDYY)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GY_V_M
+!
+!
+! #########################################################
+ FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_V_UV)
+! #########################################################
+!
+!!**** *GX_V_UV* - 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 UV 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
+! V point. The result is placed at the UV vorticity point.
+!
+!
+! ( _________________z )
+! ( (___y _________x ) )
+! 1 ( (d*zx (dzm(PA))) ) )
+! PGX_V_UV= ---- (dxm(PA) - ( (------ ) ) )
+! ___y ( ( ( ___y ) ) )
+! 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,MZF,MYM : 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 MODI_SHUMAN
+USE MODD_CONF
+!
+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
+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
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_V_UV
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGX_V_UV(:,:,:)= ( DXM(PA)- MZF( MXM( DZM(PA)/&
+ MYM(PDZZ) ) *MYM(PDZX) ) ) / MYM(PDXX)
+ELSE
+ PGX_V_UV(:,:,:)= DXM(PA) / MYM(PDXX)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GX_V_UV
+!
+!
+! #######################################################
+ FUNCTION GZ_V_VW(PA,PDZZ, KKA, KKU, KL) RESULT(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 MODI_SHUMAN
+!
+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
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_V_VW ! result VW point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_V_VW
+! ---------------------
+!
+PGZ_V_VW(:,:,:)= DZM(PA) / MYM(PDZZ)
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GZ_V_VW
diff --git a/src/PHYEX/aux/gradient_w.f90 b/src/PHYEX/aux/gradient_w.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5ca99724eb71d7dc42e1130af2cfd17848fd3975
--- /dev/null
+++ b/src/PHYEX/aux/gradient_w.f90
@@ -0,0 +1,313 @@
+!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
+! ######################
+!
+IMPLICIT NONE
+INTERFACE
+!
+!
+FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
+IMPLICIT NONE
+!
+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)
+IMPLICIT NONE
+!
+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)
+IMPLICIT NONE
+!
+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
+!
+!
+!
+! #######################################################
+ FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
+! #######################################################
+!
+!!**** *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 MODI_SHUMAN
+!
+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
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_W_M
+! --------------------
+!
+PGZ_W_M(:,:,:)= DZF(PA(:,:,:))/(MZF(PDZZ(:,:,:)))
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GZ_W_M
+!
+!
+! #########################################################
+ FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_W_UW)
+! #########################################################
+!
+!!**** *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 MODI_SHUMAN
+USE MODD_CONF
+!
+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
+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
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_W_UW
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGX_W_UW(:,:,:)= DXM(PA(:,:,:))/(MZM(PDXX(:,:,:))) &
+ -DZM(MXM(MZF(PA(:,:,:))))*PDZX(:,:,:) &
+ /( MZM(PDXX(:,:,:))*MXM(PDZZ(:,:,:)) )
+ELSE
+ PGX_W_UW(:,:,:)= DXM(PA(:,:,:))/(MZM(PDXX(:,:,:)))
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GX_W_UW
+!
+!
+! #########################################################
+ FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_W_VW)
+! #########################################################
+!
+!!**** *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 MODI_SHUMAN
+USE MODD_CONF
+!
+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
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_W_VW ! result VW point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_W_VW
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(PDYY(:,:,:))) &
+ -DZM(MYM(MZF(PA(:,:,:))))*PDZY(:,:,:) &
+ /( MZM(PDYY(:,:,:))*MYM(PDZZ(:,:,:)) )
+ELSE
+ PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(PDYY(:,:,:)))
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GY_W_VW
diff --git a/src/PHYEX/aux/modd_cst.f90 b/src/PHYEX/aux/modd_cst.f90
new file mode 100644
index 0000000000000000000000000000000000000000..35ae497930324b5dd9f586e3380c13966da0cad4
--- /dev/null
+++ b/src/PHYEX/aux/modd_cst.f90
@@ -0,0 +1,317 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###############
+ MODULE MODD_CST
+! ###############
+!
+!!**** *MODD_CST* - declaration of Physic constants
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! Physics constants.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_CST)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 16/05/94
+!! J. Stein 02/01/95 add xrholw
+!! J.-P. Pinty 13/12/95 add XALPI,XBETAI,XGAMI
+!! J. Stein 25/07/97 add XTH00
+!! V. Masson 05/10/98 add XRHOLI
+!! C. Mari 31/10/00 add NDAYSEC
+!! V. Masson 01/03/03 add conductivity of ice
+!! R. El Khatib 04/08/14 add pre-computed quantities
+!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
+! J.L. Redelsperger 03/2021: add constants for ocean penetrating solar
+! S. Riette 01/2022: introduction of a structure
+! P. Wautelet 20/05/2022: add RASTA cloud radar wavelength
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+
+REAL, PARAMETER :: XLAM_CRAD = 3.154E-3 ! RASTA cloud radar wavelength (m) <=> 95.04 GHz
+
+TYPE CST_t
+ !
+ !* 1. FUNDAMENTAL CONSTANTS
+ ! ---------------------
+ REAL :: XPI !< Pi
+ REAL :: XKARMAN !< von karman constant
+ REAL :: XLIGHTSPEED !< light speed
+ REAL :: XPLANCK !< Planck constant
+ REAL :: XBOLTZ !< Boltzman constant
+ REAL :: XAVOGADRO !< Avogadro number
+ !
+ !* 2. ASTRONOMICAL CONSTANTS
+ ! ----------------------
+ REAL :: XDAY,XSIYEA,XSIDAY !< day duration, sideral year duration, sideral day duration
+ INTEGER :: NDAYSEC !< Number of seconds in a day
+ REAL :: XOMEGA !< Earth rotation
+ !
+ !* 3. TERRESTRIAL GEOIDE CONSTANTS
+ ! ----------------------------
+ REAL :: XRADIUS !< Earth radius
+ REAL :: XG !< Gravity constant
+ !
+ !* 4. REFERENCE PRESSURE
+ ! -------------------
+ REAL :: XP00 !< Reference pressure
+ REAL :: XP00OCEAN !< Reference pressure for ocean model
+ REAL :: XRH00OCEAN !< Reference density for ocean model
+ 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
+ !
+ !* 5. RADIATION CONSTANTS
+ ! -------------------
+ REAL :: XSTEFAN,XI0 !< Stefan-Boltzman constant, solar constant
+ !
+ !* 6. THERMODYNAMIC CONSTANTS
+ ! -----------------------
+ REAL :: XMD,XMV !< Molar mass of dry air and molar mass of vapor
+ REAL :: XRD,XRV !< Gaz constant for dry air, gaz constant for vapor
+ REAL :: XEPSILO !< XMV/XMD
+ REAL :: XCPD,XCPV !< Cpd (dry air), Cpv (vapor)
+ REAL :: XRHOLW !< Volumic mass of liquid water
+ REAL :: XCL,XCI !< Cl (liquid), Ci (ice)
+ REAL :: XTT !< Triple point temperature
+ REAL :: XLVTT !< Vaporization heat constant
+ REAL :: XLSTT !< Sublimation heat constant
+ REAL :: XLMTT !< Melting heat constant
+ REAL :: XESTT !< Saturation vapor pressure at triple point temperature
+ REAL :: XALPW,XBETAW,XGAMW !< Constants for saturation vapor pressure function
+ REAL :: XALPI,XBETAI,XGAMI !< Constants for saturation vapor pressure function over solid ice
+ REAL :: XCONDI !< thermal conductivity of ice (W m-1 K-1)
+ REAL :: XALPHAOC !< thermal expansion coefficient for ocean (K-1)
+ REAL :: XBETAOC !< Haline contraction coeff for ocean (S-1)
+ REAL :: XROC=0.69 !< coeff for SW penetration in Ocean (Hoecker et al)
+ REAL :: XD1=1.1 !< coeff for SW penetration in Ocean (Hoecker et al)
+ REAL :: XD2=23. !< coeff for SW penetration in Ocean (Hoecker et al)
+ ! Values used in SURFEX CMO
+ !REAL :: XROC=0.58
+ !REAL :: XD1=0.35
+ !REAL :: XD2=23.
+ REAL :: XRHOLI !< Volumic mass of ice
+ !
+ !* 7. PRECOMPUTED CONSTANTS
+ ! ---------------------
+ REAL :: RDSRV !< XRD/XRV
+ REAL :: RDSCPD !< XRD/XCPD
+ REAL :: RINVXP00 !< 1./XP00
+ !
+ !* 8. MACHINE PRECISION VALUE DEPENDING of REAL4/8 USE
+ ! ---------------------
+ REAL :: XMNH_TINY !< minimum real on this machine
+ REAL :: XMNH_TINY_12 !< sqrt(minimum real on this machine)
+ REAL :: XMNH_EPSILON !< minimum space with 1.0
+ REAL :: XMNH_HUGE !< maximum real on this machine
+ REAL :: XMNH_HUGE_12_LOG !< maximum log(sqrt(real)) on this machine
+ REAL :: XEPS_DT !< default value for DT test
+ REAL :: XRES_FLAT_CART !< default flat&cart residual tolerance
+ REAL :: XRES_OTHER !< default not flat&cart residual tolerance
+ REAL :: XRES_PREP !< default prep residual tolerance
+END TYPE CST_t
+
+TYPE(CST_t), TARGET, SAVE :: CST
+
+REAL, POINTER :: XPI=>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
+!
+SUBROUTINE PRINT_CST(KULOUT)
+INTEGER, INTENT(IN) :: KULOUT
+
+WRITE(UNIT=KULOUT,FMT='('' MODD_CST: FUNDAMENTAL CONSTANTS '')')
+WRITE(UNIT=KULOUT,FMT='('' XPI = '',E10.4,'' XKARMAN = '',E10.4,'' XLIGHTSPEED = '',E10.4,/, &
+ &'' XPLANCK = '',E10.4,'' XBOLTZ = '',E10.4,'' XAVOGADRO = '',E10.4)')&
+ &XPI,XKARMAN,XLIGHTSPEED,&
+ &XPLANCK,XBOLTZ,XAVOGADRO
+
+WRITE(UNIT=KULOUT,FMT='('' MODD_CST: ASTRONOMICAL CONSTANTS '')')
+WRITE(UNIT=KULOUT,FMT='('' XDAY = '',E10.4,'' XSIYEA = '',E10.4,'' XSIDAY = '',E10.4,/,&
+ &'' XOMEGA = '',E10.4,'' NDAYSEC = '', I6)')&
+ &XDAY,XSIYEA,XSIDAY,&
+ &XOMEGA,NDAYSEC
+
+WRITE(UNIT=KULOUT,FMT='('' MODD_CST: TERRESTRIAL GEOIDE CONSTANTS '')')
+WRITE(UNIT=KULOUT,FMT='('' XRADIUS = '',E10.4,'' XG = '',E10.4)')&
+ &XRADIUS,XG
+
+WRITE(UNIT=KULOUT,FMT='('' MODD_CST: REFERENCE '')')
+WRITE(UNIT=KULOUT,FMT='('' XRH00OCEAN = '',E10.4,'' XTH00OCEAN = '',E10.4,'' XSA00OCEAN = '',E10.4,/,&
+ &'' XP00OCEAN = '',E10.4,'' XP00 = '',E10.4,'' XTH00 = '',E10.4)')&
+ &XRH00OCEAN,XTH00OCEAN,XSA00OCEAN,&
+ &XP00OCEAN,XP00,XTH00
+
+WRITE(UNIT=KULOUT,FMT='('' MODD_CST: RADIATION CONSTANTS '')')
+WRITE(UNIT=KULOUT,FMT='('' XSTEFAN = '',E10.4,'' XIO = '',E10.4)')&
+ &XSTEFAN,XI0
+
+WRITE(UNIT=KULOUT,FMT='('' MODD_CST: THERMODYNAMIC CONSTANTS '')')
+WRITE(UNIT=KULOUT,FMT='('' XMD = '',E10.4,'' XMV = '',E10.4,'' XRD = '',E10.4,/,&
+ &'' XRV = '',E10.4,'' XEPSILO = '',E10.4,'' XCPD = '',E10.4,/,&
+ &'' XCPV = '',E10.4,'' XRHOLW = '',E10.4,'' XRHOLI = '',E10.4,/,&
+ &'' XCONDI = '',E10.4,'' XCL = '',E10.4,'' XCI = '',E10.4,/,&
+ &'' XTT = '',E10.4,'' XLVTT = '',E10.4,'' XLSTT = '',E10.4,/,&
+ &'' XLMTT = '',E10.4,'' XESTT = '',E10.4,'' XGAMW = '',E10.4,/,&
+ &'' XBETAW = '',E10.4,'' XALPW = '',E10.4,'' XGAMI = '',E10.4,/,&
+ &'' XBETAI = '',E10.4,'' XALPI = '',E10.4,'' XALPHAOC = '',E10.4,/,&
+ &'' XBETAOC = '',E10.4)')&
+ &XMD,XMV,XRD,&
+ &XRV,XEPSILO,XCPD,&
+ &XCPV,XRHOLW,XRHOLI,&
+ &XCONDI,XCL,XCI,&
+ &XTT,XLVTT,XLSTT,&
+ &XLMTT,XESTT,XGAMW,&
+ &XBETAW,XALPW,XGAMI,&
+ &XBETAI,XALPI,XALPHAOC,&
+ &XBETAOC
+
+WRITE(UNIT=KULOUT,FMT='('' MODD_CST: PRECOMPUTED CONSTANTS '')')
+WRITE(UNIT=KULOUT,FMT='('' RDSRV = '',E10.4,'' RDSCPD = '',E10.4,'' RINVXP00 = '',E10.4)')&
+ &RDSRV,RDSCPD,RINVXP00
+
+WRITE(UNIT=KULOUT,FMT='('' MODD_CST: MACHINE PRECISION VALUE DEPENDING of REAL4/8 USE '')')
+WRITE(UNIT=KULOUT,FMT='('' XMNH_EPSILON = '',E10.4,'' XMNH_HUGE = '',E10.4,'' XMNH_HUGE_12_LOG = '',E10.4,/,&
+ &'' XMNH_TINY = '',E10.4,'' XEPS_DT '',E10.4,'' XRES_FLAT_CART = '',E10.4,/,&
+ &'' XRES_OTHER = '',E10.4,'' XRES_PREP = '',E10.4,'' XMNH_TINY_12 = '',E10.4)')&
+ &XMNH_EPSILON,XMNH_HUGE,XMNH_HUGE_12_LOG,&
+ &XMNH_TINY,XEPS_DT,XRES_FLAT_CART,&
+ &XRES_OTHER,XRES_PREP,XMNH_TINY_12
+!
+END SUBROUTINE PRINT_CST
+!
+END MODULE MODD_CST
+
diff --git a/src/PHYEX/aux/modd_les.f90 b/src/PHYEX/aux/modd_les.f90
new file mode 100644
index 0000000000000000000000000000000000000000..46be47e7a6f647ee51c8b8203bd360283a80e2f7
--- /dev/null
+++ b/src/PHYEX/aux/modd_les.f90
@@ -0,0 +1,1834 @@
+!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_LES
+! ###############
+!
+!!**** *MODD_LES* - declaration of prognostic variables
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to specify the
+! resolved fluxes and the spectra computed in LES mode
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! 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*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 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
+!! 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
+! 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_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
+!
+LOGICAL :: LLES_MEAN ! flag to activate the mean computations
+LOGICAL :: LLES_RESOLVED ! flag to activate the resolved var. computations
+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
+!
+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
+
+CHARACTER(LEN=4) :: CLES_NORM_TYPE ! type of turbulence normalization
+CHARACTER(LEN=3) :: CBL_HEIGHT_DEF ! definition of the boundary layer height
+
+REAL :: XLES_TEMP_SAMPLING ! temporal sampling between each computation
+REAL :: XLES_TEMP_MEAN_START ! time (in s) from the beginning of the simulation
+REAL :: XLES_TEMP_MEAN_END ! for start and end of the temporal averaged comp.
+REAL :: XLES_TEMP_MEAN_STEP ! time step for each averaging
+
+LOGICAL :: LLES_CART_MASK ! flag to use a cartesian mask
+INTEGER :: NLES_IINF ! definition of the cartesians mask in physical domain
+INTEGER :: NLES_ISUP ! for NLES_CART_MODNBR model
+INTEGER :: NLES_JINF ! "
+INTEGER :: NLES_JSUP ! "
+LOGICAL :: LLES_NEB_MASK ! flag to use a 2D nebulosity mask
+LOGICAL :: LLES_CORE_MASK ! flag to use a 3D cloud core mask
+LOGICAL :: LLES_MY_MASK ! flag to use its own mask (must be coded by user)
+INTEGER :: NLES_MASKS_USER ! number of user masks for LES computations
+LOGICAL :: LLES_CS_MASK ! flag to use conditional sampling mask
+INTEGER :: NPDF ! number of pdf intervals
+!
+!-------------------------------------------------------------------------------
+!
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_IINF ! definition of the cartesians mask in physical domain
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_ISUP ! for all models
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JINF ! "
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JSUP ! "
+!
+CHARACTER(LEN=4), DIMENSION(2,JPMODELMAX) :: CLES_LBCX
+! X boundary conditions for 2 points correlations computations for all models
+!
+CHARACTER(LEN=4), DIMENSION(2,JPMODELMAX) :: CLES_LBCY
+! Y boundary conditions for 2 points correlations computations for all models
+!
+!-------------------------------------------------------------------------------
+!
+LOGICAL :: LLES ! flag to compute the LES diagnostics
+!
+LOGICAL :: LLES_CALL ! flag to compute the LES diagnostics at current
+! ! time step
+!
+!
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CART_MASK
+! 2D cartesian mask of the current model
+!
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_NEB_MASK
+! 2D nebulosity mask of the current model
+!
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CORE_MASK
+! 2D surface precipitations mask of the current model
+!
+! 2D owner mask of the current model
+LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE :: LLES_CURRENT_MY_MASKS
+!
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS1_MASK
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS2_MASK
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS3_MASK
+! 2D conditional sampling mask of the current model
+!
+INTEGER :: NLES_CURRENT_TCOUNT
+! current model LES time counter
+!
+INTEGER :: NLES_CURRENT_TIMES
+! current model NLES_TIMES (number of LES samplings)
+!
+INTEGER :: NLES_CURRENT_IINF, NLES_CURRENT_ISUP, NLES_CURRENT_JINF, NLES_CURRENT_JSUP
+! coordinates (in physical domain) for write_diachro, set to NLESn_IINF(current model), etc...
+!
+REAL :: XLES_CURRENT_DOMEGAX, XLES_CURRENT_DOMEGAY
+! minimum wavelength in spectra analysis
+!
+CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCX
+! current model X boundary conditions for 2 points correlations computations
+!
+CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCY
+! current model Y boundary conditions for 2 points correlations computations
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_CURRENT_Z
+! altitudes for diachro
+!
+REAL :: XLES_CURRENT_ZS
+! orography (used for normalization of altitudes)
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NKLIN_CURRENT_LES
+! levels for vertical interpolation
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCOEFLIN_CURRENT_LES
+! coefficients for vertical interpolation
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NKLIN_CURRENT_SPEC
+! levels for vertical interpolation
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCOEFLIN_CURRENT_SPEC
+! coefficients for vertical interpolation
+!
+REAL,DIMENSION(2) :: XTIME_LES
+! time spent in subgrid LES computations in this time-step in TURB
+!
+!-------------------------------------------------------------------------------
+!
+!* normalization variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_M
+! normalization coefficient for distances (Meters)
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_K
+! normalization coefficient for temperatures (Kelvin)
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_S
+! normalization coefficient for times (Seconds)
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_RHO
+! normalization coefficient for densities
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_RV
+! normalization coefficient for mixing ratio
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XLES_NORM_SV
+! normalization coefficient for scalar variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_P
+! normalization coefficient for pressure
+!
+!-------------------------------------------------------------------------------
+!
+!* monitoring variables
+!
+INTEGER :: NLES_MASKS ! number of masks for LES computations
+INTEGER :: NLES_K ! number of vertical levels for local diagnostics
+INTEGER :: NSPECTRA_K ! number of vertical levels for spectra
+!
+CHARACTER(LEN=1) :: CLES_LEVEL_TYPE ! type of vertical levels for local diag.
+CHARACTER(LEN=1) :: CSPECTRA_LEVEL_TYPE ! type of vertical levels for spectra
+!
+!-------------------------------------------------------------------------------
+!
+!* subgrid variables for current model
+!
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_WThl ! <w'w'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_WRt ! <w'w'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_Thl2 ! <w'Thl'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_Rt2 ! <w'Rt'2>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_ThlRt! <w'Thl'Rt'>
+! _____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_RES_W_SBG_WSv ! <w'w'Sv'>
+! ____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_RES_W_SBG_Sv2 ! <w'Sv'2>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XLES_SUBGRID_RCSIGS ! rc sigmas
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XLES_SUBGRID_RCSIGC ! rc sigmac
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_U_SBG_UaU ! <du'/dxa ua'u'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_V_SBG_UaV ! <dv'/dxa ua'v'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaW ! <dw'/dxa ua'w'>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaThl ! <dw'/dxa ua'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaW ! <dThl'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Thl_SBG_W2 ! <dThl'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaRt ! <dw'/dxa ua'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaW ! <dRt'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Rt_SBG_W2 ! <dRt'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaRt! <dThl'/dxa ua'Rt'>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaThl! <dRt'/dxa ua'Thl'>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaThl! <dThl'/dxa ua'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaRt ! <dRt'/dxa ua'Rt'>
+! ______
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaSv ! <dw'/dxa ua'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Sv_SBG_UaW ! <dSv'/dxa ua'w'>
+! ___
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Sv_SBG_W2 ! <dSv'/dz w'2>
+! ______
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Sv_SBG_UaSv ! <dSv'/dxa ua'Sv'>
+!
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_U2 ! <u'2>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_V2 ! <v'2>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2 ! <w'2>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Thl2 ! <Thl'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Rt2 ! <Rt'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Rc2 ! <Rc'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Ri2 ! <Ri'2>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlRt ! <Thl'Rt'>
+! ____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_Sv2 ! <Sv'2>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UV ! <u'v'>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WU ! <w'u'>
+! ____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WV ! <w'v'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UThl ! <u'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VThl ! <v'Thl'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThl ! <w'Thl'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_URt ! <u'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VRt ! <v'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRt ! <w'Rt'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_URc ! <u'Rc'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VRc ! <v'Rc'>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRc ! <w'Rc'>
+! _____
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_USv ! <u'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VSv ! <v'Sv'>
+! _____
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WSv ! <w'Sv'>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UTke ! <u'e>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VTke ! <v'e>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTke ! <w'e>
+! ___
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ddz_WTke ! <dw'e/dz>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThv ! <w'Thv'>
+! ________
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlThv ! <Thl'Thv'>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RtThv ! <Rt'Thv'>
+! _______
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_SvThv ! <Sv'Thv'>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2Thl ! <w'2Thl>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2Rt ! <w'2Rt>
+! _____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_W2Sv ! <w'2Sv>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThlRt ! <w'ThlRt>
+! ______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThl2 ! <w'Thl2>
+! _____
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRt2 ! <w'Rt2>
+! _____
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_WSv2 ! <w'Sv2>
+! _______
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Tke ! <epsilon>
+! ____________
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Thl2 ! <epsilon_Thl2>
+! ___________
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Rt2 ! <epsilon_Rt2>
+! ______________
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_ThlRt! <epsilon_ThlRt>
+! ___________
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_DISS_Sv2 ! <epsilon_Sv2>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WP ! <w'p'>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlPz ! <Thl'dp'/dz>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RtPz ! <Rt'dp'/dz>
+!
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_SvPz ! <Sv'dp'/dz>
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_PHI3 ! phi3
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_PSI3 ! psi3
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_LMix ! mixing length
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_LDiss ! dissipative length
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Km ! eddy diffusivity for momentum
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Kh ! eddy diffusivity for heat
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_THLUP_MF ! Thl of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RTUP_MF ! Rt of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RVUP_MF ! Rv of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RCUP_MF ! Rc of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RIUP_MF ! Ri of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WUP_MF ! Thl of the Updraft
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_MASSFLUX ! Mass Flux
+!
+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_THVUP_MF ! Thv of the Updraft
+!
+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_WUMF ! Flux of u
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WVMF ! Flux of v
+!
+!* surface variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_USTAR ! local u* temporal series
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_UW0 ! uw temporal series
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_VW0 ! vw temporal series
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_Q0 ! Qo temporal series
+REAL, DIMENSION(:), ALLOCATABLE :: X_LES_E0 ! Eo temporal series
+REAL, DIMENSION(:,:), ALLOCATABLE :: X_LES_SV0 ! scalar surface fluxes
+!
+!* pdf variables
+REAL :: XRV_PDF_MIN ! min of rv pdf
+REAL :: XRV_PDF_MAX ! max of rv pdf
+REAL :: XTH_PDF_MIN ! min of theta pdf
+REAL :: XTH_PDF_MAX ! max of theta pdf
+REAL :: XW_PDF_MIN ! min of w pdf
+REAL :: XW_PDF_MAX ! max of w pdf
+REAL :: XTHV_PDF_MIN ! min of thetav pdf
+REAL :: XTHV_PDF_MAX ! max of thetav pdf
+REAL :: XRC_PDF_MIN ! min of rc pdf
+REAL :: XRC_PDF_MAX ! max of rc pdf
+REAL :: XRR_PDF_MIN ! min of rr pdf
+REAL :: XRR_PDF_MAX ! max of rr pdf
+REAL :: XRI_PDF_MIN ! min of ri pdf
+REAL :: XRI_PDF_MAX ! max of ri pdf
+REAL :: XRS_PDF_MIN ! min of rs pdf
+REAL :: XRS_PDF_MAX ! max of rs pdf
+REAL :: XRG_PDF_MIN ! min of rg pdf
+REAL :: XRG_PDF_MAX ! max of rg pdf
+REAL :: XRT_PDF_MIN ! min of rt pdf
+REAL :: XRT_PDF_MAX ! max of rt pdf
+REAL :: XTHL_PDF_MIN ! min of thetal pdf
+REAL :: XTHL_PDF_MAX ! max of thetal pdf
+!-------------------------------------------------------------------------------
+!* pdf distribution
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RV ! rv pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_TH ! theta pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_W ! w pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_THV ! thetav pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RC ! rc pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RR ! rr pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RI ! ri pdf
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RS ! rs pdf
+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(:), INTENT(IN) :: 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/modd_misc.f90 b/src/PHYEX/aux/modd_misc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4947773b5260f6089cdf52d0230c1800cc3e7ab5
--- /dev/null
+++ b/src/PHYEX/aux/modd_misc.f90
@@ -0,0 +1,5 @@
+MODULE MODD_MISC
+IMPLICIT NONE
+TYPE MISC_t
+END TYPE MISC_t
+END MODULE MODD_MISC
diff --git a/src/PHYEX/aux/modd_nsv.f90 b/src/PHYEX/aux/modd_nsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..958d1f4dfb1a180767ae8c7738cca3a33ad18a5a
--- /dev/null
+++ b/src/PHYEX/aux/modd_nsv.f90
@@ -0,0 +1,650 @@
+!MNH_LIC Copyright 2001-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ###############
+ MODULE MODD_NSV
+! ###############
+!
+!!**** *MODD_NSV* - declaration of scalar variables numbers
+!!
+!! PURPOSE
+!! -------
+!! Arrays to store the per-model NSV_* values number (suffix _A denote an array)
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen L.A.
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/01
+!! J.-P. Pinty 29/11/02 add C3R5, ELEC
+!! V. Masson 01/2004 add scalar names
+!! M. Leriche 12/04/07 add aqueous chemistry
+!! M. Leriche 08/07/10 add ice phase chemistry
+!! C.Lac 07/11 add conditional sampling
+!! Pialat/Tulet 15/02/12 add ForeFire
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! V. Vionnet 07/17 add blowing snow
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! P. Wautelet 26/11/2021: add TSVLIST and TSVLIST_A to store the metadata of all the scalar variables
+! A. Costes 12/2021: add Blaze fire model smoke
+! P. Wautelet 14/01/2022: add CSV_CHEM_LIST(_A) to store the list of all chemical variables
+! + NSV_CHEM_LIST(_A) the size of the list
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_FIELD, ONLY: tfieldmetadata
+USE MODD_PARAMETERS, ONLY: JPMODELMAX, & ! Maximum allowed number of nested models
+ JPSVMAX, & ! Maximum number of scalar variables
+ JPSVNAMELGTMAX, & ! Maximum length of a scalar variable name
+ NMNHNAMELGTMAX
+!
+IMPLICIT NONE
+TYPE NSV_t
+!
+REAL,DIMENSION(JPSVMAX) :: XSVMIN ! minimum value for SV variables
+!
+LOGICAL :: LINI_NSV(JPMODELMAX) = .FALSE. ! becomes True when routine INI_NSV is called
+!
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE :: CSV_CHEM_LIST_A !Names of all the chemical variables
+CHARACTER(LEN=6), DIMENSION(:,:), ALLOCATABLE :: CSV_A !Names of the scalar variables
+TYPE(tfieldmetadata), DIMENSION(:,:), ALLOCATABLE :: TSVLIST_A !Metadata of all the scalar variables
+
+INTEGER,DIMENSION(JPMODELMAX)::NSV_A = 0 ! total number of scalar variables
+ ! NSV_A = NSV_USER_A+NSV_C2R2_A+NSV_CHEM_A+..
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEM_LIST_A = 0 ! total number of chemical variables (including dust, salt...)
+INTEGER,DIMENSION(JPMODELMAX)::NSV_USER_A = 0 ! number of user scalar variables with
+ ! indices in the range : 1...NSV_USER_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2_A = 0 ! number of liq scalar in C2R2
+ ! and in C3R5
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2END_A = 0 ! NSV_C2R2BEG_A...NSV_C2R2END_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3_A = 0 ! number of ice scalar in C3R5
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3END_A = 0 ! NSV_C1R3BEG_A...NSV_C1R3END_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELEC_A = 0 ! number of scalar in ELEC
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECEND_A = 0 ! NSV_ELECBEG_A...NSV_ELECEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEM_A = 0 ! number of chemical scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMEND_A = 0 ! NSV_CHEMBEG_A...NSV_CHEMEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGS_A = 0 ! number of gaseous chemcial species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSEND_A = 0 ! NSV_CHGSBEG_
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHAC_A = 0 ! number of aqueous chemical species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACEND_A = 0 ! NSV_CHACBEG
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHIC_A = 0 ! number of ice phase chemical species
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICBEG_A = 0 ! with indices
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICEND_A = 0 ! NSV_CHICBEG
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LG_A = 0 ! number of LaGrangian
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LGBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LGEND_A = 0 ! NSV_LGBEG_A...NSV_LGEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOX_A = 0 ! number of lightning NOx
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXEND_A = 0 ! NSV_LNOXBEG_A...NSV_LNOXEND_A
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DST_A = 0 ! number of dust scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTEND_A = 0 ! NSV_DSTBEG_A...NSV_DSTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLT_A = 0 ! number of sea salt scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AER_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AEREND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEP_A = 0 ! number of aerosol scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PP_A = 0 ! number of passive pol.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PPBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_PPEND_A = 0 ! NSV_PPBEG_A...NSV_PPEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CS_A = 0 ! number of condit.samplings
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CSBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_CSEND_A = 0 ! NSV_CSBEG_A...NSV_CSEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_A = 0 ! number of scalar in LIMA
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_BEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_END_A = 0 ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NC_A = 0 ! First Nc variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NR_A = 0 ! First Nr variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_FREE_A = 0 ! First Free CCN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_ACTI_A = 0 ! First Acti. CNN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SCAVMASS_A = 0 ! Scavenged mass variable
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NI_A = 0 ! First Ni var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NS_A = 0 ! First Ns var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NG_A = 0 ! First Ng var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NH_A = 0 ! First Nh var.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_FREE_A = 0 ! First Free IFN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_NUCL_A = 0 ! First Nucl. IFN conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IMM_NUCL_A = 0 ! First Nucl. IMM conc.
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_HOM_HAZE_A = 0 ! Hom. freezing of CCN
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SPRO_A = 0 ! Supersaturation
+!
+#ifdef MNH_FOREFIRE
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FF_A = 0 ! number of ForeFire scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFEND_A = 0 ! NSV_FFBEG_A...NSV_FFEND_A
+!
+#endif
+! Blaze smoke indexes
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIRE_A = 0 ! number of Blaze smoke scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIREBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FIREEND_A = 0 ! NSV_FIREBEG_A...NSV_FIREEND_A
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNW_A = 0 ! number of blowing snow scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWEND_A = 0 ! NSV_SNWBEG_A...NSV_SNWEND_A
+!
+!###############################################################################
+!
+! variables updated for the current model
+!
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), POINTER :: CSV_CHEM_LIST !Names of all the chemical variables
+CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSV !Names of the scalar variables
+
+TYPE(tfieldmetadata), DIMENSION(:), POINTER :: TSVLIST !Metadata of all the scalar variables
+
+INTEGER :: NSV = 0 ! total number of user scalar variables
+!
+INTEGER :: NSV_CHEM_LIST = 0 ! total number of chemical variables (including dust, salt...)
+!
+INTEGER :: NSV_USER = 0 ! number of user scalar variables with indices
+ ! in the range : 1...NSV_USER
+INTEGER :: NSV_C2R2 = 0 ! number of liq scalar used in C2R2 and in C3R5
+INTEGER :: NSV_C2R2BEG = 0 ! with indices in the range :
+INTEGER :: NSV_C2R2END = 0 ! NSV_C2R2BEG...NSV_C2R2END
+!
+INTEGER :: NSV_C1R3 = 0 ! number of ice scalar used in C3R5
+INTEGER :: NSV_C1R3BEG = 0 ! with indices in the range :
+INTEGER :: NSV_C1R3END = 0 ! NSV_C1R3BEG...NSV_C1R3END
+!
+INTEGER :: NSV_ELEC = 0 ! number of scalar variables used in ELEC
+INTEGER :: NSV_ELECBEG = 0 ! with indices in the range :
+INTEGER :: NSV_ELECEND = 0 ! NSV_ELECBEG...NSV_ELECEND
+!
+INTEGER :: NSV_CHEM = 0 ! number of chemical scalar variables
+INTEGER :: NSV_CHEMBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHEMEND = 0 ! NSV_CHEMBEG...NSV_CHEMEND
+!
+INTEGER :: NSV_CHGS = 0 ! number of gas-phase chemicals
+INTEGER :: NSV_CHGSBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHGSEND = 0 ! NSV_CHGSBEG...NSV_CHGSEND
+!
+INTEGER :: NSV_CHAC = 0 ! number of aqueous-phase chemicals
+INTEGER :: NSV_CHACBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHACEND = 0 ! NSV_CHACBEG...NSV_CHACEND
+!
+INTEGER :: NSV_CHIC = 0 ! number of ice-phase chemicals
+INTEGER :: NSV_CHICBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CHICEND = 0 ! NSV_CHICBEG...NSV_CHICEND
+!
+INTEGER :: NSV_LG = 0 ! number of lagrangian
+INTEGER :: NSV_LGBEG = 0 ! with indices in the range :
+INTEGER :: NSV_LGEND = 0 ! NSV_LGBEG...NSV_LGEND
+!
+INTEGER :: NSV_LNOX = 0 ! number of lightning NOx variables
+INTEGER :: NSV_LNOXBEG = 0 ! with indices in the range :
+INTEGER :: NSV_LNOXEND = 0 ! NSV_LNOXBEG...NSV_LNOXEND
+!
+INTEGER :: NSV_DST = 0 ! number of dust scalar variables
+INTEGER :: NSV_DSTBEG = 0 ! with indices in the range :
+INTEGER :: NSV_DSTEND = 0 ! NSV_DSTBEG...NSV_DSTEND
+
+INTEGER :: NSV_SLT = 0 ! number of sea salt scalar variables
+INTEGER :: NSV_SLTBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SLTEND = 0 ! NSV_SLTBEG...NSV_SLTEND
+
+INTEGER :: NSV_AER = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_AERBEG = 0 ! with indices in the range :
+INTEGER :: NSV_AEREND = 0 ! NSV_AERBEG...NSV_AEREND
+
+INTEGER :: NSV_DSTDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_DSTDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_DSTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+!
+INTEGER :: NSV_AERDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_AERDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_AERDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+
+INTEGER :: NSV_SLTDEP = 0 ! number of aerosol scalar variables
+INTEGER :: NSV_SLTDEPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SLTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
+!
+INTEGER :: NSV_PP = 0 ! number of passive pollutants
+INTEGER :: NSV_PPBEG = 0 ! with indices in the range :
+INTEGER :: NSV_PPEND = 0 ! NSV_PPBEG...NSV_PPEND
+!
+INTEGER :: NSV_CS = 0 ! number of condit.samplings
+INTEGER :: NSV_CSBEG = 0 ! with indices in the range :
+INTEGER :: NSV_CSEND = 0 ! NSV_CSBEG...NSV_CSEND
+!
+INTEGER :: NSV_LIMA ! number of scalar in LIMA
+INTEGER :: NSV_LIMA_BEG ! with indices in the range :
+INTEGER :: NSV_LIMA_END ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
+INTEGER :: NSV_LIMA_NC !
+INTEGER :: NSV_LIMA_NR !
+INTEGER :: NSV_LIMA_CCN_FREE !
+INTEGER :: NSV_LIMA_CCN_ACTI !
+INTEGER :: NSV_LIMA_SCAVMASS !
+INTEGER :: NSV_LIMA_NI !
+INTEGER :: NSV_LIMA_NS !
+INTEGER :: NSV_LIMA_NG !
+INTEGER :: NSV_LIMA_NH !
+INTEGER :: NSV_LIMA_IFN_FREE !
+INTEGER :: NSV_LIMA_IFN_NUCL !
+INTEGER :: NSV_LIMA_IMM_NUCL !
+INTEGER :: NSV_LIMA_HOM_HAZE !
+INTEGER :: NSV_LIMA_SPRO !
+!
+#ifdef MNH_FOREFIRE
+INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
+INTEGER :: NSV_FFBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FFEND = 0 ! NSV_FFBEG...NSV_FFEND
+!
+#endif
+! Blaze smoke
+INTEGER :: NSV_FIRE = 0 ! number of Blaze smoke scalar variables
+INTEGER :: NSV_FIREBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FIREEND = 0 ! NSV_FIREBEG...NSV_FIREEND
+!
+INTEGER :: NSV_SNW = 0 ! number of blowing snow scalar variables
+INTEGER :: NSV_SNWBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SNWEND = 0 ! NSV_SNWBEG...NSV_SNWEND
+!
+INTEGER :: NSV_CO2 = 0 ! index for CO2
+END TYPE NSV_t
+!
+TYPE(NSV_t), TARGET, SAVE :: TNSV
+!
+
+REAL, POINTER, DIMENSION(:) :: XSVMIN => NULL()
+
+LOGICAL, POINTER :: LINI_NSV(:) => NULL()
+!
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:,:), POINTER :: CSV_CHEM_LIST_A => NULL()
+CHARACTER(LEN=6), DIMENSION(:,:), POINTER :: CSV_A => NULL()
+TYPE(tfieldmetadata), DIMENSION(:,:), POINTER :: TSVLIST_A => NULL()
+
+INTEGER, DIMENSION(:), POINTER ::NSV_A => NULL(), &
+ NSV_CHEM_LIST_A => NULL(), &
+ NSV_USER_A => NULL(), &
+ NSV_C2R2_A => NULL(), &
+ NSV_C2R2BEG_A => NULL(), &
+ NSV_C2R2END_A => NULL(), &
+ NSV_C1R3_A => NULL(), &
+ NSV_C1R3BEG_A => NULL(), &
+ NSV_C1R3END_A => NULL(), &
+ NSV_ELEC_A => NULL(), &
+ NSV_ELECBEG_A => NULL(), &
+ NSV_ELECEND_A => NULL(), &
+ NSV_CHEM_A => NULL(), &
+ NSV_CHEMBEG_A => NULL(), &
+ NSV_CHEMEND_A => NULL(), &
+ NSV_CHGS_A => NULL(), &
+ NSV_CHGSBEG_A => NULL(), &
+ NSV_CHGSEND_A => NULL(), &
+ NSV_CHAC_A => NULL(), &
+ NSV_CHACBEG_A => NULL(), &
+ NSV_CHACEND_A => NULL(), &
+ NSV_CHIC_A => NULL(), &
+ NSV_CHICBEG_A => NULL(), &
+ NSV_CHICEND_A => NULL(), &
+ NSV_LG_A => NULL(), &
+ NSV_LGBEG_A => NULL(), &
+ NSV_LGEND_A => NULL(), &
+ NSV_LNOX_A => NULL(), &
+ NSV_LNOXBEG_A => NULL(), &
+ NSV_LNOXEND_A => NULL(), &
+ NSV_DST_A => NULL(), &
+ NSV_DSTBEG_A => NULL(), &
+ NSV_DSTEND_A => NULL(), &
+ NSV_SLT_A => NULL(), &
+ NSV_SLTBEG_A => NULL(), &
+ NSV_SLTEND_A => NULL(), &
+ NSV_AER_A => NULL(), &
+ NSV_AERBEG_A => NULL(), &
+ NSV_AEREND_A => NULL(), &
+ NSV_DSTDEP_A => NULL(), &
+ NSV_DSTDEPBEG_A => NULL(), &
+ NSV_DSTDEPEND_A => NULL(), &
+ NSV_AERDEP_A => NULL(), &
+ NSV_AERDEPBEG_A => NULL(), &
+ NSV_AERDEPEND_A => NULL(), &
+ NSV_SLTDEP_A => NULL(), &
+ NSV_SLTDEPBEG_A => NULL(), &
+ NSV_SLTDEPEND_A => NULL(), &
+ NSV_PP_A => NULL(), &
+ NSV_PPBEG_A => NULL(), &
+ NSV_PPEND_A => NULL(), &
+ NSV_CS_A => NULL(), &
+ NSV_CSBEG_A => NULL(), &
+ NSV_CSEND_A => NULL(), &
+ NSV_LIMA_A => NULL(), &
+ NSV_LIMA_BEG_A => NULL(), &
+ NSV_LIMA_END_A => NULL(), &
+ NSV_LIMA_NC_A => NULL(), &
+ NSV_LIMA_NR_A => NULL(), &
+ NSV_LIMA_CCN_FREE_A => NULL(), &
+ NSV_LIMA_CCN_ACTI_A => NULL(), &
+ NSV_LIMA_SCAVMASS_A => NULL(), &
+ NSV_LIMA_NI_A => NULL(), &
+ NSV_LIMA_NS_A => NULL(), &
+ NSV_LIMA_NG_A => NULL(), &
+ NSV_LIMA_NH_A => NULL(), &
+ NSV_LIMA_IFN_FREE_A => NULL(), &
+ NSV_LIMA_IFN_NUCL_A => NULL(), &
+ NSV_LIMA_IMM_NUCL_A => NULL(), &
+ NSV_LIMA_HOM_HAZE_A => NULL(), &
+ NSV_LIMA_SPRO_A => NULL(), &
+#ifdef MNH_FOREFIRE
+ NSV_FF_A => NULL(), &
+ NSV_FFBEG_A => NULL(), &
+ NSV_FFEND_A => NULL(), &
+#endif
+ NSV_FIRE_A => NULL(), &
+ NSV_FIREBEG_A => NULL(), &
+ NSV_FIREEND_A => NULL(), &
+ NSV_SNW_A => NULL(), &
+ NSV_SNWBEG_A => NULL(), &
+ NSV_SNWEND_A => NULL()
+
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), POINTER :: CSV_CHEM_LIST => NULL()
+CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSV => NULL()
+
+TYPE(tfieldmetadata), DIMENSION(:), POINTER :: TSVLIST => NULL()
+
+INTEGER, POINTER :: NSV => NULL(), &
+ NSV_CHEM_LIST => NULL(), &
+ NSV_USER => NULL(), &
+ NSV_C2R2 => NULL(), &
+ NSV_C2R2BEG => NULL(), &
+ NSV_C2R2END => NULL(), &
+ NSV_C1R3 => NULL(), &
+ NSV_C1R3BEG => NULL(), &
+ NSV_C1R3END => NULL(), &
+ NSV_ELEC => NULL(), &
+ NSV_ELECBEG => NULL(), &
+ NSV_ELECEND => NULL(), &
+ NSV_CHEM => NULL(), &
+ NSV_CHEMBEG => NULL(), &
+ NSV_CHEMEND => NULL(), &
+ NSV_CHGS => NULL(), &
+ NSV_CHGSBEG => NULL(), &
+ NSV_CHGSEND => NULL(), &
+ NSV_CHAC => NULL(), &
+ NSV_CHACBEG => NULL(), &
+ NSV_CHACEND => NULL(), &
+ NSV_CHIC => NULL(), &
+ NSV_CHICBEG => NULL(), &
+ NSV_CHICEND => NULL(), &
+ NSV_LG => NULL(), &
+ NSV_LGBEG => NULL(), &
+ NSV_LGEND => NULL(), &
+ NSV_LNOX => NULL(), &
+ NSV_LNOXBEG => NULL(), &
+ NSV_LNOXEND => NULL(), &
+ NSV_DST => NULL(), &
+ NSV_DSTBEG => NULL(), &
+ NSV_DSTEND => NULL(), &
+ NSV_SLT => NULL(), &
+ NSV_SLTBEG => NULL(), &
+ NSV_SLTEND => NULL(), &
+ NSV_AER => NULL(), &
+ NSV_AERBEG => NULL(), &
+ NSV_AEREND => NULL(), &
+ NSV_DSTDEP => NULL(), &
+ NSV_DSTDEPBEG => NULL(), &
+ NSV_DSTDEPEND => NULL(), &
+ NSV_AERDEP => NULL(), &
+ NSV_AERDEPBEG => NULL(), &
+ NSV_AERDEPEND => NULL(), &
+ NSV_SLTDEP => NULL(), &
+ NSV_SLTDEPBEG => NULL(), &
+ NSV_SLTDEPEND => NULL(), &
+ NSV_PP => NULL(), &
+ NSV_PPBEG => NULL(), &
+ NSV_PPEND => NULL(), &
+ NSV_CS => NULL(), &
+ NSV_CSBEG => NULL(), &
+ NSV_CSEND => NULL(), &
+ NSV_LIMA => NULL(), &
+ NSV_LIMA_BEG => NULL(), &
+ NSV_LIMA_END => NULL(), &
+ NSV_LIMA_NC => NULL(), &
+ NSV_LIMA_NR => NULL(), &
+ NSV_LIMA_CCN_FREE => NULL(), &
+ NSV_LIMA_CCN_ACTI => NULL(), &
+ NSV_LIMA_SCAVMASS => NULL(), &
+ NSV_LIMA_NI => NULL(), &
+ NSV_LIMA_NS => NULL(), &
+ NSV_LIMA_NG => NULL(), &
+ NSV_LIMA_NH => NULL(), &
+ NSV_LIMA_IFN_FREE => NULL(), &
+ NSV_LIMA_IFN_NUCL => NULL(), &
+ NSV_LIMA_IMM_NUCL => NULL(), &
+ NSV_LIMA_HOM_HAZE => NULL(), &
+ NSV_LIMA_SPRO => NULL(), &
+#ifdef MNH_FOREFIRE
+ NSV_FF => NULL(), &
+ NSV_FFBEG => NULL(), &
+ NSV_FFEND => NULL(), &
+#endif
+ NSV_FIRE => NULL(), &
+ NSV_FIREBEG => NULL(), &
+ NSV_FIREEND => NULL(), &
+ NSV_SNW => NULL(), &
+ NSV_SNWBEG => NULL(), &
+ NSV_SNWEND => NULL(), &
+ NSV_CO2 => NULL()
+!
+CONTAINS
+!
+SUBROUTINE NSV_ASSOCIATE()
+IMPLICIT NONE
+
+IF(.NOT. ASSOCIATED(NSV)) THEN
+ XSVMIN => TNSV%XSVMIN
+ LINI_NSV => TNSV%LINI_NSV
+
+ NSV_A => TNSV%NSV_A
+ NSV_CHEM_LIST_A => TNSV%NSV_CHEM_LIST_A
+ NSV_USER_A => TNSV%NSV_USER_A
+ NSV_C2R2_A => TNSV%NSV_C2R2_A
+ NSV_C2R2BEG_A => TNSV%NSV_C2R2BEG_A
+ NSV_C2R2END_A => TNSV%NSV_C2R2END_A
+ NSV_C1R3_A => TNSV%NSV_C1R3_A
+ NSV_C1R3BEG_A => TNSV%NSV_C1R3BEG_A
+ NSV_C1R3END_A => TNSV%NSV_C1R3END_A
+ NSV_ELEC_A => TNSV%NSV_ELEC_A
+ NSV_ELECBEG_A => TNSV%NSV_ELECBEG_A
+ NSV_ELECEND_A => TNSV%NSV_ELECEND_A
+ NSV_CHEM_A => TNSV%NSV_CHEM_A
+ NSV_CHEMBEG_A => TNSV%NSV_CHEMBEG_A
+ NSV_CHEMEND_A => TNSV%NSV_CHEMEND_A
+ NSV_CHGS_A => TNSV%NSV_CHGS_A
+ NSV_CHGSBEG_A => TNSV%NSV_CHGSBEG_A
+ NSV_CHGSEND_A => TNSV%NSV_CHGSEND_A
+ NSV_CHAC_A => TNSV%NSV_CHAC_A
+ NSV_CHACBEG_A => TNSV%NSV_CHACBEG_A
+ NSV_CHACEND_A => TNSV%NSV_CHACEND_A
+ NSV_CHIC_A => TNSV%NSV_CHIC_A
+ NSV_CHICBEG_A => TNSV%NSV_CHICBEG_A
+ NSV_CHICEND_A => TNSV%NSV_CHICEND_A
+ NSV_LG_A => TNSV%NSV_LG_A
+ NSV_LGBEG_A => TNSV%NSV_LGBEG_A
+ NSV_LGEND_A => TNSV%NSV_LGEND_A
+ NSV_LNOX_A => TNSV%NSV_LNOX_A
+ NSV_LNOXBEG_A => TNSV%NSV_LNOXBEG_A
+ NSV_LNOXEND_A => TNSV%NSV_LNOXEND_A
+ NSV_DST_A => TNSV%NSV_DST_A
+ NSV_DSTBEG_A => TNSV%NSV_DSTBEG_A
+ NSV_DSTEND_A => TNSV%NSV_DSTEND_A
+ NSV_SLT_A => TNSV%NSV_SLT_A
+ NSV_SLTBEG_A => TNSV%NSV_SLTBEG_A
+ NSV_SLTEND_A => TNSV%NSV_SLTEND_A
+ NSV_AER_A => TNSV%NSV_AER_A
+ NSV_AERBEG_A => TNSV%NSV_AERBEG_A
+ NSV_AEREND_A => TNSV%NSV_AEREND_A
+ NSV_DSTDEP_A => TNSV%NSV_DSTDEP_A
+ NSV_DSTDEPBEG_A => TNSV%NSV_DSTDEPBEG_A
+ NSV_DSTDEPEND_A => TNSV%NSV_DSTDEPEND_A
+ NSV_AERDEP_A => TNSV%NSV_AERDEP_A
+ NSV_AERDEPBEG_A => TNSV%NSV_AERDEPBEG_A
+ NSV_AERDEPEND_A => TNSV%NSV_AERDEPEND_A
+ NSV_SLTDEP_A => TNSV%NSV_SLTDEP_A
+ NSV_SLTDEPBEG_A => TNSV%NSV_SLTDEPBEG_A
+ NSV_SLTDEPEND_A => TNSV%NSV_SLTDEPEND_A
+ NSV_PP_A => TNSV%NSV_PP_A
+ NSV_PPBEG_A => TNSV%NSV_PPBEG_A
+ NSV_PPEND_A => TNSV%NSV_PPEND_A
+ NSV_CS_A => TNSV%NSV_CS_A
+ NSV_CSBEG_A => TNSV%NSV_CSBEG_A
+ NSV_CSEND_A => TNSV%NSV_CSEND_A
+ NSV_LIMA_A => TNSV%NSV_LIMA_A
+ NSV_LIMA_BEG_A => TNSV%NSV_LIMA_BEG_A
+ NSV_LIMA_END_A => TNSV%NSV_LIMA_END_A
+ NSV_LIMA_NC_A => TNSV%NSV_LIMA_NC_A
+ NSV_LIMA_NR_A => TNSV%NSV_LIMA_NR_A
+ NSV_LIMA_CCN_FREE_A => TNSV%NSV_LIMA_CCN_FREE_A
+ NSV_LIMA_CCN_ACTI_A => TNSV%NSV_LIMA_CCN_ACTI_A
+ NSV_LIMA_SCAVMASS_A => TNSV%NSV_LIMA_SCAVMASS_A
+ NSV_LIMA_NI_A => TNSV%NSV_LIMA_NI_A
+ NSV_LIMA_NS_A => TNSV%NSV_LIMA_NS_A
+ NSV_LIMA_NG_A => TNSV%NSV_LIMA_NG_A
+ NSV_LIMA_NH_A => TNSV%NSV_LIMA_NH_A
+ NSV_LIMA_IFN_FREE_A => TNSV%NSV_LIMA_IFN_FREE_A
+ NSV_LIMA_IFN_NUCL_A => TNSV%NSV_LIMA_IFN_NUCL_A
+ NSV_LIMA_IMM_NUCL_A => TNSV%NSV_LIMA_IMM_NUCL_A
+ NSV_LIMA_HOM_HAZE_A => TNSV%NSV_LIMA_HOM_HAZE_A
+ NSV_LIMA_SPRO_A => TNSV%NSV_LIMA_SPRO_A
+#ifdef MNH_FOREFIRE
+ NSV_FF_A => TNSV%NSV_FF_A
+ NSV_FFBEG_A => TNSV%NSV_FFBEG_A
+ NSV_FFEND_A => TNSV%NSV_FFEND_A
+#endif
+ NSV_FIRE_A => TNSV%NSV_FIRE_A
+ NSV_FIREBEG_A => TNSV%NSV_FIREBEG_A
+ NSV_FIREEND_A => TNSV%NSV_FIREEND_A
+ NSV_SNW_A => TNSV%NSV_SNW_A
+ NSV_SNWBEG_A => TNSV%NSV_SNWBEG_A
+ NSV_SNWEND_A => TNSV%NSV_SNWEND_A
+
+ CSV_CHEM_LIST => TNSV%CSV_CHEM_LIST
+ CSV => TNSV%CSV
+ TSVLIST => TNSV%TSVLIST
+
+ NSV => TNSV%NSV
+ NSV_CHEM_LIST => TNSV%NSV_CHEM_LIST
+ NSV_USER => TNSV%NSV_USER
+ NSV_C2R2 => TNSV%NSV_C2R2
+ NSV_C2R2BEG => TNSV%NSV_C2R2BEG
+ NSV_C2R2END => TNSV%NSV_C2R2END
+ NSV_C1R3 => TNSV%NSV_C1R3
+ NSV_C1R3BEG => TNSV%NSV_C1R3BEG
+ NSV_C1R3END => TNSV%NSV_C1R3END
+ NSV_ELEC => TNSV%NSV_ELEC
+ NSV_ELECBEG => TNSV%NSV_ELECBEG
+ NSV_ELECEND => TNSV%NSV_ELECEND
+ NSV_CHEM => TNSV%NSV_CHEM
+ NSV_CHEMBEG => TNSV%NSV_CHEMBEG
+ NSV_CHEMEND => TNSV%NSV_CHEMEND
+ NSV_CHGS => TNSV%NSV_CHGS
+ NSV_CHGSBEG => TNSV%NSV_CHGSBEG
+ NSV_CHGSEND => TNSV%NSV_CHGSEND
+ NSV_CHAC => TNSV%NSV_CHAC
+ NSV_CHACBEG => TNSV%NSV_CHACBEG
+ NSV_CHACEND => TNSV%NSV_CHACEND
+ NSV_CHIC => TNSV%NSV_CHIC
+ NSV_CHICBEG => TNSV%NSV_CHICBEG
+ NSV_CHICEND => TNSV%NSV_CHICEND
+ NSV_LG => TNSV%NSV_LG
+ NSV_LGBEG => TNSV%NSV_LGBEG
+ NSV_LGEND => TNSV%NSV_LGEND
+ NSV_LNOX => TNSV%NSV_LNOX
+ NSV_LNOXBEG => TNSV%NSV_LNOXBEG
+ NSV_LNOXEND => TNSV%NSV_LNOXEND
+ NSV_DST => TNSV%NSV_DST
+ NSV_DSTBEG => TNSV%NSV_DSTBEG
+ NSV_DSTEND => TNSV%NSV_DSTEND
+ NSV_SLT => TNSV%NSV_SLT
+ NSV_SLTBEG => TNSV%NSV_SLTBEG
+ NSV_SLTEND => TNSV%NSV_SLTEND
+ NSV_AER => TNSV%NSV_AER
+ NSV_AERBEG => TNSV%NSV_AERBEG
+ NSV_AEREND => TNSV%NSV_AEREND
+ NSV_DSTDEP => TNSV%NSV_DSTDEP
+ NSV_DSTDEPBEG => TNSV%NSV_DSTDEPBEG
+ NSV_DSTDEPEND => TNSV%NSV_DSTDEPEND
+ NSV_AERDEP => TNSV%NSV_AERDEP
+ NSV_AERDEPBEG => TNSV%NSV_AERDEPBEG
+ NSV_AERDEPEND => TNSV%NSV_AERDEPEND
+ NSV_SLTDEP => TNSV%NSV_SLTDEP
+ NSV_SLTDEPBEG => TNSV%NSV_SLTDEPBEG
+ NSV_SLTDEPEND => TNSV%NSV_SLTDEPEND
+ NSV_PP => TNSV%NSV_PP
+ NSV_PPBEG => TNSV%NSV_PPBEG
+ NSV_PPEND => TNSV%NSV_PPEND
+ NSV_CS => TNSV%NSV_CS
+ NSV_CSBEG => TNSV%NSV_CSBEG
+ NSV_CSEND => TNSV%NSV_CSEND
+ NSV_LIMA => TNSV%NSV_LIMA
+ NSV_LIMA_BEG => TNSV%NSV_LIMA_BEG
+ NSV_LIMA_END => TNSV%NSV_LIMA_END
+ NSV_LIMA_NC => TNSV%NSV_LIMA_NC
+ NSV_LIMA_NR => TNSV%NSV_LIMA_NR
+ NSV_LIMA_CCN_FREE => TNSV%NSV_LIMA_CCN_FREE
+ NSV_LIMA_CCN_ACTI => TNSV%NSV_LIMA_CCN_ACTI
+ NSV_LIMA_SCAVMASS => TNSV%NSV_LIMA_SCAVMASS
+ NSV_LIMA_NI => TNSV%NSV_LIMA_NI
+ NSV_LIMA_NS => TNSV%NSV_LIMA_NS
+ NSV_LIMA_NG => TNSV%NSV_LIMA_NG
+ NSV_LIMA_NH => TNSV%NSV_LIMA_NH
+ NSV_LIMA_IFN_FREE => TNSV%NSV_LIMA_IFN_FREE
+ NSV_LIMA_IFN_NUCL => TNSV%NSV_LIMA_IFN_NUCL
+ NSV_LIMA_IMM_NUCL => TNSV%NSV_LIMA_IMM_NUCL
+ NSV_LIMA_HOM_HAZE => TNSV%NSV_LIMA_HOM_HAZE
+ NSV_LIMA_SPRO => TNSV%NSV_LIMA_SPRO
+#ifdef MNH_FOREFIRE
+ NSV_FF => TNSV%NSV_FF
+ NSV_FFBEG => TNSV%NSV_FFBEG
+ NSV_FFEND => TNSV%NSV_FFEND
+#endif
+ NSV_FIRE => TNSV%NSV_FIRE
+ NSV_FIREBEG => TNSV%NSV_FIREBEG
+ NSV_FIREEND => TNSV%NSV_FIREEND
+ NSV_SNW => TNSV%NSV_SNW
+ NSV_SNWBEG => TNSV%NSV_SNWBEG
+ NSV_SNWEND => TNSV%NSV_SNWEND
+ NSV_CO2 => TNSV%NSV_CO2
+ENDIF
+!
+END SUBROUTINE NSV_ASSOCIATE
+!
+END MODULE MODD_NSV
diff --git a/src/PHYEX/aux/modd_phyex.f90 b/src/PHYEX/aux/modd_phyex.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6b8ddb985f6e7736b12ae3c805788d684e4c377a
--- /dev/null
+++ b/src/PHYEX/aux/modd_phyex.f90
@@ -0,0 +1,61 @@
+MODULE MODD_PHYEX
+!
+!> @file
+!! MODD_PHYEX - decalration of the PHYEX structure gathering all the parametrisation strucutres of PHYEX
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this declarative module is to declare the
+!! the PHYEX type that allows to gather all the different structures used
+!! by the paramteriation available in PHYEX
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Mar 2023
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_CLOUDPAR_N, ONLY: CLOUDPAR_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_NEB_n, ONLY: NEB_t
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_t
+USE MODD_PARAM_LIMA_WARM, ONLY: PARAM_LIMA_WARM_t
+USE MODD_PARAM_LIMA_COLD, ONLY: PARAM_LIMA_COLD_t
+USE MODD_PARAM_LIMA_MIXED, ONLY: PARAM_LIMA_MIXED_t
+USE MODD_NSV, ONLY: NSV_t
+USE MODD_MISC, ONLY: MISC_t
+!
+IMPLICIT NONE
+!
+TYPE PHYEX_t
+ ! Structures for the different parametrisations
+ TYPE(CST_t) :: CST !< Physical constants
+ TYPE(PARAM_ICE_t) :: PARAM_ICEN !< Control parameters for microphysics
+ TYPE(RAIN_ICE_DESCR_t) :: RAIN_ICE_DESCRN !< Microphysical descriptive constants
+ TYPE(RAIN_ICE_PARAM_t) :: RAIN_ICE_PARAMN !< Microphysical factors
+ TYPE(CLOUDPAR_t) :: CLOUDPARN !< Some other microphysical values
+ TYPE(PARAM_MFSHALL_t) :: PARAM_MFSHALLN !< Mass flux scheme free parameters
+ TYPE(CSTURB_t) :: CSTURB !< Turbulence scheme constants
+ TYPE(TURB_t) :: TURBN !< Turbulence scheme constants set by namelist
+ TYPE(NEB_t) :: NEBN !< Cloud scheme constants
+ TYPE(PARAM_LIMA_t) :: PARAM_LIMA !< Control parameters for LIMA microphysics
+ TYPE(PARAM_LIMA_WARM_t):: PARAM_LIMA_WARM !< Microphysical factors for LIMA (warm processes)
+ TYPE(PARAM_LIMA_COLD_t):: PARAM_LIMA_COLD !< Microphysical factors for LIMA (cold processes)
+ TYPE(PARAM_LIMA_MIXED_t):: PARAM_LIMA_MIXED !< Microphysical factors for LIMA (mixed processes)
+ TYPE(NSV_t) :: TNSV !< NSV indexes
+ !
+ ! Supplementary strucuture to hold model specific values
+ TYPE(MISC_t) :: MISC !< Model specific values
+END TYPE PHYEX_t
+!
+END MODULE MODD_PHYEX
diff --git a/src/PHYEX/aux/mode_argslist_ll_phy.f90 b/src/PHYEX/aux/mode_argslist_ll_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ed9b07274ca4b1ff58daa7274324c9b949fd4fdc
--- /dev/null
+++ b/src/PHYEX/aux/mode_argslist_ll_phy.f90
@@ -0,0 +1,60 @@
+!MNH_LIC Copyright 2023-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+!! #######################
+MODULE MODE_ARGSLIST_ll_PHY
+!
+ USE MODE_ll
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+ CONTAINS
+!
+ SUBROUTINE ADD3DFIELD_ll_PHY(D, TPLIST, PFIELD, HNAME)
+!! ###############################################
+!
+!!**** *ADD3DFIELD_ll_PHY* -
+!
+!! Purpose
+!! -------
+! This routine is used as an interface to ADD3DFIELD_ll for
+! unpacking horizontal dimensions
+!
+!! Reference
+!! ---------
+!
+! see PHYEX documentation
+!
+!! Implicit Arguments
+!! ------------------
+!
+! Module MODD_ARGSLIST :
+! LIST_ll : list of fields
+! DIMPHYEX_t: PHYEX dimensions
+!
+!! Author
+!! ------
+!
+! Q.Rodier
+!
+!! Modifications
+!! -------------
+! Original August, 3, 2023
+!
+!-------------------------------------------------------------------------------
+!
+ IMPLICIT NONE
+!
+ TYPE(DIMPHYEX_t), INTENT(IN) :: D
+ TYPE(LIST_ll), POINTER :: TPLIST ! list of fields
+ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), TARGET :: PFIELD ! field which is unpaked here
+! of fields
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the field to be added
+
+ CALL ADD3DFIELD_ll(TPLIST, PFIELD, HNAME)
+
+ END SUBROUTINE ADD3DFIELD_ll_PHY
+END MODULE MODE_ARGSLIST_ll_PHY
diff --git a/src/PHYEX/aux/mode_check_nam_val.f90 b/src/PHYEX/aux/mode_check_nam_val.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9066b32515d2861d29d7bc4ab9f78a08b115cbab
--- /dev/null
+++ b/src/PHYEX/aux/mode_check_nam_val.f90
@@ -0,0 +1,298 @@
+MODULE MODE_CHECK_NAM_VAL
+!> @file
+!! *MODE_CHECK_NAM_VAL" - Module containing the routines to control the different kind of variables
+!! read from namelist
+!!
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE CHECK_NAM_VAL_CHAR(KLUOUT, HNAME, HVAR, HVALUE1, HVALUE2, HVALUE3, HVALUE4, HVALUE5, &
+ &HVALUE6, HVALUE7, HVALUE8, HVALUE9, HVALUE10, HVALUE11, HVALUE12)
+!!
+!! *CHECK_NAM_VAL* - Control of CHARACTER variables
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to control the validity of CHARACTER variables
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! - Original Feb 2023, from Méso-NH code
+!!
+!-------------------------------------------------------------------------------
+!
+!** DECLARATIONS
+!
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KLUOUT !< output listing logical unit
+CHARACTER(LEN=*), INTENT(IN) :: HNAME !< name of the variable to test
+CHARACTER(LEN=*), INTENT(IN) :: HVAR !< variable to test
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE1 !< Authorised value 1
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE2 !< Authorised value 2
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE3 !< Authorised value 3
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE4 !< Authorised value 4
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE5 !< Authorised value 5
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE6 !< Authorised value 6
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE7 !< Authorised value 7
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE8 !< Authorised value 8
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE9 !< Authorised value 9
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE10 !< Authorised value 10
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE11 !< Authorised value 11
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HVALUE12 !< Authorised value 12
+!
+!** CONTROLS
+!
+IF ( PRESENT (HVALUE1) ) THEN
+ IF ( HVAR==HVALUE1 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE2) ) THEN
+ IF ( HVAR==HVALUE2 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE3) ) THEN
+ IF ( HVAR==HVALUE3 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE4) ) THEN
+ IF ( HVAR==HVALUE4 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE5) ) THEN
+ IF ( HVAR==HVALUE5 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE6) ) THEN
+ IF ( HVAR==HVALUE6 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE7) ) THEN
+ IF ( HVAR==HVALUE7 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE8) ) THEN
+ IF ( HVAR==HVALUE8 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE9) ) THEN
+ IF ( HVAR==HVALUE9 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE10) ) THEN
+ IF ( HVAR==HVALUE10 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE11) ) THEN
+ IF ( HVAR==HVALUE11 ) RETURN
+END IF
+!
+IF ( PRESENT (HVALUE12) ) THEN
+ IF ( HVAR==HVALUE12 ) RETURN
+END IF
+!
+!** PRINTS AND ABORT
+!
+WRITE (KLUOUT,*) ' '
+WRITE (KLUOUT,*) 'FATAL ERROR:'
+WRITE (KLUOUT,*) '-----------'
+WRITE (KLUOUT,*) ' '
+WRITE (KLUOUT,*) 'Value "', HVAR, '" is not allowed for variable ', HNAME
+WRITE (KLUOUT,*) ' '
+WRITE (KLUOUT,*) 'Possible values are:'
+IF ( PRESENT (HVALUE1) ) WRITE (KLUOUT,*) '"',HVALUE1,'"'
+IF ( PRESENT (HVALUE2) ) WRITE (KLUOUT,*) '"',HVALUE2,'"'
+IF ( PRESENT (HVALUE3) ) WRITE (KLUOUT,*) '"',HVALUE3,'"'
+IF ( PRESENT (HVALUE4) ) WRITE (KLUOUT,*) '"',HVALUE4,'"'
+IF ( PRESENT (HVALUE5) ) WRITE (KLUOUT,*) '"',HVALUE5,'"'
+IF ( PRESENT (HVALUE6) ) WRITE (KLUOUT,*) '"',HVALUE6,'"'
+IF ( PRESENT (HVALUE7) ) WRITE (KLUOUT,*) '"',HVALUE7,'"'
+IF ( PRESENT (HVALUE8) ) WRITE (KLUOUT,*) '"',HVALUE8,'"'
+IF ( PRESENT (HVALUE9) ) WRITE (KLUOUT,*) '"',HVALUE9,'"'
+IF ( PRESENT (HVALUE10) ) WRITE (KLUOUT,*) '"',HVALUE10,'"'
+IF ( PRESENT (HVALUE11) ) WRITE (KLUOUT,*) '"',HVALUE11,'"'
+IF ( PRESENT (HVALUE12) ) WRITE (KLUOUT,*) '"',HVALUE12,'"'
+FLUSH(UNIT=KLUOUT)
+!
+CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'CHECK_NAM_VAL_CHAR', TRIM(HVAR) // ' is not allowed for variable ' // TRIM(HNAME))
+!
+END SUBROUTINE CHECK_NAM_VAL_CHAR
+
+SUBROUTINE CHECK_NAM_VAL_REAL(KLUOUT, HNAME, PVALUE, CDSIGN1, PVAL1, CDSIGN2, PVAL2)
+!!
+!! *CHECK_NAM_VAL* - Control of CHARACTER variables
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to control the validity of REAL variables
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! - Original Feb 2023
+!!
+!-------------------------------------------------------------------------------
+!
+!** DECLARATIONS
+!
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KLUOUT !< output listing logical unit
+CHARACTER(LEN=*), INTENT(IN) :: HNAME !< name of the variable to test
+REAL, INTENT(IN) :: PVALUE !< variable to test
+CHARACTER(LEN=*), INTENT(IN) :: CDSIGN1 !< sign for the first verification
+REAL, INTENT(IN) :: PVAL1 !< bound for the first verification
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: CDSIGN2 !< sign for the second verification
+REAL, INTENT(IN), OPTIONAL :: PVAL2 !< bound for the second verification
+
+INTEGER :: II, INUM
+REAL :: ZVAL
+CHARACTER(LEN=2) :: CSIGN
+LOGICAL :: LOK
+CHARACTER(LEN=10) :: CHAR_VAL
+!
+!** CONTROLS
+!
+LOK=.TRUE.
+INUM=1
+IF(PRESENT(CDSIGN2)) INUM=2
+DO II=1, INUM
+ IF(II==1) THEN
+ ZVAL=PVAL1
+ CSIGN=CDSIGN1(1:MIN(2, LEN(CDSIGN1)))
+ ELSE
+ ZVAL=PVAL2
+ CSIGN=CDSIGN2(1:MIN(2, LEN(CDSIGN2)))
+ ENDIF
+ SELECT CASE (CSIGN)
+ CASE ('<')
+ LOK=LOK .AND. PVALUE < ZVAL
+ CASE ('<=')
+ LOK=LOK .AND. PVALUE <= ZVAL
+ CASE ('>')
+ LOK=LOK .AND. PVALUE > ZVAL
+ CASE ('>=')
+ LOK=LOK .AND. PVALUE >= ZVAL
+ CASE ('==')
+ LOK=LOK .AND. PVALUE == ZVAL
+ CASE DEFAULT
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'CHECK_NAM_VAL_REAL', TRIM(CSIGN) // ' is not allowed as comparator')
+ END SELECT
+ENDDO
+!
+!** PRINTS AND ABORT
+!
+IF(.NOT. LOK) THEN
+ WRITE(KLUOUT,*) ' '
+ WRITE(KLUOUT,*) 'FATAL ERROR:'
+ WRITE(KLUOUT,*) '-----------'
+ WRITE(KLUOUT,*) ' '
+ WRITE(KLUOUT,*) 'Value "', PVALUE, '" is not allowed for variable ', HNAME
+ WRITE(KLUOUT,*) ' '
+ WRITE(KLUOUT,*) 'Possible values are such as:'
+ WRITE(KLUOUT,*) CDSIGN1, PVAL1
+ IF (PRESENT(CDSIGN2)) WRITE(KLUOUT, *) CDSIGN2, PVAL2
+ FLUSH(UNIT=KLUOUT)
+ !
+ WRITE(UNIT=CHAR_VAL, FMT=*) PVALUE
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'CHECK_NAM_VAL_REAL', TRIM(CHAR_VAL) // ' is not allowed for variable ' // TRIM(HNAME))
+ENDIF
+!
+END SUBROUTINE CHECK_NAM_VAL_REAL
+
+SUBROUTINE CHECK_NAM_VAL_INT(KLUOUT, HNAME, KVALUE, CDSIGN1, KVAL1, CDSIGN2, KVAL2)
+!!
+!! *CHECK_NAM_VAL* - Control of CHARACTER variables
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to control the validity of REAL variables
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! - Original Feb 2023
+!!
+!-------------------------------------------------------------------------------
+!
+!** DECLARATIONS
+!
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KLUOUT !< output listing logical unit
+CHARACTER(LEN=*), INTENT(IN) :: HNAME !< name of the variable to test
+INTEGER, INTENT(IN) :: KVALUE !< variable to test
+CHARACTER(LEN=*), INTENT(IN) :: CDSIGN1 !< sign for the first verification
+INTEGER, INTENT(IN) :: KVAL1 !< bound for the first verification
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: CDSIGN2 !< sign for the second verification
+INTEGER, INTENT(IN), OPTIONAL :: KVAL2 !< bound for the second verification
+
+INTEGER :: II, INUM
+INTEGER :: IVAL
+CHARACTER(LEN=2) :: CSIGN
+LOGICAL :: LOK
+CHARACTER(LEN=10) :: CHAR_VAL
+!
+!** CONTROLS
+!
+LOK=.TRUE.
+INUM=1
+IF(PRESENT(CDSIGN2)) INUM=2
+DO II=1, INUM
+ IF(II==1) THEN
+ IVAL=KVAL1
+ CSIGN=CDSIGN1(1:MIN(2, LEN(CDSIGN1)))
+ ELSE
+ IVAL=KVAL2
+ CSIGN=CDSIGN2(1:MIN(2, LEN(CDSIGN2)))
+ ENDIF
+ SELECT CASE (CSIGN)
+ CASE ('<')
+ LOK=LOK .AND. KVALUE < IVAL
+ CASE ('<=')
+ LOK=LOK .AND. KVALUE <= IVAL
+ CASE ('>')
+ LOK=LOK .AND. KVALUE > IVAL
+ CASE ('>=')
+ LOK=LOK .AND. KVALUE >= IVAL
+ CASE ('==')
+ LOK=LOK .AND. KVALUE == IVAL
+ CASE DEFAULT
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'CHECK_NAM_VAL_REAL', TRIM(CSIGN) // ' is not allowed as comparator')
+ END SELECT
+ENDDO
+!
+!** PRINTS AND ABORT
+!
+IF(.NOT. LOK) THEN
+ WRITE(KLUOUT,*) ' '
+ WRITE(KLUOUT,*) 'FATAL ERROR:'
+ WRITE(KLUOUT,*) '-----------'
+ WRITE(KLUOUT,*) ' '
+ WRITE(KLUOUT,*) 'Value "', KVALUE, '" is not allowed for variable ', HNAME
+ WRITE(KLUOUT,*) ' '
+ WRITE(KLUOUT,*) 'Possible values are such as:'
+ WRITE(KLUOUT,*) CDSIGN1, KVAL1
+ IF (PRESENT(CDSIGN2)) WRITE(KLUOUT, *) CDSIGN2, KVAL2
+ FLUSH(UNIT=KLUOUT)
+ !
+ WRITE(UNIT=CHAR_VAL, FMT=*) KVALUE
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'CHECK_NAM_VAL_REAL', TRIM(CHAR_VAL) // ' is not allowed for variable ' // TRIM(HNAME))
+ENDIF
+!
+END SUBROUTINE CHECK_NAM_VAL_INT
+!
+END MODULE MODE_CHECK_NAM_VAL
diff --git a/src/PHYEX/aux/mode_gradient_m_phy.f90 b/src/PHYEX/aux/mode_gradient_m_phy.f90
index de27a253baa2139a0f9b9a6aba94d87b6e71b390..e4df65f930da03f27b8d6f9bf524d49349f0a865 100644
--- a/src/PHYEX/aux/mode_gradient_m_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_m_phy.f90
@@ -106,8 +106,7 @@ PGZ_M_W(IIB:IIE,IJB:IJE,IKA)= PGZ_M_W(IIB:IIE,IJB:IJE,IKU) ! -999.
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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #######################################################
!
!!**** *GX_M_M* - Cartesian Gradient operator:
@@ -195,7 +194,7 @@ INTEGER :: JI,JJ,JK
!* 1. DEFINITION of GX_M_M
! --------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GX_M_M',0,ZHOOK_HANDLE)
!
IIE=D%NIEC
@@ -232,8 +231,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #######################################################
!
!!**** *GY_M_M* - Cartesian Gradient operator:
@@ -312,7 +310,7 @@ INTEGER :: JI,JJ,JK
!
!* 0.2 declaration of local variables
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GY_M_M',0,ZHOOK_HANDLE)
!
IIE=D%NIEC
@@ -356,8 +354,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ##################################################
!
!!**** *GX_M_U * - Compute the gradient along x for a variable localized at
@@ -439,7 +436,7 @@ REAL, DIMENSION(D%NIT*D%NJT*D%NKT) :: ZGX_M_U
REAL, DIMENSION(D%NIT,D%NJT,D%NKT):: ZY, ZDXX
INTEGER IIU,IKU,JI,JK,IKL, IKA
!
-INTEGER :: JJK,IJU
+INTEGER :: IJU
INTEGER :: JIJK,JIJKOR,JIJKEND
INTEGER :: JI_1JK, JIJK_1, JI_1JK_1, JIJKP1, JI_1JKP1
!
@@ -449,7 +446,7 @@ INTEGER :: JI_1JK, JIJK_1, JI_1JK_1, JIJKP1, JI_1JKP1
!* 1. COMPUTE THE GRADIENT ALONG X
! -----------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GX_M_U',0,ZHOOK_HANDLE)
IIU=D%NIT
IJU=D%NJT
@@ -506,8 +503,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ##################################################
!
!!**** *GY_M_V * - Compute the gradient along y for a variable localized at
@@ -595,7 +591,7 @@ INTEGER IJU,IKU,JI,JJ,JK,IKL, IKA
!* 1. COMPUTE THE GRADIENT ALONG Y
! ----------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GY_M_V',0,ZHOOK_HANDLE)
IJU=D%NJT
IKU=D%NKT
diff --git a/src/PHYEX/aux/mode_gradient_u_phy.f90 b/src/PHYEX/aux/mode_gradient_u_phy.f90
index ded89cd72bb39d1127422fec064b8b9efda576a9..f2c85adc9f846dbdd2a2aca207f64450372fdd60 100644
--- a/src/PHYEX/aux/mode_gradient_u_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_u_phy.f90
@@ -100,8 +100,7 @@ PGZ_U_UW(IIB:IIE,IJB:IJE,:)= PA_WORK(IIB:IIE,IJB:IJE,:) &
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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #######################################################
!
!!**** *GX_U_M* - Cartesian Gradient operator:
@@ -174,7 +173,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDXX ! metric coefficient
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), INTENT(OUT) :: PGX_U_M ! result mass point
!
REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4
INTEGER :: IIB,IJB,IIE,IJE,IKT
@@ -189,7 +188,7 @@ INTEGER :: JI,JJ,JK
!* 1. DEFINITION of GX_U_M
! --------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GX_U_M',0,ZHOOK_HANDLE)
!
IIE=D%NIEC
diff --git a/src/PHYEX/aux/mode_gradient_v_phy.f90 b/src/PHYEX/aux/mode_gradient_v_phy.f90
index 37832eae6c5e8da6d0f69f71fa3261e868f53e4f..7f5c35d70656109979206b5e3df4c9c50739a7c9 100644
--- a/src/PHYEX/aux/mode_gradient_v_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_v_phy.f90
@@ -97,8 +97,7 @@ PGZ_V_VW(IIB:IIE,IJB:IJE,:)= PA_WORK(IIB:IIE,IJB:IJE,:) &
!
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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #######################################################
!
!!**** *GY_V_M* - Cartesian Gradient operator:
@@ -170,7 +169,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDYY ! metric coefficient
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), INTENT(OUT) :: PGY_V_M ! result mass point
!
REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4
INTEGER :: IIB,IJB,IIE,IJE,IKT
@@ -178,7 +177,7 @@ INTEGER :: JI,JJ,JK
!
!* 0.2 declaration of local variables
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GY_V_M',0,ZHOOK_HANDLE)
!
IIE=D%NIEC
diff --git a/src/PHYEX/aux/mode_gradient_w_phy.f90 b/src/PHYEX/aux/mode_gradient_w_phy.f90
index 924491117970a70303cf00b0b4542b488c4ddeba..dcce7fcf58ce6e99276009981e9d0ce841f09097 100644
--- a/src/PHYEX/aux/mode_gradient_w_phy.f90
+++ b/src/PHYEX/aux/mode_gradient_w_phy.f90
@@ -2,8 +2,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #########################################################
!
!!**** *GX_W_UW* - Cartesian Gradient operator:
@@ -50,7 +49,7 @@ CONTAINS
!* 0. DECLARATIONS
!
!
-USE MODE_SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY, MXM_PHY, DXM_PHY, MZM_PHY, DZM_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZF_PHY, MXM_PHY, DXM_PHY, MZM_PHY, DZM_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -80,7 +79,7 @@ INTEGER :: JI,JJ,JK
!* 1. DEFINITION of GX_W_UW
! ---------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GX_W_UW',0,ZHOOK_HANDLE)
IIE=D%NIEC
IIB=D%NIBC
@@ -114,8 +113,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #########################################################
!
!!**** *GY_W_VW* - Cartesian Gradient operator:
@@ -162,7 +160,7 @@ END SUBROUTINE GX_W_UW_PHY
!* 0. DECLARATIONS
!
!
-USE MODE_SHUMAN_PHY, ONLY: MZF_PHY, DZF_PHY, MYM_PHY, DYM_PHY, MZM_PHY, DZM_PHY
+USE MODE_SHUMAN_PHY, ONLY: MZF_PHY, MYM_PHY, DYM_PHY, MZM_PHY, DZM_PHY
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -191,7 +189,7 @@ INTEGER :: JI,JJ,JK
!* 1. DEFINITION of GY_W_VW
! ---------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: 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)) &
@@ -233,8 +231,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #######################################################
!
!!**** *GZ_W_M* - Cartesian Gradient operator:
@@ -307,7 +304,7 @@ INTEGER :: JI,JJ,JK
!* 1. DEFINITION of GZ_W_M
! --------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GZ_W_M',0,ZHOOK_HANDLE)
IIE=D%NIEC
IIB=D%NIBC
diff --git a/src/PHYEX/aux/mode_ini_cst.f90 b/src/PHYEX/aux/mode_ini_cst.f90
new file mode 100644
index 0000000000000000000000000000000000000000..89eef4a6023da4a4be1ea9a11f9d65aff426d3e6
--- /dev/null
+++ b/src/PHYEX/aux/mode_ini_cst.f90
@@ -0,0 +1,200 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ##################
+MODULE MODE_INI_CST
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE INI_CST
+! ##################
+!
+!!**** *INI_CST * - routine to initialize the module MODD_CST
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the physical constants
+! stored in module MODD_CST.
+!
+!
+!!** METHOD
+!! ------
+!! The physical constants are set to their numerical values
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (module MODD_CST, routine INI_CST)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/05/94
+!! J. Stein 02/01/95 add the volumic mass of liquid water
+!! J.-P. Pinty 13/12/95 add the water vapor pressure over solid ice
+!! J. Stein 29/06/97 add XTH00
+!! 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
+!! 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
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PRECISION, ONLY: MNHREAL, MNHREAL32, MNHREAL64
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
+!
+IMPLICIT NONE
+!
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('INI_CST',0,ZHOOK_HANDLE)
+CALL CST_ASSOCIATE()
+!
+!* 1. FUNDAMENTAL CONSTANTS
+! ---------------------
+!
+XPI = 2.*ASIN(1.)
+XKARMAN = 0.4
+XLIGHTSPEED = 299792458.
+XPLANCK = 6.6260755E-34
+XBOLTZ = 1.380658E-23
+XAVOGADRO = 6.0221367E+23
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ASTRONOMICAL CONSTANTS
+! ----------------------
+!
+XDAY = 86400.
+XSIYEA = 365.25*XDAY*2.*XPI/ 6.283076
+XSIDAY = XDAY/(1.+XDAY/XSIYEA)
+XOMEGA = 2.*XPI/XSIDAY
+NDAYSEC = 24*3600 ! Number of seconds in a day
+!
+!-------------------------------------------------------------------------------!
+!
+!
+!* 3. TERRESTRIAL GEOIDE CONSTANTS
+! ----------------------------
+!
+XRADIUS = 6371229.
+XG = 9.80665
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. REFERENCE PRESSURE
+! -------------------
+!
+! Ocean model cst same as in 1D/CMO SURFEX
+! values used in ini_cst to overwrite XP00 and XTH00
+XRH00OCEAN =1024.
+XTH00OCEAN = 286.65
+XSA00OCEAN= 32.6
+XP00OCEAN = 201.E5
+!Atmospheric model
+XP00 = 1.E5
+XTH00 = 300.
+!-------------------------------------------------------------------------------
+!
+!* 5. RADIATION CONSTANTS
+! -------------------
+!
+! 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.
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. THERMODYNAMIC CONSTANTS
+! -----------------------
+!
+XMD = 28.9644E-3
+XMV = 18.0153E-3
+XRD = XAVOGADRO * XBOLTZ / XMD
+XRV = XAVOGADRO * XBOLTZ / XMV
+XEPSILO= XMV/XMD
+XCPD = 7.* XRD /2.
+XCPV = 4.* XRV
+XRHOLW = 1000.
+XRHOLI = 900.
+XCONDI = 2.22
+XCL = 4.218E+3
+XCI = 2.106E+3
+XTT = 273.16
+XLVTT = 2.5008E+6
+XLSTT = 2.8345E+6
+XLMTT = XLSTT - XLVTT
+XESTT = 611.14
+XGAMW = (XCL - XCPV) / XRV
+XBETAW = (XLVTT/XRV) + (XGAMW * XTT)
+XALPW = LOG(XESTT) + (XBETAW /XTT) + (XGAMW *LOG(XTT))
+XGAMI = (XCI - XCPV) / XRV
+XBETAI = (XLSTT/XRV) + (XGAMI * XTT)
+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)
+XBETAOC= 7.7475E-4
+!
+!* 7. PRECOMPUTED CONSTANTS
+! ---------------------
+!
+RDSRV = XRD/XRV
+RDSCPD = XRD/XCPD
+RINVXP00 = 1./XP00
+!
+!* 8. 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 (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
+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
+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
+
+END MODULE MODE_INI_CST
diff --git a/src/PHYEX/aux/mode_posnam_phy.f90 b/src/PHYEX/aux/mode_posnam_phy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..692ade32693b100f3b984d76bf0d0acc487cb84d
--- /dev/null
+++ b/src/PHYEX/aux/mode_posnam_phy.f90
@@ -0,0 +1,26 @@
+MODULE MODE_POSNAM_PHY
+IMPLICIT NONE
+PRIVATE
+PUBLIC :: POSNAM_PHY
+CONTAINS
+SUBROUTINE POSNAM_PHY(KULNAM, CDNAML, LDNEEDNAM, LDFOUND, KLUOUT)
+
+!Wrapper to call the Meso-NH version of posnam
+
+USE MODE_MSG, ONLY: NVERB_FATAL, PRINT_MSG
+USE MODE_POS, ONLY: POSNAM
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KULNAM !< Logical unit to access the namelist
+CHARACTER(LEN=*), INTENT(IN) :: CDNAML !< Namelist name
+LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
+LOGICAL, INTENT(OUT) :: LDFOUND !< True if namelist has been found
+INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for output
+
+CALL POSNAM(KULNAM, CDNAML, LDFOUND, KLUOUT)
+IF(LDNEEDNAM .AND. .NOT. LDFOUND) CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'POSNAM_PHY', 'CANNOT LOCATE '//CDNAML)
+
+END SUBROUTINE POSNAM_PHY
+
+END MODULE MODE_POSNAM_PHY
diff --git a/src/PHYEX/aux/modi_gamma.f90 b/src/PHYEX/aux/modi_gamma.f90
index 4f10dab67e1a8d1d68ade60fa71f6f5cb19f9767..56868045c848d74b01174f04df2a2258df660264 100644
--- a/src/PHYEX/aux/modi_gamma.f90
+++ b/src/PHYEX/aux/modi_gamma.f90
@@ -6,14 +6,17 @@
MODULE MODI_GAMMA
! #################
!
+IMPLICIT NONE
INTERFACE GAMMA
!
FUNCTION GAMMA_X0D(PX) RESULT(PGAMMA)
+IMPLICIT NONE
REAL, INTENT(IN) :: PX
REAL :: PGAMMA
END FUNCTION GAMMA_X0D
!
FUNCTION GAMMA_X1D(PX) RESULT(PGAMMA)
+IMPLICIT NONE
REAL, DIMENSION(:), INTENT(IN) :: PX
REAL, DIMENSION(SIZE(PX)) :: PGAMMA
END FUNCTION GAMMA_X1D
diff --git a/src/PHYEX/aux/modi_gamma_inc.f90 b/src/PHYEX/aux/modi_gamma_inc.f90
index 2b54c25acdd9fa4d45c450acf758e1bce0f0f0aa..e88526e5bf8b097493d3ae391751600f2e93ccf4 100644
--- a/src/PHYEX/aux/modi_gamma_inc.f90
+++ b/src/PHYEX/aux/modi_gamma_inc.f90
@@ -6,9 +6,11 @@
MODULE MODI_GAMMA_INC
!####################
!
+IMPLICIT NONE
INTERFACE
!
FUNCTION GAMMA_INC(PA,PX) RESULT(PGAMMA_INC)
+IMPLICIT NONE
REAL, INTENT(IN) :: PA
REAL, INTENT(IN) :: PX
REAL :: PGAMMA_INC
diff --git a/src/PHYEX/aux/modi_general_gamma.f90 b/src/PHYEX/aux/modi_general_gamma.f90
index 7868333a612a9b5866f88c6d856d071ae1eb1773..041c7f0b797226b2f7346b9dbe33c35fff56401d 100644
--- a/src/PHYEX/aux/modi_general_gamma.f90
+++ b/src/PHYEX/aux/modi_general_gamma.f90
@@ -6,9 +6,11 @@
MODULE MODI_GENERAL_GAMMA
!########################
!
+IMPLICIT NONE
INTERFACE
!
FUNCTION GENERAL_GAMMA(PALPHA,PNU,PLBDA,PX) RESULT(PGENERAL_GAMMA)
+IMPLICIT NONE
REAL, INTENT(IN) :: PALPHA
REAL, INTENT(IN) :: PNU
REAL, INTENT(IN) :: PLBDA
diff --git a/src/PHYEX/aux/modi_ini_cst.f90 b/src/PHYEX/aux/modi_ini_cst.f90
deleted file mode 100644
index 08f587f77df0ce8b2b6db1b487af365ea20cf9d5..0000000000000000000000000000000000000000
--- a/src/PHYEX/aux/modi_ini_cst.f90
+++ /dev/null
@@ -1,12 +0,0 @@
-! ######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/modi_ini_phyex.f90 b/src/PHYEX/aux/modi_ini_phyex.f90
new file mode 100644
index 0000000000000000000000000000000000000000..70e2c41ff8bb9941c8439ec64b1d7768d7ad7e4c
--- /dev/null
+++ b/src/PHYEX/aux/modi_ini_phyex.f90
@@ -0,0 +1,54 @@
+MODULE MODI_INI_PHYEX
+IMPLICIT NONE
+INTERFACE
+SUBROUTINE INI_PHYEX(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, KFROM, KTO, &
+ &PTSTEP, PDZMIN, &
+ &CMICRO, CSCONV, CTURB, &
+ &LDCHANGEMODEL, LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT, LDINIT, &
+ &PHYEX_IN, PHYEX_OUT)
+!
+USE MODD_PHYEX, ONLY: PHYEX_t
+USE MODD_CST, ONLY: CST_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_CLOUDPAR_N, ONLY: CLOUDPAR_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_NEB_N, ONLY: NEB_t
+!
+IMPLICIT NONE
+
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Current program
+INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
+INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
+INTEGER, INTENT(IN) :: KFROM !< Old model number
+INTEGER, INTENT(IN) :: KTO !< New model number
+REAL, INTENT(IN) :: PTSTEP !< Timestep
+REAL, INTENT(IN) :: PDZMIN !< Minimum thickness
+CHARACTER(LEN=4), INTENT(IN) :: CMICRO !< Microphysical scheme to use
+CHARACTER(LEN=4), INTENT(IN) :: CTURB !< Turbulence scheme to use
+CHARACTER(LEN=4), INTENT(IN) :: CSCONV !< Shallow convection scheme to use
+LOGICAL, OPTIONAL, INTENT(IN) :: LDCHANGEMODEL!< Must we change the active model
+LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDREADNAM !< Must we read the namelist (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDCHECK !< Must we perform some checks on values (defaults to .TRUE.)
+INTEGER, OPTIONAL, INTENT(IN) :: KPRINT !< Print level (defaults to 0): 0 for no print, 1 to safely print namelist,
+ !! 2 to print informative messages
+LOGICAL, OPTIONAL, INTENT(IN) :: LDINIT !< Must we call the init routines
+TYPE(PHYEX_t), OPTIONAL, INTENT(IN) :: PHYEX_IN !< Structure for constants (IN)
+TYPE(PHYEX_t), OPTIONAL, INTENT(INOUT) :: PHYEX_OUT !< Structure for constants (OUT)
+
+!IMPORTANT NOTE on PHYEX_OUT arguments.
+!Logically this argument should be declared with INTENT(OUT) but in this case ifort (at least) breaks the
+!execution when the same structure is given for the PHYEX_IN and the PHYEX_OUT argument.
+!When INITENT(INOUT) is used, execution is OK on ifort.
+
+
+
+
+END SUBROUTINE INI_PHYEX
+END INTERFACE
+END MODULE MODI_INI_PHYEX
diff --git a/src/PHYEX/aux/shuman.f90 b/src/PHYEX/aux/shuman.f90
new file mode 100644
index 0000000000000000000000000000000000000000..96aa554f66cc1d0cc27b3fbb8474f19404e39db8
--- /dev/null
+++ b/src/PHYEX/aux/shuman.f90
@@ -0,0 +1,1304 @@
+!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$
+!-----------------------------------------------------------------
+! ##################
+ MODULE MODI_SHUMAN
+! ##################
+!
+IMPLICIT NONE
+INTERFACE
+!
+FUNCTION DXF(PA) RESULT(PDXF)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXF ! result at mass
+ ! localization
+END FUNCTION DXF
+!
+FUNCTION DXM(PA) RESULT(PDXM)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXM ! result at flux
+ ! side
+END FUNCTION DXM
+!
+FUNCTION DYF(PA) RESULT(PDYF)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYF ! result at mass
+ ! localization
+END FUNCTION DYF
+!
+FUNCTION DYM(PA) RESULT(PDYM)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux
+ ! side
+END FUNCTION DYM
+!
+FUNCTION DZF(PA, KKA, KKU, KL) RESULT(PDZF)
+IMPLICIT NONE
+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)
+END FUNCTION DZF
+!
+FUNCTION DZM(PA, KKA, KKU, KL) RESULT(PDZM)
+IMPLICIT NONE
+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)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXF ! result at mass
+ ! localization
+END FUNCTION MXF
+!
+FUNCTION MXM(PA) RESULT(PMXM)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXM ! result at flux localization
+END FUNCTION MXM
+
+FUNCTION MYF(PA) RESULT(PMYF)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYF ! result at mass
+ ! localization
+END FUNCTION MYF
+!
+FUNCTION MYM(PA) RESULT(PMYM)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYM ! result at flux localization
+END FUNCTION MYM
+!
+FUNCTION MZF(PA,KKA,KKU,KL) RESULT(PMZF)
+IMPLICIT NONE
+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 (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+END FUNCTION MZF
+!
+FUNCTION MZM(PA,KKA,KKU,KL) RESULT(PMZM)
+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 (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+END FUNCTION MZM
+!
+END INTERFACE
+!
+END MODULE MODI_SHUMAN
+!
+!
+! ###############################
+ FUNCTION MXF(PA) RESULT(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
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: 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 FUNCTION MXF
+! ###############################
+ FUNCTION MXM(PA) RESULT(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
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXM ! result at flux localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! 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 FUNCTION MXM
+! ###############################
+ FUNCTION MYF(PA) RESULT(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
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: 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 FUNCTION MYF
+! ###############################
+ FUNCTION MYM(PA) RESULT(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
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: 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 FUNCTION MYM
+! ###############################
+ FUNCTION MZF(PA,KKA,KKU,KL) RESULT(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
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+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
+! -------------------------------
+!
+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 FUNCTION MZF
+! ###############################
+ FUNCTION MZM(PA,KKA,KKU,KL) RESULT(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
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+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
+! -------------------------------
+!
+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 FUNCTION MZM
+! ###############################
+ FUNCTION DXF(PA) RESULT(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_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: 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 FUNCTION DXF
+! ###############################
+ FUNCTION DXM(PA) RESULT(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
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXM ! result at flux
+ ! side
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! 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 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 FUNCTION DXM
+! ###############################
+ FUNCTION DYF(PA) RESULT(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_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: 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 FUNCTION DYF
+! ###############################
+ FUNCTION DYM(PA) RESULT(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
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: 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 FUNCTION DYM
+! ###############################
+ FUNCTION DZF(PA, KKA, KKU, KL) RESULT(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
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+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
+! -------------------------------
+!
+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 FUNCTION DZF
+! ###############################
+ FUNCTION DZM(PA, KKA, KKU, KL) RESULT(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
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+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
+! -------------------------------
+!
+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 FUNCTION DZM
diff --git a/src/PHYEX/aux/shuman_phy.f90 b/src/PHYEX/aux/shuman_phy.f90
index e3e493afe37c2a8414312116367dfad2c3c0bbc1..69f793542be2f229603988822277fb711da29aed 100644
--- a/src/PHYEX/aux/shuman_phy.f90
+++ b/src/PHYEX/aux/shuman_phy.f90
@@ -552,7 +552,7 @@ IMPLICIT NONE
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
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PDZM ! result at flux
! side
!
!* 0.2 Declarations of local variables
diff --git a/src/PHYEX/conv/deep_convection.f90 b/src/PHYEX/conv/deep_convection.f90
index 2a6b30b5531b2dac28bbf5cee664245f10faf5ff..004cd7033fc8c973db46cbab925d0df1289afa0b 100644
--- a/src/PHYEX/conv/deep_convection.f90
+++ b/src/PHYEX/conv/deep_convection.f90
@@ -52,7 +52,7 @@ REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical
! velocity (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
-REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! horizontal grid area (m -a2)
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! horizontal grid area (m**2)
REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC ! value of convective adjustment
! time if OSETTADJ=.TRUE.
!
@@ -261,7 +261,7 @@ REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical
! velocity (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
-REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! horizontal grid area (m -a2)
+REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! horizontal grid area (**2)
REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC ! value of convective adjustment
! time if OSETTADJ=.TRUE.
!
@@ -667,7 +667,7 @@ ALLOCATE( ILCL(ICONV) )
ALLOCATE( ICTL(ICONV) )
ALLOCATE( IETL(ICONV) )
!
- ! grid scale variables
+ ! grid scale variables
!
ALLOCATE( ZZ(ICONV,IKS) ) ; ZZ = 0.0
ALLOCATE( ZPRES(ICONV,IKS) ) ; ZPRES = 0.0
diff --git a/src/PHYEX/ext/advection_metsv.f90 b/src/PHYEX/ext/advection_metsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8473c5a3b9f58609ef24a788a49f2153056a0380
--- /dev/null
+++ b/src/PHYEX/ext/advection_metsv.f90
@@ -0,0 +1,719 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_ADVECTION_METSV
+! ###########################
+!
+INTERFACE
+ SUBROUTINE ADVECTION_METSV (TPFILE, HUVW_ADV_SCHEME, &
+ HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT, &
+ OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
+ HLBCX, HLBCY, KRR, KSV, TPDTCUR, PTSTEP, &
+ PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, PPABST, &
+ PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
+ PRTHS, PRRS, PRTKES, PRSVS, &
+ PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
+ HSV_ADV_SCHEME, & ! scheme applied
+ HUVW_ADV_SCHEME
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
+!
+INTEGER, INTENT(INOUT):: KSPLIT ! Number of time splitting
+ ! for PPM advection
+LOGICAL, INTENT(IN) :: OSPLIT_CFL ! flag to automatically chose number of iterations
+REAL, INTENT(IN) :: PSPLIT_CFL ! maximum CFL to automatically chose number of iterations
+LOGICAL, INTENT(IN) :: OCFL_WRIT ! flag to write CFL fields in output files
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+!
+TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
+ ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
+ ! Sources terms
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD,PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
+!
+END SUBROUTINE ADVECTION_METSV
+!
+END INTERFACE
+!
+END MODULE MODI_ADVECTION_METSV
+! ##########################################################################
+ SUBROUTINE ADVECTION_METSV (TPFILE, HUVW_ADV_SCHEME, &
+ HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT, &
+ OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
+ HLBCX, HLBCY, KRR, KSV, TPDTCUR, PTSTEP, &
+ PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, PPABST, &
+ PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
+ PRTHS, PRRS, PRTKES, PRSVS, &
+ PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
+! ##########################################################################
+!
+!!**** *ADVECTION_METSV * - routine to call the specialized advection routines
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to control the advection routines.
+!! For that, it is first necessary to compute the metric coefficients
+!! and the contravariant components of the momentum.
+!!
+!!** METHOD
+!! ------
+!! Once the scheme is selected, it is applied to the following group of
+!! variables: METeorologicals (temperature, water substances, TKE,
+!! dissipation TKE) and Scalar Variables. It is possible to select different
+!! advection schemes for each group of variables.
+!!
+!! EXTERNAL
+!! --------
+!! CONTRAV : computes the contravariant components.
+!! ADVECUVW : computes the advection terms for momentum.
+!! ADVECSCALAR : computes the advection terms for scalar fields.
+!! ADD3DFIELD_ll : add a field to 3D-list
+!! ADVEC_4TH_ORDER : 4th order advection scheme
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book1 and book2 ( routine ADVECTION )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! J.-P. Lafore * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/07/94
+!! 01/04/95 (Ph. Hereil J. Nicolau) add the model number
+!! 23/10/95 (J. Vila and JP Lafore) advection schemes scalar
+!! 16/01/97 (JP Pinty) change presentation
+!! 30/04/98 (J. Stein P Jabouille) extrapolation for the cyclic
+!! case and parallelisation
+!! 24/06/99 (P Jabouille) case of NHALO>1
+!! 25/10/05 (JP Pinty) 4th order scheme
+!! 24/04/06 (C.Lac) Split scalar and passive
+!! tracer routines
+!! 08/06 (T.Maric) PPM scheme
+!! 04/2011 (V.Masson & C. Lac) splits the routine and add time splitting
+!! 04/2014 (C.Lac) adaptation of time
+!! splitting for L1D and L2D
+!! 09/2014 (G.Delautier) close OUTPUT_LISTING before STOP
+!! 04/2015 (J.Escobar) remove/commente some NHALO=1 test
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 01/10/2015 : add computation of CFL for L1D case
+!! 04/2016 (C.Lac) : correction of negativity for KHKO
+!! 10/2016 (C.Lac) Correction on the flag for Strang splitting
+!! to insure reproducibility between START and RESTA
+! V. Vionnet 07/2017: add advection of 2D variables at the surface for the blowing snow scheme
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! 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 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
+! P. Wautelet + Benoît Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_TKE, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST
+USE MODD_TURB_n, ONLY: XTKEMIN
+USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
+use modd_field, only: tfieldmetadata, TYPEREAL
+USE MODD_IBM_PARAM_n, ONLY: LIBM,XIBM_LS,XIBM_EPSI
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_n
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+USE MODD_PARAMETERS
+USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
+USE MODE_MSG
+use mode_sources_neg_correct, only: Sources_neg_correct
+!
+USE MODI_ADV_BOUNDARIES
+USE MODI_CONTRAV
+USE MODI_GET_HALO
+USE MODI_PPM_RHODJ
+USE MODI_PPM_MET
+USE MODI_PPM_SCALAR
+!
+!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
+ HSV_ADV_SCHEME, & ! scheme applied
+ HUVW_ADV_SCHEME
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
+!
+INTEGER, INTENT(INOUT):: KSPLIT ! Number of time splitting
+ ! for PPM advection
+LOGICAL, INTENT(IN) :: OSPLIT_CFL ! flag to automatically chose number of iterations
+REAL, INTENT(IN) :: PSPLIT_CFL ! maximum CFL to automatically chose number of iterations
+LOGICAL, INTENT(IN) :: OCFL_WRIT ! flag to write CFL fields in output files
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+!
+TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
+ ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
+ ! Sources terms
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
+!
+!
+!* 0.2 declarations of local variables
+!
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCPPM
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCPPM
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCPPM
+ ! contravariant
+ ! components
+ ! of momentum
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLU
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLV
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLW
+! ! CFL numbers on each direction
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFL
+! ! CFL number
+!
+REAL :: ZCFLU_MAX, ZCFLV_MAX, ZCFLW_MAX, ZCFL_MAX ! maximum CFL numbers
+!
+REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZTH
+REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZTKE
+REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_OTHER
+REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_OTHER
+REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_PPM
+REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_PPM
+REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZR
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSV
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NBLOWSNOW_2D) :: ZSNWC
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NBLOWSNOW_2D) :: ZSNWC_INIT
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NBLOWSNOW_2D) :: ZRSNWCS
+! Guess at the sub time step
+REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_OTHER
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_OTHER
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NBLOWSNOW_2D) :: ZRSNWCS_OTHER
+! Tendencies since the beginning of the time step
+REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_PPM
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_PPM
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NBLOWSNOW_2D) :: ZRSNWCS_PPM
+! Guess at the end of the sub time step
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOX1,ZRHOX2
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOY1,ZRHOY2
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOZ1,ZRHOZ2
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR
+! Temporary advected rhodj for PPM routines
+!
+INTEGER :: JS,JR,JSV,JSPL, JI, JJ ! Loop index
+REAL :: ZTSTEP_PPM ! Sub Time step
+LOGICAL :: GTKE
+!
+INTEGER :: IINFO_ll ! return code of parallel routine
+TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS1_ll ! list of fields to exchange
+!
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! logical unit
+INTEGER :: ISPLIT_PPM ! temporal time splitting
+INTEGER :: IIB, IIE, IJB, IJE,IKB,IKE
+TYPE(TFIELDMETADATA) :: TZFIELD
+!-------------------------------------------------------------------------------
+!
+!* 0. INITIALIZATION
+! --------------
+
+GTKE=(SIZE(PTKET)/=0)
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'ADV', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'ADV', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'ADV', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'ADV', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'ADV', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'ADV', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'ADV', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'ADV', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'ADV', prrs (:, :, :, 7) )
+if ( lbudget_sv) then
+ do jsv = 1, ksv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv ), 'ADV', prsvs(:, :, :, jsv) )
+ end do
+end if
+
+ILUOUT = TLUOUT%NLU
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PSVT,3) - JPVEXT
+!
+IF(LBLOWSNOW) THEN ! Put 2D Canopy blowing snow variables into a 3D array for advection
+ ZSNWC_INIT = 0.
+ ZRSNWCS = 0.
+
+ DO JSV=1,(NBLOWSNOW_2D)
+ ZSNWC_INIT(:,:,IKB,JSV) = XSNWCANO(:,:,JSV)
+ ZRSNWCS(:,:,IKB,JSV) = XRSNWCANOS(:,:,JSV)
+ END DO
+ENDIF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTES THE CONTRAVARIANT COMPONENTS (FOR PPM ONLY)
+! --------------------------------------
+!
+!* 2.1 computes contravariant components
+!
+IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
+ CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,2)
+ELSE
+ CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,4)
+END IF
+!
+!
+!* 2.2 computes CFL numbers
+!
+
+IF (.NOT. L1D) THEN
+ ZCFLU = 0.0 ; ZCFLV = 0.0 ; ZCFLW = 0.0
+ ZCFLU(IIB:IIE,IJB:IJE,:) = ABS(ZRUCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
+ ZCFLV(IIB:IIE,IJB:IJE,:) = ABS(ZRVCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
+ ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
+ IF (LIBM) THEN
+ ZCFLU(IIB:IIE,IJB:IJE,:) = ZCFLU(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,2)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ ZCFLV(IIB:IIE,IJB:IJE,:) = ZCFLV(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,3)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ ZCFLW(IIB:IIE,IJB:IJE,:) = ZCFLW(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,4)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,2).GT.(-XIBM_EPSI)) ZCFLU(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,3).GT.(-XIBM_EPSI)) ZCFLV(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,4).GT.(-XIBM_EPSI)) ZCFLW(IIB:IIE,IJB:IJE,:)=0.
+ ENDIF
+ IF (.NOT. L2D) THEN
+ ZCFL = SQRT(ZCFLU**2+ZCFLV**2+ZCFLW**2)
+ ELSE
+ ZCFL = SQRT(ZCFLU**2+ZCFLW**2)
+ END IF
+ELSE
+ ZCFLU = 0.0 ; ZCFLV = 0.0 ; ZCFLW = 0.0
+ ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
+ ZCFL = SQRT(ZCFLW**2)
+END IF
+!
+!* prints in the file the 3D Courant numbers (one should flag this)
+!
+IF ( tpfile%lopened .AND. OCFL_WRIT .AND. (.NOT. L1D) ) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CFLU', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CFLU', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_CFLU', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCFLU)
+!
+ IF (.NOT. L2D) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CFLV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CFLV', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_CFLV', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCFLV)
+ END IF
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CFLW', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CFLW', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_CFLW', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCFLW)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CFL', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CFL', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_CFL', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCFL)
+END IF
+!
+!* prints in the output file the maximum CFL
+!
+ZCFLU_MAX = MAX_ll(ZCFLU,IINFO_ll)
+ZCFLV_MAX = MAX_ll(ZCFLV,IINFO_ll)
+ZCFLW_MAX = MAX_ll(ZCFLW,IINFO_ll)
+ZCFL_MAX = MAX_ll(ZCFL,IINFO_ll)
+!
+WRITE(ILUOUT,FMT='(A24,F10.2,A5,F10.2,A5,F10.2,A9,F10.2)') &
+ 'Max. CFL number for U : ',ZCFLU_MAX, &
+ ' V : ',ZCFLV_MAX,' W : ', ZCFLW_MAX,&
+ 'global : ',ZCFL_MAX
+!
+!
+!* 2.3 updates time step splitting loop
+!
+IF (OSPLIT_CFL .AND. (.NOT.L1D) ) THEN
+!
+ ISPLIT_PPM = INT(ZCFL_MAX/PSPLIT_CFL)+1
+ IF ( KSPLIT /= ISPLIT_PPM ) &
+ WRITE(ILUOUT,FMT='(A37,I2,A4,I2,A11)') &
+ 'PPM time spliting loop changed from ', &
+ KSPLIT,' to ',ISPLIT_PPM, ' iterations'
+!
+ KSPLIT = ISPLIT_PPM
+!
+END IF
+! ---------------------------------------------------------------
+IF (( (ZCFLU_MAX>=3.) .AND. (.NOT.L1D) ) .OR. &
+ ( (ZCFLV_MAX>=3.) .AND. (.NOT.L1D) .AND. (.NOT.L2D) ) .OR. &
+ ( (ZCFLW_MAX>=8.) .AND. (.NOT.L1D) ) ) THEN
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ WRITE(ILUOUT,*) ' | MODEL ERROR |'
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ WRITE(ILUOUT,*) ' | |'
+ WRITE(ILUOUT,*) ' | The model wind speed becomes too high |'
+ WRITE(ILUOUT,*) ' | |'
+ IF ( ZCFLU_MAX>=3. .OR. ZCFLV_MAX>=3. ) &
+ WRITE(ILUOUT,*) ' | The horizontal CFL value reaches 3. or more |'
+ IF ( ZCFLW_MAX>=8. ) &
+ WRITE(ILUOUT,*) ' | The vertical CFL value reaches 8. or more |'
+ WRITE(ILUOUT,*) ' | |'
+ WRITE(ILUOUT,*) ' | This can be due either to : |'
+ WRITE(ILUOUT,*) ' | - a numerical explosion of the model |'
+ WRITE(ILUOUT,*) ' | - or a too high wind speed for an |'
+ WRITE(ILUOUT,*) ' | acceptable accuracy of the advection |'
+ WRITE(ILUOUT,*) ' | |'
+ WRITE(ILUOUT,*) ' | Please decrease your time-step |'
+ WRITE(ILUOUT,*) ' | |'
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ WRITE(ILUOUT,*) ' | MODEL STOPS |'
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ADVECTION_METSV','')
+END IF
+!
+!
+ZTSTEP_PPM = PTSTEP / REAL(KSPLIT)
+!
+!
+!* 2.4 normalized contravariant components for split PPM time-step
+!
+ZRUCPPM = ZRUCPPM*ZTSTEP_PPM
+ZRVCPPM = ZRVCPPM*ZTSTEP_PPM
+ZRWCPPM = ZRWCPPM*ZTSTEP_PPM
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. COMPUTES THE TENDENCIES SINCE THE BEGINNING OF THE TIME STEP
+! ------------------------------------------------------------
+!
+!* This represent the effects of all OTHER processes
+! Clouds related processes from previous time-step are taken into account in PRTHS_CLD
+! Advection related processes from previous time-step will be taken into account in ZRTHS_PPM
+!
+ZRTHS_OTHER = PRTHS - PTHT * PRHODJ / PTSTEP
+IF (GTKE) ZRTKES_OTHER = PRTKES - PTKET * PRHODJ / PTSTEP
+DO JR = 1, KRR
+ ZRRS_OTHER(:,:,:,JR) = PRRS(:,:,:,JR) - PRT(:,:,:,JR) * PRHODJ(:,:,:) / PTSTEP
+END DO
+DO JSV = 1, KSV
+ ZRSVS_OTHER(:,:,:,JSV) = PRSVS(:,:,:,JSV) - PSVT(:,:,:,JSV) * PRHODJ / PTSTEP
+END DO
+IF(LBLOWSNOW) THEN
+ DO JSV = 1, (NBLOWSNOW_2D)
+ ZRSNWCS_OTHER(:,:,:,JSV) = ZRSNWCS(:,:,:,JSV) - ZSNWC_INIT(:,:,:,JSV) * PRHODJ / PTSTEP
+ END DO
+ENDIF
+!
+! Top and bottom Boundaries
+!
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTHS_OTHER)
+IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTKES_OTHER)
+DO JR = 1, KRR
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRRS_OTHER(:,:,:,JR))
+END DO
+DO JSV = 1, KSV
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRSVS_OTHER(:,:,:,JSV))
+END DO
+IF(LBLOWSNOW) THEN
+ DO JSV = 1, (NBLOWSNOW_2D)
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRSNWCS_OTHER(:,:,:,JSV))
+ END DO
+END IF
+!
+! Exchanges on processors
+!
+NULLIFY(TZFIELDS0_ll)
+!!$IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll( TZFIELDS0_ll, ZRTHS_OTHER, 'ADVECTION_METSV::ZRTHS_OTHER' )
+ IF (GTKE) CALL ADD3DFIELD_ll( TZFIELDS0_ll, ZRTKES_OTHER, 'ADVECTION_METSV::ZRTKES_OTHER' )
+ IF ( KRR>0 ) CALL ADD4DFIELD_ll( TZFIELDS0_ll, ZRRS_OTHER(:,:,:,1:KRR), 'ADVECTION_METSV::ZRRS_OTHER' )
+ IF ( KSV>0 ) CALL ADD4DFIELD_ll( TZFIELDS0_ll, ZRSVS_OTHER(:,:,:,1:KSV), 'ADVECTION_METSV::ZRSVS_OTHER' )
+ IF(LBLOWSNOW) CALL ADD4DFIELD_ll( TZFIELDS0_ll, ZRSNWCS_OTHER(:,:,:,1:NBLOWSNOW_2D), 'ADVECTION_METSV::ZRSNWCS_OTHER' )
+ CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS0_ll)
+!!$END IF
+!
+!
+
+!-------------------------------------------------------------------------------
+!
+!* 4. CALLS THE PPM ADVECTION INSIDE A TIME SPLITTING
+! --------------------------------------
+!
+CALL PPM_RHODJ(HLBCX,HLBCY, ZRUCPPM, ZRVCPPM, ZRWCPPM, &
+ ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, &
+ ZRHOZ1, ZRHOZ2 )
+!
+!* values of the fields at the beginning of the time splitting loop
+ZTH = PTHT
+ZTKE = PTKET
+IF (KRR /=0 ) ZR = PRT
+IF (KSV /=0 ) ZSV = PSVT
+IF(LBLOWSNOW) THEN
+ DO JSV = 1, (NBLOWSNOW_2D)
+ ZSNWC(:,:,:,JSV) = ZRSNWCS(:,:,:,JSV)* PTSTEP/ PRHODJ
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSNWC(:,:,:,JSV))
+ END DO
+ ZSNWC_INIT=ZSNWC
+ENDIF
+!
+IF (GTKE) PRTKES_ADV(:,:,:) = 0.
+!
+!* time splitting loop
+DO JSPL=1,KSPLIT
+!
+ !ZRTHS_PPM(:,:,:) = 0.
+ !ZRTKES_PPM(:,:,:) = 0.
+ !IF (KRR /=0) ZRRS_PPM(:,:,:,:) = 0.
+ !IF (KSV /=0) ZRSVS_PPM(:,:,:,:) = 0.
+!
+ IF (LNEUTRAL) ZTH=ZTH-PTHVREF !* To be removed with the new PPM scheme ?
+ CALL PPM_MET (HLBCX,HLBCY, KRR, TPDTCUR,ZRUCPPM, ZRVCPPM, ZRWCPPM, PTSTEP,ZTSTEP_PPM, &
+ PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ ZTH, ZTKE, ZR, ZRTHS_PPM, ZRTKES_PPM, ZRRS_PPM, HMET_ADV_SCHEME)
+ IF (LNEUTRAL) ZTH=ZTH+PTHVREF !* To be removed with the new PPM scheme ?
+!
+ CALL PPM_SCALAR (HLBCX,HLBCY, KSV, TPDTCUR, ZRUCPPM, ZRVCPPM, ZRWCPPM, PTSTEP, &
+ ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ ZSV, ZRSVS_PPM, HSV_ADV_SCHEME )
+!
+! Tendencies of PPM
+!
+ PRTHS(:,:,:) = PRTHS (:,:,:) + ZRTHS_PPM (:,:,:) / KSPLIT
+ IF (GTKE) PRTKES_ADV(:,:,:) = PRTKES_ADV(:,:,:) + ZRTKES_PPM(:,:,:) / KSPLIT
+ IF (KRR /=0) PRRS (:,:,:,:) = PRRS (:,:,:,:) + ZRRS_PPM (:,:,:,:) / KSPLIT
+ IF (KSV /=0 ) PRSVS (:,:,:,:) = PRSVS (:,:,:,:) + ZRSVS_PPM (:,:,:,:) / KSPLIT
+!
+ IF (JSPL<KSPLIT) THEN
+!
+! Guesses of the field inside the time splitting loop
+!
+ ZTH = ZTH + ( ZRTHS_PPM(:,:,:) + ZRTHS_OTHER(:,:,:) + PRTHS_CLD(:,:,:)) * &
+ ZTSTEP_PPM / PRHODJ(:,:,:)
+ IF (GTKE) ZTKE = ZTKE + ( ZRTKES_PPM(:,:,:) + ZRTKES_OTHER(:,:,:) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
+ DO JR = 1, KRR
+ ZR(:,:,:,JR) = ZR(:,:,:,JR) + ( ZRRS_PPM(:,:,:,JR) + ZRRS_OTHER(:,:,:,JR) + PRRS_CLD(:,:,:,JR) ) &
+ * ZTSTEP_PPM / PRHODJ(:,:,:)
+ END DO
+ DO JSV = 1, KSV
+ ZSV(:,:,:,JSV) = ZSV(:,:,:,JSV) + ( ZRSVS_PPM(:,:,:,JSV) + ZRSVS_OTHER(:,:,:,JSV) + &
+ PRSVS_CLD(:,:,:,JSV) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
+ END DO
+!
+! Top and bottom Boundaries and LBC for the guesses
+!
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTH, PTHT )
+ IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTKE, PTKET)
+ DO JR = 1, KRR
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZR(:,:,:,JR), PRT(:,:,:,JR))
+ END DO
+ DO JSV = 1, KSV
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSV(:,:,:,JSV), PSVT(:,:,:,JSV))
+ END DO
+
+ IF(LBLOWSNOW) THEN ! Advection of Canopy mass at the 1st atmospheric level
+ ZRSNWCS_PPM(:,:,:,:) = 0.
+ !
+
+ CALL PPM_SCALAR (HLBCX,HLBCY, NBLOWSNOW_2D, TPDTCUR, ZRUCPPM, ZRVCPPM, ZRWCPPM,PTSTEP, &
+ ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ ZSNWC, ZRSNWCS_PPM, HSV_ADV_SCHEME)
+
+
+! Tendencies of PPM
+ ZRSNWCS(:,:,:,:) = ZRSNWCS(:,:,:,:) + ZRSNWCS_PPM (:,:,:,:) / KSPLIT
+! Guesses of the field inside the time splitting loop
+ DO JSV = 1, ( NBLOWSNOW_2D)
+ ZSNWC(:,:,:,JSV) = ZSNWC(:,:,:,JSV) + ZRSNWCS_PPM(:,:,:,JSV)*ZTSTEP_PPM/ PRHODJ(:,:,:)
+ END DO
+
+! Top and bottom Boundaries and LBC for the guesses
+ DO JSV = 1, (NBLOWSNOW_2D)
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSNWC(:,:,:,JSV), ZSNWC_INIT(:,:,:,JSV))
+ END DO
+ END IF
+!
+! Exchanges fields between processors
+!
+ NULLIFY(TZFIELDS1_ll)
+!!$ IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll( TZFIELDS1_ll, ZTH, 'ZTH' )
+ IF (GTKE) CALL ADD3DFIELD_ll( TZFIELDS1_ll, ZTKE, 'ADVECTION_METSV::ZTKE' )
+ IF ( KRR>0 ) CALL ADD4DFIELD_ll( TZFIELDS1_ll, ZR (:,:,:,1:KRR), 'ADVECTION_METSV::ZR' )
+ IF ( KSV>0 ) CALL ADD4DFIELD_ll( TZFIELDS1_ll, ZSV(:,:,:,1:KSV), 'ADVECTION_METSV::ZSV' )
+ IF ( LBLOWSNOW ) CALL ADD4DFIELD_ll( TZFIELDS1_ll, ZSNWC(:,:,:,1:NBLOWSNOW_2D), 'ADVECTION_METSV::ZSNWC' )
+ CALL UPDATE_HALO_ll(TZFIELDS1_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS1_ll)
+!!$ END IF
+ END IF
+!
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+! TKE special case: advection is the last process for TKE
+!
+! TKE must be greater than its minimum value
+! (previously done in tke_eps_sources)
+!
+IF (GTKE) THEN
+ PRTKES(:,:,:) = PRTKES(:,:,:) + PRTKES_ADV(:,:,:)
+ PRTKES(:,:,:) = MAX (PRTKES(:,:,:) , XTKEMIN * PRHODJ(:,:,:) / PTSTEP )
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+! Update tendency for cano variables : from 3D to 2D
+!
+IF(LBLOWSNOW) THEN
+
+ DO JSV=1,(NBLOWSNOW_2D)
+ DO JI=1,SIZE(PSVT,1)
+ DO JJ=1,SIZE(PSVT,2)
+ XRSNWCANOS(JI,JJ,JSV) = SUM(ZRSNWCS(JI,JJ,IKB:IKE,JSV))
+ END DO
+ END DO
+ END DO
+IF(LWEST_ll()) XRSNWCANOS(IIB,:,:) = ZRSNWCS(IIB,:,IKB,:)
+IF(LEAST_ll()) XRSNWCANOS(IIE,:,:) = ZRSNWCS(IIE,:,IKB,:)
+IF(LSOUTH_ll()) XRSNWCANOS(:,IJB,:) = ZRSNWCS(:,IJB,IKB,:)
+IF(LNORTH_ll()) XRSNWCANOS(:,IJE,:) = ZRSNWCS(:,IJE,IKB,:)
+
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 5. BUDGETS
+! -------
+!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'ADV', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'ADV', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'ADV', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'ADV', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'ADV', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'ADV', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'ADV', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'ADV', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'ADV', prrs (:, :, :, 7) )
+if ( lbudget_sv) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv ), 'ADV', prsvs(:, :, :, jsv) )
+ end do
+end if
+
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NEADV', krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs )
+
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADVECTION_METSV
diff --git a/src/PHYEX/ext/aer_effic.f90 b/src/PHYEX/ext/aer_effic.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7b91959ce7cac78848bdefcdb50673cf811955ae
--- /dev/null
+++ b/src/PHYEX/ext/aer_effic.f90
@@ -0,0 +1,257 @@
+!ORILAM_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+! ######spl
+ MODULE MODI_AER_EFFIC
+!! ########################
+!!
+!
+INTERFACE
+!!
+SUBROUTINE AER_EFFIC(PRG,PVGG, & !aerosol radius/fall speed (m/s)
+ PRHODREF, & !Air density
+ PMUW, PMU, & !mu water/air
+ PDPG, PEFC, & !diffusivity, efficiency
+ PRRS, & ! Rain water m.r. at time
+ KMODE, & ! Number of aerosol modes
+ PTEMP, PCOR, & ! air temp, cunningham corr factor
+ PDENSITY_AER, & ! aerosol density
+ PRR, PNT ) ! radius and number of rain drops
+!
+IMPLICIT NONE
+REAL, DIMENSION(:,:), INTENT(IN) :: PRG, PVGG
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:), INTENT(IN) :: PDPG
+REAL, DIMENSION(:), INTENT(IN) :: PMU, PMUW
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PEFC
+REAL, DIMENSION(:), INTENT(IN) :: PRRS
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOR
+REAL, DIMENSION(:), INTENT(IN) :: PRR, PNT
+INTEGER, INTENT(IN) :: KMODE
+REAL, DIMENSION(:,:), INTENT(IN) :: PDENSITY_AER
+
+
+END SUBROUTINE AER_EFFIC
+!!
+END INTERFACE
+END MODULE MODI_AER_EFFIC
+! ######spl
+SUBROUTINE AER_EFFIC(PRG,PVGG, & !aerosol radius/fall speed (m/s)
+ PRHODREF, & !Air density
+ PMUW, PMU, & !mu water/air
+ PDPG, PEFC, & !diffusivity, efficiency
+ PRRT, & ! Rain water m.r. at time t
+ KMODE, & ! Number of aerosol modes
+ PTEMP, PCOR, & ! air temp, cunningham corr factor
+ PDENSITY_AER, & ! aerosol density
+ PRR, PNT ) ! radius and number of rain drops
+!! #######################################
+!!**********AER_EFFIC**********
+!! PURPOSE
+!! -------
+!! Calculate the collection efficiency of
+! a falling drop interacting with a dust aerosol
+! for use with aer_wet_dep_kmt_warm.f90
+!!
+!!** METHOD
+!! ------
+!! Using basic theory, and the one dimensional variables sent
+!! from aer_wet_dep_kmt_warm.f90, calculation of the average
+!! fall speed calculations, chapter 17.3.4, MESONH Handbook
+!! droplet number based on the Marshall_Palmer distribution
+!! and Stokes number, Reynolds number, etc. based on theory
+!! (S&P, p.1019)
+!!
+!! REFERENCE
+!! ---------
+!! Seinfeld and Pandis p.1019
+!! MESONH Handbook chapter 17.3.4
+!!
+!! AUTHOR
+!! ------
+!! K. Crahan Kaku / P. Tulet (CNRM/GMEI)
+!!
+!! MODIFICATIONS
+!! -------------
+!! T. Hoarau (LACy) 15/05/17 add LIMA
+!! Philippe Wautelet 28/05/2018: corrected truncated integer division (1/12 -> 1./12.)
+!! P. Tulet and C. Barthe (LAERO) 15/01/22 correction for lima
+!!
+!-----------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_RAIN_ICE_PARAM_n, ONLY : YFSEDR => XFSEDR, YEXSEDR => XEXSEDR
+!++cb++
+!++th++
+USE MODD_RAIN_ICE_DESCR_n, ONLY : YCCR => XCCR, YLBR => XLBR, YLBEXR => XLBEXR, &
+ YCEXVT => XCEXVT
+USE MODD_PARAM_LIMA_WARM, ONLY : WCCR => XCCR, WLBR => XLBR, WLBEXR => XLBEXR, &
+ XFSEDRR, XFSEDRC
+USE MODD_PARAM_LIMA, ONLY : WCEXVT => XCEXVT, WFSEDR => XFSEDR, WFSEDC=>XFSEDC, &
+ XRTMIN
+!--cb--
+USE MODD_PARAM_n, ONLY: CCLOUD
+!--th--
+USE MODD_CST, ONLY : XPI, XRHOLW, XP00, XRD
+USE MODD_PARAMETERS , ONLY : JPVEXT
+USE MODD_REF, ONLY : XTHVREFZ
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+REAL, DIMENSION(:,:), INTENT(IN) :: PRG, PVGG
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:), INTENT(IN) :: PDPG
+REAL, DIMENSION(:), INTENT(IN) :: PMU, PMUW
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PEFC
+REAL, DIMENSION(:), INTENT(IN) :: PRRT
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(:), INTENT(IN) :: PRR, PNT
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOR
+INTEGER, INTENT(IN) :: KMODE
+REAL, DIMENSION(:,:), INTENT(IN) :: PDENSITY_AER
+!
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IKB ! Coordinates of the first physical
+ ! points along z
+REAL :: ZRHO00 ! Surface reference air density
+!viscosity ratio, Reynolds number
+REAL, DIMENSION(SIZE(PRG,1)) :: ZOMG, ZREY
+!rain radius, m, and rain fall speed, m/s; aerosol radius (m),
+REAL, DIMENSION(SIZE(PRG,1)) :: ZRR, ZVR
+!lambda, number concentration according to marshall palmer,
+REAL, DIMENSION(SIZE(PRG,1)) :: ZNT, ZLBDA1
+!RHO_dref*r_r, Rain LWC
+REAL, DIMENSION(SIZE(PRG,1)) :: RLWC
+! schmidts number
+REAL, DIMENSION(SIZE(PRG,1),KMODE) :: ZSCH
+!
+!Stokes number, ratio of diameters,aerosol radius
+REAL, DIMENSION(SIZE(PRG,1),KMODE) :: ZSTO, ZPHI, ZRG
+! S Star Term
+REAL, DIMENSION(SIZE(PRG,1)) :: ZSTA, ZDIFF, ZTAU
+!
+!Term 1, Term 2, Term 3, Term 4 such that
+! E = Term1 * Term 2 + Term 3 + Term 4
+REAL, DIMENSION(SIZE(PRG,1),KMODE) :: ZT1, ZT2
+REAL, DIMENSION(SIZE(PRG,1),KMODE) :: ZT3, ZT4
+!
+INTEGER :: JI,JK
+!++th++
+REAL :: KLBEXR, KLBR, KCEXVT, KCCR, ZFSEDR, ZBR, ZDR, ZEXSEDR
+!--th--
+!
+!-----------------------------------------------------------------
+IKB = 1 + JPVEXT
+ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+ZRG(:,:) = PRG(:,:) * 1.E-6 !change units to meters
+ZVR(:) = 0.
+
+SELECT CASE(CCLOUD)
+CASE('ICE3')
+ KLBEXR = YLBEXR
+ KLBR = YLBR
+ KCEXVT = YCEXVT
+ KCCR = YCCR
+ ZFSEDR = YFSEDR
+ ZEXSEDR = YEXSEDR
+
+!Fall Speed calculations
+!similar to rain_ice.f90, chapter 17.3.4, MESONH Handbook
+ ZVR(:) = ZFSEDR * PRRT(:)**(ZEXSEDR-1) * &
+ PRHODREF(:)**(ZEXSEDR-KCEXVT)
+
+CASE('LIMA')
+ KLBEXR = WLBEXR
+ KLBR = WLBR
+ KCEXVT = WCEXVT
+ KCCR = WCCR
+ ZFSEDR = XFSEDRR
+ ZBR = 3.0
+ ZDR = 0.8
+ ZEXSEDR = (ZBR + ZDR + 1.0) / (ZBR + 1.0)
+ WHERE (PRRT(:) > XRTMIN(3) .AND. PNT(:) > 0.)
+ ZLBDA1(:) = (KLBR * PNT(:) / PRRT(:))**KLBEXR
+ ZVR(:) = XFSEDRR * PRHODREF(:)**(1.-KCEXVT) * ZLBDA1(:)**(-ZDR)
+ END WHERE
+END SELECT
+
+
+!Fall speed cannot be faster than 7 m/s
+ZVR(:) = MIN(ZVR(:), 7.)
+
+KCCR = 8.E6
+
+
+!Ref SEINFELD AND PANDIS p.1019
+! Viscosity Ratio
+ZOMG(:) = PMUW(:) / PMU(:)
+!!Reynolds number
+ZREY(:) = PRR(:) * ZVR(:) * PRHODREF(:) / PMU(:)
+ZREY(:) = MAX(ZREY(:), 1.E-2)
+!
+!S Star
+ZSTA(:) = (1.2 + 1./12. * LOG(1.+ZREY(:))) / (1. + LOG(1.+ZREY(:)))
+
+PEFC(:,:) = 0.0
+!
+DO JI = 1, KMODE
+!Scmidts number
+ ZSCH(:,JI) = PMU(:) / PRHODREF(:) / PDPG(:,JI)
+!
+! Rain-Aerosol relative velocity
+ ZDIFF(:) = MAX(ZVR(:)-PVGG(:,JI), 0.)
+!
+! Relaxation time
+ ZTAU(:) = (ZRG(:,JI)*2.)**2. * PDENSITY_AER(:,JI) * PCOR(:,JI) / (18. * PMU(:))
+!
+! Stockes number
+ ZSTO(:,JI) = ZTAU(:) * ZDIFF(:) / PRR(:)
+!
+!Ratio of diameters
+ ZPHI(:,JI) = ZRG(:,JI) / PRR(:)
+ ZPHI(:,JI) = MIN(ZPHI(:,JI), 1.)
+!
+!Term 1
+ ZT1(:,JI) = 4.0 / ZREY(:) / ZSCH(:,JI)
+!
+!Term 2
+ ZT2(:,JI) = 1.0 + 0.4 * ZREY(:)**(0.5) * ZSCH(:,JI)**(1./3.) + &
+ 0.16 * ZREY(:)**(0.5) * ZSCH(:,JI)**(0.5)
+!
+!Brownian diffusion
+ ZT1(:,JI) = ZT1(:,JI) * ZT2(:,JI)
+!
+!Term 3 - interception
+ ZT3(:,JI) = 4. * ZPHI(:,JI) * (1. / ZOMG(:) + &
+ (1.0 + 2.0 * ZREY(:)**0.5) * ZPHI(:,JI))
+!
+ ZT4(:,JI) = 0.0
+!
+ WHERE(ZSTO(:,JI) .GT. ZSTA(:))
+!Term 4 - impaction
+ ZT4(:,JI) = ((ZSTO(:,JI) - ZSTA(:)) / &
+ (ZSTO(:,JI) - ZSTA(:) + 2. / 3.))**(3./2.) * &
+ (XRHOLW / PDENSITY_AER(:,JI))**(1./2.)
+
+ END WHERE
+!
+!Collision Efficiancy
+ PEFC(:,JI) = ZT1(:,JI) + ZT3(:,JI) + ZT4(:,JI)
+!
+! Physical radius of a rain collector droplet up than 20 um
+ WHERE (PRR(:) .LE. 20.E-6)
+ PEFC(:,JI) = 0.
+ END WHERE
+ENDDO
+!
+PEFC(:,:) = MIN(PEFC(:,:), 1.0)
+PEFC(:,:) = MAX(PEFC(:,:), 0.0)
+
+END SUBROUTINE AER_EFFIC
diff --git a/src/PHYEX/ext/aer_effic3D.f90 b/src/PHYEX/ext/aer_effic3D.f90
new file mode 100644
index 0000000000000000000000000000000000000000..568965581e10742596a7f9c730a8564659c955a6
--- /dev/null
+++ b/src/PHYEX/ext/aer_effic3D.f90
@@ -0,0 +1,225 @@
+!ORILAM_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!
+! ######spll
+ MODULE MODI_AER_EFFIC3D
+!! ########################
+!!
+!
+INTERFACE
+!!
+SUBROUTINE AER_EFFIC3D(PRG,PVGG, & !aerosol radius/fall speed (m/s)
+ PRHODREF, & !Air density
+ PMUW, PMU, & !mu water/air
+ PDPG, & !diffusivity
+ PURR, & ! Rain water m.r. at time t
+ NMODE_DST, & ! Number of aerosol modes
+ PTEMP, PCOR, & ! air temp, cunningham corr factor
+ PDENSITY_AER, & ! aerosol density
+ PEFFIC ) ! scavenging efficiency
+!
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG, PVGG
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDPG
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMU, PMUW
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCOR
+INTEGER, INTENT(IN) :: NMODE_DST
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PEFFIC
+
+
+
+END SUBROUTINE AER_EFFIC3D
+!!
+END INTERFACE
+END MODULE MODI_AER_EFFIC3D
+! ######spll
+SUBROUTINE AER_EFFIC3D(PRG,PVGG, & !aerosol radius/fall speed (m/s)
+ PRHODREF, & !Air density
+ PMUW, PMU, & !mu water/air
+ PDPG, & !diffusivity
+ PURR, & ! Rain water m.r. at time t
+ NMODE_DST, & ! Number of aerosol modes
+ PTEMP, PCOR, & ! air temp, cunningham corr factor
+ PDENSITY_AER, & ! aerosol density
+ PEFFIC ) ! scavenging efficiency
+!! #######################################
+!!**********AER_EFFIC3D**********
+!! PURPOSE
+!! -------
+!! Calculate the collection efficiency of
+! a falling drop interacting with a dust aerosol
+! for use with aer_wet_dep_kmt_warm.f90
+!!
+!!** METHOD
+!! ------
+!! Using basic theory, and the one dimensional variables sent
+!! from aer_wet_dep_kmt_warm.f90, calculation of the average
+!! fall speed calculations, chapter 17.3.4, MESONH Handbook
+!! droplet number based on the Marshall_Palmer distribution
+!! and Stokes number, Reynolds number, etc. based on theory
+!! (S&P, p.1019)
+!!
+!! REFERENCE
+!! ---------
+!! Seinfeld and Pandis p.1019
+!! MESONH Handbook chapter 17.3.4
+!!
+!! AUTHOR
+!! ------
+!! K. Crahan Kaku / P. Tulet (CNRM/GMEI)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Philippe Wautelet 28/05/2018: corrected truncated integer division (1/12 -> 1./12.)
+!!
+!-----------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_RAIN_ICE_PARAM_n
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_CST, ONLY : XPI, XRHOLW, XP00, XRD
+USE MODD_PARAMETERS , ONLY : JPVEXT
+USE MODD_REF, ONLY : XTHVREFZ
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG, PVGG
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDPG
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMU, PMUW
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCOR
+INTEGER, INTENT(IN) :: NMODE_DST
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PEFFIC
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IKB ! Coordinates of the first physical
+ ! points along z
+REAL :: ZRHO00 ! Surface reference air density
+!viscosity ratio, Reynolds number
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZOMG, ZREY
+!rain radius, m, and rain fall speed, m/s; aerosol radius (m),
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRR, ZVR
+!lambda, number concentration according to marshall palmer,
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZNT, ZLBDA
+! Rain water m.r. source
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRRS
+!RHO_dref*r_r, Rain LWC
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRLWC
+! schmidts number
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),NMODE_DST) :: ZSCH
+!
+!Stokes number, ratio of diameters,aerosol radius
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),NMODE_DST) :: ZSTO, ZPHI, ZRG
+! S Star Term
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZSTA, ZDIFF, ZTAU
+!
+!Term 1, Term 2, Term 3, Term 4 such that
+! E = Term1 * Term 2 + Term 3 + Term 4
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),NMODE_DST) :: ZT1, ZT2
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),NMODE_DST) :: ZT3, ZT4
+!
+INTEGER :: JI,JK
+!
+!-----------------------------------------------------------------
+ZLBDA = 1E20
+ZNT = 1E-20
+ZRR = 10E-6
+ZRRS(:,:,:)=PURR(:,:,:)
+IKB = 1 + JPVEXT
+ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+ZRG(:,:,:,:)=PRG(:,:,:,:)*1.E-6 !change units to meters
+!
+!Fall Speed calculations
+!similar to rain_ice.f90, chapter 17.3.4, MESONH Handbook
+!
+ZVR (:,:,:)= XFSEDR * ZRRS(:,:,:)**(XEXSEDR-1) * &
+ PRHODREF(:,:,:)**(XEXSEDR-XCEXVT-1)
+
+! Drop Radius calculation in m
+!lbda = pi*No*rho(lwc)/(rho(dref)*rain rate) p.212 MESONH Handbook
+! compute the slope parameter Lbda_r
+
+WHERE((ZRRS(:,:,:).GT. 0.).AND.(PRHODREF(:,:,:) .GT. 0.))
+
+ZLBDA(:,:,:) = XLBR*(PRHODREF(:,:,:)*ZRRS(:,:,:))**XLBEXR
+!Number concentration NT=No/lbda p. 415 Jacobson
+ZNT(:,:,:) = XCCR/ZLBDA(:,:,:)
+!rain lwc (kg/m3) = rain m.r.(kg/kg) * rho_air(kg/m3)
+ZRLWC(:,:,:)=ZRRS(:,:,:)*PRHODREF(:,:,:)
+!4/3 *pi *r**3*NT*rho_eau(kg/m3) =rho(lwc)=rho(air)* qc(kg/kg)
+ZRR(:,:,:) = (ZRLWC(:,:,:)/(XRHOLW*ZNT(:,:,:)*4./3.*XPI))**(1./3.)
+END WHERE
+
+ZRR(:,:,:) = MIN(ZRR(:,:,:), 100.E-6)
+!Fall speed cannot be faster than 7 m/s
+ZVR (:,:,:)=MIN(ZVR (:,:,:),7.)
+
+!Ref SEINFELD AND PANDIS p.1019
+! Viscosity Ratio
+ZOMG(:,:,:)=PMUW(:,:,:)/PMU(:,:,:)
+!!Reynolds number
+ZREY(:,:,:)=ZRR(:,:,:)*ZVR(:,:,:)*PRHODREF(:,:,:)/PMU(:,:,:)
+ZREY(:,:,:)= MAX(ZREY(:,:,:), 1E-2)
+
+
+!S Star
+ZSTA(:,:,:)=(1.2+(1./12.)*LOG(1.+ZREY(:,:,:)))/(1.+LOG(1.+ZREY(:,:,:)))
+PEFFIC(:,:,:,:)=0.0
+DO JI=1,NMODE_DST
+!
+!Scmidts number
+ ZSCH(:,:,:,JI)=PMU(:,:,:)/PRHODREF(:,:,:)/PDPG(:,:,:,JI)
+! Rain-Aerosol relative velocity
+ ZDIFF(:,:,:) = MAX(ZVR(:,:,:)-PVGG(:,:,:,JI),0.)
+! Relaxation time
+ ZTAU(:,:,:) = (ZRG(:,:,:,JI)*2.)**2. * PDENSITY_AER(:,:,:,JI) * PCOR(:,:,:,JI) / (18.*PMU(:,:,:))
+! Stockes number
+ ZSTO(:,:,:,JI)= ZTAU(:,:,:) * ZDIFF(:,:,:) / ZRR(:,:,:)
+!Ratio of diameters
+ ZPHI(:,:,:,JI)=ZRG(:,:,:,JI)/ZRR(:,:,:)
+ ZPHI(:,:,:,JI)=MIN(ZPHI(:,:,:,JI), 1.)
+!Term 1
+ ZT1(:,:,:,JI)=4.0/ZREY(:,:,:)/ZSCH(:,:,:,JI)
+!Term 2
+ ZT2(:,:,:,JI)=1.0+(0.4*ZREY(:,:,:)**(0.5)*ZSCH(:,:,:,JI)**(1./3.))+ &
+ (0.16*ZREY(:,:,:)**(0.5)*ZSCH(:,:,:,JI)**(0.5))
+
+!Brownian diffusion
+ ZT1(:,:,:,JI)= ZT1(:,:,:,JI)*ZT2(:,:,:,JI)
+!Term 3 - interception
+ ZT3(:,:,:,JI)=4.*ZPHI(:,:,:,JI)*(1./ZOMG(:,:,:)+ &
+ (1.0+(2.0*ZREY(:,:,:)**0.5))*ZPHI(:,:,:,JI))
+
+ ZT4(:,:,:,JI)=0.0
+ WHERE(ZSTO(:,:,:,JI).GT.ZSTA(:,:,:))
+!Term 4 - impaction
+ ZT4(:,:,:,JI)=((ZSTO(:,:,:,JI)-ZSTA(:,:,:))/ &
+ (ZSTO(:,:,:,JI)-ZSTA(:,:,:)+2./3.))**(3./2.) &
+ *((XRHOLW/PDENSITY_AER(:,:,:,JI))**(1./2.))
+
+ END WHERE
+!Collision Efficiancy
+ PEFFIC(:,:,:,JI)=ZT1(:,:,:,JI)+ ZT3(:,:,:,JI)+ZT4(:,:,:,JI)
+! Physical radius of a rain collector droplet up than 20 um
+WHERE (ZRR(:,:,:) .LE. 9.9E-6)
+ PEFFIC(:,:,:,JI)= 0.
+END WHERE
+ENDDO
+PEFFIC(:,:,:,:)=MIN(PEFFIC(:,:,:,:),1.0)
+PEFFIC(:,:,:,:)=MAX(PEFFIC(:,:,:,:),0.0)
+
+END SUBROUTINE AER_EFFIC3D
diff --git a/src/PHYEX/ext/aer_wet_dep_kmt_warm.f90 b/src/PHYEX/ext/aer_wet_dep_kmt_warm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..441484721eb49a50eede482f07cf7d23bb3c7dd1
--- /dev/null
+++ b/src/PHYEX/ext/aer_wet_dep_kmt_warm.f90
@@ -0,0 +1,1060 @@
+!ORILAM_LIC Copyright 2007-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!-----------------------------------------------------------------
+! ################################
+ MODULE MODI_AER_WET_DEP_KMT_WARM
+!! ################################
+!!
+!
+INTERFACE
+!!
+SUBROUTINE AER_WET_DEP_KMT_WARM(KSPLITR, PTSTEP, PZZ, PRHODREF, &
+ PRCT, PRRT, &
+ PSVT, PTHT, &
+ PPABST, PRGAER, PEVAP3D, KMODE, &
+ PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
+ PCCT, PCRT )
+!
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference [kg/m3] air density
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Potential temp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! [Pa] pressure
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRGAER ! Aerosol radius (um)
+INTEGER, INTENT(IN) :: KMODE ! Nb aerosols mode
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER ! Begin Index for aerosol in cloud
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMASSMIN ! Aerosol mass minimum value
+REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN) :: PSEA ! Sea mask
+REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN) :: PTOWN ! Town mask
+REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(IN) :: PCCT ! Cloud water concentration
+REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(IN) :: PCRT ! Rain water concentration
+!
+END SUBROUTINE AER_WET_DEP_KMT_WARM
+!!
+END INTERFACE
+END MODULE MODI_AER_WET_DEP_KMT_WARM
+
+! ###############################################################
+ SUBROUTINE AER_WET_DEP_KMT_WARM (KSPLITR, PTSTEP, PZZ, &
+ PRHODREF, PRCT, PRRT, &
+ PSVT, PTHT, &
+ PPABST, PRGAER, PEVAP3D, KMODE, &
+ PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
+ PCCT, PCRT )
+! ###############################################################
+!
+!!**** * - compute the explicit microphysical processes involved in the
+!!*** * - wet deposition of aerosols species in mixed clouds
+!!
+!! PURPOSE
+!! -------
+!!
+!! The purpose of this subroutine is to calculate the mass transfer
+!! of aerosol species between cloud hydrometeors.
+!!
+!!
+!!
+!!** METHOD
+!! ------
+!! Aerosols mass are dissolved into the cloud water and rain
+!! drops, it is subject to transfer through the microphysical processes
+!! that affect the parent hydrometeor [Rutledge et al., 1986].
+!! Aerosol mass transfer has been computed using scavenging coefficient
+!! and brownian nucleation scavenging coefficient (Seinfeld and Pandis,
+!! 1998; Tost et al, 2006).
+!!
+!! The sedimentation rate is computed with a time spliting technique and
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!!
+!! KMODE: Number of aerosol modes (lognormal, bin..)
+!! PSVT : 1 => KMODE : dry aerosol mass
+!! PSVT : KMODE+1 => 2*KMODE : aerosol mass in cloud
+!! PSVT : 2*KMODE+1 => 3*KMODE: aerosol mass in rain
+
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XRD,XRV ! Gaz constant for dry air, vapor
+!! XMD,XMV ! Molecular weight for dry air, vapor
+!! XCPD ! Cpd (dry air)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! P. Tulet & K. Crahan-Kaku * CNRM *
+!!
+!! Based on rain_ice.f90 and ch_wet_dep_kmt_warm.f90
+!! from C. Mari & J.P. Pinty * LA*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/05/07
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_RAIN_ICE_PARAM_n, ONLY : YEXCACCR=>XEXCACCR, XFSEDC, XFCACCR,&
+ XEXSEDR, XCRIAUTC, XFSEDR, XTIMAUTC,&
+ YFCACCR => XFCACCR
+!++th++ 10/05/17
+USE MODD_RAIN_ICE_DESCR_n, ONLY : YRTMIN => XRTMIN, YCEXVT => XCEXVT, &
+ XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
+ XNUC2, XALPHAC2, XNUC, XALPHAC, &
+ YLBC => XLBC, XLBEXC, &
+ XCCR, &
+ YLBR => XLBR, YLBEXR => XLBEXR
+!--th--
+USE MODD_PRECIP_n
+USE MODI_AER_VELGRAV
+USE MODI_AER_EFFIC
+USE MODI_GAMMA
+!++th++ 10/05/17
+USE MODD_PARAM_LIMA, ONLY : XCTMIN, WRTMIN => XRTMIN, WCEXVT => XCEXVT
+USE MODD_PARAM_LIMA_WARM, ONLY : WLBR => XLBR, WLBEXR => XLBEXR, & ! for
+ XFSEDRR, XDR, XBR, & ! sedim.
+ XAUTO1, XAUTO2, XCAUTR, XITAUTR, XLAUTR, & ! for
+ XLAUTR_THRESHOLD, XITAUTR_THRESHOLD, & ! autoconv.
+ WLBC => XLBC, &
+ XACCR1, XACCR2, XACCR3, XACCR4, XACCR5, & ! for
+ XACCR_RLARGE1, XACCR_RLARGE2, & ! accr.
+ XACCR_RSMALL1, XACCR_RSMALL2, &
+ WEXCACCR=>XEXCACCR, WFCACCR=>XFCACCR
+USE MODD_PARAM_n, ONLY: CCLOUD
+!--th--
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference [kg/m3] air density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temp
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! [Pa] pressure
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRGAER ! Aerosols radius (um)
+INTEGER, INTENT(IN) :: KMODE ! Nb aerosols mode
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER ! Begin Index for aerosol in cloud
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMASSMIN ! Aerosol mass minimum value
+REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN) :: PSEA ! Sea mask
+REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN) :: PTOWN ! Town mask
+REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(IN) :: PCCT ! Cloud water concentration
+REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(IN) :: PCRT ! Rain water concentration
+
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK ! Vertical loop index for the rain sedimentation
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: JJ ! Loop index for the interpolation
+!
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFC !efficiency factor [unitless]
+!
+!Declaration of Dust Variables
+!
+INTEGER :: ICLOUD, IRAIN
+! Case number of sedimentation, T>0 (for HEN)
+ ! and r_x>0 locations
+LOGICAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
+ :: GRAIN, GCLOUD ! Test where to compute all processes
+ ! Test where to compute the SED/EVAP processes
+!++cb++ 15/05/17
+!REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
+! :: ZW, ZZW1, ZZW2, ZZW4 ! work array
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
+ :: ZW, ZZW1, ZZW2, ZZW4, & ! work array
+ ZZW3, ZZW5
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
+ :: ZDIM, &
+ ZLBDC3, ZLBDC, &
+ ZLBDR3, ZLBDR
+!--cb--
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
+ :: ZWEVAP ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)+1) &
+ :: ZWSED ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZLBDAR
+! Slope parameter of the raindrop distribution
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
+ :: ZZRCT, ZZEVAP, ZMASK
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
+ :: ZRAY, & ! Mean radius
+ ZNRT, & ! Number of rain droplets
+ ZLBC , & ! XLBC weighted by sea fraction
+ ZFSEDC
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2)) :: ZCONC_TMP
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZCONC
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSVT ! Tracer m.r. concentration
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZVGG, ZDPG !aerosol velocity [m/s], diffusivity [m2/s]
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRG !Dust R[\b5m]
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOR !Cunningham correction factor [unitless]
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZMASSMIN ! Aerosol mass minimum value
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDENSITY_AER ! Aerosol density
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZTHT, & ! Potential temp
+ ZPABST, & ! Pressure [Pa]
+ ZZW, & ! Work array
+ ZTEMP, & ! Air Temp [K]
+ ZRC, & ! Cloud radius [m]
+ ZRCT, & ! Cloud water
+ ZRR, & ! Rain radius [m]
+ ZNT, & ! Rain droplets number
+ ZRRT, & ! Rain water
+ ZMU,ZMUW, & ! viscosity aerosol, water [Pa s]
+ ZFLUX, & ! Effective precipitation flux (kg.m-2.s-1)
+ ZCONC1D, & ! Weighted droplets concentration
+ ZWLBDC, & ! Slope parameter of the droplet distribution
+ ZGAMMA, & ! scavenging coefficient
+ ZLBDA ! lambda parameter for lima distribution
+REAL, DIMENSION(:), ALLOCATABLE :: ZW1 ! Work arrays
+
+INTEGER :: JL ! and PACK intrinsics
+!
+INTEGER :: JKAQ, JSV
+!
+REAL :: A0, A1, A2, A3 ! Constants for computing viscocity
+INTEGER :: IKE
+!
+REAL, DIMENSION(:), ALLOCATABLE :: KRTMIN
+REAL :: KCEXVT, KLBR, KLBEXR, KLBC, ZLBEXC
+REAL, DIMENSION(2) :: ZXLBC
+REAL :: ZEXSEDR, ZDR, ZEXCACCR, ZFCACCR
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. Initialize work array
+! ---------------------
+!
+!++cb++ 15/05/17 gestion des parametres redondants entre lima et ice3
+! ATTENTION : pour le moment, les autres schemas microphysiques ne sont pas geres
+! NOTE : les noms sont changes dans toute la routine X... --> K...
+SELECT CASE(CCLOUD)
+CASE('ICE3')
+ ALLOCATE(KRTMIN(SIZE(YRTMIN)))
+ KRTMIN(:) = YRTMIN(:)
+ KCEXVT = YCEXVT
+ KLBR = YLBR
+ KLBEXR = YLBEXR
+ ZXLBC(:) = YLBC(:)
+ ZLBEXC = XLBEXC
+ ZEXCACCR = YEXCACCR
+ ZFCACCR = YFCACCR
+CASE('LIMA')
+ ALLOCATE(KRTMIN(SIZE(WRTMIN)))
+ KRTMIN = WRTMIN
+ KCEXVT = WCEXVT
+ KLBR = WLBR
+ KLBEXR = WLBEXR
+ KLBC = WLBC
+ ZLBEXC = 1.0 / 3.0
+ ZDR = 0.8
+ ZEXCACCR = WEXCACCR
+ ZFCACCR = WFCACCR
+END SELECT
+!--cb--
+!
+! Compute Effective cloud radius
+ZRAY(:,:,:) = 0.
+ZLBC(:,:,:) = 0.
+!
+!++th++ 05/05/17 test thomas
+IF (PRESENT(PCCT)) THEN ! case KHKO, C2R2, C3R5, LIMA (two moments schemes)
+!
+ WHERE (PCCT(:,:,:) .GT. 0. .AND. PRCT(:,:,:) .GT. 0.)
+ ZRAY(:,:,:) = 3. * PRCT(:,:,:) / (4. * XPI * XRHOLW * PCCT(:,:,:))
+ ZRAY(:,:,:) = ZRAY(:,:,:)**(1./3.) ! Cloud mean radius in m
+ ELSEWHERE
+ ZRAY(:,:,:) = 30. ! Cloud mean radius in m
+ ENDWHERE
+!--th--
+!
+ELSE IF (PRESENT(PSEA)) THEN ! Case ICE3, REVE, KESS, ..
+ ZLBC(:,:,:) = ZXLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC(:,:,:) = XCONC_LAND
+ ZCONC_TMP(:,:) = PSEA(:,:) * XCONC_SEA + (1. - PSEA(:,:)) * XCONC_LAND
+!
+ DO JK = 1, SIZE(PRHODREF,3)
+ ZLBC(:,:,JK) = PSEA(:,:) * ZXLBC(2) + (1. - PSEA(:,:)) * ZXLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:) * XFSEDC(2) + (1. - PSEA(:,:)) * XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC(:,:,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
+ ZRAY(:,:,:) = MAX(1., ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(ZXLBC(1),ZXLBC(2)), ZLBC(:,:,:))
+ELSE
+ ZRAY(:,:,:) = 30. ! default value for cloud radius
+END IF
+!
+ZNRT(:,:,:) = 0.
+IF (PRESENT(PCRT)) THEN ! case KHKO, C2R2, C3R5, LIMA
+! Transfert Number of rain droplets
+ ZNRT(:,:,:) = PCRT(:,:,:)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE AEROSOL/CLOUD-RAIN MASS TRANSFER
+! ----------------------------------------------
+!
+CALL AER_WET_MASS_TRANSFER
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+CALL AER_WET_DEP_KMT_WARM_SEDIMENT
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES
+! --------------------------------------
+!
+CALL AER_WET_DEP_KMT_ICE_WARM
+!
+!-------------------------------------------------------------------------------
+!* 4. COMPUTES EVAPORATION PROCESS
+! ----------------------------
+!
+CALL AER_WET_DEP_KMT_EVAP
+!
+DEALLOCATE(KRTMIN)
+!
+!-------------------------------------------------------------------------------
+!
+!
+CONTAINS
+!
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE AER_WET_MASS_TRANSFER
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+!
+INTEGER , DIMENSION(SIZE(GCLOUD)) :: I1C,I2C,I3C! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GRAIN)) :: I1R,I2R,I3R ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: JKAQ ! counter for chemistry
+!
+!
+! 1 Mass transfer Aerosol to cloud (Tost et al., 2006)
+!
+GCLOUD(:,:,:) = .FALSE.
+!
+IF (PRESENT(PCCT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
+ GCLOUD(:,:,:) = PRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2)
+ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
+ GCLOUD(:,:,:) = PRCT(:,:,:) > KRTMIN(2)
+END IF
+
+ICLOUD = COUNTJV( GCLOUD(:,:,:),I1C(:),I2C(:),I3C(:))
+IF( ICLOUD >= 1 ) THEN
+ ALLOCATE(ZSVT(ICLOUD,KMODE*3))
+ ALLOCATE(ZRHODREF(ICLOUD))
+ ALLOCATE(ZTHT(ICLOUD))
+ ALLOCATE(ZRC(ICLOUD))
+ ALLOCATE(ZPABST(ICLOUD))
+ ALLOCATE(ZRG(ICLOUD,KMODE))
+ ALLOCATE(ZTEMP(ICLOUD))
+ ALLOCATE(ZMU(ICLOUD))
+ ALLOCATE(ZRCT(ICLOUD))
+ ALLOCATE(ZVGG(ICLOUD,KMODE))
+ ALLOCATE(ZDPG(ICLOUD,KMODE))
+ ALLOCATE(ZGAMMA(ICLOUD))
+ ALLOCATE(ZW1(ICLOUD))
+ ALLOCATE(ZCOR(ICLOUD,KMODE))
+ ALLOCATE(ZMASSMIN(ICLOUD,KMODE))
+ ALLOCATE(ZWLBDC(ICLOUD))
+ ALLOCATE(ZCONC1D(ICLOUD))
+ ALLOCATE(ZDENSITY_AER(ICLOUD,KMODE))
+!
+ ZSVT(:,:) = 0.
+!
+ DO JL = 1, ICLOUD
+ DO JKAQ = 1, KMODE
+ ZRG(JL,JKAQ) = PRGAER(I1C(JL),I2C(JL),I3C(JL),JKAQ)
+ ENDDO
+ DO JKAQ = 1, KMODE*3
+ ZSVT(JL,JKAQ) = PSVT(I1C(JL),I2C(JL),I3C(JL),JKAQ)
+ END DO
+ !
+ ZTHT(JL) = PTHT(I1C(JL),I2C(JL),I3C(JL))
+ ZRC(JL) = ZRAY(I1C(JL),I2C(JL),I3C(JL))
+ ZPABST(JL) = PPABST(I1C(JL),I2C(JL),I3C(JL))
+ ZRCT(JL) = PRCT(I1C(JL),I2C(JL),I3C(JL))
+ ZRHODREF(JL) = PRHODREF(I1C(JL),I2C(JL),I3C(JL))
+ ZMASSMIN(JL,:) = PMASSMIN(I1C(JL),I2C(JL),I3C(JL),:)
+ ZWLBDC(JL) = ZLBC(I1C(JL),I2C(JL),I3C(JL))
+ ZCONC1D(JL) = ZCONC(I1C(JL),I2C(JL),I3C(JL))
+ ZDENSITY_AER(JL,:) = PDENSITY_AER(I1C(JL),I2C(JL),I3C(JL),:)
+ END DO
+!
+ IF (ANY(ZWLBDC(:) /= 0.)) THEN ! case one moments
+ ! On calcule Rc a partir de M(3) car c'est le seul moment indt de alpha et nu
+ ! Rho_air * Rc / (Pi/6 * Rho_eau * Nc) = M(3) = 1/ (Lambda**3 * rapport des
+ ! gamma)
+ ZWLBDC(:) = ZWLBDC(:) * ZCONC1D(:) / (ZRHODREF(:) * ZRCT(:))
+ ZWLBDC(:) = ZWLBDC(:)**ZLBEXC
+ ZRC(:) = ZRC(:) / ZWLBDC(:)
+ END IF
+!
+! initialize temperature
+ ZTEMP(:) = ZTHT(:) * (ZPABST(:) / XP00)**(XRD/XCPD)
+!
+! compute diffusion and gravitation velocity
+ CALL AER_VELGRAV(ZRG(:,:), ZPABST(:), &
+ KMODE, ZMU(:), ZVGG(:,:), &
+ ZDPG(:,:),ZTEMP(:),ZCOR(:,:), &
+ ZDENSITY_AER(:,:))
+
+ DO JKAQ = 1, KMODE
+! Browninan nucleation scavenging (Pruppacher and Klett, 2000, p723)
+ ZGAMMA(:) = 1.35 * ZRCT(:) * ZRHODREF(:) * 1.E-3 * ZDPG(:,JKAQ) / &
+ (ZRC(:) * ZRC(:))
+!
+ ZW1(:) = ZSVT(:,JKAQ) * EXP(-ZGAMMA(:) * PTSTEP)
+ ZW1(:) = MAX(ZW1(:), ZMASSMIN(:,JKAQ))
+! ZW1(:) = MIN(ZW1(:), ZSVT(:,JKAQ))
+! Aerosol mass in cloud
+ ZSVT(:,KMODE+JKAQ) = ZSVT(:,KMODE+JKAQ) + ZSVT(:,JKAQ) - ZW1(:)
+! New aerosol mass
+ ZSVT(:,JKAQ) = ZW1(:)
+! Return in 3D
+ PSVT(:,:,:,JKAQ) = &
+ UNPACK(ZSVT(:,JKAQ),MASK=GCLOUD(:,:,:),FIELD=PSVT(:,:,:,JKAQ))
+ PSVT(:,:,:,KMODE+JKAQ) = &
+ UNPACK(ZSVT(:,KMODE+JKAQ),MASK=GCLOUD(:,:,:),FIELD=PSVT(:,:,:,KMODE+JKAQ))
+ ENDDO
+!
+ DEALLOCATE(ZSVT)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZTHT)
+ DEALLOCATE(ZRC)
+ DEALLOCATE(ZPABST)
+ DEALLOCATE(ZRG)
+ DEALLOCATE(ZTEMP)
+ DEALLOCATE(ZMU)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZVGG)
+ DEALLOCATE(ZDPG)
+ DEALLOCATE(ZGAMMA)
+ DEALLOCATE(ZW1)
+ DEALLOCATE(ZCOR)
+ DEALLOCATE(ZMASSMIN)
+ DEALLOCATE(ZWLBDC)
+ DEALLOCATE(ZCONC1D)
+ DEALLOCATE(ZDENSITY_AER)
+END IF
+!
+! 2 Mass transfer Aerosol to Rain (Seinfeld and Pandis, 1998, Tost et al., 2006)
+!
+GRAIN(:,:,:) = .FALSE.
+!
+IF (PRESENT(PCRT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
+ GRAIN(:,:,:) = PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3)
+ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
+ GRAIN(:,:,:) = PRRT(:,:,:) > KRTMIN(3)
+END IF
+
+IRAIN = COUNTJV( GRAIN(:,:,:),I1R(:),I2R(:),I3R(:))
+IF( IRAIN >= 1 ) THEN
+!
+ ALLOCATE(ZRRT(IRAIN))
+ ALLOCATE(ZSVT(IRAIN,3*KMODE))
+ ALLOCATE(ZRHODREF(IRAIN))
+ ALLOCATE(ZTHT(IRAIN))
+ ALLOCATE(ZRR(IRAIN))
+ ALLOCATE(ZNT(IRAIN))
+ ALLOCATE(ZPABST(IRAIN))
+ ALLOCATE(ZRG(IRAIN,KMODE))
+ ALLOCATE(ZCOR(IRAIN,KMODE))
+ ALLOCATE(ZTEMP(IRAIN))
+ ALLOCATE(ZMU(IRAIN))
+ ALLOCATE(ZVGG(IRAIN,KMODE))
+ ALLOCATE(ZDPG(IRAIN,KMODE))
+ ALLOCATE(ZMUW(IRAIN))
+ ALLOCATE(ZEFC(IRAIN,KMODE))
+ ALLOCATE(ZW1(IRAIN))
+ ALLOCATE(ZFLUX(IRAIN))
+ ALLOCATE(ZGAMMA(IRAIN))
+ ALLOCATE(ZMASSMIN(IRAIN,KMODE))
+ ALLOCATE(ZDENSITY_AER(IRAIN,KMODE))
+ ALLOCATE(ZLBDA(IRAIN))
+!
+ ZSVT(:,:) = 0.
+!
+ DO JL = 1, IRAIN
+ DO JKAQ = 1, KMODE
+ ZRG(JL,JKAQ) = PRGAER(I1R(JL),I2R(JL),I3R(JL),JKAQ )
+ ZSVT(JL,JKAQ) = PSVT(I1R(JL),I2R(JL),I3R(JL),JKAQ)
+ ZSVT(JL,KMODE*2+JKAQ) = PSVT(I1R(JL),I2R(JL),I3R(JL),KMODE*2+JKAQ)
+ END DO
+!
+ ZTHT(JL) = PTHT(I1R(JL),I2R(JL),I3R(JL))
+ ZPABST(JL) = PPABST(I1R(JL),I2R(JL),I3R(JL))
+ ZRRT(JL) = PRRT(I1R(JL),I2R(JL),I3R(JL))
+ ZRHODREF(JL) = PRHODREF(I1R(JL),I2R(JL),I3R(JL))
+ ZMASSMIN(JL,:) = PMASSMIN(I1R(JL),I2R(JL),I3R(JL),:)
+ ZNT(JL) = ZNRT(I1R(JL),I2R(JL),I3R(JL))
+ ZDENSITY_AER(JL,:) = PDENSITY_AER(I1R(JL),I2R(JL),I3R(JL),:)
+ ENDDO
+
+! Compute scavenging coefficient
+ ZFLUX(:) = 0.
+ ZRRT(:) = MAX(ZRRT(:), 0.)
+!
+! Effective precipitation flux (kg.m-2.s-1)
+ IF (PRESENT(PCRT)) THEN ! cf lima_precip_scavenging.f90 (l. 751)
+ ZEXSEDR = (XBR + XDR + 1.0) / (XBR + 1.0)
+
+ ZLBDA(:) = (KLBR * ZNT(:) / ZRRT(:))**KLBEXR
+ ZFLUX(:) = XFSEDRR * ZRRT(:) * ZRHODREF(:)**(1.-KCEXVT) * ZLBDA(:)**(-ZDR)
+
+ ELSE ! cf ZWSED dans rain_ice.f90 (l. 1077)
+ ZFLUX(:) = XFSEDR * ZRRT(:)**(XEXSEDR) * ZRHODREF(:)**(XEXSEDR-KCEXVT)
+ END IF
+ ZFLUX(:) = MAX(ZFLUX(:), 0.)
+
+ IF (ALL(ZNT(:) == 0.)) THEN ! case one moments
+! Number concentration NT=No/lbda p. 415 Jacobson
+! 4/3 *pi *r\b3*NT*rho_eau(kg/m3) =rho(lwc)=rho(air)* qc(kg/kg)
+ ZNT(:) = XCCR / (KLBR * (ZRHODREF(:) * ZRRT(:))**KLBEXR)
+ END IF
+!
+ ZRR(:) = (ZRRT(:) * ZRHODREF(:) / &
+ (XRHOLW * ZNT(:) * 4. / 3. * XPI))**(1./3.)
+
+ CALL AER_WET_DEP_KMT_EFFIC
+
+ DO JKAQ = 1, KMODE
+ ! Tost et al, 2006
+ ZGAMMA(:) = 0.75 * ZEFC(:,JKAQ) * ZFLUX(:) / (ZRR(:) * 1.E3)
+
+ ZW1(:) = ZSVT(:,JKAQ) * EXP(-ZGAMMA(:)*PTSTEP)
+ ZW1(:) = MAX(ZW1(:), ZMASSMIN(:,JKAQ))
+
+ ! Aerosol mass in rain
+ ZSVT(:,KMODE*2+JKAQ) = ZSVT(:,KMODE*2+JKAQ) + ZSVT(:,JKAQ) - ZW1(:)
+
+ ! New aerosol mass
+ ZSVT(:,JKAQ) = ZW1(:)
+
+ ! Return to 3D
+ PSVT(:,:,:,JKAQ) = &
+ UNPACK(ZSVT(:,JKAQ),MASK=GRAIN(:,:,:),FIELD=PSVT(:,:,:,JKAQ))
+ PSVT(:,:,:,KMODE*2+JKAQ) = &
+ UNPACK(ZSVT(:,KMODE*2+JKAQ),MASK=GRAIN(:,:,:),FIELD=PSVT(:,:,:,KMODE*2+JKAQ))
+ ENDDO
+!
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZSVT)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZTHT)
+ DEALLOCATE(ZRR)
+ DEALLOCATE(ZNT)
+ DEALLOCATE(ZPABST)
+ DEALLOCATE(ZRG)
+ DEALLOCATE(ZCOR)
+ DEALLOCATE(ZTEMP)
+ DEALLOCATE(ZMU)
+ DEALLOCATE(ZVGG)
+ DEALLOCATE(ZDPG)
+ DEALLOCATE(ZMUW)
+ DEALLOCATE(ZEFC)
+ DEALLOCATE(ZW1)
+ DEALLOCATE(ZFLUX)
+ DEALLOCATE(ZGAMMA)
+ DEALLOCATE(ZMASSMIN)
+ DEALLOCATE(ZDENSITY_AER)
+ DEALLOCATE(ZLBDA)
+END IF
+!
+END SUBROUTINE AER_WET_MASS_TRANSFER
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE AER_WET_DEP_KMT_WARM_SEDIMENT
+!
+!* Sedimentation of aerosol in rain droplets
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use mode_tools, only: Countjv
+!
+IMPLICIT NONE
+!
+!* declaration of local variables
+!
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: JKAQ ! counter for acquous aerosols
+INTEGER :: IRAIN, ILISTLENR
+INTEGER :: ILENALLOCR
+INTEGER, SAVE :: IOLDALLOCR = 6000
+INTEGER, DIMENSION(SIZE(PZZ)) :: IR1,IR2,IR3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: ILISTR
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAMBDA, ZRHODREF, ZCRT, ZRRT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSVT
+!
+!-------------------------------------------------------------------------------
+!
+!* Time splitting initialization
+!
+ZTSPLITR = PTSTEP / REAL(KSPLITR)
+!
+ZW(:,:,:)=0.
+ZWSED(:,:,:) = 0.
+IKE = SIZE(PRCT,3)
+ILENALLOCR = 0
+
+DO JK = 1 , SIZE(PZZ,3)-1
+ ZW(:,:,JK) = ZTSPLITR / ((PZZ(:,:,JK+1) - PZZ(:,:,JK)))
+END DO
+
+IF (PRESENT(PCRT)) THEN !two moments
+ WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3))
+ ZW(:,:,:) = 0.
+ END WHERE
+ELSE ! one moment
+ WHERE (PRRT(:,:,:) <= KRTMIN(3))
+ ZW(:,:,:) = 0.
+ END WHERE
+END IF
+
+GRAIN(:,:,:) = .FALSE.
+
+IF (PRESENT(PCRT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
+ GRAIN(:,:,:) = PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3)
+ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
+ GRAIN(:,:,:) = PRRT(:,:,:) > KRTMIN(3)
+END IF
+
+IRAIN = COUNTJV( GRAIN(:,:,:),IR1(:),IR2(:),IR3(:))
+
+IF( IRAIN >= 1 ) THEN
+DO JN = 1 , KSPLITR
+ IF( JN==1 ) THEN
+ DO JKAQ = 1,KMODE
+ DO JK = 1, IKE
+ PSVT(:,:,JK,KMODE*2+JKAQ) = PSVT(:,:,JK,KMODE*2+JKAQ) / FLOAT(KSPLITR)
+ END DO
+ END DO
+ END IF
+ IF ( IRAIN .GT. ILENALLOCR ) THEN
+ IF ( ILENALLOCR .GT. 0 ) THEN
+ DEALLOCATE (ILISTR,ZSVT,ZRHODREF,ZCRT,ZRRT,ZLAMBDA)
+ END IF
+ ILENALLOCR = MAX (IOLDALLOCR, 2*IRAIN )
+ IOLDALLOCR = ILENALLOCR
+ ALLOCATE(ILISTR(ILENALLOCR), ZRHODREF(ILENALLOCR), ZSVT(ILENALLOCR,3*KMODE),&
+ ZCRT(ILENALLOCR), ZRRT(ILENALLOCR), ZLAMBDA(ILENALLOCR))
+ END IF
+
+ DO JL = 1, IRAIN
+ DO JKAQ = 1, KMODE
+ ZSVT(JL,KMODE*2+JKAQ) = PSVT(IR1(JL),IR2(JL),IR3(JL),KMODE*2+JKAQ)
+ END DO
+!
+ IF (PRESENT(PCRT)) ZCRT(JL) = PCRT(IR1(JL),IR2(JL),IR3(JL))
+ ZRRT(JL) = PRRT(IR1(JL),IR2(JL),IR3(JL))
+ ZRHODREF(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
+ ENDDO
+
+ ILISTLENR = 0
+ DO JL=1,IRAIN
+ IF (PRESENT(PCRT)) THEN !two moments
+ IF (ZRRT(JL) > KRTMIN(3) .AND. ZCRT(JL) > XCTMIN(3)) THEN
+ ILISTLENR = ILISTLENR + 1
+ ILISTR(ILISTLENR) = JL
+ END IF
+ ELSE ! one moment
+ IF (ZRRT(JL) > KRTMIN(3)) THEN
+ ILISTLENR = ILISTLENR + 1
+ ILISTR(ILISTLENR) = JL
+ END IF
+ END IF
+ END DO
+
+!
+! Flux mass aerosol in rain droplets =
+! Flux mass rain water * Mass aerosol in rain / Mass rain water
+ DO JKAQ = 1,KMODE
+ DO JJ = 1, ILISTLENR
+ JL = ILISTR(JJ)
+ IF (PRESENT(PCRT)) THEN !two moments
+ IF (ZRRT(JL) > KRTMIN(3) .AND. ZCRT(JL) > XCTMIN(3)) THEN
+ ZLAMBDA(JL) = (KLBR * ZCRT(JL) / ZRRT(JL))**KLBEXR
+
+ ZWSED(IR1(JL),IR2(JL),IR3(JL)) = XFSEDRR * ZRHODREF(JL)**(1.-KCEXVT) &
+ * ZLAMBDA(JL)**(-ZDR) &
+ * ZSVT(JL,KMODE*2+JKAQ)
+ END IF
+ ELSE ! one moments
+! cf rain_ice.f90 : l. 1077 (zwsed * psvt(kmode+2+jkaq) / zrrs)
+ IF (ZRRT(JL) > KRTMIN(3)) THEN
+
+ ZWSED(IR1(JL),IR2(JL),IR3(JL)) = XFSEDR &
+ * ZRRT(JL)**(XEXSEDR-1.) &
+ * ZRHODREF(JL)**(XEXSEDR-KCEXVT) &
+ * ZSVT(JL,KMODE*2+JKAQ)
+ END IF
+ END IF ! moments
+ END DO ! JJ
+
+ DO JK = 1, IKE
+ PSVT(:,:,JK,KMODE*2+JKAQ) = PSVT(:,:,JK,KMODE*2+JKAQ) + &
+ ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ END DO ! JKAQ
+
+END DO ! JN - time splitting
+
+ DO JKAQ = 1,KMODE
+! Aerosol mass in rain droplets need to be positive
+ PSVT(:,:,:,KMODE*2+JKAQ) = MAX(PSVT(:,:,:,KMODE*2+JKAQ), 0.)
+ END DO ! KKAQ
+END IF !(IRAIN)
+!
+IF (ALLOCATED(ILISTR)) DEALLOCATE(ILISTR)
+IF (ALLOCATED(ZSVT)) DEALLOCATE(ZSVT)
+IF (ALLOCATED(ZRHODREF)) DEALLOCATE(ZRHODREF)
+IF (ALLOCATED(ZCRT)) DEALLOCATE(ZCRT)
+IF (ALLOCATED(ZRRT)) DEALLOCATE(ZRRT)
+IF (ALLOCATED(ZLAMBDA)) DEALLOCATE(ZLAMBDA)
+
+!
+END SUBROUTINE AER_WET_DEP_KMT_WARM_SEDIMENT
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE AER_WET_DEP_KMT_ICE_WARM
+!
+!* 0. DECLARATIONS
+!
+USE MODD_CST, ONLY: XMNH_HUGE
+
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. compute the autoconversion of r_c for r_r production: RCAUTR
+!
+ZZW4(:,:,:) = 0.0
+! to be sure no division by zero in case of ZZRCT = 0.
+ZZRCT(:,:,:) = PRCT(:,:,:)
+ZZRCT(:,:,:) = MAX(ZZRCT(:,:,:), KRTMIN(2)/2.)
+!
+IF (PRESENT(PCRT)) THEN ! 2-moment schemes
+!
+! from lima_warm_coal.f90 (AUTO)
+ ZLBDC3(:,:,:) = 1E40
+ ! ZLBDC3(:,:,:) = XMNH_HUGE
+ ZLBDC(:,:,:) = 1.E15
+ WHERE (ZZRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2))
+ ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / ZZRCT(:,:,:)
+ ! ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / PRCT(:,:,:)
+ ZLBDC(:,:,:) = ZLBDC3(:,:,:)**ZLBEXC
+ END WHERE
+!
+ ZZW3(:,:,:) = 0.
+ WHERE (ZZRCT(:,:,:) > KRTMIN(2))
+ ZZW3(:,:,:) = MAX(0.0, XLAUTR*PRHODREF(:,:,:)*ZZRCT(:,:,:)* &
+ (XAUTO1/ZLBDC3(:,:,:)**4-XLAUTR_THRESHOLD)) ! L
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), MAX(0.0, XITAUTR*ZZW3(:,:,:)*ZZRCT(:,:,:)* &
+ (XAUTO2/ZLBDC3(:,:,:)-XITAUTR_THRESHOLD))) ! L/tau
+ END WHERE
+!
+ELSE ! 1-moment scheme
+!
+ WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRCT(:,:,:) > 0.0))
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), XTIMAUTC* &
+ MAX((ZZRCT(:,:,:)-XCRIAUTC/PRHODREF(:,:,:)), 0.0))
+ END WHERE
+!
+END IF
+!--cb--
+
+DO JKAQ = 1,KMODE
+ ZZW2(:,:,:) = 0.0
+ ZZW2(:,:,:) = ZZW4(:,:,:) * PSVT(:,:,:,KMODE+JKAQ) / ZZRCT(:,:,:) * PTSTEP
+ ZZW2(:,:,:) = MAX(MIN(ZZW2(:,:,:), PSVT(:,:,:,KMODE+JKAQ)), 0.0)
+
+! For rain - Increase the aerosol conc in rain
+ PSVT(:,:,:,KMODE*2+JKAQ) = PSVT(:,:,:,KMODE*2+JKAQ) + ZZW2(:,:,:)
+! For Cloud Decrease the aerosol conc in cloud
+ PSVT(:,:,:,KMODE+JKAQ) = PSVT(:,:,:,KMODE+JKAQ) - ZZW2(:,:,:)
+ENDDO
+!
+!
+!* 2. compute the accretion of r_c for r_r production: RCACCR
+!
+ZZW4(:,:,:) = 0.0
+ZZW5(:,:,:) = 0.
+ZDIM(:,:,:) = 0.
+ZLBDAR(:,:,:)=0.
+
+!
+IF (PRESENT(PCRT)) THEN ! 2-moment schemes
+!
+! from lima_warm_coal.f90 (ACCR)
+ ZLBDR3(:,:,:) = 1.E30
+ ZLBDR(:,:,:) = 1.E10
+
+
+ WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3))
+ ZLBDAR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
+ ZLBDR3(:,:,:) = KLBR * PCRT(:,:,:) / PRRT(:,:,:)
+ ZLBDR(:,:,:) = ZLBDR3(:,:,:)**KLBEXR
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), ZFCACCR * ZZRCT(:,:,:) &
+ * ZLBDAR(:,:,:)**ZEXCACCR &
+ * PRHODREF(:,:,:)**(-KCEXVT) )
+ ZDIM(:,:,:) = XACCR1 / ZLBDAR(:,:,:)
+ END WHERE
+!
+! Accretion for D > 100 10-6 m
+ WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3) .AND. &
+ ZZRCT(:,:,:) > KRTMIN(2) .AND. ZZW4(:,:,:) > 1.E-4 .AND. &
+ (PRRT(:,:,:) > 1.2*ZZW3(:,:,:)/PRHODREF(:,:,:) .OR. &
+ ZDIM(:,:,:) >= MAX(XACCR2,XACCR3/(XACCR4/ZLBDC(:,:,:)-XACCR5))))
+ ZZW5(:,:,:) = ZLBDC3(:,:,:) / ZLBDR3(:,:,:)
+ ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**2) * PRHODREF(:,:,:)
+ ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW5(:,:,:)), &
+ PRCT(:,:,:))
+ END WHERE
+! Accretion for D < 100 10-6 m
+ WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3) .AND. &
+ ZZRCT(:,:,:) > KRTMIN(2) .AND. ZZW4(:,:,:) <= 1.E-4 .AND. &
+ (PRRT(:,:,:) > (1.2*ZZW2(:,:,:)/PRHODREF(:,:,:)) .OR. &
+ ZDIM(:,:,:) >= MAX(XACCR2,XACCR3/(XACCR4/ZLBDC(:,:,:)-XACCR5))))
+ ZZW5(:,:,:) = (ZLBDC3(:,:,:) / ZLBDR3(:,:,:))**2
+ ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**3) * PRHODREF(:,:,:)
+ ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW5(:,:,:)), &
+ PRCT(:,:,:))
+ END WHERE
+!
+ELSE ! 1-moment schemes
+!
+ ZLBDR(:,:,:) = 0.0
+ WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRRT(:,:,:) > KRTMIN(3)) &
+ .AND. (PRCT(:,:,:) > 0.0))
+ ZLBDR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
+ ZZW4(:,:,:) = MIN(PRCT(:,:,:), ZFCACCR * ZZRCT(:,:,:) &
+ * ZLBDR(:,:,:)**ZEXCACCR &
+ * PRHODREF(:,:,:)**(-KCEXVT) )
+ END WHERE
+END IF
+!--cb--
+!
+DO JKAQ = 1, KMODE
+ ZZW2(:,:,:) = 0.0
+ ZZW2(:,:,:) = ZZW4(:,:,:) * PSVT(:,:,:,KMODE+JKAQ) / ZZRCT(:,:,:) * PTSTEP
+ ZZW2(:,:,:) = MAX(MIN(ZZW2(:,:,:), PSVT(:,:,:,KMODE+JKAQ)), 0.0)
+!
+!
+!* 3. compute the new acqueous aerosol mass
+!
+! For rain - Increase the aerosol conc in rain
+ PSVT(:,:,:,KMODE*2+JKAQ) = PSVT(:,:,:,KMODE*2+JKAQ) + ZZW2(:,:,:)
+! For Cloud Decrease the aerosol conc in cloud
+ PSVT(:,:,:,KMODE+JKAQ) = PSVT(:,:,:,KMODE+JKAQ) - ZZW2(:,:,:)
+ENDDO
+!
+END SUBROUTINE AER_WET_DEP_KMT_ICE_WARM
+!
+!---------------------------------------------------------------------------------------
+!
+ SUBROUTINE AER_WET_DEP_KMT_EVAP
+!
+!* COMPUTES THE EVAPORATION OF CLOUD-RAIN FOR THE
+!* RE-RELEASE OF AER INTO THE ENVIRONMENT
+! --------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* declaration of local variables
+!
+INTEGER :: JKAQ ! counter for aerosols
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. compute the evaporation of r_r: RREVAV
+!
+!When partial reevaporation of precip takes place, the fraction of
+!tracer precipitating form above is reevaporated is equal to
+!half of the evaporation rate of water
+!
+! Rain water evaporated during PTSTEP in kg/kg
+ZZEVAP(:,:,:) = PEVAP3D(:,:,:) * PTSTEP
+!
+! Fraction of rain water evaporated
+! at this stage (bulk), we consider that the flux of evaporated aerosol
+! is a ratio of the evaporated rain water.
+! It will interested to calculate with a two moment scheme (C2R2 or C3R5)
+! the complete evaporation of rain droplet to use it for the compuation
+! of the evaporated aerosol flux.
+ZWEVAP(:,:,:) = 0.0
+WHERE(PRRT(:,:,:) .GT. KRTMIN(3))
+ ZWEVAP(:,:,:) = ZZEVAP(:,:,:) / (PRRT(:,:,:))
+END WHERE
+ZWEVAP(:,:,:) = MIN(ZWEVAP(:,:,:), 1.0)
+ZWEVAP(:,:,:) = MAX(ZWEVAP(:,:,:), 0.0)
+!
+!
+!* 2. compute the mask of r_c evaporation : all cloud is evaporated
+! no partial cloud evaporation at this stage
+!
+ZMASK(:,:,:) = 0.
+WHERE(PRCT(:,:,:) .LT. KRTMIN(2))
+ ZMASK(:,:,:) = 1.
+END WHERE
+!
+DO JKAQ = 1, KMODE
+ ZZW1(:,:,:) = ZMASK(:,:,:) * PSVT(:,:,:,KMODE+JKAQ)
+ ZZW2(:,:,:) = ZWEVAP(:,:,:) * PSVT(:,:,:,KMODE*2+JKAQ)
+!
+ ZZW1(:,:,:) = MIN(ZZW1(:,:,:),PSVT(:,:,:,KMODE+JKAQ))
+ ZZW2(:,:,:) = MIN(ZZW2(:,:,:),PSVT(:,:,:,KMODE*2+JKAQ))
+!
+! 3. New dry aerosol mass
+!
+ PSVT(:,:,:,JKAQ) = PSVT(:,:,:,JKAQ) + ZZW2(:,:,:) + ZZW1(:,:,:)
+!
+!
+! 4. New cloud aerosol mass
+!
+ PSVT(:,:,:,KMODE+JKAQ) = PSVT(:,:,:,KMODE+JKAQ) - ZZW1(:,:,:)
+!
+!
+! 5. New rain aerosol mass
+!
+ PSVT(:,:,:,KMODE*2+JKAQ) = PSVT(:,:,:,KMODE*2+JKAQ) - ZZW2(:,:,:)
+END DO
+!
+END SUBROUTINE AER_WET_DEP_KMT_EVAP
+!
+!---------------------------------------------------------------------------------------
+!
+ SUBROUTINE AER_WET_DEP_KMT_EFFIC
+!
+!* COMPUTES THE EFFICIENCY FACTOR
+! ------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTES THE EFFICIENCY FACTOR
+! --------------------------------------
+!
+!* 1.1 compute gravitational velocities
+!
+!initialize
+ZTEMP(:) = ZTHT(:) * (ZPABST(:) / XP00)**(XRD/XCPD)
+ZTEMP(:) = MAX(ZTEMP(:), 1.e-12)
+!
+CALL AER_VELGRAV(ZRG(:,:), ZPABST(:), KMODE, &
+ ZMU(:), ZVGG(:,:), &
+ ZDPG(:,:),ZTEMP(:), &
+ ZCOR(:,:), ZDENSITY_AER(:,:))
+
+! Above gives mu (ZMU), v(aerosol)(PVGG, m/s), diffusion (ZDPG, m2/s)
+!
+!* 1.2 Compute Water Viscocity in kg/m/s Prup. & Klett, p.95
+!
+A0 = 1.76
+A1 = -5.5721e-2
+A2 = -1.3943e-3
+A3 = -4.3015e-5
+ZMUW(:) = A0 * EXP(A1*(ZTEMP(:)-273.15) &
+ + A2*(ZTEMP(:)-273.15) + A3*(ZTEMP(:)-273.15)) * 1.e-3
+!
+A1 = -3.5254e-2
+A2 = 4.7163e-4
+A3 = -6.0667e-6
+WHERE (ZTEMP(:) > 273.15)
+ ZMUW(:) = A0 * EXP(A1*(ZTEMP(:)-273.15) &
+ + A2*(ZTEMP(:)-273.15) + A3*(ZTEMP(:)-273.15)) * 1.e-3
+END WHERE
+ZMUW(:) = MAX(ZMUW(:), 1.e-12)
+!
+!* 1.3 compute efficiency factor
+!
+! This gives aerosol collection efficiency by calculating Reynolds number
+! schmidt number, stokes number, etc
+CALL AER_EFFIC(ZRG(:,:), ZVGG(:,:), & !aerosol radius/velocity
+ ZRHODREF(:), & !Air density
+ ZMUW(:), ZMU(:), & !mu water/air
+ ZDPG(:,:), ZEFC(:,:), & !diffusivity, efficiency
+ ZRRT(:), KMODE, & !Rain water, nb aerosols modes
+ ZTEMP(:),ZCOR(:,:), & ! Temperature, Cunnimgham coeff
+ ZDENSITY_AER(:,:), & ! aerosol density
+ ZRR, ZNT ) ! radius and number of rain drops
+!
+END SUBROUTINE AER_WET_DEP_KMT_EFFIC
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE AER_WET_DEP_KMT_WARM
diff --git a/src/PHYEX/ext/aero_effic3D.f90 b/src/PHYEX/ext/aero_effic3D.f90
new file mode 100644
index 0000000000000000000000000000000000000000..05d5e2ce113b62c25577b3a085670c1e4766cc38
--- /dev/null
+++ b/src/PHYEX/ext/aero_effic3D.f90
@@ -0,0 +1,247 @@
+!MNH_LIC Copyright 1994-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.
+!
+! ######spll
+ MODULE MODI_AERO_EFFIC3D
+!! ########################
+!!
+!
+INTERFACE
+!!
+SUBROUTINE AERO_EFFIC3D(PRG,PVGG, & !aerosol radius/fall speed (m/s)
+ PRHODREF, & !Air density
+ PMUW, PMU, & !mu water/air
+ PDPG, & !diffusivity
+ PURR, & ! Rain water m.r. at time t
+ KMODE, & ! Number of aerosol modes
+ PTEMP, PCOR, & ! air temp, cunningham corr factor
+ PDENSITY_AER, & ! aerosol density
+ PEFFIC_AER ) ! scavenging efficiency for aerosol
+!
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG, PVGG
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDPG
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMU, PMUW
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCOR
+INTEGER, INTENT(IN) :: KMODE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PEFFIC_AER
+
+
+
+END SUBROUTINE AERO_EFFIC3D
+!!
+END INTERFACE
+END MODULE MODI_AERO_EFFIC3D
+! ######spll
+SUBROUTINE AERO_EFFIC3D(PRG,PVGG, & !aerosol radius/fall speed (m/s)
+ PRHODREF, & !Air density
+ PMUW, PMU, & !mu water/air
+ PDPG, & !diffusivity
+ PURR, & ! Rain water m.r. at time t
+ KMODE, & ! Number of aerosol modes
+ PTEMP, PCOR, & ! air temp, cunningham corr factor
+ PDENSITY_AER, & ! aerosol density
+ PEFFIC_AER ) ! scavenging efficiency for aerosol
+!! #######################################
+!!**********AERO_EFFIC3D**********
+!! PURPOSE
+!! -------
+!! Calculate the collection efficiency of
+! a falling drop interacting with a dust aerosol
+! for use with aer_wet_dep_kmt_warm.f90
+!!
+!!** METHOD
+!! ------
+!! Using basic theory, and the one dimensional variables sent
+!! from aer_wet_dep_kmt_warm.f90, calculation of the average
+!! fall speed calculations, chapter 17.3.4, MESONH Handbook
+!! droplet number based on the Marshall_Palmer distribution
+!! and Stokes number, Reynolds number, etc. based on theory
+!! (S&P, p.1019)
+!!
+!! REFERENCE
+!! ---------
+!! Seinfeld and Pandis p.1019
+!! MESONH Handbook chapter 17.3.4
+!!
+!! AUTHOR
+!! ------
+!! K. Crahan Kaku / P. Tulet (CNRM/GMEI)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Philippe Wautelet 28/05/2018: corrected truncated integer division (1/12 -> 1./12.)
+!!
+!-----------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_RAIN_ICE_PARAM_n
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_CST, ONLY : XPI, XRHOLW, XP00, XRD
+USE MODD_PARAMETERS , ONLY : JPVEXT
+USE MODD_REF, ONLY : XTHVREFZ
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG, PVGG
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDPG
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMU, PMUW
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCOR
+INTEGER, INTENT(IN) :: KMODE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PEFFIC_AER
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IKB ! Coordinates of the first physical
+ ! points along z
+REAL :: ZRHO00 ! Surface reference air density
+!viscosity ratio, Reynolds number
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZOMG, ZREY
+!rain radius, m, and rain fall speed, m/s; aerosol radius (m),
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRR, ZVR
+!lambda, number concentration according to marshall palmer,
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZNT, ZLBDA
+! Rain water m.r. source
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRRS
+!RHO_dref*r_r, Rain LWC
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRLWC
+! schmidts number
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),KMODE) :: ZSCH
+!
+!Stokes number, ratio of diameters,aerosol radius
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),KMODE) :: ZSTO, ZPHI, ZRG
+! S Star Term
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZSTA, ZDIFF, ZTAU
+!
+!Term 1, Term 2, Term 3, Term 4 such that
+! E = Term1 * Term 2 + Term 3 + Term 4
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),KMODE) :: ZT1, ZT2
+REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),KMODE) :: ZT3, ZT4
+!
+INTEGER :: JI,JK
+!
+!-----------------------------------------------------------------
+ZLBDA = 1E20
+ZNT = 1E-20
+ZRR = 10E-6
+ZRRS(:,:,:)=PURR(:,:,:)
+IKB = 1 + JPVEXT
+ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+ZRG(:,:,:,:)=PRG(:,:,:,:)*1.E-6 !change units to meters
+!
+!Fall Speed calculations
+!similar to rain_ice.f90, chapter 17.3.4, MESONH Handbook
+!
+ZVR (:,:,:)= XFSEDR * ZRRS(:,:,:)**(XEXSEDR-1) * &
+ PRHODREF(:,:,:)**(XEXSEDR-XCEXVT-1)
+
+! Drop Radius calculation in m
+!lbda = pi*No*rho(lwc)/(rho(dref)*rain rate) p.212 MESONH Handbook
+! compute the slope parameter Lbda_r
+
+WHERE((ZRRS(:,:,:).GT. 0.).AND.(PRHODREF(:,:,:) .GT. 0.))
+
+ZLBDA(:,:,:) = XLBR*(PRHODREF(:,:,:)*ZRRS(:,:,:))**XLBEXR
+!Number concentration NT=No/lbda p. 415 Jacobson
+ZNT(:,:,:) = XCCR/ZLBDA(:,:,:)
+!rain lwc (kg/m3) = rain m.r.(kg/kg) * rho_air(kg/m3)
+ZRLWC(:,:,:)=ZRRS(:,:,:)*PRHODREF(:,:,:)
+!4/3 *pi *r**3*NT*rho_eau(kg/m3) =rho(lwc)=rho(air)* qc(kg/kg)
+ZRR(:,:,:) = (ZRLWC(:,:,:)/(XRHOLW*ZNT(:,:,:)*4./3.*XPI))**(1./3.)
+END WHERE
+
+ZRR(:,:,:) = MIN(ZRR(:,:,:), 100.E-6)
+
+
+!Fall speed cannot be faster than 7 m/s
+ZVR (:,:,:)=MIN(ZVR (:,:,:),7.)
+
+
+!Ref SEINFELD AND PANDIS p.1019
+! Viscosity Ratio
+ZOMG(:,:,:)=PMUW(:,:,:)/PMU(:,:,:)
+!!Reynolds number
+ZREY(:,:,:)=ZRR(:,:,:)*ZVR(:,:,:)*PRHODREF(:,:,:)/PMU(:,:,:)
+ZREY(:,:,:)= MAX(ZREY(:,:,:), 1E-2)
+
+
+!S Star
+ZSTA(:,:,:)=(1.2+(1./12.)*LOG(1.+ZREY(:,:,:)))/(1.+LOG(1.+ZREY(:,:,:)))
+
+PEFFIC_AER(:,:,:,:)=0.0
+
+DO JI=1,KMODE
+
+!
+!Scmidts number
+ ZSCH(:,:,:,JI)=PMU(:,:,:)/PRHODREF(:,:,:)/PDPG(:,:,:,JI)
+! Rain-Aerosol relative velocity
+ ZDIFF(:,:,:) = MAX(ZVR(:,:,:)-PVGG(:,:,:,JI),0.)
+
+
+! Relaxation time
+ ZTAU(:,:,:) = (ZRG(:,:,:,JI)*2.)**2. * PDENSITY_AER(:,:,:,JI) * PCOR(:,:,:,JI) / (18.*PMU(:,:,:))
+
+
+! Stockes number
+ ZSTO(:,:,:,JI)= ZTAU(:,:,:) * ZDIFF(:,:,:) / ZRR(:,:,:)
+
+
+
+!Ratio of diameters
+ ZPHI(:,:,:,JI)=ZRG(:,:,:,JI)/ZRR(:,:,:)
+ ZPHI(:,:,:,JI)=MIN(ZPHI(:,:,:,JI), 1.)
+!Term 1
+ ZT1(:,:,:,JI)=4.0/ZREY(:,:,:)/ZSCH(:,:,:,JI)
+
+!Term 2
+ ZT2(:,:,:,JI)=1.0+(0.4*ZREY(:,:,:)**(0.5)*ZSCH(:,:,:,JI)**(1./3.))+ &
+ (0.16*ZREY(:,:,:)**(0.5)*ZSCH(:,:,:,JI)**(0.5))
+
+!Brownian diffusion
+ ZT1(:,:,:,JI)= ZT1(:,:,:,JI)*ZT2(:,:,:,JI)
+
+!Term 3 - interception
+ ZT3(:,:,:,JI)=4.*ZPHI(:,:,:,JI)*(1./ZOMG(:,:,:)+ &
+ (1.0+(2.0*ZREY(:,:,:)**0.5))*ZPHI(:,:,:,JI))
+
+ ZT4(:,:,:,JI)=0.0
+ WHERE(ZSTO(:,:,:,JI).GT.ZSTA(:,:,:))
+!Term 4 - impaction
+ ZT4(:,:,:,JI)=((ZSTO(:,:,:,JI)-ZSTA(:,:,:))/ &
+ (ZSTO(:,:,:,JI)-ZSTA(:,:,:)+2./3.))**(3./2.) &
+ *((XRHOLW/PDENSITY_AER(:,:,:,JI))**(1./2.))
+
+ END WHERE
+
+!Collision Efficiancy
+
+
+ PEFFIC_AER(:,:,:,JI)=ZT1(:,:,:,JI)+ ZT3(:,:,:,JI)+ZT4(:,:,:,JI)
+
+! Physical radius of a rain collector droplet up than 20 um
+
+WHERE (ZRR(:,:,:) .LE. 9.9E-6)
+ PEFFIC_AER(:,:,:,JI)= 0.
+END WHERE
+
+ENDDO
+
+PEFFIC_AER(:,:,:,:)=MIN(PEFFIC_AER(:,:,:,:),1.0)
+PEFFIC_AER(:,:,:,:)=MAX(PEFFIC_AER(:,:,:,:),0.0)
+
+END SUBROUTINE AERO_EFFIC3D
diff --git a/src/PHYEX/ext/aircraft_balloon_evol.f90 b/src/PHYEX/ext/aircraft_balloon_evol.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d59b33721819904ac9baabd7719c0572b91a2433
--- /dev/null
+++ b/src/PHYEX/ext/aircraft_balloon_evol.f90
@@ -0,0 +1,1037 @@
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Author: Valery Masson (Meteo-France *)
+! Original 15/05/2000
+! Modifications:
+! G. Jaubert 19/04/2001: add CVBALL type
+! P. Lacarrere 03/2008: add 3D fluxes
+! M. Leriche 12/12/2008: move ZTDIST out from if.not.(tpflyer%fly)
+! V. Masson 15/12/2008: correct do while aircraft move
+! O. Caumont 03/2013: add radar reflectivities
+! C. Lac 04/2014: allow RARE calculation only if CCLOUD=ICE3
+! O. Caumont 05/2014: modify RARE for hydrometeors containing ice + add bright band calculation for RARE
+! C. Lac 02/2015: correction to prevent aircraft crash
+! O. Nuissier/F. Duffourg 07/2015: add microphysics diagnostic for aircraft, ballon and profiler
+! G. Delautier 10/2016: LIMA
+! 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 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 01/10/2020: bugfix: initialize GSTORE
+! P. Wautelet 14/01/2021: bugfixes: -ZXCOEF and ZYCOEF were not computed if CVBALL
+! -PCIT was used if CCLOUD/=ICEx (not allocated)
+! -PSEA was always used even if not allocated (CSURF/=EXTE)
+! -do not use PMAP if cartesian domain
+! P. Wautelet 06/2022: reorganize flyers
+! P. Wautelet 01/06/2023: deduplicate code => moved to modd/mode_sensors.f90
+!-----------------------------------------------------------------
+! ##########################
+MODULE MODE_AIRCRAFT_BALLOON_EVOL
+! ##########################
+
+USE MODE_MSG
+
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: AIRCRAFT_BALLOON_EVOL
+
+PUBLIC :: AIRCRAFT_COMPUTE_POSITION
+
+PUBLIC :: FLYER_GET_RANK_MODEL_ISCRASHED
+
+CONTAINS
+! ########################################################
+ SUBROUTINE AIRCRAFT_BALLOON_EVOL(PTSTEP, &
+ PZ, PMAP, PLONOR, PLATOR, &
+ PU, PV, PW, PP, PTH, PR, PSV, PTKE, &
+ PTS, PRHODREF, PCIT, TPFLYER, &
+ KRANK_CUR, KRANK_NXT, PSEA )
+! ########################################################
+!
+!
+!!**** *AIRCRAFT_BALLOON_EVOL* - (advects and) stores
+!! balloons/aircrafts in the model
+!!
+!! PURPOSE
+!! -------
+!
+!
+!!** METHOD
+!! ------
+!!
+!! 1) All the balloons are tested. If the current balloon is
+!! a) in the current model
+!! b) not crashed
+!! the following computations are done.
+!!
+!! 2) The balloon position is computed.
+!! Interpolations at balloon positions are performed according to mass
+!! points (because density is computed here for iso-density balloons).
+!! Therefore, all model variables are used at mass points. Shuman averaging
+!! are performed on X, Y, Z, U, V, W.
+!!
+!! 3) Storage of balloon data
+!! If storage is asked for this time-step, the data are recorded in the
+!! balloon time-series.
+!!
+!! 4) Balloon advection
+!! If the balloon is launched, it is advected according its type
+!! a) iso-density balloons are advected following horizontal wind.
+!! the slope of the iso-density surfaces is neglected.
+!! b) radio-sounding balloons are advected according to all wind velocities.
+!! the vertical ascent speed is added to the vertical wind speed.
+!! c) Constant Volume balloons are advected according to all wind velocities.
+!! the vertical ascent speed is computed using the balloon equation
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_AIRCRAFT_BALLOON
+USE MODD_CST, ONLY: XCPD, XLVTT
+USE MODD_IO, ONLY: ISP
+USE MODD_TIME_n, ONLY: TDTCUR
+USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY: XRCW_FLUX, XSVW_FLUX, XTHW_FLUX
+!
+USE MODE_DATETIME
+USE MODE_NEST_ll, ONLY: GET_MODEL_NUMBER_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+REAL, INTENT(IN) :: PTSTEP ! time step
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
+REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! map factor
+REAL, INTENT(IN) :: PLONOR ! origine longitude
+REAL, INTENT(IN) :: PLATOR ! origine latitude
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! horizontal wind X component
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! horizontal wind Y component
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW ! vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! potential temperature
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratios
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSV ! Scalar variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE ! turbulent kinetic energy
+REAL, DIMENSION(:,:), INTENT(IN) :: PTS ! surface temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry air density of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! pristine ice concentration
+!
+CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
+INTEGER, INTENT(IN) :: KRANK_CUR
+INTEGER, INTENT(OUT) :: KRANK_NXT
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+!
+INTEGER :: IMI ! model index
+INTEGER :: IKB ! vertical domain sizes
+INTEGER :: IKE
+INTEGER :: IKU
+!
+REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZM ! mass point coordinates
+REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZU ! U points z coordinates
+REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZV ! V points z coordinates
+REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZWM ! mass point wind
+!
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZEXN ! Exner function
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTH_EXN ! potential temperature multiplied by Exner function
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRHO ! air density
+REAL :: ZFLYER_EXN ! balloon/aircraft Exner func.
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTHW_FLUX !
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRCW_FLUX !
+REAL, DIMENSION(2,2,SIZE(PSV,3),SIZE(PSV,4)) :: ZSVW_FLUX
+!
+LOGICAL :: GLAUNCH ! launch/takeoff is effective at this time-step (if true)
+LOGICAL :: GOWNER_CUR ! The process is the current owner of the flyer
+!
+INTEGER :: II_M ! mass balloon position (x index)
+INTEGER :: IJ_M ! mass balloon position (y index)
+INTEGER :: II_U ! U flux point balloon position (x index)
+INTEGER :: IJ_V ! V flux point balloon position (y index)
+!
+INTEGER :: ISTORE ! time index for storage
+!
+REAL :: ZTSTEP
+TYPE(DATE_TIME) :: TZNEXT ! Time for next position
+!----------------------------------------------------------------------------
+IKU = SIZE(PZ,3)
+
+CALL GET_MODEL_NUMBER_ll(IMI)
+
+! Set initial value for KRANK_NXT
+! It needs to be 0 on all processes except the one where it is when this subroutine is called
+! If the flyer flies to an other process, KRANK_NXT will be set accordingly by the current owner
+IF ( TPFLYER%NRANK_CUR == ISP ) THEN
+ GOWNER_CUR = .TRUE. ! This variable is set and used because NRANK_CUR could change in this subroutine
+ KRANK_NXT = ISP
+ELSE
+ GOWNER_CUR = .FALSE.
+ KRANK_NXT = 0
+END IF
+
+SELECT TYPE ( TPFLYER )
+ CLASS IS ( TAIRCRAFTDATA)
+ ! Take-off?
+ TAKEOFF: IF ( .NOT. TPFLYER%LTOOKOFF ) THEN
+ ! Do the take-off positioning only once
+ ! (on model 1 for 'MOB', if aircraft is on an other model, data will be available on the right one anyway)
+ IF ( ( TPFLYER%CMODEL == 'MOB' .AND. IMI == 1 ) &
+ .OR. ( TPFLYER%CMODEL == 'FIX' .AND. IMI == TPFLYER%NMODEL ) ) THEN
+ ! Is the aircraft in flight ?
+ IF ( TDTCUR >= TPFLYER%TLAUNCH .AND. TDTCUR <= TPFLYER%TLAND ) THEN
+ TPFLYER%LFLY = .TRUE.
+ TPFLYER%LTOOKOFF = .TRUE.
+ END IF
+ END IF
+ END IF TAKEOFF
+
+ !Do we have to store aircraft data?
+ IF ( IMI == TPFLYER%NMODEL ) THEN
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
+ END IF
+
+
+ ! For aircrafts, data has only to be computed at store moments
+ IF ( IMI == TPFLYER%NMODEL .AND. TPFLYER%LFLY .AND. TPFLYER%LSTORE ) THEN
+ ! Check if it is the right moment to store data
+ IF ( ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
+ ISOWNERAIR: IF ( TPFLYER%NRANK_CUR == ISP ) THEN
+ CALL FLYER_INTERP_TO_MASSPOINTS()
+
+ ZEXN(:,:,:) = FLYER_COMPUTE_EXNER( )
+ ZRHO(:,:,:) = FLYER_COMPUTE_RHO( )
+
+ ZTHW_FLUX(:,:,:) = ZRHO(:,:,:)*XCPD *XTHW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:)
+ ZRCW_FLUX(:,:,:) = ZRHO(:,:,:)*XLVTT*XRCW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:)
+ ZSVW_FLUX(:,:,:,:) = XSVW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:,:)
+
+ ! Compute coefficents for horizontal interpolations
+ CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1( )
+ ! Compute coefficents for vertical interpolations
+ CALL FLYER_COMPUTE_INTERP_COEFF_VER( )
+ ! Compute coefficents for horizontal interpolations
+ CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
+
+ CALL FLYER_RECORD_DATA( )
+ END IF ISOWNERAIR
+
+ ! Store has been done
+ TPFLYER%LSTORE = .FALSE.
+ END IF
+ END IF
+
+ ! Compute next position if the previous store has just been done (right moment on right model)
+ IF ( IMI == TPFLYER%NMODEL .AND. ISTORE > 0 ) THEN
+ ! This condition may only be tested if ISTORE > 0
+ IF (ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
+ ! Next store moment
+ TZNEXT = TDTCUR + TPFLYER%TFLYER_TIME%XTSTEP
+
+ ! Is the aircraft in flight ?
+ IF ( TZNEXT >= TPFLYER%TLAUNCH .AND. TZNEXT <= TPFLYER%TLAND ) THEN
+ TPFLYER%LFLY = .TRUE.
+ ! Force LTOOKOFF to prevent to do it again (at a next timestep)
+ TPFLYER%LTOOKOFF = .TRUE.
+
+ ! Compute next position
+ CALL AIRCRAFT_COMPUTE_POSITION( TZNEXT, TPFLYER )
+
+ ! Get rank of the process where the aircraft is and the model number
+ CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPFLYER )
+ ELSE
+ TPFLYER%LFLY = .FALSE.
+ END IF
+ END IF
+ END IF
+
+ IF ( GOWNER_CUR ) KRANK_NXT = TPFLYER%NRANK_CUR
+
+ CLASS IS ( TBALLOONDATA)
+ GLAUNCH = .FALSE. !Set to true only at the launch instant (set to false in flight after launch)
+
+ ! Launch?
+ LAUNCH: IF ( .NOT. TPFLYER%LFLY .AND. .NOT. TPFLYER%LCRASH .AND. TPFLYER%NMODEL == IMI ) THEN
+ ! Check if it is launchtime
+ LAUNCHTIME: IF ( ( TDTCUR - TPFLYER%TLAUNCH ) >= -1.e-10 ) THEN
+ TPFLYER%LFLY = .TRUE.
+ GLAUNCH = .TRUE.
+
+ TPFLYER%XX_CUR = TPFLYER%XXLAUNCH
+ TPFLYER%XY_CUR = TPFLYER%XYLAUNCH
+ TPFLYER%TPOS_CUR = TDTCUR
+ END IF LAUNCHTIME
+ END IF LAUNCH
+
+ ! Check if it is time to store data. This has also to be checked if the balloon
+ ! is not yet launched or is crashed (data is also written in these cases, but with default values)
+ IF ( TPFLYER%NMODEL == IMI .AND. &
+ ( .NOT. TPFLYER%LFLY .OR. TPFLYER%LCRASH .OR. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) ) THEN
+ !Do we have to store balloon data?
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
+ END IF
+
+ ! In flight
+ INFLIGHTONMODEL: IF ( TPFLYER%LFLY .AND. .NOT. TPFLYER%LCRASH .AND. TPFLYER%NMODEL == IMI &
+ .AND. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) THEN
+ ISOWNERBAL: IF ( TPFLYER%NRANK_CUR == ISP ) THEN
+ CALL FLYER_INTERP_TO_MASSPOINTS()
+
+ ZEXN(:,:,:) = FLYER_COMPUTE_EXNER( )
+ ZRHO(:,:,:) = FLYER_COMPUTE_RHO( )
+
+ ZTHW_FLUX(:,:,:) = ZRHO(:,:,:)*XCPD *XTHW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:)
+ ZRCW_FLUX(:,:,:) = ZRHO(:,:,:)*XLVTT*XRCW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:)
+ ZSVW_FLUX(:,:,:,:) = XSVW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:,:)
+
+ ! Compute coefficents for horizontal interpolations
+ CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1( )
+
+ IF ( GLAUNCH ) CALL BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION( TPFLYER )
+
+ ! Compute coefficents for vertical interpolations
+ CALL FLYER_COMPUTE_INTERP_COEFF_VER( )
+
+ CRASH_VERT: IF ( TPFLYER%LCRASH ) THEN
+ TPFLYER%LFLY = .FALSE.
+ WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
+ 's (too low or too high)' )" ) &
+ TRIM( TPFLYER%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ ELSE CRASH_VERT
+ !No vertical crash
+
+ ! Compute coefficents for horizontal interpolations
+ CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
+
+ ! Check if it is the right moment to store data
+ IF ( TPFLYER%LSTORE ) THEN
+ ISTORE = TPFLYER%TFLYER_TIME%N_CUR
+ IF ( ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
+ CALL FLYER_RECORD_DATA( )
+ END IF
+ END IF
+
+ ! Compute next horizontal position (balloon advection)
+ CALL BALLOON_ADVECTION_HOR( TPFLYER )
+
+ ! Compute next vertical position (balloon advection)
+ CALL BALLOON_ADVECTION_VER( TPFLYER )
+
+ TPFLYER%TPOS_CUR = TDTCUR + ZTSTEP
+ END IF CRASH_VERT !end of no vertical crash branch
+ END IF ISOWNERBAL
+ END IF INFLIGHTONMODEL
+
+ IF ( GOWNER_CUR ) KRANK_NXT = TPFLYER%NRANK_CUR
+END SELECT
+
+CONTAINS
+
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION( TPBALLOON )
+
+USE MODD_CST, ONLY: XCPD, XP00, XRD
+
+IMPLICIT NONE
+
+CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+
+LOGICAL :: GLOW, GHIGH
+
+SELECT CASE ( TPBALLOON%CTYPE )
+ !
+ ! Iso-density balloon
+ !
+ CASE ( 'ISODEN' )
+ IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
+ ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
+ ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH )
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
+ ELSE
+ CMNHMSG(1) = 'Error in balloon initial position (balloon ' // TRIM(TPBALLOON%CNAME) // ' )'
+ CMNHMSG(2) = 'neither initial ALTITUDE or PRESsure is given'
+ CMNHMSG(3) = 'Check your INI_BALLOON routine'
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ END IF
+ !
+ ! Radiosounding balloon
+ !
+ CASE ( 'RADIOS' )
+ TPBALLOON%XZ_CUR = TPBALLOON%XALTLAUNCH
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,1,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+ IF ( TPBALLOON%XZ_CUR > TPBALLOON%XALTLAUNCH ) THEN
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3, " (instead of ", EN12.3, ")" )' ) TPBALLOON%XZ_CUR, TPBALLOON%XALTLAUNCH
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+ END IF
+ !
+ ! Constant Volume Balloon
+ !
+ CASE ( 'CVBALL' )
+ IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ IF ( GLOW ) THEN
+ TPBALLOON%XZ_CUR = TPBALLOON%XALTLAUNCH
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,1,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3, " (instead of ", EN12.3, ")" )' ) TPBALLOON%XZ_CUR, TPBALLOON%XALTLAUNCH
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XALTLAUNCH, ZZM, GLOW, GHIGH )
+ ELSE
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
+ END IF
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
+ ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
+ ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH )
+ IF ( GLOW ) THEN
+ TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3 )' ) TPBALLOON%XZ_CUR
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XZ_CUR, ZZM, GLOW, GHIGH )
+ ELSE
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
+ END IF
+ TPBALLOON%XRHO = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
+ ELSE
+ TPBALLOON%XRHO = TPBALLOON%XMASS / TPBALLOON%XVOLUME
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XRHO, ZRHO, GLOW, GHIGH )
+ IF ( GLOW ) THEN
+ TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
+ TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
+
+ WRITE( CMNHMSG(1), '(A)' ) 'initial vertical position of ' // TRIM( TPBALLOON%CNAME ) // ' was too low'
+ WRITE( CMNHMSG(2), '( "forced to ", EN12.3 )' ) TPBALLOON%XZ_CUR
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION', OLOCAL = .TRUE. )
+
+ !Recompute the vertical interpolation coefficients at the corrected vertical position
+ CALL TPBALLOON%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPBALLOON%XZ_CUR, ZZM, GLOW, GHIGH )
+ ELSE
+ TPBALLOON%XZ_CUR = TPBALLOON%INTERP_FROM_MASSPOINT( ZZM )
+ END IF
+ END IF
+END SELECT
+
+END SUBROUTINE BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE BALLOON_ADVECTION_HOR( TPBALLOON )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: TBALLOONDATA
+USE MODD_CONF, ONLY: LCARTESIAN
+USE MODD_NESTING, ONLY: NDAD, NDTRATIO
+USE MODD_TIME, only: TDTSEG
+USE MODD_TIME_n, ONLY: TDTCUR
+
+IMPLICIT NONE
+
+CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+
+INTEGER :: IMODEL
+INTEGER :: IMODEL_OLD
+REAL :: ZX_OLD, ZY_OLD
+REAL :: ZDELTATIME
+REAL :: ZDIVTMP
+REAL :: ZMAP ! map factor at balloon location
+REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
+REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
+
+ZTSTEP = PTSTEP
+
+ZU_BAL = TPBALLOON%INTERP_FROM_UPOINT( PU )
+ZV_BAL = TPBALLOON%INTERP_FROM_VPOINT( PV )
+if ( .not. lcartesian ) then
+ ZMAP = TPBALLOON%INTERP_HOR_FROM_MASSPOINT( PMAP )
+else
+ ZMAP = 1.
+end if
+!
+ZX_OLD = TPBALLOON%XX_CUR
+ZY_OLD = TPBALLOON%XY_CUR
+
+TPBALLOON%XX_CUR = TPBALLOON%XX_CUR + ZU_BAL * ZTSTEP * ZMAP
+TPBALLOON%XY_CUR = TPBALLOON%XY_CUR + ZV_BAL * ZTSTEP * ZMAP
+
+! Compute rank and model for next position
+! This is done here because we need to check if there is a change of model (for 'MOB' balloons)
+! because position has to be adapted to the timestep of a coarser model (if necessary)
+IMODEL_OLD = TPBALLOON%NMODEL
+
+! Get rank of the process where the balloon is and the model number
+CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPBALLOON )
+
+IF ( TPBALLOON%LCRASH ) THEN
+ WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
+ 's (out of the horizontal boundaries)' )" ) &
+ TRIM( TPBALLOON%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+END IF
+
+IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
+ ! Balloon has changed of model
+ IF ( NDAD(TPBALLOON%NMODEL ) == IMODEL_OLD ) THEN
+ ! Nothing special to do when going to child model
+ ELSE IF ( TPBALLOON%NMODEL == NDAD(IMODEL_OLD) ) THEN
+ ! Balloon go to parent model
+ ! Recompute position to be compatible with parent timestep
+ ! Parent timestep could be bigger (factor NDTRATIO) and therefore next position is not the one computed just before
+
+ ! Determine step compatible with parent model at next parent timestep
+ ZDELTATIME = TDTCUR - TDTSEG
+ ZDIVTMP = ZDELTATIME / ( PTSTEP * NDTRATIO(IMODEL_OLD) )
+ IF ( ABS( ZDIVTMP - NINT( ZDIVTMP ) ) < 1E-6 * PTSTEP * NDTRATIO(IMODEL_OLD) ) THEN
+ ! Current time is a multiple of parent timestep => next position is parent timestep
+ ZTSTEP = ZTSTEP * NDTRATIO(IMODEL_OLD)
+ ELSE
+ ! Current time is not a multiple of parent timestep
+ ! Next position must be a multiple of parent timestep
+ ! NINT( NDTRATIO(IMODEL_OLD) * ( 1 - ( ZDIVTMP - INT( ZDIVTMP ) ) ) ) corresponds to the number
+ ! of child timesteps to go to the next parent timestep
+ ! We skip one timestep (+NDTRATIO(IMODEL_OLD)) because it has already been computed for the parent model
+ ZTSTEP = ZTSTEP * ( NINT( NDTRATIO(IMODEL_OLD) * ( 1 - ( ZDIVTMP - INT( ZDIVTMP ) ) ) ) + NDTRATIO(IMODEL_OLD) )
+
+ ! Detect if we need to skip a store (if time of next position is after time of next store)
+ ! This can happen when a ballon goes to its parent model
+ IF ( TDTCUR + ZTSTEP > TPBALLOON%TFLYER_TIME%TPDATES(TPBALLOON%TFLYER_TIME%N_CUR) + TPBALLOON%TFLYER_TIME%XTSTEP + 1e-6 ) THEN
+ !Force a dummy store (nothing is computed, therefore default/initial values will be stored)
+ TPBALLOON%LSTORE = .TRUE.
+
+ TPBALLOON%TFLYER_TIME%N_CUR = TPBALLOON%TFLYER_TIME%N_CUR + 1
+ ISTORE = TPBALLOON%TFLYER_TIME%N_CUR
+
+ !Remark: by construction here, ISTORE is always > 1 => no risk with ISTORE-1 value
+ TPBALLOON%TFLYER_TIME%TPDATES(ISTORE) = TPBALLOON%TFLYER_TIME%TPDATES(ISTORE-1) + TPBALLOON%TFLYER_TIME%XTSTEP
+
+ WRITE( CMNHMSG(1), "( 'Balloon ', A, ': store skipped at ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
+ TRIM( TPBALLOON%CNAME ), &
+ TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NDAY, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NMONTH, &
+ TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NYEAR, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%XTIME
+ CMNHMSG(2) = 'due to change of model (child to its parent)'
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ END IF
+ END IF
+
+ ! Compute new horizontal position
+ TPBALLOON%XX_CUR = TPBALLOON%XX_CUR + ZU_BAL * ZTSTEP * ZMAP
+ TPBALLOON%XY_CUR = TPBALLOON%XY_CUR + ZV_BAL * ZTSTEP * ZMAP
+
+ ! Get rank of the process where the balloon is and the model number
+ ! Model number is now imposed
+ IMODEL = TPBALLOON%NMODEL
+ CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPBALLOON, KMODEL = IMODEL )
+ IF ( TPBALLOON%LCRASH ) THEN
+ WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
+ 's (out of the horizontal boundaries)' )" ) &
+ TRIM( TPBALLOON%CNAME ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ END IF
+ ELSE
+ ! Special case not-managed (different dads, change of several models in 1 step (going to grand parent/grand children)...)
+ ! This situation should be very infrequent => reasonable risk, error on the trajectory should be relatively small in most cases
+ CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CNAME
+ CMNHMSG(2) = 'its trajectory might be wrong'
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
+ END IF
+END IF
+
+END SUBROUTINE BALLOON_ADVECTION_HOR
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE BALLOON_ADVECTION_VER( TPBALLOON )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: TBALLOONDATA
+USE MODD_CST, ONLY: XG
+
+IMPLICIT NONE
+
+CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+
+INTEGER :: JK ! loop index
+REAL :: ZRO_BAL ! air density at balloon location
+REAL :: ZW_BAL ! vertical wind speed at balloon location (along z)
+
+IF ( TPBALLOON%CTYPE == 'RADIOS' ) THEN
+ ZW_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZWM )
+ TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * ZTSTEP
+END IF
+
+IF ( TPBALLOON%CTYPE == 'CVBALL' ) THEN
+ ZW_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZWM )
+ ZRO_BAL = TPBALLOON%INTERP_FROM_MASSPOINT( ZRHO )
+ ! calculation with a time step of 1 second or less
+ IF (INT(ZTSTEP) .GT. 1 ) THEN
+ DO JK=1,INT(ZTSTEP)
+ TPBALLOON%XWASCENT = TPBALLOON%XWASCENT &
+ - ( 1. / (1. + TPBALLOON%XINDDRAG ) ) * 1. * &
+ ( XG * ( ( TPBALLOON%XMASS / TPBALLOON%XVOLUME ) - ZRO_BAL ) / ( TPBALLOON%XMASS / TPBALLOON%XVOLUME ) &
+ + TPBALLOON%XWASCENT * ABS ( TPBALLOON%XWASCENT ) * &
+ TPBALLOON%XDIAMETER * TPBALLOON%XAERODRAG / ( 2. * TPBALLOON%XVOLUME ) &
+ )
+ TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * 1.
+ END DO
+ END IF
+ IF (ZTSTEP .GT. INT(ZTSTEP)) THEN
+ TPBALLOON%XWASCENT = TPBALLOON%XWASCENT &
+ - ( 1. / (1. + TPBALLOON%XINDDRAG ) ) * (ZTSTEP-INT(ZTSTEP)) * &
+ ( XG * ( ( TPBALLOON%XMASS / TPBALLOON%XVOLUME ) - ZRO_BAL ) / ( TPBALLOON%XMASS / TPBALLOON%XVOLUME ) &
+ + TPBALLOON%XWASCENT * ABS ( TPBALLOON%XWASCENT ) * &
+ TPBALLOON%XDIAMETER * TPBALLOON%XAERODRAG / ( 2. * TPBALLOON%XVOLUME ) &
+ )
+ TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * (ZTSTEP-INT(ZTSTEP))
+ END IF
+END IF
+
+END SUBROUTINE BALLOON_ADVECTION_VER
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE FLYER_INTERP_TO_MASSPOINTS()
+
+USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
+USE MODD_PARAMETERS, ONLY: JPVEXT
+
+IMPLICIT NONE
+
+INTEGER :: IDU ! difference between II_U and II_M
+INTEGER :: IDV ! difference between IJ_V and IJ_M
+
+! Indices
+IKB = 1 + JPVEXT
+IKE = SIZE(PZ,3) - JPVEXT
+
+! Interpolations of model variables to mass points
+! ------------------------------------------------
+
+! X position
+TPFLYER%NI_U = COUNT( XXHAT (:) <= TPFLYER%XX_CUR )
+TPFLYER%NI_M = COUNT( XXHATM(:) <= TPFLYER%XX_CUR )
+II_U = TPFLYER%NI_U
+II_M = TPFLYER%NI_M
+
+! Y position
+TPFLYER%NJ_V = COUNT( XYHAT (:)<=TPFLYER%XY_CUR )
+TPFLYER%NJ_M = COUNT( XYHATM(:)<=TPFLYER%XY_CUR )
+IJ_V = TPFLYER%NJ_V
+IJ_M = TPFLYER%NJ_M
+
+ZZM(:,:,1:IKU-1)=0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,1:IKU-1)+0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,2:IKU )
+ZZM(:,:, IKU )=1.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-1)-0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-2)
+
+IDU = II_U - II_M
+ZZU(:,:,1:IKU-1)=0.25*PZ(IDU+II_M-1:IDU+II_M, IJ_M :IJ_M+1,1:IKU-1)+0.25*PZ(IDU+II_M-1:IDU+II_M ,IJ_M :IJ_M+1,2:IKU ) &
+ +0.25*PZ(IDU+II_M :IDU+II_M+1,IJ_M :IJ_M+1,1:IKU-1)+0.25*PZ(IDU+II_M :IDU+II_M+1,IJ_M :IJ_M+1,2:IKU )
+ZZU(:,:, IKU )=0.75*PZ(IDU+II_M-1:IDU+II_M ,IJ_M :IJ_M+1, IKU-1)-0.25*PZ(IDU+II_M-1:IDU+II_M ,IJ_M :IJ_M+1, IKU-2) &
+ +0.75*PZ(IDU+II_M :IDU+II_M+1,IJ_M :IJ_M+1, IKU-1)-0.25*PZ(IDU+II_M :IDU+II_M+1,IJ_M :IJ_M+1, IKU-2)
+
+IDV = IJ_V - IJ_M
+ZZV(:,:,1:IKU-1)=0.25*PZ(II_M :II_M+1,IDV+IJ_M-1:IDV+IJ_M ,1:IKU-1)+0.25*PZ(II_M :II_M+1,IDV+IJ_M-1:IDV+IJ_M ,2:IKU ) &
+ +0.25*PZ(II_M :II_M+1,IDV+IJ_M :IDV+IJ_M+1,1:IKU-1)+0.25*PZ(II_M :II_M+1,IDV+IJ_M :IDV+IJ_M+1,2:IKU )
+ZZV(:,:, IKU )=0.75*PZ(II_M :II_M+1,IDV+IJ_M-1:IDV+IJ_M , IKU-1)-0.25*PZ(II_M :II_M+1,IDV+IJ_M-1:IDV+IJ_M , IKU-2) &
+ +0.75*PZ(II_M :II_M+1,IDV+IJ_M :IDV+IJ_M+1, IKU-1)-0.25*PZ(II_M :II_M+1,IDV+IJ_M :IDV+IJ_M+1, IKU-2)
+
+ZWM(:,:,1:IKU-1)=0.5*PW(II_M:II_M+1,IJ_M:IJ_M+1,1:IKU-1)+0.5*PW(II_M:II_M+1,IJ_M:IJ_M+1,2:IKU )
+ZWM(:,:, IKU )=1.5*PW(II_M:II_M+1,IJ_M:IJ_M+1, IKU-1)-0.5*PW(II_M:II_M+1,IJ_M:IJ_M+1, IKU-2)
+
+END SUBROUTINE FLYER_INTERP_TO_MASSPOINTS
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+PURE FUNCTION FLYER_COMPUTE_EXNER( ) RESULT( PEXN )
+
+USE MODD_CST, ONLY: XCPD, XP00, XRD
+
+IMPLICIT NONE
+
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: PEXN
+
+INTEGER :: JK
+
+PEXN(:,:,:) = ( PP(II_M:II_M+1, IJ_M:IJ_M+1, :) / XP00) ** ( XRD / XCPD )
+DO JK = IKB-1, 1, -1
+ PEXN(:,:,JK) = 1.5 * PEXN(:,:,JK+1) - 0.5 * PEXN(:,:,JK+2)
+END DO
+DO JK = IKE+1, IKU
+ PEXN(:,:,JK) = 1.5 * PEXN(:,:,JK-1) - 0.5 * PEXN(:,:,JK-2)
+END DO
+
+END FUNCTION FLYER_COMPUTE_EXNER
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+PURE FUNCTION FLYER_COMPUTE_RHO( ) RESULT( PRHO )
+
+USE MODD_CST, ONLY: XRD, XRV
+
+USE MODI_WATER_SUM
+
+IMPLICIT NONE
+
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: PRHO
+
+INTEGER :: JK
+REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTHV ! virtual potential temperature
+
+ZTHV(:,:,:) = PTH(II_M:II_M+1, IJ_M:IJ_M+1, :)
+IF ( SIZE( PR, 4 ) > 0 ) &
+ ZTHV(:,:,:) = ZTHV(:,:,:) * ( 1. + XRV / XRD * PR(II_M:II_M+1, IJ_M:IJ_M+1, :, 1) ) &
+ / ( 1. + WATER_SUM( PR(II_M:II_M+1, IJ_M:IJ_M+1, :, :)) )
+!
+PRHO(:,:,:) = PP(II_M:II_M+1, IJ_M:IJ_M+1, :) / ( XRD * ZTHV(:,:,:) * ZEXN(:,:,:) )
+DO JK = IKB-1, 1, -1
+ PRHO(:,:,JK) = 1.5 * PRHO(:,:,JK+1) - 0.5 * PRHO(:,:,JK+2)
+END DO
+DO JK = IKE+1, IKU
+ PRHO(:,:,JK) = 1.5 * PRHO(:,:,JK-1) - 0.5 * PRHO(:,:,JK-2)
+END DO
+
+END FUNCTION FLYER_COMPUTE_RHO
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1( )
+! Compute coefficents for horizontal interpolations (1st stage)
+
+USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
+
+IMPLICIT NONE
+
+! Interpolation coefficient for X
+TPFLYER%XXMCOEF = ( TPFLYER%XX_CUR - XXHATM(II_M) ) / ( XXHATM(II_M+1) - XXHATM(II_M) )
+TPFLYER%XXMCOEF = MAX( 0., MIN( TPFLYER%XXMCOEF, 1. ) )
+
+! Interpolation coefficient for y
+TPFLYER%XYMCOEF = ( TPFLYER%XY_CUR - XYHATM(IJ_M) ) / ( XYHATM(IJ_M+1) - XYHATM(IJ_M) )
+TPFLYER%XYMCOEF = MAX( 0., MIN( TPFLYER%XYMCOEF, 1. ) )
+
+! Interpolation coefficient for X (for U)
+TPFLYER%XXUCOEF = ( TPFLYER%XX_CUR - XXHAT(II_U) ) / ( XXHAT(II_U+1) - XXHAT(II_U) )
+TPFLYER%XXUCOEF = MAX( 0., MIN( TPFLYER%XXUCOEF, 1. ) )
+
+! Interpolation coefficient for y (for V)
+TPFLYER%XYVCOEF = ( TPFLYER%XY_CUR - XYHAT(IJ_V) ) / ( XYHAT(IJ_V+1) - XYHAT(IJ_V) )
+TPFLYER%XYVCOEF = MAX( 0., MIN( TPFLYER%XYVCOEF, 1. ) )
+
+END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_VER( )
+! Compute coefficent for vertical interpolations
+
+USE MODD_CST, ONLY: XCPD, XP00, XRD
+USE MODD_TIME_n, ONLY: TDTCUR
+
+IMPLICIT NONE
+
+LOGICAL :: GLOW, GHIGH
+
+! Find indices surrounding the vertical box where the flyer is
+SELECT TYPE ( TPFLYER )
+ CLASS IS ( TAIRCRAFTDATA)
+ IF ( TPFLYER%LALTDEF ) THEN
+ ZFLYER_EXN = (TPFLYER%XP_CUR/XP00)**(XRD/XCPD)
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', ZFLYER_EXN, ZEXN, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
+ ELSE
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XZ_CUR, ZZM, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
+ END IF
+
+ CLASS IS ( TBALLOONDATA)
+ IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XRHO, ZRHO, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
+ ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
+ CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'MASS', TPFLYER%XZ_CUR, ZZM, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
+ END IF
+
+END SELECT
+
+! Check if the flyer crashed vertically (higher bound)
+IF ( GHIGH ) THEN
+ TPFLYER%LCRASH = .TRUE.
+ TPFLYER%NCRASH = NCRASH_OUT_HIGH
+END IF
+
+SELECT TYPE ( TPFLYER )
+ CLASS IS ( TAIRCRAFTDATA)
+ IF ( TPFLYER%LALTDEF ) THEN
+ TPFLYER%XZ_CUR = TPFLYER%INTERP_FROM_MASSPOINT( ZZM )
+ ELSE
+ TPFLYER%XP_CUR = TPFLYER%INTERP_FROM_MASSPOINT( PP )
+ END IF
+
+ CLASS IS ( TBALLOONDATA)
+ IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
+ TPFLYER%XZ_CUR = TPFLYER%INTERP_FROM_MASSPOINT( ZZM )
+ ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
+ !Nothing to do
+ END IF
+
+END SELECT
+
+END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_VER
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
+! Compute coefficents for horizontal interpolations (2nd stage)
+! This stage must be done after FLYER_COMPUTE_INTERP_COEFF_VER because we should need XZ_CUR computed in it
+
+IMPLICIT NONE
+
+LOGICAL :: GLOW, GHIGH
+
+! Interpolation coefficients for the 4 surroundings verticals (for U)
+! ODONOLOWCRASH = .TRUE. because check for low crash has already been done
+CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'U', TPFLYER%XZ_CUR, ZZU, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
+
+! Interpolation coefficients for the 4 suroundings verticals (for V)
+CALL TPFLYER%COMPUTE_VERTICAL_INTERP_COEFF( 'V', TPFLYER%XZ_CUR, ZZV, GLOW, GHIGH, ODONOLOWCRASH = .TRUE. )
+
+END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE FLYER_RECORD_DATA( )
+
+USE MODD_CST, ONLY: XP00, XPI, XRD
+USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_TKE_DISS
+USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
+
+USE MODE_GRIDPROJ, ONLY: SM_LATLON
+USE MODE_SENSOR, ONLY: Sensor_rare_compute, Sensor_wc_compute
+
+IMPLICIT NONE
+
+INTEGER :: JLOOP ! loop counter
+REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
+REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
+REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
+REAL, DIMENSION(SIZE(PZ,3)) :: ZZ ! altitude of model levels at station location
+REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
+
+TPFLYER%NMODELHIST(ISTORE) = TPFLYER%NMODEL
+
+TPFLYER%XX(ISTORE) = TPFLYER%XX_CUR
+TPFLYER%XY(ISTORE) = TPFLYER%XY_CUR
+TPFLYER%XZ(ISTORE) = TPFLYER%XZ_CUR
+!
+CALL SM_LATLON( PLATOR, PLONOR, &
+ TPFLYER%XX_CUR, TPFLYER%XY_CUR, &
+ TPFLYER%XLAT_CUR, TPFLYER%XLON_CUR )
+TPFLYER%XLAT(ISTORE) = TPFLYER%XLAT_CUR
+TPFLYER%XLON(ISTORE) = TPFLYER%XLON_CUR
+!
+ZU_BAL = TPFLYER%INTERP_FROM_UPOINT( PU )
+ZV_BAL = TPFLYER%INTERP_FROM_VPOINT( PV )
+ZGAM = (XRPK * (TPFLYER%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
+TPFLYER%XZON (1,ISTORE) = ZU_BAL * COS(ZGAM) + ZV_BAL * SIN(ZGAM)
+TPFLYER%XMER (1,ISTORE) = - ZU_BAL * SIN(ZGAM) + ZV_BAL * COS(ZGAM)
+!
+TPFLYER%XW (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZWM )
+TPFLYER%XTH (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PTH )
+!
+ZFLYER_EXN = TPFLYER%INTERP_FROM_MASSPOINT( ZEXN )
+TPFLYER%XP (1,ISTORE) = XP00 * ZFLYER_EXN**(XCPD/XRD)
+
+ZR(:,:,:) = 0.
+DO JLOOP=1,SIZE(PR,4)
+ TPFLYER%XR (1,ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
+ IF (JLOOP>=2) ZR(:,:,:) = ZR(:,:,:) + PR(:,:,:,JLOOP)
+END DO
+DO JLOOP=1,SIZE(PSV,4)
+ TPFLYER%XSV (1,ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( PSV(:,:,:,JLOOP) )
+END DO
+TPFLYER%XRTZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZR(:,:,:) )
+DO JLOOP=1,SIZE(PR,4)
+ TPFLYER%XRZ (:,ISTORE,JLOOP) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JLOOP) )
+END DO
+
+TPFLYER%XFFZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( SQRT(PU**2+PV**2) )
+
+TPFLYER%XRHOD (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PRHODREF )
+
+IF (CCLOUD=="LIMA") THEN
+ TPFLYER%XCIZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ TPFLYER%XCCZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ TPFLYER%XCRZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
+ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
+ TPFLYER%XCIZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PCIT(:,:,:) )
+END IF
+
+ZTH_EXN(:,:,:) = PTH(TPFLYER%NI_M:TPFLYER%NI_M+1, TPFLYER%NJ_M:TPFLYER%NJ_M+1, :) * ZEXN(:,:,:)
+ZZ(:) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZZM(:,:,:) )
+TPFLYER%XZZ(:,ISTORE) = ZZ(:)
+
+CALL Sensor_wc_compute( TPFLYER, ISTORE, PR, PRHODREF )
+CALL Sensor_rare_compute( TPFLYER, ISTORE, PR, PSV, PRHODREF, PCIT, ZTH_EXN, ZZ, PSEA )
+
+! vertical wind
+TPFLYER%XWZ (:,ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( ZWM(:,:,:) )
+
+! Dry air density at flyer position
+TPFLYER%XRHOD_SENSOR(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PRHODREF )
+
+IF (SIZE(PTKE)>0) TPFLYER%XTKE (1,ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( PTKE )
+IF ( CRAD /= 'NONE' ) TPFLYER%XTSRAD(ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT(PTS )
+TPFLYER%XTKE_DISS(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( XCURRENT_TKE_DISS )
+TPFLYER%XZS(ISTORE) = TPFLYER%INTERP_HOR_FROM_MASSPOINT( PZ(:,:,1+JPVEXT) )
+TPFLYER%XTHW_FLUX(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZTHW_FLUX )
+TPFLYER%XRCW_FLUX(ISTORE) = TPFLYER%INTERP_FROM_MASSPOINT( ZRCW_FLUX )
+DO JLOOP=1,SIZE(PSV,4)
+TPFLYER%XSVW_FLUX(ISTORE,JLOOP) = TPFLYER%INTERP_FROM_MASSPOINT( ZSVW_FLUX(:,:,:,JLOOP) )
+END DO
+
+END SUBROUTINE FLYER_RECORD_DATA
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+END SUBROUTINE AIRCRAFT_BALLOON_EVOL
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE AIRCRAFT_COMPUTE_POSITION( TPDATE, TPAIRCRAFT )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: TAIRCRAFTDATA
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+
+USE MODE_DATETIME
+USE MODE_POSITION_TOOLS, ONLY: FIND_PROCESS_AND_MODEL_FROM_XY_POS
+
+IMPLICIT NONE
+
+TYPE(DATE_TIME), INTENT(IN) :: TPDATE
+CLASS(TAIRCRAFTDATA), INTENT(INOUT) :: TPAIRCRAFT !aircraft
+
+INTEGER :: IL ! flight segment index
+REAL :: ZTDIST ! time since launch (sec)
+REAL :: ZSEG_FRAC ! fraction of flight in the current segment
+
+! Find the flight segment
+ZTDIST = TPDATE - TPAIRCRAFT%TLAUNCH
+IL = TPAIRCRAFT%NPOSCUR
+DO WHILE ( ZTDIST > TPAIRCRAFT%XPOSTIME(IL+1) )
+ IL = IL + 1
+ IF ( IL > TPAIRCRAFT%NPOS-1 ) THEN
+ !Security (should not happen)
+ IL = TPAIRCRAFT%NPOS-1
+ EXIT
+ END IF
+END DO
+TPAIRCRAFT%NPOSCUR = IL
+
+! Compute the current position
+ZSEG_FRAC = ( ZTDIST - TPAIRCRAFT%XPOSTIME(IL) ) / ( TPAIRCRAFT%XPOSTIME(IL+1) - TPAIRCRAFT%XPOSTIME(IL) )
+
+TPAIRCRAFT%XX_CUR = (1.-ZSEG_FRAC) * TPAIRCRAFT%XPOSX(IL ) &
+ + ZSEG_FRAC * TPAIRCRAFT%XPOSX(IL+1)
+TPAIRCRAFT%XY_CUR = (1.-ZSEG_FRAC) * TPAIRCRAFT%XPOSY(IL ) &
+ + ZSEG_FRAC * TPAIRCRAFT%XPOSY(IL+1)
+
+IF (TPAIRCRAFT%LALTDEF) THEN
+ TPAIRCRAFT%XP_CUR = (1.-ZSEG_FRAC) * TPAIRCRAFT%XPOSP(IL ) &
+ + ZSEG_FRAC * TPAIRCRAFT%XPOSP(IL+1)
+ELSE
+ TPAIRCRAFT%XZ_CUR = (1.-ZSEG_FRAC) * TPAIRCRAFT%XPOSZ(IL ) &
+ + ZSEG_FRAC * TPAIRCRAFT%XPOSZ(IL +1)
+END IF
+
+END SUBROUTINE AIRCRAFT_COMPUTE_POSITION
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE FLYER_GET_RANK_MODEL_ISCRASHED( TPFLYER, PX, PY, KMODEL )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: NCRASH_NO, NCRASH_OUT_HORIZ, TFLYERDATA
+
+USE MODE_POSITION_TOOLS, ONLY: FIND_PROCESS_AND_MODEL_FROM_XY_POS
+
+IMPLICIT NONE
+
+CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
+REAL, OPTIONAL, INTENT(IN) :: PX ! X position (if not provided, takes current flyer position)
+REAL, OPTIONAL, INTENT(IN) :: PY ! Y position (if not provided, takes current flyer position)
+INTEGER, OPTIONAL, INTENT(IN) :: KMODEL ! if provided, model number is imposed (if not 0)
+
+INTEGER :: IMODEL
+INTEGER :: IRANK
+REAL :: ZX, ZY
+
+IF ( PRESENT( KMODEL ) ) THEN
+ IMODEL = KMODEL
+ELSE
+ IF ( TPFLYER%CMODEL == 'FIX' ) THEN
+ IMODEL = TPFLYER%NMODEL
+ ELSE
+ IMODEL = 0
+ END IF
+END IF
+
+IF ( PRESENT( PX ) ) THEN
+ ZX = PX
+ELSE
+ ZX = TPFLYER%XX_CUR
+END IF
+
+IF ( PRESENT( PY ) ) THEN
+ ZY = PY
+ELSE
+ ZY = TPFLYER%XY_CUR
+END IF
+
+CALL FIND_PROCESS_AND_MODEL_FROM_XY_POS( ZX, ZY, IRANK, IMODEL )
+
+IF ( IRANK < 1 ) THEN
+ ! Flyer is outside of horizontal domain
+ ! TPFLYER%NMODEL !Do not change to keep a valid value
+ TPFLYER%LCRASH = .TRUE.
+ TPFLYER%NCRASH = NCRASH_OUT_HORIZ
+ TPFLYER%LFLY = .FALSE.
+ELSE
+ TPFLYER%NMODEL = IMODEL
+ TPFLYER%LCRASH = .FALSE.
+ TPFLYER%NCRASH = NCRASH_NO
+ !TPFLYER%LFLY = !Do not touch LFLY (flyer could be in flight or not)
+ TPFLYER%NRANK_CUR = IRANK
+END IF
+
+END SUBROUTINE FLYER_GET_RANK_MODEL_ISCRASHED
+!----------------------------------------------------------------------------
+
+END MODULE MODE_AIRCRAFT_BALLOON_EVOL
diff --git a/src/PHYEX/ext/boundaries.f90 b/src/PHYEX/ext/boundaries.f90
new file mode 100644
index 0000000000000000000000000000000000000000..04860f27e0b15748eb3c9d075427d97f3dc803b9
--- /dev/null
+++ b/src/PHYEX/ext/boundaries.f90
@@ -0,0 +1,1281 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!#####################
+MODULE MODI_BOUNDARIES
+!#####################
+!
+INTERFACE
+!
+ SUBROUTINE BOUNDARIES ( &
+ PTSTEP,HLBCX,HLBCY,KRR,KSV,KTCOUNT, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
+ PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
+ PRHODJ,PRHODREF, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
+!
+REAL, INTENT(IN) :: PTSTEP ! time step dt
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+! Lateral Boundary fields at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! temporal derivative of the Lateral Boundary fields
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKES ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKES
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS ,PLBXSVS ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-dir.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
+ ! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+END SUBROUTINE BOUNDARIES
+!
+END INTERFACE
+!
+
+END MODULE MODI_BOUNDARIES
+!
+!
+! ####################################################################
+ SUBROUTINE BOUNDARIES ( &
+ PTSTEP,HLBCX,HLBCY,KRR,KSV,KTCOUNT, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
+ PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
+ PRHODJ,PRHODREF, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
+! ####################################################################
+!
+!!**** *BOUNDARIES* - routine to prepare the Lateral Boundary Conditions for
+!! all variables at a scalar localization relative to the
+!! considered boundary.
+!!
+!! PURPOSE
+!! -------
+! Fill up the left and right lateral EXTernal zones, for all prognostic
+! variables, at time t and t-dt, to avoid particular cases close to
+! the Lateral Boundaries in routines computing the evolution terms, in
+! particular in the advection routines.
+!
+!!** METHOD
+!! ------
+!! 3 different options are proposed: 'WALL' 'CYCL' 'OPEN'
+!! to define the Boundary Condition type,
+!! though the variables HLBCX and HLBCY (for the X and Y-directions
+!! respectively).
+!! For the 'OPEN' type of LBC, the treatment depends
+!! on the flow configuration: i.e. INFLOW or OUTFLOW conditions.
+!!
+!! EXTERNAL
+!! --------
+!! GET_INDICE_ll : get physical sub-domain bounds
+!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS :
+!! JPHEXT ,JPVEXT
+!!
+!! Module MODD_CONF :
+!! CCONF
+!!
+!! Module MODE_UPDATE_NSV :
+!! NSV_CHEM, NSV_CHEMBEG, NSV_CHEMEND
+!!
+!! Module MODD_CTURB :
+!! XTKEMIN
+!!
+!! REFERENCE
+!! ---------
+!! Book1 and book2 of documentation (routine BOUNDARIES)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Lafore J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 17/10/94
+!! Modification 02/11/94 (J.Stein) copy for t-dt at the external points
+!! + change the copy formulation
+!! Modification 18/11/94 (J.Stein) bug correction in the normal velocity
+!! prescription in the WALL cases
+!! Modification 13/02/95 (Lafore) to account for the OPEN case and
+!! for the LS fields introduction
+!! Modification 03/03/95 (Mallet) corrections in variables names in
+!! the Y-OPEN case
+!! 16/03/95 (J.Stein) remove R from the historical variables
+!! Modification 31/05/95 (Lafore) MASTER_DEV2.1 preparation after the
+!! LBC tests performed by I. Mallet
+!! Modification 15/03/96 (Richard) bug correction for OPEN CASE: (TOP Y-LBC)
+!! Rv case
+!! Modification 15/03/96 (Shure) bug correction for SV variable in
+!! open x right case
+!! Modification 24/10/96 (Masson) initialization of outer points in
+!! wall cases for spawning interpolations
+!! Modification 13/03/97 (Lafore) "surfacic" LS-fields introduction
+!! Modification 10/04/97 (Lafore) proper treatment of minima for TKE and EPS
+!! Modification 01/09/97 (Masson) minimum value for water and passive
+!! scalars set to zero at instants M,T
+!! Modification 20/10/97 (Lafore) introduction of DAVI type of lbc
+!! suppression of NEST type
+!! Modification 12/11/97 ( Stein ) use the lB fields
+!! Modification 02/06/98 (Lafore) declaration of local variables (PLBXUM
+!! and PLBXWM do'nt have the same size)
+!! Modification 24/08/98 (Jabouille) parallelize the code
+!! Modification 20/04/99 ( Stein ) use the same conditions for times t
+!! and t-dt
+!! Modification 11/04/00 (Mari) special conditions for chemical variables
+!! Modification 10/01/01 (Tulet) update for MOCAGE boundary conditions
+!! Modification 22/01/01 (Gazen) use NSV_CHEM,NSV_CHEMBEG,NSV_CHEMEND variables
+!! Modification 22/06/01(Jabouille) use XSVMIN
+!! Modification 20/11/01(Gazen & Escobar) rewrite GCHBOUNDARY for portability
+!! Modification 14/03/05 (Tulet) bug : in case of CYCL do not call ch_boundaries
+!! Modification 14/05/05 (Tulet) add aerosols / dust
+!! Modification 05/06 Suppression of DAVI type of lbc
+!! Modification 05/06 Remove EPS
+!! Modification 12/2010 (Chong) Add boundary condition for ions
+!! (fair weather profiles)
+!! Modification 07/2013 (Bosseur & Filippi) adds Forefire
+!! Modification 04/2013 (C.Lac) Remove instant M
+!! Modification 01/2015 (JL Redelsperger) Introduction of ponderation
+!! for non normal velocity and potential temp
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Redelsperger & Pianezze : 08/2015 : add XPOND coefficient
+!! Modification 01/2016 (JP Pinty) Add LIMA that is LBC for CCN and IFN
+!! Modification 18/07/17 (Vionnet) Add blowing snow variables
+!! Modification 01/2018 (JL Redelsperger) Correction for TKE treatment
+!! Modification 03/02/2020 (B. Vié) Correction for SV with LIMA
+! P. Wautelet 04/06/2020: correct call to Set_conc_lima
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_BLOWSNOW, ONLY : LBLOWSNOW,NBLOWSNOW_2D
+USE MODD_BLOWSNOW_n
+USE MODD_CH_AEROSOL , ONLY : LORILAM
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHIC
+USE MODD_CONDSAMP, ONLY : LCONDSAMP
+USE MODD_CONF
+USE MODD_TURB_n, ONLY : XTKEMIN
+USE MODD_DUST
+USE MODD_GRID_n, ONLY : XZZ
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE, ONLY : LFOREFIRE
+#endif
+USE MODD_LBC_n, ONLY : XPOND
+USE MODE_ll
+USE MODD_NESTING, ONLY : NDAD
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN
+USE MODD_PARAM_n, ONLY : CELEC,CCLOUD
+USE MODD_PASPOL, ONLY : LPASPOL
+USE MODD_PRECISION, ONLY: MNHREAL32
+USE MODD_REF_n
+USE MODD_SALT, ONLY : LSALT
+
+USE MODE_MODELN_HANDLER
+USE MODE_SET_CONC_LIMA
+
+USE MODI_CH_BOUNDARIES
+USE MODI_INIT_AEROSOL_CONCENTRATION
+USE MODI_ION_BOUNDARIES
+
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+!
+REAL, INTENT(IN) :: PTSTEP ! time step dt
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+! Lateral Boundary fields at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! temporal derivative of the Lateral Boundary fields
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS ! Wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHS ! Mass
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKES ! TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKES
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS ,PLBXSVS ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-dir.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
+ ! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB ! indice I Beginning in x direction
+INTEGER :: IJB ! indice J Beginning in y direction
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IIE ! indice I End in x direction
+INTEGER :: IJE ! indice J End in y direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: JEXT ! Loop index for EXTernal points
+INTEGER :: JRR ! Loop index for RR variables (water)
+INTEGER :: JSV ! Loop index for Scalar Variables
+INTEGER :: IMI ! Model Index
+REAL :: ZTSTEP ! effective time step
+REAL :: ZPOND ! Coeff PONDERATION LS
+INTEGER :: ILBX,ILBY ! size of LB fields' arrays
+LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: GCHBOUNDARY, GAERBOUNDARY,&
+ GDSTBOUNDARY, GSLTBOUNDARY, GPPBOUNDARY, &
+ GCSBOUNDARY, GICBOUNDARY, GLIMABOUNDARY,GSNWBOUNDARY
+LOGICAL, SAVE :: GFIRSTCALL1 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL2 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL3 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALL5 = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLPP = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLCS = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLIC = .TRUE.
+LOGICAL, SAVE :: GFIRSTCALLLIMA = .TRUE.
+!
+REAL, DIMENSION(SIZE(PLBXWM,1),SIZE(PLBXWM,2),SIZE(PLBXWM,3)) :: &
+ ZLBXVT,ZLBXWT,ZLBXTHT
+REAL, DIMENSION(SIZE(PLBYWM,1),SIZE(PLBYWM,2),SIZE(PLBYWM,3)) :: &
+ ZLBYUT,ZLBYWT,ZLBYTHT
+REAL, DIMENSION(SIZE(PLBXTKEM,1),SIZE(PLBXTKEM,2),SIZE(PLBXTKEM,3)) :: &
+ ZLBXTKET
+REAL, DIMENSION(SIZE(PLBYTKEM,1),SIZE(PLBYTKEM,2),SIZE(PLBYTKEM,3)) :: &
+ ZLBYTKET
+REAL, DIMENSION(SIZE(PLBXRM,1),SIZE(PLBXRM,2),SIZE(PLBXRM,3),SIZE(PLBXRM,4)) :: &
+ ZLBXRT
+REAL, DIMENSION(SIZE(PLBYRM,1),SIZE(PLBYRM,2),SIZE(PLBYRM,3),SIZE(PLBYRM,4)) :: &
+ ZLBYRT
+REAL, DIMENSION(SIZE(PLBXSVM,1),SIZE(PLBXSVM,2),SIZE(PLBXSVM,3),SIZE(PLBXSVM,4)) :: &
+ ZLBXSVT
+REAL, DIMENSION(SIZE(PLBYSVM,1),SIZE(PLBYSVM,2),SIZE(PLBYSVM,3),SIZE(PLBYSVM,4)) :: &
+ ZLBYSVT
+LOGICAL :: GCHTMP
+LOGICAL :: GPPTMP
+LOGICAL :: GCSTMP
+!
+LOGICAL, SAVE :: GFIRSTCALL4 = .TRUE.
+!
+#ifdef MNH_FOREFIRE
+LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: GFFBOUNDARY
+LOGICAL, SAVE :: GFIRSTCALLFF = .TRUE.
+LOGICAL :: GFFTMP
+#endif
+!
+INTEGER :: JI,JJ
+!
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSVT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: ZRT
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PUT,3) - JPVEXT
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. UPPER AND LOWER BC FILLING:
+! ---------------------------
+!
+!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
+!
+
+!
+! at the instant t
+!
+IF(SIZE(PUT) /= 0) PUT (:,:,IKB-1) = PUT (:,:,IKB)
+IF(SIZE(PVT) /= 0) PVT (:,:,IKB-1) = PVT (:,:,IKB)
+IF(SIZE(PWT) /= 0) PWT (:,:,IKB-1) = PWT (:,:,IKB)
+IF(SIZE(PTHT) /= 0) PTHT (:,:,IKB-1) = PTHT (:,:,IKB)
+IF(SIZE(PTKET) /= 0) PTKET(:,:,IKB-1) = PTKET(:,:,IKB)
+IF(SIZE(PRT) /= 0) PRT (:,:,IKB-1,:)= PRT (:,:,IKB,:)
+IF(SIZE(PSVT)/= 0) PSVT (:,:,IKB-1,:)= PSVT (:,:,IKB,:)
+IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKB-1) = PSRCT(:,:,IKB)
+!
+!
+!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
+!
+! at the instant t
+!
+IF(SIZE(PWT) /= 0) PWT (:,:,IKE+1) = 0.
+IF(SIZE(PUT) /= 0) PUT (:,:,IKE+1) = PUT (:,:,IKE)
+IF(SIZE(PVT) /= 0) PVT (:,:,IKE+1) = PVT (:,:,IKE)
+IF(SIZE(PTHT) /= 0) PTHT (:,:,IKE+1) = PTHT (:,:,IKE)
+IF(SIZE(PTKET) /= 0) PTKET(:,:,IKE+1) = PTKET(:,:,IKE)
+IF(SIZE(PRT) /= 0) PRT (:,:,IKE+1,:) = PRT (:,:,IKE,:)
+IF(SIZE(PSVT)/= 0) PSVT (:,:,IKE+1,:) = PSVT (:,:,IKE,:)
+IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKE+1) = PSRCT(:,:,IKE)
+
+! specific for positive and negative ions mixing ratios (1/kg)
+
+IF (NSV_ELEC .NE. 0) THEN
+!
+ IF (SIZE(PWT) /= 0) THEN
+ WHERE ( PWT(:,:,IKE+1) .GE. 0.) ! Outflow
+ PSVT (:,:,IKE+1,NSV_ELECBEG) = 2.*PSVT (:,:,IKE,NSV_ELECBEG) - &
+ PSVT (:,:,IKE-1,NSV_ELECBEG)
+ PSVT (:,:,IKE+1,NSV_ELECEND) = 2.*PSVT (:,:,IKE,NSV_ELECEND) - &
+ PSVT (:,:,IKE-1,NSV_ELECEND)
+ ELSE WHERE ! Inflow from the top
+ PSVT (:,:,IKE+1,NSV_ELECBEG) = XCION_POS_FW(:,:,IKE+1)
+ PSVT (:,:,IKE+1,NSV_ELECEND) = XCION_NEG_FW(:,:,IKE+1)
+ END WHERE
+ ENDIF
+!
+END IF
+
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTE LB FIELDS AT TIME T
+! ---------------------------
+!
+!
+IF ( KTCOUNT == 1) THEN
+ ZTSTEP = 0.
+ELSE
+ ZTSTEP = PTSTEP
+END IF
+!
+!
+IF ( SIZE(PLBXTHS,1) /= 0 .AND. &
+ ( HLBCX(1)=='OPEN' .OR. HLBCX(2)=='OPEN') ) THEN
+ ZLBXVT(:,:,:) = PLBXVM(:,:,:) + ZTSTEP * PLBXVS(:,:,:)
+ ZLBXWT(:,:,:) = PLBXWM(:,:,:) + ZTSTEP * PLBXWS(:,:,:)
+ ZLBXTHT(:,:,:) = PLBXTHM(:,:,:) + ZTSTEP * PLBXTHS(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:) + ZTSTEP * PLBXTKES(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = PLBXRM(:,:,:,:) + ZTSTEP * PLBXRS(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = PLBXSVM(:,:,:,:) + ZTSTEP * PLBXSVS(:,:,:,:)
+ END IF
+!
+ELSE
+!
+ ZLBXVT(:,:,:) = PLBXVM(:,:,:)
+ ZLBXWT(:,:,:) = PLBXWM(:,:,:)
+ ZLBXTHT(:,:,:) = PLBXTHM(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = PLBXRM(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = PLBXSVM(:,:,:,:)
+ END IF
+!
+END IF
+!
+! ============================================================
+!
+! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result
+!
+ZLBXVT(:,:,:) = real(ZLBXVT(:,:,:),kind=MNHREAL32)
+ZLBXWT(:,:,:) = real(ZLBXWT(:,:,:),kind=MNHREAL32)
+ZLBXTHT(:,:,:) = real(ZLBXTHT(:,:,:),kind=MNHREAL32)
+IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBXTKET(:,:,:) = real(ZLBXTKET(:,:,:),kind=MNHREAL32)
+END IF
+IF ( KRR > 0) THEN
+ ZLBXRT(:,:,:,:) = real(ZLBXRT(:,:,:,:),kind=MNHREAL32)
+END IF
+IF ( KSV > 0) THEN
+ ZLBXSVT(:,:,:,:) = real(ZLBXSVT(:,:,:,:),kind=MNHREAL32)
+END IF
+! ============================================================
+!
+IF ( SIZE(PLBYTHS,1) /= 0 .AND. &
+ ( HLBCY(1)=='OPEN' .OR. HLBCY(2)=='OPEN' )) THEN
+ ZLBYUT(:,:,:) = PLBYUM(:,:,:) + ZTSTEP * PLBYUS(:,:,:)
+ ZLBYWT(:,:,:) = PLBYWM(:,:,:) + ZTSTEP * PLBYWS(:,:,:)
+ ZLBYTHT(:,:,:) = PLBYTHM(:,:,:) + ZTSTEP * PLBYTHS(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:) + ZTSTEP * PLBYTKES(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = PLBYRM(:,:,:,:) + ZTSTEP * PLBYRS(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = PLBYSVM(:,:,:,:) + ZTSTEP * PLBYSVS(:,:,:,:)
+ END IF
+!
+ELSE
+!
+ ZLBYUT(:,:,:) = PLBYUM(:,:,:)
+ ZLBYWT(:,:,:) = PLBYWM(:,:,:)
+ ZLBYTHT(:,:,:) = PLBYTHM(:,:,:)
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:)
+ END IF
+ IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = PLBYRM(:,:,:,:)
+ END IF
+ IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = PLBYSVM(:,:,:,:)
+ END IF
+!
+END IF
+!
+!
+! ============================================================
+!
+! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result
+!
+ZLBYUT(:,:,:) = real(ZLBYUT(:,:,:),kind=MNHREAL32)
+ZLBYWT(:,:,:) = real(ZLBYWT(:,:,:),kind=MNHREAL32)
+ZLBYTHT(:,:,:) = real(ZLBYTHT(:,:,:),kind=MNHREAL32)
+IF ( SIZE(PTKET,1) /= 0 ) THEN
+ ZLBYTKET(:,:,:) = real(ZLBYTKET(:,:,:),kind=MNHREAL32)
+END IF
+IF ( KRR > 0) THEN
+ ZLBYRT(:,:,:,:) = real(ZLBYRT(:,:,:,:),kind=MNHREAL32)
+END IF
+IF ( KSV > 0) THEN
+ ZLBYSVT(:,:,:,:) = real(ZLBYSVT(:,:,:,:),kind=MNHREAL32)
+END IF
+! ============================================================
+!
+!-------------------------------------------------------------------------------
+! PONDERATION COEFF for Non-Normal velocities and pot temperature
+!
+ZPOND = XPOND
+!
+!* 4. LBC FILLING IN THE X DIRECTION (LEFT WEST SIDE):
+! ------------------------------------------------
+IF (LWEST_ll( )) THEN
+!
+!
+SELECT CASE ( HLBCX(1) )
+!
+!* 4.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (IIB-JEXT,:,:) = PUT (IIB ,:,:) ! never used during run
+ IF(SIZE(PVT) /= 0) PVT (IIB-JEXT,:,:) = PVT (IIB-1+JEXT,:,:)
+ IF(SIZE(PWT) /= 0) PWT (IIB-JEXT,:,:) = PWT (IIB-1+JEXT,:,:)
+ IF(SIZE(PTHT) /= 0) PTHT(IIB-JEXT,:,:) = PTHT (IIB-1+JEXT,:,:)
+ IF(SIZE(PTKET)/= 0) PTKET(IIB-JEXT,:,:) = PTKET(IIB-1+JEXT,:,:)
+ IF(SIZE(PRT) /= 0) PRT (IIB-JEXT,:,:,:) = PRT (IIB-1+JEXT,:,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT(IIB-JEXT,:,:,:) = PSVT (IIB-1+JEXT,:,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIB-JEXT,:,:) = PSRCT (IIB-1+JEXT,:,:)
+ IF(LBLOWSNOW) XSNWCANO(IIB-JEXT,:,:) = XSNWCANO(IIB-1+JEXT,:,:)
+!
+ END DO
+!
+ IF(SIZE(PUT) /= 0) PUT(IIB ,:,:) = 0. ! set the normal velocity
+!
+!
+!* 4.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PUT(JI,:,:)=0.
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PVT (JI,:,:) = 2.*PVT (JI+1,:,:) -PVT (JI+2,:,:)
+ PWT (JI,:,:) = 2.*PWT (JI+1,:,:) -PWT (JI+2,:,:)
+ PTHT (JI,:,:) = 2.*PTHT (JI+1,:,:) -PTHT (JI+2,:,:)
+ !
+ ELSEWHERE ! INFLOW condition
+ PVT (JI,:,:) = ZPOND*ZLBXVT (JI,:,:) + (1.-ZPOND)* PVT(JI+1,:,:) ! 1
+ PWT (JI,:,:) = ZPOND*ZLBXWT (JI,:,:) + (1.-ZPOND)* PWT(JI+1,:,:) ! 1
+ PTHT (JI,:,:) = ZPOND*ZLBXTHT (JI,:,:) + (1.-ZPOND)* PTHT(JI+1,:,:)! 1
+ ENDWHERE
+ ENDDO
+ ENDIF
+!
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PTKET(JI,:,:) = MAX(XTKEMIN, 2.*PTKET(JI+1,:,:)-PTKET(JI+2,:,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(JI,:,:) = MAX(XTKEMIN, ZPOND*ZLBXTKET(JI,:,:) + (1.-ZPOND)*PTKET(JI+1,:,:))
+ ENDWHERE
+ ENDDO
+ END IF
+ !
+! Case with KRR moist variables
+!
+!
+!
+ DO JRR =1 ,KRR
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PRT(JI,:,:,JRR) = MAX(0.,2.*PRT(JI+1,:,:,JRR) -PRT(JI+2,:,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(JI,:,:,JRR) = MAX(0.,ZLBXRT(JI,:,:,JRR)) ! 1
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PSRCT (JI,:,:) = PSRCT (JI+1,:,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PSVT(JI,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(JI+1,:,:,JSV) - &
+ PSVT(JI+2,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(JI,:,:,JSV) = MAX(XSVMIN(JSV),ZLBXSVT(JI,:,:,JSV)) ! 1
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+ !
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,NBLOWSNOW_2D
+ WHERE ( PUT(IIB,:,IKB) <= 0. ) ! OUTFLOW condition
+ XSNWCANO(IIB-1,:,JSV) = MAX(0.,2.*XSNWCANO(IIB,:,JSV) - &
+ XSNWCANO(IIB+1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(IIB-1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PUT) /= 0) THEN
+ WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
+ PSVT(IIB-1,:,:,JSV) = MAX(0.,2.*PSVT(IIB,:,:,JSV) - &
+ PSVT(IIB+1,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIB-1,:,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ ENDIF
+!
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 5 LBC FILLING IN THE X DIRECTION (RIGHT EAST SIDE):
+! ===============--------------------------------
+!
+IF (LEAST_ll( )) THEN
+!
+SELECT CASE ( HLBCX(2) )
+!
+!* 5.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (IIE+JEXT,:,:) = PUT (IIE ,:,:) ! never used during run
+ IF(SIZE(PVT) /= 0) PVT (IIE+JEXT,:,:) = PVT (IIE+1-JEXT,:,:)
+ IF(SIZE(PWT) /= 0) PWT (IIE+JEXT,:,:) = PWT (IIE+1-JEXT,:,:)
+ IF(SIZE(PTHT) /= 0) PTHT (IIE+JEXT,:,:) = PTHT (IIE+1-JEXT,:,:)
+ IF(SIZE(PTKET) /= 0) PTKET(IIE+JEXT,:,:) = PTKET(IIE+1-JEXT,:,:)
+ IF(SIZE(PRT) /= 0) PRT (IIE+JEXT,:,:,:) = PRT (IIE+1-JEXT,:,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT(IIE+JEXT,:,:,:) = PSVT (IIE+1-JEXT,:,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIE+JEXT,:,:)= PSRCT (IIE+1-JEXT,:,:)
+ IF(LBLOWSNOW) XSNWCANO(IIE+JEXT,:,:) = XSNWCANO(IIE+1-JEXT,:,:)
+!
+ END DO
+!
+ IF(SIZE(PUT) /= 0) PUT(IIE+1 ,:,:) = 0. ! set the normal velocity
+!
+!* 5.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ ILBX = SIZE(PLBXVM,1)
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PVT (IIE+JI,:,:) = 2.*PVT (IIE+JI-1,:,:) -PVT (IIE+JI-2,:,:)
+ PWT (IIE+JI,:,:) = 2.*PWT (IIE+JI-1,:,:) -PWT (IIE+JI-2,:,:)
+ PTHT (IIE+JI,:,:) = 2.*PTHT (IIE+JI-1,:,:) -PTHT (IIE+JI-2,:,:)
+ !
+ ELSEWHERE ! INFLOW condition
+ PVT (IIE+JI,:,:) = ZPOND*ZLBXVT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PVT(IIE+JI-1,:,:)
+ PWT (IIE+JI,:,:) = ZPOND*ZLBXWT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PWT(IIE+JI-1,:,:)
+ PTHT (IIE+JI,:,:) = ZPOND*ZLBXTHT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PTHT(IIE+JI-1,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+ !
+ IF(SIZE(PTKET) /= 0) THEN
+ ILBX = SIZE(PLBXTKEM,1)
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PTKET(IIE+JI,:,:) = MAX(XTKEMIN, 2.*PTKET(IIE+JI-1,:,:)-PTKET(IIE+JI-2,:,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(IIE+JI,:,:) = MAX(XTKEMIN, ZPOND*ZLBXTKET(ILBX-JPHEXT+JI,:,:) + &
+ (1.-ZPOND)*PTKET(IIE+JI-1,:,:))
+ ENDWHERE
+ END DO
+ END IF
+ !
+!
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ ILBX=SIZE(PLBXRM,1)
+ !
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PRT(IIE+JI,:,:,JRR) = MAX(0.,2.*PRT(IIE+JI-1,:,:,JRR) -PRT(IIE+JI-2,:,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(IIE+JI,:,:,JRR) = MAX(0.,ZLBXRT(ILBX-JPHEXT+JI,:,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JI=1,JPHEXT
+ PSRCT (IIE+JI,:,:) = PSRCT (IIE+JI-1,:,:)
+ END DO
+ END IF
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ ILBX=SIZE(PLBXSVM,1)
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PSVT(IIE+JI,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(IIE+JI-1,:,:,JSV) - &
+ PSVT(IIE+JI-2,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIE+JI,:,:,JSV) = MAX(XSVMIN(JSV),ZLBXSVT(ILBX-JPHEXT+JI,:,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PUT(IIE+1,:,IKB) >= 0. ) ! OUTFLOW condition
+ XSNWCANO(IIE+1,:,JSV) = MAX(0.,2.*XSNWCANO(IIE,:,JSV) - &
+ XSNWCANO(IIE-1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(IIE+1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PUT) /= 0) THEN
+ WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
+ PSVT(IIE+1,:,:,JSV) = MAX(0.,2.*PSVT(IIE,:,:,JSV) - &
+ PSVT(IIE-1,:,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(IIE+1,:,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ END IF
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 6. LBC FILLING IN THE Y DIRECTION (BOTTOM SOUTH SIDE):
+! ------------------------------
+IF (LSOUTH_ll( )) THEN
+!
+SELECT CASE ( HLBCY(1) )
+!
+!* 6.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (:,IJB-JEXT,:) = PUT (:,IJB-1+JEXT,:)
+ IF(SIZE(PVT) /= 0) PVT (:,IJB-JEXT,:) = PVT (:,IJB ,:) ! never used during run
+ IF(SIZE(PWT) /= 0) PWT (:,IJB-JEXT,:) = PWT (:,IJB-1+JEXT,:)
+ IF(SIZE(PTHT) /= 0) PTHT (:,IJB-JEXT,:) = PTHT (:,IJB-1+JEXT,:)
+ IF(SIZE(PTKET) /= 0) PTKET(:,IJB-JEXT,:) = PTKET(:,IJB-1+JEXT,:)
+ IF(SIZE(PRT) /= 0) PRT (:,IJB-JEXT,:,:) = PRT (:,IJB-1+JEXT,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT (:,IJB-JEXT,:,:)= PSVT (:,IJB-1+JEXT,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJB-JEXT,:) = PSRCT(:,IJB-1+JEXT,:)
+ IF(LBLOWSNOW) XSNWCANO(:,IJB-JEXT,:) = XSNWCANO(:,IJB-1+JEXT,:)
+!
+ END DO
+!
+ IF(SIZE(PVT) /= 0) PVT(:,IJB ,:) = 0. ! set the normal velocity
+!
+!* 6.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PVT(:,JJ,:)=0.
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PUT (:,JJ,:) = 2.*PUT (:,JJ+1,:) -PUT (:,JJ+2,:)
+ PWT (:,JJ,:) = 2.*PWT (:,JJ+1,:) -PWT (:,JJ+2,:)
+ PTHT (:,JJ,:) = 2.*PTHT (:,JJ+1,:) -PTHT (:,JJ+2,:)
+ ELSEWHERE ! INFLOW condition
+ PUT (:,JJ,:) = ZPOND*ZLBYUT (:,JJ,:) + (1.-ZPOND)* PUT(:,JJ+1,:)
+ PWT (:,JJ,:) = ZPOND*ZLBYWT (:,JJ,:) + (1.-ZPOND)* PWT(:,JJ+1,:)
+ PTHT (:,JJ,:) = ZPOND*ZLBYTHT (:,JJ,:) + (1.-ZPOND)* PTHT(:,JJ+1,:)
+ ENDWHERE
+ END DO
+ ENDIF
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PTKET(:,JJ,:) = MAX(XTKEMIN, 2.*PTKET(:,JJ+1,:)-PTKET(:,JJ+2,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(:,JJ,:) = MAX(XTKEMIN,ZPOND*ZLBYTKET(:,JJ,:) + &
+ (1.-ZPOND)*PTKET(:,JJ+1,:))
+ ENDWHERE
+ END DO
+ END IF
+ !
+!
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PRT(:,JJ,:,JRR) = MAX(0.,2.*PRT(:,JJ+1,:,JRR) -PRT(:,JJ+2,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(:,JJ,:,JRR) = MAX(0.,ZLBYRT(:,JJ,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PSRCT(:,JJ,:) = PSRCT(:,JJ+1,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+!
+ DO JSV=1 ,KSV
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PSVT(:,JJ,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(:,JJ+1,:,JSV) - &
+ PSVT(:,JJ+2,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,JJ,:,JSV) = MAX(XSVMIN(JSV),ZLBYSVT(:,JJ,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PVT(:,IJB,IKB) <= 0. ) ! OUTFLOW condition
+ XSNWCANO(:,IJB-1,JSV) = MAX(0.,2.*XSNWCANO(:,IJB,JSV) - &
+ XSNWCANO(:,IJB+1,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(:,IJB-1,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ IF(SIZE(PVT) /= 0) THEN
+ WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
+ PSVT(:,IJB-1,:,JSV) = MAX(0.,2.*PSVT(:,IJB,:,JSV) - &
+ PSVT(:,IJB+1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJB-1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ END IF
+!
+!
+END SELECT
+!
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 7. LBC FILLING IN THE Y DIRECTION (TOP NORTH SIDE):
+! ===============
+!
+IF (LNORTH_ll( )) THEN
+!
+SELECT CASE ( HLBCY(2) )
+!
+!* 4.3.1 WALL CASE:
+! =========
+!
+ CASE ('WALL')
+!
+ DO JEXT=1,JPHEXT
+ IF(SIZE(PUT) /= 0) PUT (:,IJE+JEXT,:) = PUT (:,IJE+1-JEXT,:)
+ IF(SIZE(PVT) /= 0) PVT (:,IJE+JEXT,:) = PVT (:,IJE ,:) ! never used during run
+ IF(SIZE(PWT) /= 0) PWT (:,IJE+JEXT,:) = PWT (:,IJE+1-JEXT,:)
+ IF(SIZE(PTHT) /= 0) PTHT (:,IJE+JEXT,:) = PTHT (:,IJE+1-JEXT,:)
+ IF(SIZE(PTKET) /= 0) PTKET(:,IJE+JEXT,:) = PTKET(:,IJE+1-JEXT,:)
+ IF(SIZE(PRT) /= 0) PRT (:,IJE+JEXT,:,:) = PRT (:,IJE+1-JEXT,:,:)
+ IF(SIZE(PSVT) /= 0) PSVT (:,IJE+JEXT,:,:)= PSVT (:,IJE+1-JEXT,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJE+JEXT,:) = PSRCT(:,IJE+1-JEXT,:)
+ IF(LBLOWSNOW) XSNWCANO(:,IJE+JEXT,:) = XSNWCANO(:,IJE+1-JEXT,:)
+!
+ END DO
+!
+ IF(SIZE(PVT) /= 0) PVT(:,IJE+1 ,:) = 0. ! set the normal velocity
+!
+!* 4.3.2 OPEN CASE:
+! =========
+!
+ CASE ('OPEN')
+!
+!
+ ILBY=SIZE(PLBYUM,2)
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PUT (:,IJE+JJ,:) = 2.*PUT (:,IJE+JJ-1,:) -PUT (:,IJE+JJ-2,:)
+ PWT (:,IJE+JJ,:) = 2.*PWT (:,IJE+JJ-1,:) -PWT (:,IJE+JJ-2,:)
+ PTHT (:,IJE+JJ,:) = 2.*PTHT (:,IJE+JJ-1,:) -PTHT (:,IJE+JJ-2,:)
+ ELSEWHERE ! INFLOW condition
+ PUT (:,IJE+JJ,:) = ZPOND*ZLBYUT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PUT(:,IJE+JJ-1,:)
+ PWT (:,IJE+JJ,:) = ZPOND*ZLBYWT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PWT(:,IJE+JJ-1,:)
+ PTHT (:,IJE+JJ,:) = ZPOND*ZLBYTHT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PTHT(:,IJE+JJ-1,:)
+ ENDWHERE
+ END DO
+ ENDIF
+!
+ IF(SIZE(PTKET) /= 0) THEN
+ ILBY=SIZE(PLBYTKEM,2)
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PTKET(:,IJE+JJ,:) = MAX(XTKEMIN, 2.*PTKET(:,IJE+JJ-1,:)-PTKET(:,IJE+JJ-2,:))
+ ELSEWHERE ! INFLOW condition
+ PTKET(:,IJE+JJ,:) = MAX(XTKEMIN,ZPOND*ZLBYTKET(:,ILBY-JPHEXT+JJ,:) + &
+ (1.-ZPOND)*PTKET(:,IJE+JJ-1,:))
+ ENDWHERE
+ END DO
+ ENDIF
+ !
+! Case with KRR moist variables
+!
+!
+ DO JRR =1 ,KRR
+ ILBY=SIZE(PLBYRM,2)
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PRT(:,IJE+JJ,:,JRR) = MAX(0.,2.*PRT(:,IJE+JJ-1,:,JRR) -PRT(:,IJE+JJ-2,:,JRR))
+ ELSEWHERE ! INFLOW condition
+ PRT(:,IJE+JJ,:,JRR) = MAX(0.,ZLBYRT(:,ILBY-JPHEXT+JJ,:,JRR))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(SIZE(PSRCT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ PSRCT(:,IJE+JJ,:) = PSRCT(:,IJE+JJ-1,:)
+ END DO
+ END IF
+!
+! Case with KSV scalar variables
+ DO JSV=1 ,KSV
+ ILBY=SIZE(PLBYSVM,2)
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PSVT(:,IJE+JJ,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(:,IJE+JJ-1,:,JSV) - &
+ PSVT(:,IJE+JJ-2,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJE+JJ,:,JSV) = MAX(XSVMIN(JSV),ZLBYSVT(:,ILBY-JPHEXT+JJ,:,JSV))
+ END WHERE
+ END DO
+ END IF
+ !
+ END DO
+!
+ IF(LBLOWSNOW) THEN
+ DO JSV=1 ,3
+ WHERE ( PVT(:,IJE+1,IKB) >= 0. ) ! OUTFLOW condition
+ XSNWCANO(:,IJE+1,JSV) = MAX(0.,2.*XSNWCANO(:,IJE,JSV) - &
+ XSNWCANO(:,IJE-1,JSV))
+ ELSEWHERE ! INFLOW condition
+ XSNWCANO(:,IJE+1,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END DO
+ DO JSV=NSV_SNWBEG ,NSV_SNWEND
+ !
+ IF(SIZE(PVT) /= 0) THEN
+ WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
+ PSVT(:,IJE+1,:,JSV) = MAX(0.,2.*PSVT(:,IJE,:,JSV) - &
+ PSVT(:,IJE-1,:,JSV))
+ ELSEWHERE ! INFLOW condition
+ PSVT(:,IJE+1,:,JSV) = 0. ! Assume no snow enter throug
+ ! boundaries
+ END WHERE
+ END IF
+ !
+ END DO
+ ENDIF
+!
+END SELECT
+END IF
+!
+!
+IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
+
+ ZSVT=PSVT
+ ZRT=PRT
+
+ IF (GFIRSTCALLLIMA) THEN
+ ALLOCATE(GLIMABOUNDARY(NSV_LIMA))
+ GFIRSTCALLLIMA = .FALSE.
+ DO JSV=NSV_LIMA_BEG,NSV_LIMA_END
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+ CALL INIT_AEROSOL_CONCENTRATION(PRHODREF,ZSVT,XZZ)
+ DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
+ PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
+ PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
+ DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
+ PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
+ PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
+
+ CALL SET_CONC_LIMA( IMI, 'NONE', PRHODREF, ZRT(:, :, :, :), ZSVT(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) )
+ IF (NSV_LIMA_NC.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NC-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NC)=ZSVT(IIB-1,:,:,NSV_LIMA_NC) ! cloud
+ PSVT(IIE+1,:,:,NSV_LIMA_NC)=ZSVT(IIE+1,:,:,NSV_LIMA_NC)
+ PSVT(:,IJB-1,:,NSV_LIMA_NC)=ZSVT(:,IJB-1,:,NSV_LIMA_NC)
+ PSVT(:,IJE+1,:,NSV_LIMA_NC)=ZSVT(:,IJE+1,:,NSV_LIMA_NC)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NR.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NR-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NR)=ZSVT(IIB-1,:,:,NSV_LIMA_NR) ! rain
+ PSVT(IIE+1,:,:,NSV_LIMA_NR)=ZSVT(IIE+1,:,:,NSV_LIMA_NR)
+ PSVT(:,IJB-1,:,NSV_LIMA_NR)=ZSVT(:,IJB-1,:,NSV_LIMA_NR)
+ PSVT(:,IJE+1,:,NSV_LIMA_NR)=ZSVT(:,IJE+1,:,NSV_LIMA_NR)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NI.GE.1) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NI-NSV_LIMA_BEG+1)) THEN
+ PSVT(IIB-1,:,:,NSV_LIMA_NI)=ZSVT(IIB-1,:,:,NSV_LIMA_NI) ! ice
+ PSVT(IIE+1,:,:,NSV_LIMA_NI)=ZSVT(IIE+1,:,:,NSV_LIMA_NI)
+ PSVT(:,IJB-1,:,NSV_LIMA_NI)=ZSVT(:,IJB-1,:,NSV_LIMA_NI)
+ PSVT(:,IJE+1,:,NSV_LIMA_NI)=ZSVT(:,IJE+1,:,NSV_LIMA_NI)
+ ENDIF
+ END IF
+END IF
+!
+!
+IF (LUSECHEM .AND. IMI == 1) THEN
+ IF (GFIRSTCALL1) THEN
+ ALLOCATE(GCHBOUNDARY(NSV_CHEM))
+ GFIRSTCALL1 = .FALSE.
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GCHBOUNDARY(JSV-NSV_CHEMBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ IF (GCHBOUNDARY(JSV-NSV_CHEMBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LUSECHIC .AND. IMI == 1) THEN
+ IF (GFIRSTCALLIC) THEN
+ ALLOCATE(GICBOUNDARY(NSV_CHIC))
+ GFIRSTCALLIC = .FALSE.
+ DO JSV=NSV_CHICBEG,NSV_CHICEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GICBOUNDARY(JSV-NSV_CHICBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CHICBEG,NSV_CHICEND
+ IF (GICBOUNDARY(JSV-NSV_CHICBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+IF (LORILAM .AND. IMI == 1) THEN
+ IF (GFIRSTCALL2) THEN
+ ALLOCATE(GAERBOUNDARY(NSV_AER))
+ GFIRSTCALL2 = .FALSE.
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GAERBOUNDARY(JSV-NSV_AERBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ IF (GAERBOUNDARY(JSV-NSV_AERBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LDUST .AND. IMI == 1) THEN
+ IF (GFIRSTCALL3) THEN
+ ALLOCATE(GDSTBOUNDARY(NSV_DST))
+ GFIRSTCALL3 = .FALSE.
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GDSTBOUNDARY(JSV-NSV_DSTBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ IF (GDSTBOUNDARY(JSV-NSV_DSTBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (LSALT .AND. IMI == 1) THEN
+ IF (GFIRSTCALL5) THEN
+ ALLOCATE(GSLTBOUNDARY(NSV_SLT))
+ GFIRSTCALL5 = .FALSE.
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GSLTBOUNDARY(JSV-NSV_SLTBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ IF (GSLTBOUNDARY(JSV-NSV_SLTBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF ( LPASPOL .AND. IMI == 1) THEN
+ IF (GFIRSTCALLPP) THEN
+ ALLOCATE(GPPBOUNDARY(NSV_PP))
+ GFIRSTCALLPP = .FALSE.
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ GPPTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GPPBOUNDARY(JSV-NSV_PPBEG+1) = GPPTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ IF (GPPBOUNDARY(JSV-NSV_PPBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF ( LCONDSAMP .AND. IMI == 1) THEN
+ IF (GFIRSTCALLCS) THEN
+ ALLOCATE(GCSBOUNDARY(NSV_CS))
+ GFIRSTCALLCS = .FALSE.
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ GCSTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GCSBOUNDARY(JSV-NSV_CSBEG+1) = GCSTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ IF (GCSBOUNDARY(JSV-NSV_CSBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+
+IF (LBLOWSNOW .AND. IMI == 1) THEN
+ IF (GFIRSTCALL3) THEN
+ ALLOCATE(GSNWBOUNDARY(NSV_SNW))
+ GFIRSTCALL3 = .FALSE.
+ DO JSV=NSV_SNWBEG,NSV_SNWEND
+ GCHTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(1,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,1,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY,:,JSV)==0)
+ GSNWBOUNDARY(JSV-NSV_SNWBEG+1) = GCHTMP
+ ENDDO
+ ENDIF
+ENDIF
+
+#ifdef MNH_FOREFIRE
+!ForeFire
+IF ( LFOREFIRE .AND. IMI == 1) THEN
+ IF (GFIRSTCALLFF) THEN
+ ALLOCATE(GFFBOUNDARY(NSV_FF))
+ GFIRSTCALLFF = .FALSE.
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ GFFTMP = .FALSE.
+ IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
+ IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
+ IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
+ IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
+ GFFBOUNDARY(JSV-NSV_FFBEG+1) = GFFTMP
+ ENDDO
+ ENDIF
+
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ IF (GFFBOUNDARY(JSV-NSV_FFBEG+1)) THEN
+ IF (SIZE(PSVT)>0) THEN
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
+ ENDIF
+ ENDIF
+ ENDDO
+ENDIF
+#endif
+!
+IF ( CELEC /= 'NONE' .AND. (NSV_ELEC_A(NDAD(IMI)) == 0 .OR. IMI == 1)) THEN
+ CALL ION_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE BOUNDARIES
diff --git a/src/PHYEX/ext/ch_aqueous_sedim1mom.f90 b/src/PHYEX/ext/ch_aqueous_sedim1mom.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ba0b6ffd5418befa08bfb5c44cdb761c3856a448
--- /dev/null
+++ b/src/PHYEX/ext/ch_aqueous_sedim1mom.f90
@@ -0,0 +1,382 @@
+!MNH_LIC Copyright 2007-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_CH_AQUEOUS_SEDIM1MOM
+! ################################
+!
+INTERFACE
+ SUBROUTINE CH_AQUEOUS_SEDIM1MOM (KSPLITR, HCLOUD, OUSECHIC, PTSTEP, &
+ PZZ, PRHODREF, PRHODJ, PRRS, &
+ PRSS, PRGS, PRRSVS, PSGRSVS, PINPRR )
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+INTEGER, INTENT(IN) :: KSPLITR ! Current time
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, INTENT(IN) :: OUSECHIC ! flag for ice chem.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rainwater m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Snow m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRSVS ! Rainwater aq. species source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSGRSVS ! Precip. ice species source
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! instantaneaous precip.
+!
+END SUBROUTINE CH_AQUEOUS_SEDIM1MOM
+END INTERFACE
+END MODULE MODI_CH_AQUEOUS_SEDIM1MOM
+!
+! ######################################################################
+ SUBROUTINE CH_AQUEOUS_SEDIM1MOM (KSPLITR, HCLOUD, OUSECHIC, PTSTEP, &
+ PZZ, PRHODREF, PRHODJ, PRRS, &
+ PRSS, PRGS, PRRSVS, PSGRSVS, PINPRR )
+! ######################################################################
+!
+!!**** * - compute the explicit microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the sedimentation
+!! of chemical species in the raindrops for the Kessler, ICE2, ICE3 and
+!! ICE4 cloud microphysical scheme
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process). see rain_ice.f90
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CONF :
+!! CCONF configuration of the model for the first time step
+!!
+!! REFERENCE
+!! ---------
+!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIM1MOM )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 22/07/07
+!! 04/11/08 (M Leriche) add ICE3
+!! 17/09/10 (M Leriche) add LUSECHIC flag
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 16/12/15 (M Leriche) compute instantaneous rain at the surface
+! P. Wautelet 12/02/2019: bugfix: ZRR_SEDIM was not initialized everywhere
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_CONF
+USE MODD_CST, ONLY : XRHOLW
+USE MODD_CLOUDPAR, ONLY : VCEXVT=>XCEXVT, XCRS, XCEXRS
+USE MODD_RAIN_ICE_DESCR_n, ONLY : WCEXVT=>XCEXVT, WRTMIN=>XRTMIN
+USE MODD_RAIN_ICE_PARAM_n, ONLY : XFSEDR, XEXSEDR, &
+ XFSEDS, XEXSEDS, &
+ XFSEDG, XEXSEDG
+
+use mode_tools, only: Countjv
+use mode_tools_ll, only: GET_INDICE_ll
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+INTEGER, INTENT(IN) :: KSPLITR ! Current time
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, INTENT(IN) :: OUSECHIC ! flag for ice chem.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rainwater m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Snow m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRSVS ! Rainwater aq. species source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSGRSVS ! Precip. ice species source
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! instantaneaous precip.
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK,JI,JJ ! Vertical loop index for the rain sedimentation
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+!
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+!
+INTEGER :: ISEDIMR, ISEDIMS, ISEDIMG ! Case number of sedimentation
+LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: GSEDIMR ! where to compute the SED processes
+LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: GSEDIMS ! where to compute the SED processes
+LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: GSEDIMG ! where to compute the SED processes
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZRRS ! rainwater m.r.source phys.tendency
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZRSS ! snow m.r.source phys.tendency
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZRGS ! graupel m.r.source phys.tendency
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZWSED ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZZRRS ! Rainwater m.r. source phys.tendency *dt
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZZRSS ! Snow m.r. source phys.tendency *dt
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZZRGS ! Graupel m.r. source phys.tendency *dt
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZRR_SEDIM ! Drain/Dt sur ZTSPLIT
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZSV_SEDIM_FACTR ! Cumul des Dsv/DT
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZSV_SEDIM_FACTS ! Cumul des Dsv/DT
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZSV_SEDIM_FACTG ! Cumul des Dsv/DT
+REAL, DIMENSION(:), ALLOCATABLE :: ZZZRRS ! Rainwater m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZZZRSS ! Snow m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZZZRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
+ ZZW ! Work array
+REAL, DIMENSION(7), SAVE :: Z_XRTMIN
+!
+REAL :: ZVTRMAX, ZT
+LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
+REAL, SAVE :: ZFSEDR, ZEXSEDR, ZCEXVT
+!
+INTEGER , DIMENSION(SIZE(GSEDIMR)) :: IR1,IR2,IR3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMG)) :: IG1,IG2,IG3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+PINPRR(:,:) = 0. ! initialize instantaneous precip.
+!
+!-------------------------------------------------------------------------------
+!
+!!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
+! ---------------------------------------
+!
+ZRRS(:,:,:) = PRRS(:,:,:) / PRHODJ(:,:,:)
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZRSS(:,:,:) = PRSS(:,:,:) / PRHODJ(:,:,:)
+ ZRGS(:,:,:) = PRGS(:,:,:) / PRHODJ(:,:,:)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!* 3.1 Initialize some constants
+!
+firstcall : IF (GSFIRSTCALL) THEN
+ GSFIRSTCALL = .FALSE.
+ SELECT CASE ( HCLOUD)
+ CASE('KESS')
+ ZVTRMAX = 20.
+ CASE('ICE3')
+ ZVTRMAX = 10.
+ CASE('ICE4')
+ ZVTRMAX = 40.
+ END SELECT
+!
+ SELECT CASE ( HCLOUD ) ! constants for rain sedimentation
+ CASE('KESS')
+ Z_XRTMIN(2:3) = 1.0E-20 ! Default values
+ ZFSEDR = XCRS
+ ZEXSEDR = XCEXRS
+ ZCEXVT = VCEXVT
+ CASE('ICE3','ICE4')
+ Z_XRTMIN(1:SIZE(WRTMIN)) = WRTMIN ! Values given in ICEx schemes
+ ZFSEDR = XFSEDR
+ ZEXSEDR = XEXSEDR
+ ZCEXVT = WCEXVT
+ END SELECT
+END IF firstcall
+!
+!* 3.2 time splitting loop initialization
+!
+ZTSPLITR = PTSTEP / REAL(KSPLITR) ! Small time step
+!
+!* 3.3 compute the fluxes
+!
+ZSV_SEDIM_FACTR(:,:,:) = 1.0
+ZZRRS(:,:,:) = ZRRS(:,:,:) * PTSTEP
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZZRSS(:,:,:) = ZRSS(:,:,:) * PTSTEP
+ ZZRGS(:,:,:) = ZRGS(:,:,:) * PTSTEP
+ ZSV_SEDIM_FACTS(:,:,:) = 1.0
+ ZSV_SEDIM_FACTG(:,:,:) = 1.0
+ENDIF
+DO JN = 1 , KSPLITR
+ IF( JN==1 ) THEN
+ ZW(:,:,:) = 0.0
+ DO JK = IKB , IKE-1
+ ZW(:,:,JK) =ZTSPLITR*2./(PRHODREF(:,:,JK)*(PZZ(:,:,JK+2)-PZZ(:,:,JK)))
+ END DO
+ ZW(:,:,IKE) =ZTSPLITR/(PRHODREF(:,:,IKE)*(PZZ(:,:,IKE+1)-PZZ(:,:,IKE)))
+ END IF
+!
+!* 3.3.1 for rain
+!
+ GSEDIMR(:,:,:) = .FALSE.
+ GSEDIMR(IIB:IIE,IJB:IJE,IKB:IKE) = ZZRRS(IIB:IIE,IJB:IJE,IKB:IKE) > Z_XRTMIN(3)
+ ISEDIMR = COUNTJV( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:))
+!
+ IF ( ISEDIMR >= 1 ) THEN
+ ALLOCATE(ZZZRRS(ISEDIMR))
+ ALLOCATE(ZRHODREF(ISEDIMR))
+ DO JL=1,ISEDIMR
+ ZZZRRS(JL) = ZZRRS(IR1(JL),IR2(JL),IR3(JL))
+ ZRHODREF(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
+ ENDDO
+ ALLOCATE(ZZW(ISEDIMR)) ; ZZW(:) = 0.0
+!
+ ZZW(:) = ZFSEDR * ZZZRRS(:)**(ZEXSEDR) * ZRHODREF(:)**(ZEXSEDR-ZCEXVT)
+ ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMR(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
+ DO JK = IKB , IKE
+ ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ ZZRRS(:,:,:) = ZZRRS(:,:,:) + ZRR_SEDIM(:,:,:)
+ PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
+!
+ ZZW(:) = ZFSEDR * ZZZRRS(:)**(ZEXSEDR-1.0) * ZRHODREF(:)**(ZEXSEDR-ZCEXVT)
+ ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMR(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
+ DO JK = IKB , IKE
+ ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZZRRS)
+ DEALLOCATE(ZZW)
+ ZSV_SEDIM_FACTR(:,:,:) = ZSV_SEDIM_FACTR(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
+!! (1.0 + ZRR_SEDIM(:,:,:)/MAX(ZZRRS(:,:,:),XRTMIN_AQ))
+ END IF
+ IF (HCLOUD == 'KESS') EXIT
+!
+!* 3.3.1 for iced precip.hydrometeors
+!
+ GSEDIMS(:,:,:) = .FALSE.
+ GSEDIMG(:,:,:) = .FALSE.
+ GSEDIMS(IIB:IIE,IJB:IJE,IKB:IKE) = ZZRSS(IIB:IIE,IJB:IJE,IKB:IKE) > Z_XRTMIN(5)
+ GSEDIMG(IIB:IIE,IJB:IJE,IKB:IKE) = ZZRGS(IIB:IIE,IJB:IJE,IKB:IKE) > Z_XRTMIN(6)
+ ISEDIMS = COUNTJV( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:))
+ ISEDIMG = COUNTJV( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:))
+! for snow
+ IF ( ISEDIMS >= 1) THEN
+ ALLOCATE(ZZZRSS(ISEDIMS))
+ ALLOCATE(ZRHODREF(ISEDIMS))
+ DO JL=1,ISEDIMS
+ ZZZRSS(JL) = ZZRSS(IS1(JL),IS2(JL),IS3(JL))
+ ZRHODREF(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
+ ENDDO
+ ALLOCATE(ZZW(ISEDIMS)) ; ZZW(:) = 0.0
+!
+ ZZW(:) = XFSEDS * ZZZRSS(:)**(XEXSEDS) * ZRHODREF(:)**(XEXSEDS-ZCEXVT)
+ ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMS(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
+ DO JK = IKB , IKE
+ ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ ZZRSS(:,:,:) = ZZRSS(:,:,:) + ZRR_SEDIM(:,:,:)
+!
+ ZZW(:) = XFSEDS * ZZZRSS(:)**(XEXSEDS-1.0) * ZRHODREF(:)**(XEXSEDS-ZCEXVT)
+ ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMS(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
+ DO JK = IKB , IKE
+ ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZZRSS)
+ DEALLOCATE(ZZW)
+ ZSV_SEDIM_FACTS(:,:,:) = ZSV_SEDIM_FACTS(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
+ ENDIF
+! for graupel
+ IF ( ISEDIMG >= 1) THEN
+ ALLOCATE(ZZZRGS(ISEDIMG))
+ ALLOCATE(ZRHODREF(ISEDIMG))
+ DO JL=1,ISEDIMG
+ ZZZRGS(JL) = ZZRGS(IG1(JL),IG2(JL),IG3(JL))
+ ZRHODREF(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
+ ENDDO
+ ALLOCATE(ZZW(ISEDIMG)) ; ZZW(:) = 0.0
+!
+ ZZW(:) = XFSEDG * ZZZRGS(:)**(XEXSEDG) * ZRHODREF(:)**(XEXSEDG-ZCEXVT)
+ ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMG(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
+ DO JK = IKB , IKE
+ ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ ZZRGS(:,:,:) = ZZRGS(:,:,:) + ZRR_SEDIM(:,:,:)
+!
+ ZZW(:) = XFSEDG * ZZZRGS(:)**(XEXSEDG-1.0) * ZRHODREF(:)**(XEXSEDG-ZCEXVT)
+ ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMG(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
+ DO JK = IKB , IKE
+ ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZZRGS)
+ DEALLOCATE(ZZW)
+ ZSV_SEDIM_FACTG(:,:,:) = ZSV_SEDIM_FACTG(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
+ ENDIF
+END DO
+!
+! Apply the rain sedimentation rate to the WR_xxx aqueous species
+DO JL= 1, SIZE(PRRSVS,4)
+ PRRSVS(:,:,:,JL) = MAX( 0.0,ZSV_SEDIM_FACTR(:,:,:)*PRRSVS(:,:,:,JL) )
+ENDDO
+!ice phase
+IF (OUSECHIC) THEN
+ DO JL= 1, SIZE(PSGRSVS,4)
+ PSGRSVS(:,:,:,JL) = MAX( 0.0, &
+ ((ZSV_SEDIM_FACTS(:,:,:)+ZSV_SEDIM_FACTG(:,:,:))/2.) &
+ *PSGRSVS(:,:,:,JL) )
+ ENDDO
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE CH_AQUEOUS_SEDIM1MOM
diff --git a/src/PHYEX/ext/ch_aqueous_tmicice.f90 b/src/PHYEX/ext/ch_aqueous_tmicice.f90
new file mode 100644
index 0000000000000000000000000000000000000000..51255f6fd86cc99c6db1de25b0a21483f0edde7f
--- /dev/null
+++ b/src/PHYEX/ext/ch_aqueous_tmicice.f90
@@ -0,0 +1,1304 @@
+!MNH_LIC Copyright 2008-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_CH_AQUEOUS_TMICICE
+! ####################################
+!
+INTERFACE
+ SUBROUTINE CH_AQUEOUS_TMICICE( PTSTEP, PRHODREF, PRHODJ, PTHT, PPABST, &
+ PRTMIN_AQ, OUSECHIC, OCH_RET_ICE, HNAMES, &
+ HICNAMES, KEQ, KEQAQ, PRVT, PRCT, PRRT, PRIT,&
+ PRST, PRGT, PCIT, PRCS, PRRS, PRIS, PRSS, &
+ PRGS, PGSVT, PGRSVS, PCSVT, PCRSVS, PRSVT, &
+ PRRSVS, PSGSVT, PSGRSVS )
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PRTMIN_AQ ! LWC threshold liq. chem.
+INTEGER, INTENT(IN) :: KEQ ! Number of chem. spec.
+INTEGER, INTENT(IN) :: KEQAQ ! Number of liq. chem. spec.
+LOGICAL, INTENT(IN) :: OUSECHIC ! flag for ice chem.
+LOGICAL, INTENT(IN) :: OCH_RET_ICE ! flag for retention in ice
+!
+CHARACTER(LEN=32), DIMENSION(:), INTENT(IN) :: HNAMES ! name of chem. species
+CHARACTER(LEN=32), DIMENSION(:), INTENT(IN) :: HICNAMES ! name of ice chem. species
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rainwater m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine conc. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rainwater m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS ! Pristine m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Snow m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! graupel m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PGSVT ! gas species at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PGRSVS ! gas species source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCSVT ! cloud water aq. species at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PCRSVS ! cloud water aq. species source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRSVT ! Rainwater aq. species at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRSVS ! Rainwater aq. species source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSGSVT ! ice species at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSGRSVS ! ice species source
+!
+END SUBROUTINE CH_AQUEOUS_TMICICE
+END INTERFACE
+END MODULE MODI_CH_AQUEOUS_TMICICE
+!
+! ################################################################################
+ SUBROUTINE CH_AQUEOUS_TMICICE( PTSTEP, PRHODREF, PRHODJ, PTHT, PPABST, &
+ PRTMIN_AQ, OUSECHIC, OCH_RET_ICE, HNAMES, &
+ HICNAMES, KEQ, KEQAQ, PRVT, PRCT, PRRT, PRIT,&
+ PRST, PRGT, PCIT, PRCS, PRRS, PRIS, PRSS, &
+ PRGS, PGSVT, PGRSVS, PCSVT, PCRSVS, PRSVT, &
+ PRRSVS, PSGSVT, PSGRSVS )
+! ################################################################################
+!
+!!**** * - compute the explicit microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! corresponding to collision/coalescence processes (autoconversion + accretion)
+!! and to the freezing, rimin and melting processes for snow and graupel
+!! for the ICE3(4) cloud microphysics parameterization (see rain_ice)
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!!
+!! REFERENCE
+!! ---------
+!! Book1 of the documentation ( routine CH_AQUEOUS_TMICICE )
+!!
+!! AUTHOR
+!! ------
+!! C. Mari J.P. Pinty M. Leriche * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/08
+!! M. Leriche 19/07/2010 add riming, freezing and melting for ice phase(ICE3)
+!! M. Leriche 17/09/2010 add OUSECHIC flag
+!! Juan 24/09/2012: for BUG Pgi rewrite PACK function on mode_pack_pgi
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Leriche 2015 correction bug
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPHEXT, &! number of horizontal External points
+ JPVEXT ! number of vertical External points
+USE MODD_CST, ONLY : XP00, XRD, XRV, XCPD, XTT, XLMTT, XLVTT, XCPV, &
+ XCL, XCI, XESTT, XMV, XMD
+USE MODD_RAIN_ICE_DESCR_n, ONLY : XLBR, XLBEXR, XCEXVT, XLBDAS_MAX, XLBS, XLBEXS, &
+ XLBG, XLBEXG, XCXS, XCXG, XDG, XBS
+USE MODD_RAIN_ICE_PARAM_n, ONLY : XTIMAUTC, XCRIAUTC, XFCACCR, XEXCACCR, &
+ XRIMINTP1, XRIMINTP2, XCRIMSS, XCRIMSG,&
+ XEXCRIMSS, XEXCRIMSG, NGAMINC, XGAMINC_RIM1, &
+ XFRACCSS, XLBRACCS1, XLBRACCS2, XLBRACCS3, &
+ XACCINTP1S, XACCINTP2S, XACCINTP1R, XACCINTP2R, &
+ NACCLBDAS, NACCLBDAR, XKER_RACCSS, XKER_RACCS, &
+ XEXRCFRI, XRCFRI, X0DEPG, XEX0DEPG, X1DEPG, &
+ XEX1DEPG, XSCFAC, XFCDRYG, XFIDRYG, XCOLEXIG, &
+ XCOLEXSG, XFSDRYG, NDRYLBDAG, XDRYINTP1G, &
+ XDRYINTP2G, NDRYLBDAS, XDRYINTP1S, XDRYINTP2S, &
+ XKER_SDRYG, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, &
+ XFRDRYG, NDRYLBDAR, XDRYINTP1R, XDRYINTP2R, &
+ XKER_RDRYG, XLBRDRYG1, XLBRDRYG2, XLBRDRYG3, &
+ XCOLIG, XCOLEXIG, XCOLSG, XCOLEXSG
+USE MODD_CH_ICE ! value of retention coefficient
+USE MODD_CH_ICE_n ! index for ice phase chemistry with IC3/4
+!
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+use mode_tools, only: Countjv
+use mode_tools_ll, only: GET_INDICE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PRTMIN_AQ ! LWC threshold liq. chem.
+INTEGER, INTENT(IN) :: KEQ ! Number of chem. spec.
+INTEGER, INTENT(IN) :: KEQAQ ! Number of liq. chem. spec.
+LOGICAL, INTENT(IN) :: OUSECHIC ! flag for ice chem.
+LOGICAL, INTENT(IN) :: OCH_RET_ICE ! flag for retention in ice
+!
+CHARACTER(LEN=32), DIMENSION(:), INTENT(IN) :: HNAMES ! name of chem. species
+CHARACTER(LEN=32), DIMENSION(:), INTENT(IN) :: HICNAMES ! name of ice chem. species
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rainwater m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine conc. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rainwater m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS ! Pristine m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Snow m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! graupel m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PGSVT ! gas species at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PGRSVS ! gas species source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCSVT ! cloud water aq. species at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PCRSVS ! cloud water aq. species source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRSVT ! Rainwater aq. species at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRSVS ! Rainwater aq. species source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSGSVT ! ice species at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSGRSVS ! ice species source
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JLC, JLR, JLI, JLG, JLW ! Loop index for cloud water, rainwater and ice species
+INTEGER :: JJ ! Loop index
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB
+INTEGER :: IJE
+INTEGER :: IKB
+INTEGER :: IKE
+!
+INTEGER :: IMICRO ! case number of r_x>0 locations
+LOGICAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: GMICRO ! where to compute mic. processes
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZT ! Temperature
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZRCS ! Cloud water m.r. source phys.tendency
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZRRS ! Rain water m.r. source phys. tendency
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZRIS ! Pristine m.r. source phys. tendency
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZRSS ! Snow m.r. source phys. tendency
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZRGS ! Graupel m.r. source phys. tendency
+REAL, DIMENSION(SIZE(PGRSVS,1),SIZE(PGRSVS,2),SIZE(PGRSVS,3),SIZE(PGRSVS,4)) &
+ :: ZZGRSVS ! Gas species source
+REAL, DIMENSION(SIZE(PCRSVS,1),SIZE(PCRSVS,2),SIZE(PCRSVS,3),SIZE(PCRSVS,4)) &
+ :: ZZCRSVS ! Cloud water aq. species source
+REAL, DIMENSION(SIZE(PRRSVS,1),SIZE(PRRSVS,2),SIZE(PRRSVS,3),SIZE(PRRSVS,4)) &
+ :: ZZRRSVS ! Rain water aq. species source
+REAL, DIMENSION(SIZE(PSGRSVS,1),SIZE(PSGRSVS,2),SIZE(PSGRSVS,3),SIZE(PSGRSVS,4)) &
+ :: ZZSGRSVS ! Ice (snow+graupel) species source
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZCW ! work array
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZRW ! work array
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZSGW ! work array
+REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
+ :: ZGW ! work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZZT ! Temperature
+REAL, DIMENSION(:), ALLOCATABLE :: ZPRES ! Pressure
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZZRIS ! Pristine m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZZRSS ! snow m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZZRGS ! graupel m.r. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCSVT ! Cloud water aq. species at t
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRSVT ! Rain water aq. species at t
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSGSVT ! Ice (snow + graupel) species at t
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZGRSVS ! Gas species source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCRSVS ! Cloud water aq. species source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRRSVS ! Rain water aq. species source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSGRSVS! Ice (snow+graupel) species source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), ALLOCATABLE :: ZKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), ALLOCATABLE :: ZDV ! Diffusivity of water vapor in the air
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
+ ZZW, & ! Work array
+ ZLBDAR, & ! Slope parameter of the raindrop distribution
+ ZLBDAS, & ! Slope parameter of the snow distribution
+ ZLBDAG, & ! Slope parameter of the graupel distribution
+ ZRDRYG, & ! Dry growth rate of the graupel
+ ZRWETG ! Wet growth rate of the graupel
+!
+INTEGER :: IGRIM, IGACC ! Case number of riming, accretion
+INTEGER :: IGDRY
+!, IGWET ! dry growth and wet growth locations for graupels
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GRIM ! Test where to compute riming
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GACC ! Test where to compute accretion
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GDRY ! Test where to compute dry growth
+!LOGICAL, DIMENSION(:), ALLOCATABLE :: GWET ! Test where to compute wet growt
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices for
+ ! interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for
+ ! interpolations
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
+!
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!
+! compute the temperature
+!
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PRCT,3) - JPVEXT
+!
+!-------------------------------------------------------------------------------
+!
+!!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
+! ---------------------------------------
+!
+ZRCS(:,:,:) = PRCS(:,:,:) / PRHODJ(:,:,:)
+ZRRS(:,:,:) = PRRS(:,:,:) / PRHODJ(:,:,:)
+ZRSS(:,:,:) = PRSS(:,:,:) / PRHODJ(:,:,:)
+ZRIS(:,:,:) = PRIS(:,:,:) / PRHODJ(:,:,:)
+ZRGS(:,:,:) = PRGS(:,:,:) / PRHODJ(:,:,:)
+!
+DO JLC= 1, SIZE(PCRSVS,4)
+ ZZCRSVS(:,:,:,JLC) = PCRSVS(:,:,:,JLC) / PRHODJ(:,:,:)
+ENDDO
+DO JLR= 1, SIZE(PRRSVS,4)
+ ZZRRSVS(:,:,:,JLR) = PRRSVS(:,:,:,JLR) / PRHODJ(:,:,:)
+ENDDO
+IF (OUSECHIC) THEN
+ DO JLG= 1, SIZE(PGRSVS,4)
+ ZZGRSVS(:,:,:,JLG) = PGRSVS(:,:,:,JLG) / PRHODJ(:,:,:)
+ ENDDO
+ DO JLI= 1, SIZE(PSGRSVS,4)
+ ZZSGRSVS(:,:,:,JLI) = PSGRSVS(:,:,:,JLI) / PRHODJ(:,:,:)
+ ENDDO
+ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLG= 1, SIZE(PGRSVS,4)
+ ZZGRSVS(:,:,:,JLG) = PGRSVS(:,:,:,JLG) / PRHODJ(:,:,:)
+ ENDDO
+ ENDIF
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. OPTIMIZATION: looking for locations where m.r. hydro. > min value
+! -----------------------------------------------------------------
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ (PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>PRTMIN_AQ*1.e3/PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)) .OR. &
+ (PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>PRTMIN_AQ*1.e3/PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)) .OR. &
+ (PRST(IIB:IIE,IJB:IJE,IKB:IKE)>PRTMIN_AQ*1.e3/PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)) .OR. &
+ (PRGT(IIB:IIE,IJB:IJE,IKB:IKE)>PRTMIN_AQ*1.e3/PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE))
+!
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZRST(IMICRO))
+ ALLOCATE(ZRGT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+ ALLOCATE(ZCSVT(IMICRO,SIZE(PCSVT,4)))
+ ALLOCATE(ZRSVT(IMICRO,SIZE(PRSVT,4)))
+ ALLOCATE(ZZRCS(IMICRO))
+ ALLOCATE(ZZRRS(IMICRO))
+ ALLOCATE(ZZRIS(IMICRO))
+ ALLOCATE(ZZRSS(IMICRO))
+ ALLOCATE(ZZRGS(IMICRO))
+ ALLOCATE(ZCRSVS(IMICRO,SIZE(PCRSVS,4)))
+ ALLOCATE(ZRRSVS(IMICRO,SIZE(PRRSVS,4)))
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZZW2(IMICRO,SIZE(PCSVT,4)))
+ ALLOCATE(ZZW4(IMICRO,SIZE(PCSVT,4)))
+ ALLOCATE(ZZW1(IMICRO,6))
+ ALLOCATE(ZLBDAR(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZLBDAG(IMICRO))
+ ALLOCATE(ZRDRYG(IMICRO))
+ ALLOCATE(ZRWETG(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ DO JL=1,IMICRO
+ ZCSVT(JL,:) = PCSVT(I1(JL),I2(JL),I3(JL),:)
+ ZCRSVS(JL,:) = ZZCRSVS(I1(JL),I2(JL),I3(JL),:)
+ ZRSVT(JL,:) = PRSVT(I1(JL),I2(JL),I3(JL),:)
+ ZRRSVS(JL,:) = ZZRRSVS(I1(JL),I2(JL),I3(JL),:)
+!
+ 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))
+!
+ ZZRCS(JL) = ZRCS(I1(JL),I2(JL),I3(JL))
+ ZZRRS(JL) = ZRRS(I1(JL),I2(JL),I3(JL))
+ ZZRIS(JL) = ZRIS(I1(JL),I2(JL),I3(JL))
+ ZZRSS(JL) = ZRSS(I1(JL),I2(JL),I3(JL))
+ ZZRGS(JL) = ZRGS(I1(JL),I2(JL),I3(JL))
+!
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ IF (OUSECHIC) THEN
+ ALLOCATE(ZSGSVT(IMICRO,SIZE(PSGSVT,4)))
+ ALLOCATE(ZGRSVS(IMICRO,SIZE(PGRSVS,4)))
+ ALLOCATE(ZSGRSVS(IMICRO,SIZE(PSGRSVS,4)))
+ ALLOCATE(ZZW3(IMICRO,SIZE(PSGSVT,4)))
+ DO JL=1,IMICRO
+ ZGRSVS(JL,:) = ZZGRSVS(I1(JL),I2(JL),I3(JL),:)
+ ZSGSVT(JL,:) = PSGSVT(I1(JL),I2(JL),I3(JL),:)
+ ZSGRSVS(JL,:) = ZZSGRSVS(I1(JL),I2(JL),I3(JL),:)
+ ENDDO
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ ALLOCATE(ZGRSVS(IMICRO,SIZE(PGRSVS,4)))
+ DO JL=1,IMICRO
+ ZGRSVS(JL,:) = ZZGRSVS(I1(JL),I2(JL),I3(JL),:)
+ ENDDO
+ ENDIF
+ ENDIF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. COMPUTES THE SLOW WARM PROCESS SOURCES
+! --------------------------------------
+!
+!* 4.1 compute the slope parameter Lbda_r
+!
+ WHERE( ZRRT(:)>0.0 )
+ ZLBDAR(:) = XLBR*( ZRHODREF(:)*MAX( ZRRT(:),PRTMIN_AQ*1.e3/ZRHODREF(:)) )**XLBEXR
+ END WHERE
+!
+!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
+!
+ ZZW(:) = 0.0
+ ZZW2(:,:) = 0.0
+!
+ DO JL=1,IMICRO
+ IF ( (ZRCT(JL)>0.0) .AND. (ZZRCS(JL)>0.0) ) THEN
+ ZZW(JL) = MIN( ZZRCS(JL),XTIMAUTC*MAX( ZRCT(JL)-XCRIAUTC/ZRHODREF(JL),0.0))
+!
+ ZZW2(JL,:) = ZZW(JL) * ZCSVT(JL,:)/ZRCT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
+ ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) + ZZW2(JL,:)
+ END IF
+ END DO
+!
+!* 4.3 compute the accretion of r_c for r_r production: RCACCR
+!
+ ZZW(:) = 0.0
+ ZZW2(:,:) = 0.0
+!
+ DO JL = 1,IMICRO
+ IF( (ZRCT(JL)>0.0) .AND. (ZRRT(JL)>0.0) .AND. (ZZRCS(JL)>0.0) ) THEN
+ ZZW(JL) = MIN( ZZRCS(JL),XFCACCR * ZRCT(JL) &
+ * ZLBDAR(JL)**XEXCACCR &
+ * ZRHODREF(JL)**(-XCEXVT) )
+!
+ ZZW2(JL,:) = ZZW(JL) * ZCSVT(JL,:)/ZRCT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
+ ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) + ZZW2(JL,:)
+ END IF
+ END DO
+!
+!
+!* 4.4 compute the evaporation of r_r: RREVAV
+!
+! calculated by the kinetic mass transfer equation (BASIC.f90)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. COMPUTES THE SLOW COLD PROCESS SOURCES
+! --------------------------------------
+!
+!* 5.1 compute the spontaneous freezing source: RRHONG
+!
+ ZZW(:) = 0.0
+ ZZW2(:,:) = 0.0
+!
+ DO JL = 1,IMICRO
+ IF( (ZZT(JL)<XTT-35.0) .AND. (ZRRT(JL)>0.) .AND. (ZZRRS(JL)>0.) ) THEN
+ ZZW(JL) = MIN( ZZRRS(JL),ZRRT(JL)/PTSTEP )
+ ZZW2(JL,:) = ZZW(JL) * ZRSVT(JL,:)/ZRRT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:)
+ IF (OUSECHIC) THEN
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
+ .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
+ .OR. NINDEXGI(JLI).EQ.0) THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
+ TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
+ ENDIF
+ ENDDO
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLW = 1, SIZE(PRRSVS,4)
+ IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
+ ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. COMPUTES THE FAST COLD PROCESS SOURCES
+! --------------------------------------
+!
+!* 6.1 compute the slope parameter Lbda_s and Lbda_g
+!
+ WHERE ( ZRST(:)>0.0 )
+ ZLBDAS(:) = MIN( XLBDAS_MAX, &
+ XLBS*( ZRHODREF(:)*MAX( ZRST(:),PRTMIN_AQ*1.e3/ZRHODREF(:)) )**XLBEXS )
+ END WHERE
+!
+ WHERE ( ZRGT(:)>0.0 )
+ ZLBDAG(:) = XLBG*( ZRHODREF(:)*MAX( ZRGT(:),PRTMIN_AQ*1.e3/ZRHODREF(:)))**XLBEXG
+ END WHERE
+!
+!* 6.2 cloud droplet riming of the aggregates
+!
+ ZZW1(:,:) = 0.0
+ ZZW(:) = 0.0
+
+ ALLOCATE(GRIM(IMICRO))
+ GRIM(:) = (ZRCT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
+ (ZRST(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
+ (ZZRCS(:)>0.0) .AND. (ZZT(:)<XTT)
+ IGRIM = COUNT( GRIM(:) )
+!
+ IF( IGRIM>0 ) THEN
+!
+! 6.2.0 allocations
+!
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC1(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+!
+! 6.2.1 select the ZLBDAS
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) )
+!
+! 6.2.2 find the next lower indice for the ZLBDAS 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 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+!
+! 6.2.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)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+! 6.2.4 riming of the small sized aggregates
+!
+ ZZW2(:,:) = 0.0
+ DO JL = 1,IMICRO
+ IF ( GRIM(JL) ) THEN
+ ZZW1(JL,1) = MIN( ZZRCS(JL), XCRIMSS * ZZW(JL) * ZRCT(JL) * ZRST(JL) & ! RCRIMSS
+ * ZLBDAS(JL)**(XBS+XEXCRIMSS) * ZRHODREF(JL)**(-XCEXVT+1) )
+ ZZW2(JL,:) = ZZW1(JL,1) * ZCSVT(JL,:)/ZRCT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
+ ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
+ IF (OUSECHIC) THEN
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
+ .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
+ .OR. NINDEXGI(JLI).EQ.0) THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
+ TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
+ ENDIF
+ ENDDO
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLW = 1, SIZE(PCRSVS,4)
+ IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
+ ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+!
+! 6.2.5 riming-conversion of the large sized aggregates into graupel
+!
+ ZZW2(:,:) = 0.0
+ DO JL = 1,IMICRO
+ IF ( GRIM(JL) .AND. (ZZRSS(JL)>0.0) ) THEN
+ ZZW1(JL,2) = MIN( ZZRCS(JL), XCRIMSG * ZRCT(JL) * ZRST(JL) * ZLBDAS(JL)**(XBS+XEXCRIMSG) & ! RCRIMSG
+ * ZRHODREF(JL)**(-XCEXVT+1) - ZZW1(JL,1) )
+ ZZW2(JL,:) = ZZW1(JL,2) * ZCSVT(JL,:)/ZRCT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
+ ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
+ IF (OUSECHIC) THEN
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
+ .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
+ .OR. NINDEXGI(JLI).EQ.0) THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
+ TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
+ ENDIF
+ ENDDO
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLW = 1, SIZE(PCRSVS,4)
+ IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
+ ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+ DEALLOCATE(GRIM)
+!
+!* 6.3 rain accretion onto the aggregates
+!
+ ZZW(:) = 0.0
+ ZZW1(:,2:3) = 0.0
+ ALLOCATE(GACC(IMICRO))
+ GACC(:) = (ZRRT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
+ (ZRST(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
+ (ZZRRS(:)>0.0) .AND. (ZZT(:)<XTT)
+ IGACC = COUNT( GACC(:) )
+!
+ IF( IGACC>0 ) THEN
+!
+! 6.3.0 allocations
+!
+ ALLOCATE(ZVEC1(IGACC))
+ ALLOCATE(ZVEC2(IGACC))
+ ALLOCATE(ZVEC3(IGACC))
+ ALLOCATE(IVEC1(IGACC))
+ ALLOCATE(IVEC2(IGACC))
+!
+! 6.3.1 select the (ZLBDAS,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) )
+!
+! 6.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
+! 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 ) )
+ 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 ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
+!
+! 6.3.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) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+! 6.3.4 raindrop accretion on the small sized aggregates
+!
+ ZZW2(:,:) = 0.0
+ DO JL = 1,IMICRO
+ IF ( GACC(JL) ) THEN
+ ZZW1(JL,2) = & !! coef of RRACCS
+ XFRACCSS*( ZRST(JL)*ZLBDAS(JL)**XBS )*( ZRHODREF(JL)**(-XCEXVT) ) &
+ *( XLBRACCS1/((ZLBDAS(JL)**2) ) + &
+ XLBRACCS2/( ZLBDAS(JL) * ZLBDAR(JL) ) + &
+ XLBRACCS3/( (ZLBDAR(JL)**2)) )/ZLBDAR(JL)**4
+ ZZW1(JL,4) = MIN( ZZRRS(JL),ZZW1(JL,2)*ZZW(JL) ) ! RRACCSS
+ ZZW2(JL,:) = ZZW1(JL,4) * ZRSVT(JL,:)/ZRRT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:)
+ IF (OUSECHIC) THEN
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
+ .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
+ .OR. NINDEXGI(JLI).EQ.0) THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
+ TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
+ ENDIF
+ ENDDO
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLW = 1, SIZE(PRRSVS,4)
+ IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
+ ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+!
+! 6.3.4b perform the bilinear interpolation of the normalized
+! RACCS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+ ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 )
+!
+! 6.3.5 raindrop accretion-conversion of the large sized aggregates
+! into graupeln
+!
+ ZZW2(:,:) = 0.0
+ WHERE ( GACC(:) .AND. (ZZRSS(:)>0.0) )
+ ZZW1(:,2) = MAX( MIN( ZZRRS(:),ZZW1(:,2)-ZZW1(:,4) ),0.0 ) ! RRACCSG
+ END WHERE
+ DO JL = 1,IMICRO
+ IF ( GACC(JL) .AND. (ZZRSS(JL)>0.0) .AND. ZZW1(JL,2)>0.0 ) THEN
+ ZZW2(JL,:) = ZZW1(JL,2) * ZRSVT(JL,:)/ZRRT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:)
+ IF (OUSECHIC) THEN
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
+ .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
+ .OR. NINDEXGI(JLI).EQ.0) THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
+ TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
+ ENDIF
+ ENDDO
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLW = 1, SIZE(PRRSVS,4)
+ IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
+ ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+ DEALLOCATE(GACC)
+!
+!* 6.4 rain contact freezing
+!
+ ZZW1(:,4) = 0.0
+ ZZW2(:,:) = 0.0
+ DO JL = 1,IMICRO
+ IF ( (ZRIT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. &
+ (ZRRT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. &
+ (ZZRIS(JL)>0.0) .AND. (ZZRRS(JL)>0.0) ) THEN
+ ZZW1(JL,4) = MIN( ZZRRS(JL), XRCFRI * ZCIT(JL) & ! RRCFRIG
+ * ZLBDAR(JL)**XEXRCFRI &
+ * ZRHODREF(JL)**(-XCEXVT-1.) )
+ ZZW2(JL,:) = ZZW1(JL,4) * ZRSVT(JL,:)/ZRRT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:)
+ IF (OUSECHIC) THEN
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
+ .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
+ .OR. NINDEXGI(JLI).EQ.0) THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
+ TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
+ ENDIF
+ ENDDO
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLW = 1, SIZE(PRRSVS,4)
+ IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
+ ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+!
+!* 6.5 compute the Dry growth case of graupel
+!
+ ZZW(:) = 0.0
+ ZZW1(:,:) = 0.0
+ WHERE( (ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
+ ((ZRCT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:) .AND. ZZRCS(:)>0.0)) )
+ ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( ZZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
+ END WHERE
+ WHERE( (ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
+ ((ZRIT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:) .AND. ZZRIS(:)>0.0)) )
+ ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
+ ZZW1(:,2) = MIN( ZZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
+ * ZRIT(:) * ZZW(:) ) ! RIDRYG
+ END WHERE
+!
+! 6.5.1 accretion of aggregates on the graupeln
+!
+ ALLOCATE(GDRY(IMICRO))
+ GDRY(:) = (ZRST(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
+ (ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. (ZZRSS(:)>0.0)
+ IGDRY = COUNT( GDRY(:) )
+!
+ IF( IGDRY>0 ) THEN
+!
+! 6.5.2 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+! 6.5.3 select the (ZLBDAG,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) )
+!
+! 6.5.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
+! 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 ) )
+ 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 ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+! 6.5.5 perform the bilinear interpolation of the normalized
+! 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) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,3) = MIN( ZZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
+ * EXP( XCOLEXSG*(ZZT(:)-XTT) ) &
+ *ZRST(:)*( ZLBDAG(:)**XCXG ) &
+ *( ZRHODREF(:)**(-XCEXVT) ) &
+ *( XLBSDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + &
+ XLBSDRYG3/( ZLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+! 6.5.6 accretion of raindrops on the graupeln
+!
+ GDRY(:) = (ZRRT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
+ (ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. (ZZRRS(:)>0.0)
+ IGDRY = COUNT( GDRY(:) )
+!
+ IF( IGDRY>0 ) THEN
+!
+! 6.5.7 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+! 6.5.8 select the (ZLBDAG,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
+!
+! 6.5.9 find the next lower indice for the ZLBDAG and for the ZLBDAR
+! 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 ) )
+ 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 ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+! 6.5.10 perform the bilinear interpolation of the normalized
+! 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) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,4) = MIN( ZZRRS(:), XFRDRYG*ZZW(:) & ! RRDRYG
+ *( ZLBDAR(:)**(-4) )*( ZLBDAG(:)**XCXG ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + &
+ XLBRDRYG3/( ZLBDAR(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+ ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
+ DEALLOCATE(GDRY)
+!
+!* 6.6 compute the Wet growth case of the graupel
+!
+ ZZW(:) = 0.0
+ ZRWETG(:) = 0.0
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+ !c^prime_j (in the ventilation factor)
+ WHERE( ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:) )
+ ZZW1(:,5) = MIN( ZZRIS(:), &
+ ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG
+ ZZW1(:,6) = MIN( ZZRSS(:), &
+ ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(:)-XTT)) ) ) ! RSWETG
+!
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+! compute RWETG
+!
+ ZRWETG(:)=MAX( 0.0, &
+ ( ZZW(:) * ( X0DEPG* ZLBDAG(:)**XEX0DEPG + &
+ X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) + &
+ ( ZZW1(:,5)+ZZW1(:,6) ) * &
+ ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
+ ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
+ END WHERE
+!
+!* 6.7 Select Wet or Dry case for the growth of the graupel
+!
+ ZZW(:) = 0.0
+ ZZW2(:,:) = 0.0
+ ZZW4(:,:) = 0.0
+ DO JL = 1,IMICRO
+ IF ( (ZRGT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. & ! wet case
+ ZZT(JL)<XTT .AND. ZRDRYG(JL)>=ZRWETG(JL) .AND. &
+ ZRWETG(JL)>0.0 .AND. ZRCT(JL)>0.0 .AND. ZRRT(JL)>0.0) THEN
+ ZZW(JL) = ZRWETG(JL)
+ ZZW2(JL,:) = ZZW(JL) * ZRSVT(JL,:)/ZRRT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:) ! rain -> graupel
+ IF (OUSECHIC) THEN
+ ZZW3(:,:) = 0.0
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
+ .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
+ .OR. NINDEXGI(JLI).EQ.0) THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
+ TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
+ ELSE
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
+ (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
+ ENDIF
+ ENDDO
+ IF (ZRST(JL)>0.0) THEN
+ ZZW3(JL,:) = ZZW1(JL,6) * ZSGSVT(JL,:)/ZRST(JL)
+ ZZW3(JL,:) = MAX(MIN(ZZW3(JL,:),(ZSGSVT(JL,:)/PTSTEP)),0.0)
+ ZSGRSVS(JL,:) = ZSGRSVS(JL,:) - ZZW3(JL,:) !snow->rain
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ ZRRSVS(JL,NINDEXWI(JLI)) = ZRRSVS(JL,NINDEXWI(JLI)) + ZZW3(JL,JLI)
+ ENDDO
+ ENDIF
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLW = 1, SIZE(PRRSVS,4)
+ IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
+ ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ZZW4(JL,:) = ZZW1(JL,1) * ZCSVT(JL,:)/ZRCT(JL)
+ ZZW4(JL,:) = MAX(MIN(ZZW4(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
+ ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW4(JL,:) !cloud->rain
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) + ZZW4(JL,:)
+ ELSE IF ( (ZRGT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. & ! dry case
+ ZZT(JL)<XTT .AND. ZRDRYG(JL)<ZRWETG(JL) .AND. &
+ ZRDRYG(JL)>0.0 .AND. ZRCT(JL)>0.0 .AND. ZRRT(JL)>0.0) THEN
+ ZZW2(JL,:) = ZZW1(JL,1) * ZCSVT(JL,:)/ZRCT(JL)
+ ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
+ ZZW4(JL,:) = ZZW1(JL,4) * ZRSVT(JL,:)/ZRRT(JL)
+ ZZW4(JL,:) = MAX(MIN(ZZW4(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
+ ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
+ ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW4(JL,:)
+ IF (OUSECHIC) THEN
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
+ .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
+ .OR. NINDEXGI(JLI).EQ.0) THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ( &
+ ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ( &
+ ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + (1. - XRETHP) * ( &
+ ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
+ ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
+ .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
+ TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ( &
+ ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + (1. - XRETSU) * ( &
+ ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
+ ELSE
+ ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ( &
+ ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
+ ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + (1. - XRETDF) * ( &
+ ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
+ ENDIF
+ ENDDO
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLW = 1, SIZE(PRRSVS,4)
+ IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
+ ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW) &
+ + ZZW4(JL,JLW)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+!
+!* 6.8 Melting of the graupel
+!
+ IF (OUSECHIC) THEN
+ ZZW(:) = 0.0
+ ZZW3(:,:) = 0.0
+ DO JL = 1,IMICRO
+ IF ( (ZRGT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. &
+ (ZZRGS(JL)>0.0) .AND. (ZZT(JL)>XTT) ) THEN
+ ZZW(JL) = ZRVT(JL)*ZPRES(JL)/((XMV/XMD)+ZRVT(JL)) ! Vapor pressure
+ ZZW(JL) = ZKA(JL)*(XTT-ZZT(JL)) + &
+ ( ZDV(JL)*(XLVTT + ( XCPV - XCL ) * ( ZZT(JL) - XTT )) &
+ *(XESTT-ZZW(JL))/(XRV*ZZT(JL)) )
+! compute RGMLTR
+ ZZW(JL) = MIN( ZZRGS(JL), MAX( 0.0,( -ZZW(JL) * &
+ ( X0DEPG* ZLBDAG(JL)**XEX0DEPG + &
+ X1DEPG*ZCJ(JL)*ZLBDAG(JL)**XEX1DEPG ) - &
+ ( ZZW1(JL,1)+ZZW1(JL,4) ) * &
+ ( ZRHODREF(JL)*XCL*(XTT-ZZT(JL))) ) / &
+ ( ZRHODREF(JL)*XLMTT ) ) )
+ ZZW3(JL,:) = ZZW(JL) * ZSGSVT(JL,:)/ZRGT(JL)
+ ZZW3(JL,:) = MAX(MIN(ZZW3(JL,:),(ZSGSVT(JL,:)/PTSTEP)),0.0)
+ ZSGRSVS(JL,:) = ZSGRSVS(JL,:) - ZZW3(JL,:) !graupel->rain
+ DO JLI = 1, SIZE(PSGRSVS,4)
+ ZRRSVS(JL,NINDEXWI(JLI)) = ZRRSVS(JL,NINDEXWI(JLI)) + ZZW3(JL,JLI)
+ ENDDO
+ ENDIF
+ ENDDO
+ ENDIF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. UNPACK RESULTS AND DEALLOCATE ARRAYS
+! ------------------------------------
+
+
+ DO JLC= 1, SIZE(PCRSVS,4)
+ ZCW(:,:,:) = ZZCRSVS(:,:,:,JLC)
+ ZZCRSVS(:,:,:,JLC) = UNPACK(ZCRSVS(:,JLC), MASK=GMICRO(:,:,:), FIELD=ZCW(:,:,:))
+ PCRSVS(:,:,:,JLC) = ZZCRSVS(:,:,:,JLC) * PRHODJ(:,:,:)
+ END DO
+ DO JLR= 1, SIZE(PRRSVS,4)
+ ZRW(:,:,:) = ZZRRSVS(:,:,:,JLR)
+ ZZRRSVS(:,:,:,JLR) = UNPACK(ZRRSVS(:,JLR), MASK=GMICRO(:,:,:), FIELD=ZRW(:,:,:))
+ PRRSVS(:,:,:,JLR) = ZZRRSVS(:,:,:,JLR) * PRHODJ(:,:,:)
+ END DO
+ IF (OUSECHIC) THEN
+ DO JLI= 1, SIZE(PSGRSVS,4)
+ ZSGW(:,:,:) = ZZSGRSVS(:,:,:,JLI)
+ ZZSGRSVS(:,:,:,JLI) = UNPACK(ZSGRSVS(:,JLI), MASK=GMICRO(:,:,:), FIELD=ZSGW(:,:,:))
+ PSGRSVS(:,:,:,JLI) = ZZSGRSVS(:,:,:,JLI) * PRHODJ(:,:,:)
+ END DO
+ DO JLG= 1, SIZE(PGRSVS,4)
+ ZGW(:,:,:) = ZZGRSVS(:,:,:,JLG)
+ ZZGRSVS(:,:,:,JLG) = UNPACK(ZGRSVS(:,JLG), MASK=GMICRO(:,:,:), FIELD=ZGW(:,:,:))
+ PGRSVS(:,:,:,JLG) = ZZGRSVS(:,:,:,JLG) * PRHODJ(:,:,:)
+ END DO
+ DEALLOCATE(ZGRSVS)
+ DEALLOCATE(ZSGRSVS)
+ DEALLOCATE(ZSGSVT)
+ DEALLOCATE(ZZW3)
+ ELSE
+ IF (.NOT.(OCH_RET_ICE)) THEN
+ DO JLG= 1, SIZE(PGRSVS,4)
+ ZGW(:,:,:) = ZZGRSVS(:,:,:,JLG)
+ ZZGRSVS(:,:,:,JLG) = UNPACK(ZGRSVS(:,JLG), MASK=GMICRO(:,:,:), FIELD=ZGW(:,:,:))
+ PGRSVS(:,:,:,JLG) = ZZGRSVS(:,:,:,JLG) * PRHODJ(:,:,:)
+ END DO
+ DEALLOCATE(ZGRSVS)
+ ENDIF
+ ENDIF
+
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW4)
+ DEALLOCATE(ZZRCS)
+ DEALLOCATE(ZZRRS)
+ DEALLOCATE(ZZRIS)
+ DEALLOCATE(ZZRSS)
+ DEALLOCATE(ZZRGS)
+ DEALLOCATE(ZCRSVS)
+ DEALLOCATE(ZRRSVS)
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZCSVT)
+ DEALLOCATE(ZRSVT)
+ DEALLOCATE(ZLBDAR)
+ DEALLOCATE(ZLBDAS)
+ DEALLOCATE(ZLBDAG)
+ DEALLOCATE(ZRDRYG)
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE CH_AQUEOUS_TMICICE
diff --git a/src/PHYEX/ext/ch_meteo_trans_kess.f90 b/src/PHYEX/ext/ch_meteo_trans_kess.f90
new file mode 100644
index 0000000000000000000000000000000000000000..debd6ae61a8107d41da8ba5870e267cb73c5a0d1
--- /dev/null
+++ b/src/PHYEX/ext/ch_meteo_trans_kess.f90
@@ -0,0 +1,351 @@
+!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_CH_METEO_TRANS_KESS
+!! ###############################
+!!
+!
+INTERFACE
+!!
+SUBROUTINE CH_METEO_TRANS_KESS(KL, PRHODJ, PRHODREF, PRTSM, PTHT, PABST, &
+ KVECNPT, KVECMASK, TPM, KDAY, KMONTH, &
+ KYEAR, PLAT, PLON, PLAT0, PLON0, OUSERV, &
+ OUSERC, OUSERR, KLUOUT, HCLOUD, PTSTEP )
+!
+USE MODD_CH_M9_n, ONLY: METEOTRANSTYPE
+!
+IMPLICIT NONE
+REAL, INTENT(IN), OPTIONAL :: PTSTEP !timestep
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! air density
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRTSM ! moist variables at t or t-dt or water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PABST ! theta and pressure at t
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK
+!
+TYPE(METEOTRANSTYPE), DIMENSION(:), INTENT(INOUT) :: TPM
+ ! meteo variable for CCS
+INTEGER, INTENT(IN) :: KYEAR ! Current Year
+INTEGER, INTENT(IN) :: KMONTH ! Current Month
+INTEGER, INTENT(IN) :: KDAY ! Current Day
+INTEGER, INTENT(IN) :: KLUOUT ! channel for output listing
+INTEGER, INTENT(IN) :: KL, KVECNPT
+REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON
+REAL, INTENT(IN) :: PLAT0, PLON0
+LOGICAL, INTENT(IN) :: OUSERV, OUSERC, OUSERR
+END SUBROUTINE CH_METEO_TRANS_KESS
+!!
+END INTERFACE
+!!
+END MODULE MODI_CH_METEO_TRANS_KESS
+!!
+!! ####################################################################
+SUBROUTINE CH_METEO_TRANS_KESS(KL, PRHODJ, PRHODREF, PRTSM, PTHT, PABST, &
+ KVECNPT, KVECMASK, TPM, KDAY, KMONTH, &
+ KYEAR, PLAT, PLON, PLAT0, PLON0, OUSERV, &
+ OUSERC, OUSERR, KLUOUT, HCLOUD, PTSTEP )
+!! ####################################################################
+!!
+!!*** *CH_METEO_TRANS_KESS*
+!!
+!! PURPOSE
+!! -------
+! Transfer of meteorological data, such as temperature, pressure
+! and water vapor mixing ratio for one point into the variable TPM(JM+1)
+! here LWC, LWR and mean radius computed from Kessler or ICEx schemes
+!!
+!! METHOD
+!! ------
+!! For the given grid-point KI,KJ,KK, the meteorological parameters
+!! will be transfered for use by CH_SET_RATES and CH_SET_PHOTO_RATES.
+!! Presently, the variables altitude, air density, temperature,
+!! water vapor mixing ratio, cloud water, longitude, latitude and date
+!! will be transfered. In the chemical definition file (.chf)
+!! these variables have to be transfered into variables like O2, H2O etc.
+!! Also, consistency is checked between the number of
+!! variables expected by the CCS (as defined in the .chf file) and
+!! the number of variables to be transfered here. If you change
+!! the meaning of XMETEOVARS in your .chf file, make sure to modify
+!! this subroutine accordingly.
+!! If the model is run in 1D mode, the model level instead of altitude
+!! is passed. In 2D and 3D, altitude is passed with a negative sign
+!! so that the radiation scheme TUV can make the difference between
+!! model levels and altitude.
+!!
+!! AUTHOR
+!! ------
+!! K. Suhre *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/05/95
+!! 04/08/96 (K. Suhre) restructured
+!! 21/02/97 (K. Suhre) add XLAT0 and XLON0 for LCARTESIAN=T case
+!! 27/08/98 (P. Tulet) add temperature at t for kinetic coefficient
+!! 09/03/99 (V. Crassier & K. Suhre) vectorization
+!! 09/03/99 (K. Suhre) modification for TUV
+!! 09/03/99 (C. Mari & J. Escobar) Code optimization
+!! 01/12/03 (D. Gazen) change Chemical scheme interface
+!! 01/12/03 (D. Gazen) change Chemical scheme interface
+!! 01/12/04 (P. Tulet) update ch_meteo_transn.f90 for Arome
+!! 01/12/07 (M. Leriche) include rain
+!! 14/05/08 (M. Leriche) include raindrops and cloud droplets mean radius
+!! 05/06/08 (M. Leriche) calculate LWC and LWR in coherence with time spliting scheme
+!! 05/11/08 (M. Leriche) split in two routines for 1-moment and 2-moment cloud schemes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!!
+!! EXTERNAL
+!! --------
+!! GAMMA : gamma function
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+USE MODD_CH_M9_n, ONLY: NMETEOVARS, & ! number of meteorological variables
+ METEOTRANSTYPE !type for meteo . transfer
+!!
+USE MODD_CST, ONLY: XP00, & ! Surface pressure
+ XRD, & ! R gas constant
+ XCPD, & !specific heat for dry air
+ XPI, & !pie
+ XRHOLW !density of water
+!!
+USE MODD_CONF, ONLY: LCARTESIAN ! Logical for cartesian geometry
+!!
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XNUC, XALPHAC, & !Cloud droplets distrib. param.
+ XRTMIN, & ! min values of the water m. r.
+ XLBC, XLBEXC, & !shape param. of the cloud droplets
+ XLBR, XLBEXR, & !shape param. of the raindrops
+ XCONC_LAND
+!!
+use mode_msg
+
+USE MODI_GAMMA
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, INTENT(IN), OPTIONAL :: PTSTEP ! Double timestep
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! air density
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRTSM ! moist variables at t or t-dt or water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PABST ! theta and pressure at t
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK
+!
+TYPE(METEOTRANSTYPE), DIMENSION(:), INTENT(INOUT) :: TPM
+ ! meteo variable for CCS
+INTEGER, INTENT(IN) :: KYEAR ! Current Year
+INTEGER, INTENT(IN) :: KMONTH ! Current Month
+INTEGER, INTENT(IN) :: KDAY ! Current Day
+INTEGER, INTENT(IN) :: KLUOUT ! channel for output listing
+INTEGER, INTENT(IN) :: KL, KVECNPT
+REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON
+REAL, INTENT(IN) :: PLAT0, PLON0
+LOGICAL, INTENT(IN) :: OUSERV, OUSERC, OUSERR
+!
+!* 0.2 declarations of local variables
+!
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3),3) :: ZRTSM
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2)) :: ZLAT, ZLON
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZRAYC, ZWLBDC, &
+ ZWLBDC3, ZCONC
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZRAYR, ZWLBDR, ZWLBDR3
+LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
+INTEGER :: JI,JJ,JK,JM
+INTEGER :: IDTI,IDTJ,IDTK
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZE METEO VARIABLE TRANSFER
+! ----------------------------------
+!
+firstcall : IF (GSFIRSTCALL) THEN
+!
+ GSFIRSTCALL = .FALSE.
+!
+!* 1.1 check if number of variables NMETEOVARS
+! corresponds to what the CCS expects
+!
+ IF (NMETEOVARS /= 13) THEN
+ WRITE(KLUOUT,*) "CH_METEO_TRANS ERROR: number of meteovars to transfer"
+ WRITE(KLUOUT,*) "does not correspond to the number expected by the CCS:"
+ WRITE(KLUOUT,*) " meteovars to transfer: ", 13
+ WRITE(KLUOUT,*) " NMETEOVARS expected: ", NMETEOVARS
+ WRITE(KLUOUT,*) "Check the definition of NMETEOVARS in your .chf file."
+ WRITE(KLUOUT,*) "The program will be stopped now!"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_METEO_TRANS_KESS', &
+ 'number of meteovars to transfer does not correspond to the expected number.' )
+ END IF
+!
+!* 1.2 initialize names of meteo vars
+!
+ TPM(:)%CMETEOVAR(1) = "Model level"
+ TPM(:)%CMETEOVAR(2) = "Air density (kg/m3)"
+ TPM(:)%CMETEOVAR(3) = "Temperature (K)"
+ TPM(:)%CMETEOVAR(4) = "Water vapor (kg/kg)"
+ TPM(:)%CMETEOVAR(5) = "Cloud water (kg/kg)"
+ TPM(:)%CMETEOVAR(6) = "Latitude (rad)"
+ TPM(:)%CMETEOVAR(7) = "Longitude (rad)"
+ TPM(:)%CMETEOVAR(8) = "Current date (year)"
+ TPM(:)%CMETEOVAR(9) = "Current date (month)"
+ TPM(:)%CMETEOVAR(10)= "Current date (day)"
+ TPM(:)%CMETEOVAR(11)= "Rain water (kg/kg)"
+ TPM(:)%CMETEOVAR(12)= "Mean cloud droplets radius (m)"
+ TPM(:)%CMETEOVAR(13)= "Mean raindrops radius (m)"
+!
+ENDIF firstcall
+!
+! "Water vapor (kg/kg)"
+!
+IF (OUSERV) THEN
+! if split option, use tendency
+ IF (PRESENT(PTSTEP)) THEN
+ ZRTSM(:,:,:,1) = (PRTSM(:,:,:, 1)/ PRHODJ(:,:,:))*PTSTEP
+ ELSE
+ ZRTSM(:,:,:,1) = PRTSM(:,:,:, 1)
+ ENDIF
+ELSE
+ ZRTSM(:,:,:,1) = 0.0
+ENDIF
+!
+! "Cloud water (kg/kg)" and "Mean cloud droplets radius (m)"
+!
+IF (OUSERC) THEN
+ IF (PRESENT(PTSTEP)) THEN
+ ZRTSM(:,:,:,2) = (PRTSM(:,:,:, 2)/ PRHODJ(:,:,:))*PTSTEP
+ ELSE
+ ZRTSM(:,:,:,2) = PRTSM(:,:,:, 2)
+ ENDIF
+ ZRAYC(:,:,:) = 10.e-6 ! avoid division by zero
+ SELECT CASE (HCLOUD)
+ CASE ('KESS')
+ WHERE (ZRTSM(:,:,:, 2)>1.e-20) !default value for Kessler
+ ZRAYC(:,:,:) = 10.e-6 ! assume a cloud droplet radius of 10 µm
+ ENDWHERE
+ CASE ('ICE3','ICE4')
+ WHERE (ZRTSM(:,:,:, 2)>XRTMIN(2))
+ ZCONC(:,:,:) = XCONC_LAND
+ ZWLBDC3(:,:,:) = XLBC(1) * ZCONC(:,:,:) / (PRHODREF(:,:,:) * ZRTSM(:,:,:, 2))
+ ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
+ ZRAYC(:,:,:) = 0.5*GAMMA(XNUC+1./XALPHAC)/(GAMMA(XNUC)*ZWLBDC(:,:,:))
+! ZRAYC(:,:,:) = 10.e-6 ! assume a cloud droplet radius of 10 µm
+ ENDWHERE
+ END SELECT
+ELSE
+ ZRTSM(:,:,:,2) = 0.0
+ ZRAYC(:,:,:) = 10.e-6 ! avoid division by zero
+ENDIF
+!
+! "Rain water (kg/kg)" and "Mean raindrops radius (m)"
+!
+IF (OUSERR) THEN
+ IF (PRESENT(PTSTEP)) THEN
+ ZRTSM(:,:,:,3) = (PRTSM(:,:,:, 3)/ PRHODJ(:,:,:))*PTSTEP
+ ELSE
+ ZRTSM(:,:,:,3) = PRTSM(:,:,:, 3)
+ ENDIF
+ ZRAYR(:,:,:) = 500.e-6 ! avoid division by zero
+ SELECT CASE (HCLOUD)
+ CASE ('KESS')
+ WHERE (ZRTSM(:,:,:, 3)>1.e-20) !default value for Kessler
+ ZRAYR(:,:,:) = 0.5*((XPI*XRHOLW*1.E7)/ &
+ (PRHODREF(:,:,:)*ZRTSM(:,:,:,3)))**(-1./4.)
+ ENDWHERE
+ CASE ('ICE3','ICE4')
+ WHERE (ZRTSM(:,:,:, 3)>XRTMIN(3))
+ ZRAYR(:,:,:) = 0.5*(1./(XLBR*(PRHODREF(:,:,:)*ZRTSM(:,:,:,3))**XLBEXR))
+ ENDWHERE
+ END SELECT
+ELSE
+ ZRTSM(:,:,:,3) = 0.0
+ ZRAYR(:,:,:) = 500.e-6 ! avoid division by zero
+ENDIF
+
+IF(LCARTESIAN) THEN
+! "Latitude (rad)"
+ ZLAT(:,:) = PLAT0
+! "Longitude (rad)"
+ ZLON(:,:) = PLON0
+ELSE
+! "Latitude (rad)"
+ ZLAT(:,:) = PLAT(:,:)
+! "Longitude (rad)"
+ ZLON(:,:) = PLON(:,:)
+END IF
+!!
+!* 2. TRANSFER METEO VARIABLES
+! ------------------------
+!
+IDTI=KVECMASK(2,KL)-KVECMASK(1,KL)+1
+IDTJ=KVECMASK(4,KL)-KVECMASK(3,KL)+1
+IDTK=KVECMASK(6,KL)-KVECMASK(5,KL)+1
+!Vectorization:
+!ocl novrec
+!cdir nodep
+DO JM=0,KVECNPT-1
+ JI=JM-IDTI*(JM/IDTI)+KVECMASK(1,KL)
+ JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+KVECMASK(3,KL)
+ JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+KVECMASK(5,KL)
+!
+!"Model Altitude"
+!
+ TPM(JM+1)%XMETEOVAR(1) = JK-1 ! assuming first model level is level 2
+! TPM(JM+1)%XMETEOVAR(1) = JK ! assuming first model level is level 1
+!
+! "Air density (kg/m3)"
+!
+ TPM(JM+1)%XMETEOVAR(2) = PRHODREF(JI, JJ, JK)
+!
+! "Temperature (K)"
+!
+ TPM(JM+1)%XMETEOVAR(3) = PTHT(JI,JJ,JK)*((PABST(JI,JJ,JK)/XP00)**(XRD/XCPD))
+!
+! "Water vapor (kg/kg)"
+!
+ TPM(JM+1)%XMETEOVAR(4) = ZRTSM(JI, JJ, JK, 1)
+!
+! "Cloud water (kg/kg)"
+!
+ TPM(JM+1)%XMETEOVAR(5) = ZRTSM(JI, JJ, JK, 2)
+!
+! "Latitude (rad)"
+!
+ TPM(JM+1)%XMETEOVAR(6) = ZLAT(JI, JJ)
+!
+! "Longitude (rad)"
+!
+ TPM(JM+1)%XMETEOVAR(7) = ZLON(JI, JJ)
+!
+! "Current date"
+!
+ TPM(JM+1)%XMETEOVAR(8) = REAL(KYEAR)
+ TPM(JM+1)%XMETEOVAR(9) = REAL(KMONTH)
+ TPM(JM+1)%XMETEOVAR(10)= REAL(KDAY)
+!
+! "Rain water (kg/kg)"
+!
+ TPM(JM+1)%XMETEOVAR(11) = ZRTSM(JI, JJ, JK, 3)
+!
+! "Mean cloud droplets radius (m)"
+!
+ TPM(JM+1)%XMETEOVAR(12) = ZRAYC(JI, JJ, JK)
+!
+! "Mean raindrops radius (m)"
+!
+ TPM(JM+1)%XMETEOVAR(13) = ZRAYR(JI, JJ, JK)
+!
+ENDDO
+!
+END SUBROUTINE CH_METEO_TRANS_KESS
diff --git a/src/PHYEX/ext/cphase_profile.f90 b/src/PHYEX/ext/cphase_profile.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f403e5447f35bf807c2a92cf68c92885ae3d71d8
--- /dev/null
+++ b/src/PHYEX/ext/cphase_profile.f90
@@ -0,0 +1,140 @@
+!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_CPHASE_PROFILE
+!#########################
+!
+INTERFACE
+!
+ SUBROUTINE CPHASE_PROFILE (PZHAT,PCPHASE,PCPHASE_PBL,PCPHASE_PROFILE,PTKEM)
+!
+REAL, DIMENSION(:) , INTENT(IN) :: PZHAT ! height level without orography
+REAL , INTENT(IN) :: PCPHASE ! prescribed phase velocity
+REAL , INTENT(IN) :: PCPHASE_PBL ! prescribed phase velocity
+REAL, DIMENSION(:,:) , INTENT(OUT) :: PCPHASE_PROFILE ! profile of Cphase speed
+REAL, DIMENSION(:,:),OPTIONAL , INTENT(IN) :: PTKEM ! TKE at t-dt
+!
+END SUBROUTINE CPHASE_PROFILE
+!
+END INTERFACE
+!
+END MODULE MODI_CPHASE_PROFILE
+!
+! ##########################################################################
+ SUBROUTINE CPHASE_PROFILE (PZHAT,PCPHASE,PCPHASE_PBL,PCPHASE_PROFILE,PTKEM)
+! ##########################################################################
+!
+!!**** *CPHASE_PROFILE* - defines a non-constant vertical profile for Cphase
+!! velocity
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson & C. Lac * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/2010
+!! Escobar 9/11/2010 : array bound problem if NO Turb => PTKEM optional
+!! C.Lac 06/2013 : correction and introduction of PCPHASE_PBL
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TURB_n, ONLY: XTKEMIN
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+REAL, DIMENSION(:) , INTENT(IN) :: PZHAT ! height level without orography
+REAL , INTENT(IN) :: PCPHASE ! prescribed phase velocity
+REAL , INTENT(IN) :: PCPHASE_PBL ! prescribed phase velocity
+REAL, DIMENSION(:,:) , INTENT(OUT) :: PCPHASE_PROFILE ! profile of Cphase speed
+REAL, DIMENSION(:,:),OPTIONAL , INTENT(IN) :: PTKEM ! TKE at t-dt
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IKE ! indice K End in z direction
+!
+REAL, DIMENSION(SIZE(PCPHASE_PROFILE,1)) :: ZTKE, ZTKEMIN
+INTEGER :: JL,JK,JKTKE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PROLOGUE
+! --------
+!
+!* 1.1 Compute dimensions of arrays and other indices
+!
+IKB = 1 + JPVEXT
+IKE = SIZE(PCPHASE_PROFILE,2) - JPVEXT
+!
+!
+!* 1.2 Initializations
+!
+!
+PCPHASE_PROFILE = 0.0
+ZTKEMIN = PZHAT(IKE)
+ZTKE = PZHAT(IKE-1)
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+ IF (PRESENT(PTKEM)) THEN
+!
+ DO JL = 1,SIZE(PCPHASE_PROFILE,1)
+ JKTKE=IKE-1
+ DO JK = IKB, IKE-1
+ IF (PTKEM(JL,JK) < 5.*XTKEMIN ) THEN
+ ZTKE (JL) = PZHAT (JK)
+ JKTKE = JK
+ EXIT
+ END IF
+ END DO
+ DO JK = JKTKE+1,IKE
+ IF (PTKEM(JL,JK) == XTKEMIN ) THEN
+ ZTKEMIN (JL) = PZHAT (JK)
+ EXIT
+ END IF
+ END DO
+ END DO
+!
+ ELSE
+ ZTKE (:) = 1000.
+ ZTKEMIN (:) = 2000.
+ END IF
+!
+ DO JL = 1,SIZE(PCPHASE_PROFILE,1)
+ DO JK = IKB, IKE
+ IF (PZHAT(JK) > ZTKEMIN (JL) ) THEN
+ PCPHASE_PROFILE(JL,JK) = PCPHASE
+ ELSE IF (PZHAT(JK) < ZTKE (JL) ) THEN
+ PCPHASE_PROFILE(JL,JK) = PCPHASE_PBL
+ ELSE
+ PCPHASE_PROFILE(JL,JK) = 1./(ZTKEMIN (JL) - ZTKE (JL)) * &
+ ((PZHAT(JK) - ZTKE(JL)) * PCPHASE + (ZTKEMIN (JL) - PZHAT(JK)) * PCPHASE_PBL )
+ END IF
+ END DO
+ END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE CPHASE_PROFILE
diff --git a/src/PHYEX/ext/deallocate_model1.f90 b/src/PHYEX/ext/deallocate_model1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8b8f572144596c81b071b80cc4352ff347790191
--- /dev/null
+++ b/src/PHYEX/ext/deallocate_model1.f90
@@ -0,0 +1,705 @@
+!MNH_LIC Copyright 1997-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!############################
+MODULE MODI_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_FIRE_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_n
+USE MODD_RAIN_ICE_DESCR_n
+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)
+ IF (ASSOCIATED(XCEI)) DEALLOCATE(XCEI)
+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..33466cf0a528ecca3559fcc0713d498b6249d33e
--- /dev/null
+++ b/src/PHYEX/ext/default_desfmn.f90
@@ -0,0 +1,1327 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_DEFAULT_DESFM_n
+! ###########################
+!
+INTERFACE
+!
+SUBROUTINE DEFAULT_DESFM_n(KMI)
+INTEGER, INTENT(IN) :: KMI ! Model index
+END SUBROUTINE DEFAULT_DESFM_n
+!
+END INTERFACE
+!
+END MODULE MODI_DEFAULT_DESFM_n
+!
+!
+!
+! ###############################
+ SUBROUTINE DEFAULT_DESFM_n(KMI)
+! ###############################
+!
+!!**** *DEFAULT_DESFM_n * - set default values for descriptive variables of
+!! model KMI
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to set default values for the variables
+! in descriptor files by filling the corresponding variables which
+! are stored in modules.
+!
+!
+!!** METHOD
+!! ------
+!! Each variable in modules, which can be initialized by reading its
+!! value in the descriptor file is set to a default value.
+!! When this routine is used during INIT, the modules of the first model
+!! are used to temporarily store the variables associated with a nested
+!! model.
+!! When this routine is used during SPAWNING, the modules of a second
+!! model must be initialized.
+!! Default values for variables common to all models are set only
+!! at the first call of DEFAULT_DESFM_n (i.e. when KMI=1)
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : JPHEXT,JPVEXT
+!!
+!! Module MODD_CONF : CCONF,L2D,L1D,LFLAT,NMODEL,NVERB
+!!
+!! Module MODD_DYN : XSEGLEN,XASSELIN,LCORIO,LNUMDIFF
+!! XALKTOP,XALZBOT
+!!
+!! Module MODD_BAKOUT
+!!
+!! Module MODD_NESTING : NDAD(m),NDTRATIO(m),XWAY(m)
+!!
+!! Module MODD_CONF_n : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS
+!! LUSERG,LUSERH,CSEG,CEXP
+!!
+!! Module MODD_LUNIT_n : CINIFILE,CCPLFILE
+!!
+!!
+!! Module MODD_DYN_n : XTSTEP,CPRESOPT,NITR,XRELAX,LHO_RELAX
+!! LVE_RELAX,XRIMKMAX,NRIMX,NRIMY
+!!
+!! Module MODD_ADV_n : CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME,NLITER
+!!
+!! Module MODD_PARAM_n : CTURB,CRAD,CDCONV,CSCONV
+!!
+!! Module MODD_LBC_n : CLBCX, CLBCY,NLBLX,NLBLY,XCPHASE,XCPHASE_PBL,XPOND
+!!
+!! Module MODD_TURB_n : XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG,LSUBG_COND
+!! LTGT_FLX
+!!
+!!
+!! Module MODD_PARAM_RAD_n:
+!! XDTRAD,XDTRAD_CLONLY,LCLEAR_SKY,NRAD_COLNBR, NRAD_DIAG
+!!
+!! Module MODD_BUDGET : CBUTYPE,NBUMOD,XBULEN,NBUKL, NBUKH,LBU_KCP,XBUWRI
+!! NBUIL, NBUIH,NBUJL, NBUJH,LBU_ICP,LBU_JCP,NBUMASK
+!!
+!! Module MODD_BLANK_n:
+!!
+!! XDUMMYi, NDUMMYi, LDUMMYi, CDUMMYi
+!!
+!! Module MODD_FRC :
+!!
+!! LGEOST_UV_FRC,LGEOST_TH_FRC,LTEND_THRV_FRC
+!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,LRELAX_UVMEAN_FRC,
+!! XRELAX_TIME_FRC
+!! XRELAX_HEIGHT_FRC,CRELAX_HEIGHT_TYPE,LTRANS,XUTRANS,XVTRANS,
+!! LPGROUND_FRC
+!!
+!! Module MODD_PARAM_ICE :
+!!
+!! LWARM,CPRISTINE_ICE
+!!
+!! Module MODD_PARAM_KAFR_n :
+!!
+!! XDTCONV,LREFRESH_ALL,LDOWN,NICE,LCHTRANS
+!!
+!! Module MODD_PARAM_MFSHALL_n :
+!!
+!! CMF_UPDRAFT,LMIXUV,CMF_CLOUD,XIMPL_MF,LMF_FLX
+!!
+!!
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine DEFAULT_DESFM_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/06/94
+!! Modifications 17/10/94 (Stein) For LCORIO
+!! Modifications 06/12/94 (Stein) remove LBOUSS+add LABSLAYER, LNUMDIFF
+!! ,LSTEADYLS
+!! Modifications 06/12/94 (Stein) remove LABSLAYER, add LHO_RELAX,
+!! LVE_RELAX, NRIMX, NRIMY, XRIMKMAX
+!! Modifications 09/01/95 (Lafore) add LSTEADY_DMASS
+!! Modifications 09/01/95 (Stein) add the turbulence scheme namelist
+!! Modifications 09/01/95 (Stein) add the 1D switch
+!! Modifications 10/03/95 (Mallet) add the coupling files
+!! 29/06/95 ( Stein, Nicolau, Hereil) add the budgets
+!! Modifications 25/09/95 ( Stein )add the LES tools
+!! Modifications 25/10/95 ( Stein )add the radiations
+!! Modifications 23/10/95 (Vila, lafore) new scalar advection scheme
+!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE
+!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for
+!! spawning
+!! Modifications 25/04/96 (Suhre) add the blank module
+!! Modifications 29/07/96 (Pinty&Suhre) add module MODD_FRC
+!! Modifications 11/04/96 (Pinty) add the rain-ice scheme and modify
+!! the split arrays in MODD_PARAM_RAD_n
+!! Modifications 11/01/97 (Pinty) add the deep convection scheme
+!! Modifications 24/11/96 (Masson) add LREFRESH_ALL in deep convection
+!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for spawning
+!! Modifications 22/07/96 (Lafore) gridnesting implementation
+!! Modifications 29/07/96 (Lafore) add the module MODD_FMOUT (renamed MODD_BAKOUT)
+!! Modifications 23/06/97 (Stein) add the equation system name
+!! Modifications 10/07/97 (Masson) add MODD_PARAM_GROUNDn : CROUGH
+!! Modifications 28/07/97 (Masson) remove LREFRESH_ALL and LSTEADY_DMASS
+!! Modifications 08/10/97 (Stein) switch (_n=1) to initialize the
+!! parameters common to all models
+!! Modifications 24/01/98 (Bechtold) add LREFRESH_ALL, LCHTRANS,
+!! LTEND_THRV_FR and LSST_FRC
+!! Modifications 18/07/99 (Stein) add LRAD_DIAG
+!! Modification 15/03/99 (Masson) use of XUNDEF
+!! Modification 11/12/00 (Tomasini) Add CSEA_FLUX to MODD_PARAMn
+!! Modification 22/01/01 (Gazen) delete NSV and add LHORELAX_SVC2R2
+!! LHORELAX_SVCHEM,LHORELAX_SVLG
+!! Modification 15/03/02 (Solmon) radiation scheme: remove NSPOT and add
+!! default for aerosol and cloud rad. prop. control
+!! Modification 22/05/02 (Jabouille) put chimical default here
+!! Modification 01/2004 (Masson) removes surface (externalization)
+!! 09/04 (M. Tomasini) New namelist to modify the
+!! Cloud mixing length
+!! 07/05 (P.Tulet) New namelists for dust and aerosol
+!! Modification 01/2007 (Malardel, Pergaud) Add MODD_PARAM_MFSHALL_n
+!! Modification 10/2009 (Aumond) Add user multimasks for LES
+!! Modification 10/2009 (Aumond) Add MEAN_FIELD
+!! Modification 12/04/07 (Leriche) add LUSECHAQ for aqueous chemistry
+!! Modification 30/05/07 (Leriche) add LCH_PH and XCH_PHINIT for pH
+!! Modification 25/04/08 (Leriche) add XRTMIN_AQ LWC threshold for aq. chemistry
+!! 16/07/10 add LHORELAX_SVIC
+!! 16/09/10 add LUSECHIC
+!! 13/01/11 add LCH_RET_ICE
+!! 01/07/11 (F.Couvreux) Add CONDSAMP
+!! 01/07/11 (B.Aouizerats) Add CAOP
+!! 07/2013 (C.Lac) add WENO, LCHECK
+!! 07/2013 (Bosseur & Filippi) adds Forefire
+!! 08/2015 (Redelsperger & Pianezze) add XPOND coefficient for LBC
+!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
+!! put NCH_VEC_LENGTH = 50 instead of 1000
+!!
+!! 04/2016 (C.LAC) negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
+!! put NCH_VEC_LENGTH = 50 instead of 1000
+!! 10/2016 (C.Lac) VSIGQSAT change from 0 to 0.02 for coherence with AROME
+!! 10/2016 (C.Lac) Add droplet deposition
+!! 10/2016 (R.Honnert and S.Riette) : Improvement of EDKF and adaptation to the grey zone
+!! 10/2016 (F Brosse) add prod/loss terms computation for chemistry
+!! 07/2017 (V. Masson) adds time step for output files writing.
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 02/2018 Q.Libois ECRAD
+! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 01/2018 (S. Riette) new budgets and variables for ICE3/ICE4
+!! 01/2018 (J.Colin) add VISC and DRAG
+!! 07/2017 (V. Vionnet) add blowing snow variables
+!! 01/2019 (R. Honnert) add reduction of the mass-flux surface closure with the resolution
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!! 05/2019 F.Brient add tracer emission from the top of the boundary-layer
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! P. Wautelet 17/04/2020: move budgets switch values into modd_budget
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! F. Auguste, T. Nagel 02/2021: add IBM defaults parameters
+! T. Nagel 02/2021: add turbulence recycling defaults parameters
+! P-A Joulin 21/05/2021: add Wind turbines
+! S. Riette 21/05/2021: add options to PDF subgrid scheme
+! D. Ricard 05/2021: add the contribution of Leonard terms in the turbulence scheme
+! JL Redelsperger 06/2021: add parameters allowing to active idealized oceanic convection
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation)
+! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
+! Q. Rodier 07/2021: modify XPOND=1
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
+! A. Costes 12/2021: Blaze fire model
+! C. Barthe 03/2022: add CIBU and RDSF options in LIMA
+! Delbeke/Vie 03/2022: KHKO option in LIMA
+! P. Wautelet 27/04/2022: add namelist for profilers
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_PARAMETERS
+USE MODD_LUNIT_n, ONLY: TLUOUT
+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, ONLY: TURBN_INIT
+USE MODD_NEB_n, ONLY: NEBN_INIT
+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_n, ONLY: PARAM_ICEN_INIT
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
+USE MODD_PARAM_C2R2
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
+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_COUPLING_LEVELS_n
+USE MODD_EOL_MAIN
+USE MODD_EOL_ADNR
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO
+USE MODD_ALLPROFILER_n
+USE MODD_ALLSTATION_n
+!
+USE MODD_LATZ_EDFLX
+USE MODD_2D_FRC
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+USE MODD_DRAG_n
+USE MODD_VISCOSITY
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n
+USE MODD_IBM_LSF
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_FIRE_n
+USE MODD_IO, ONLY: TFILEDATA
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JM ! loop index
+TYPE(TFILEDATA) TFILENAM ! Empty file to satisfy interface of PHYEX_init routines which may calls POSNAM (but do not)
+!
+!-------------------------------------------------------------------------------
+!
+!* 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 :
+! ----------------------------------
+!
+CALL TURBN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
+ &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
+!-------------------------------------------------------------------------------
+!
+!* 10a. SET DEFAULT VALUES FOR MODD_NEB_n :
+! ----------------------------------
+!
+CALL NEBN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
+ &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
+!-------------------------------------------------------------------------------
+!
+!* 10b. SET DEFAULT VALUES FOR MODD_DRAGTREE :
+! ----------------------------------
+!
+LDRAGTREE = .FALSE.
+LDEPOTREE = .FALSE.
+XVDEPOTREE = 0.02 ! 2 cm/s
+!------------------------------------------------------------------------------
+!
+!* 10b. SET DEFAULT VALUES FOR MODD_DRAGBLDG_n :
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
+LFLUXBLDG = .FALSE.
+LDRAGURBVEG = .FALSE.
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_COUPLING_LEVELS_n :
+! ----------------------------------
+!
+NLEV_COUPLE = 1
+!------------------------------------------------------------------------------
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
+!
+!* 10d. SET DEFAULT VALUES FOR MODD_EOL* :
+! ----------------------------------
+!
+! 10d.i) MODD_EOL_MAIN
+!
+LMAIN_EOL = .FALSE.
+CMETH_EOL = 'ADNR'
+CSMEAR = '3LIN'
+NMODEL_EOL = 1
+!
+! 10d.ii) MODD_EOL_SHARED_IO
+!
+CFARM_CSVDATA = 'data_farm.csv'
+CTURBINE_CSVDATA = 'data_turbine.csv'
+CBLADE_CSVDATA = 'data_blade.csv'
+CAIRFOIL_CSVDATA = 'data_airfoil.csv'
+!
+CINTERP = 'CLS'
+!
+! 10d.iii) MODD_EOL_ALM
+!
+NNB_BLAELT = 42
+LTIMESPLIT = .FALSE.
+LTIPLOSSG = .TRUE.
+LTECOUTPTS = .FALSE.
+!
+!------------------------------------------------------------------------------
+!* 10.e SET DEFAULT VALUES FOR MODD_ALLPROFILER_n :
+! ----------------------------------
+!
+NNUMB_PROF = 0
+XSTEP_PROF = 60.0
+XX_PROF(:) = XUNDEF
+XY_PROF(:) = XUNDEF
+XZ_PROF(:) = XUNDEF
+XLAT_PROF(:) = XUNDEF
+XLON_PROF(:) = XUNDEF
+CNAME_PROF(:) = ''
+CFILE_PROF = 'NO_INPUT_CSV'
+LDIAG_SURFRAD_PROF = .TRUE.
+!------------------------------------------------------------------------------
+!* 10.f SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
+! ----------------------------------
+!
+NNUMB_STAT = 0
+XSTEP_STAT = 60.0
+XX_STAT(:) = XUNDEF
+XY_STAT(:) = XUNDEF
+XZ_STAT(:) = XUNDEF
+XLAT_STAT(:) = XUNDEF
+XLON_STAT(:) = XUNDEF
+CNAME_STAT(:) = ''
+CFILE_STAT = 'NO_INPUT_CSV'
+LDIAG_SURFRAD_STAT = .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 :
+! ---------------------------------------
+!
+CALL PARAM_ICEN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
+ &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 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 :
+! --------------------------------------------
+!
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
+ &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
+!
+!-------------------------------------------------------------------------------
+!
+!* 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
+ CALL PARAM_LIMA_INIT(CPROGRAM, TFILENAM, .FALSE., TLUOUT%NLU, &
+ &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
+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 = 'MNHC.input'
+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_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 = "EQSAM" ! mineral equilibrium scheme
+CORGANIC = "MPMPO" ! mineral equilibrium scheme
+CNUCLEATION = "NONE" ! sulfates nucleation scheme
+LDEPOS_AER(:) = .FALSE.
+
+ENDIF
+
+!* 23. SET DEFAULT VALUES FOR MODD_DUST and MODD_SALT
+! ----------------------------------------------
+!
+IF (KMI == 1) THEN ! other values initialized in modd_dust
+ LDUST = .FALSE.
+ NMODE_DST = 3
+ LVARSIG = .FALSE.
+ LSEDIMDUST = .FALSE.
+ LDEPOS_DST(:) = .FALSE.
+
+ LSALT = .FALSE.
+ LVARSIG_SLT= .FALSE.
+ LSEDIMSALT = .FALSE.
+ LDEPOS_SLT(:) = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 24. SET DEFAULT VALUES FOR MODD_PASPOL
+! ----------------------------------
+!
+! other values initialized in modd_paspol
+!
+IF (KMI == 1) THEN
+ LPASPOL = .FALSE.
+ NRELEASE = 0
+ CPPINIT(:) ='1PT'
+ XPPLAT(:) = 0.
+ XPPLON (:) = 0.
+ XPPMASS(:) = 0.
+ XPPBOT(:) = 0.
+ XPPTOP(:) = 0.
+ CPPT1(:) = "20010921090000"
+ CPPT2(:) = "20010921090000"
+ CPPT3(:) = "20010921091500"
+ CPPT4(:) = "20010921091500"
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 25. SET DEFAULT VALUES FOR MODD_CONDSAMP
+! ----------------------------------
+!
+! other values initialized in modd_condsamp
+!
+IF (KMI == 1) THEN
+ LCONDSAMP = .FALSE.
+ NCONDSAMP = 3
+ XRADIO(:) = 900.
+ XSCAL(:) = 1.
+ XHEIGHT_BASE = 100.
+ XDEPTH_BASE = 100.
+ XHEIGHT_TOP = 100.
+ XDEPTH_TOP = 100.
+ NFINDTOP = 0
+ XTHVP = 0.25
+ LTPLUS = .TRUE.
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!
+!* 26. SET DEFAULT VALUES FOR MODD_LATZ_EDFLX
+! ----------------------------------
+!
+IF (KMI == 1) THEN
+ LUV_FLX=.FALSE.
+ XUV_FLX1=3.E+14
+ XUV_FLX2=0.
+ LTH_FLX=.FALSE.
+ XTH_FLX=0.75
+ENDIF
+#ifdef MNH_FOREFIRE
+!-------------------------------------------------------------------------------
+!
+!* 27. SET DEFAULT VALUES FOR MODD_FOREFIRE
+! ----------------------------------
+!
+! other values initialized in modd_forefire
+!
+IF (KMI == 1) THEN
+ LFOREFIRE = .FALSE.
+ LFFCHEM = .FALSE.
+ COUPLINGRES = 100.
+ NFFSCALARS = 0
+ENDIF
+#endif
+!-------------------------------------------------------------------------------
+!
+!* 28. SET DEFAULT VALUES FOR MODD_BLOWSNOW AND MODD_BLOWSNOW_n
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ LBLOWSNOW = .FALSE.
+ XALPHA_SNOW = 3.
+ XRSNOW = 4.
+ CSNOWSEDIM = 'TABC'
+END IF
+LSNOWSUBL = .FALSE.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 29. SET DEFAULT VALUES FOR MODD_VISC
+! ----------------------------------
+!
+! other values initialized in modd_VISC
+!
+IF (KMI == 1) THEN
+ LVISC = .FALSE.
+ LVISC_UVW = .FALSE.
+ LVISC_TH = .FALSE.
+ LVISC_SV = .FALSE.
+ LVISC_R = .FALSE.
+ XMU_V = 0.
+ XPRANDTL = 0.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 30. SET DEFAULT VALUES FOR MODD_DRAG
+! ----------------------------------
+!
+! other values initialized in modd_DRAG
+!
+IF (KMI == 1) THEN
+ LDRAG = .FALSE.
+ LMOUNT = .FALSE.
+ NSTART = 1
+ XHSTART = 0.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 31. SET DEFAULT VALUES FOR MODD_IBM_PARAMn
+! --------------------------------------
+!
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ XIBM_EPSI = 1.E-9
+ XIBM_IEPS = 1.E+9
+ NIBM_ITR = 8
+ XIBM_RUG = 0.01 ! (m^1.s^-0)
+ XIBM_VISC = 1.56e-5 ! (m^2.s^-1)
+ XIBM_CNU = 0.06 ! (m^0.s^-0)
+
+ NIBM_LAYER_P = 2
+ NIBM_LAYER_Q = 2
+ NIBM_LAYER_R = 2
+ NIBM_LAYER_S = 2
+ NIBM_LAYER_T = 2
+ NIBM_LAYER_E = 2
+ NIBM_LAYER_V = 2
+
+ XIBM_RADIUS_P = 2.
+ XIBM_RADIUS_Q = 2.
+ XIBM_RADIUS_R = 2.
+ XIBM_RADIUS_S = 2.
+ XIBM_RADIUS_T = 2.
+ XIBM_RADIUS_E = 2.
+ XIBM_RADIUS_V = 2.
+
+ XIBM_POWERS_P = 1.
+ XIBM_POWERS_Q = 1.
+ XIBM_POWERS_R = 1.
+ XIBM_POWERS_S = 1.
+ XIBM_POWERS_T = 1.
+ XIBM_POWERS_E = 1.
+ XIBM_POWERS_V = 1.
+
+ CIBM_MODE_INTE3_P = 'LAI'
+ CIBM_MODE_INTE3_Q = 'LAI'
+ CIBM_MODE_INTE3_R = 'LAI'
+ CIBM_MODE_INTE3_S = 'LAI'
+ CIBM_MODE_INTE3_T = 'LAI'
+ CIBM_MODE_INTE3_E = 'LAI'
+ CIBM_MODE_INTE3_V = 'LAI'
+
+ CIBM_MODE_INTE1_P = 'CL2'
+ CIBM_MODE_INTE1_Q = 'CL2'
+ CIBM_MODE_INTE1_R = 'CL2'
+ CIBM_MODE_INTE1_S = 'CL2'
+ CIBM_MODE_INTE1_T = 'CL2'
+ CIBM_MODE_INTE1_E = 'CL2'
+ CIBM_MODE_INTE1NV = 'CL2'
+ CIBM_MODE_INTE1TV = 'CL2'
+ CIBM_MODE_INTE1CV = 'CL2'
+
+ CIBM_MODE_BOUND_P = 'SYM'
+ CIBM_MODE_BOUND_Q = 'SYM'
+ CIBM_MODE_BOUND_R = 'SYM'
+ CIBM_MODE_BOUND_S = 'SYM'
+ CIBM_MODE_BOUND_T = 'SYM'
+ CIBM_MODE_BOUND_E = 'SYM'
+ CIBM_MODE_BOUNT_V = 'ASY'
+ CIBM_MODE_BOUNN_V = 'ASY'
+ CIBM_MODE_BOUNC_V = 'ASY'
+
+ XIBM_FORC_BOUND_P = 0.
+ XIBM_FORC_BOUND_Q = 0.
+ XIBM_FORC_BOUND_R = 0.
+ XIBM_FORC_BOUND_S = 0.
+ XIBM_FORC_BOUND_T = 0.
+ XIBM_FORC_BOUND_E = 0.
+ XIBM_FORC_BOUNN_V = 0.
+ XIBM_FORC_BOUNT_V = 0.
+ XIBM_FORC_BOUNC_V = 0.
+
+ CIBM_TYPE_BOUND_P = 'NEU'
+ CIBM_TYPE_BOUND_Q = 'NEU'
+ CIBM_TYPE_BOUND_R = 'NEU'
+ CIBM_TYPE_BOUND_S = 'NEU'
+ CIBM_TYPE_BOUND_T = 'NEU'
+ CIBM_TYPE_BOUND_E = 'NEU'
+ CIBM_TYPE_BOUNT_V = 'DIR'
+ CIBM_TYPE_BOUNN_V = 'DIR'
+ CIBM_TYPE_BOUNC_V = 'DIR'
+
+ CIBM_FORC_BOUND_P = 'CST'
+ CIBM_FORC_BOUND_Q = 'CST'
+ CIBM_FORC_BOUND_R = 'CST'
+ CIBM_FORC_BOUND_S = 'CST'
+ CIBM_FORC_BOUND_T = 'CST'
+ CIBM_FORC_BOUND_E = 'CST'
+ CIBM_FORC_BOUNN_V = 'CST'
+ CIBM_FORC_BOUNT_V = 'CST'
+ CIBM_FORC_BOUNC_V = 'CST'
+ CIBM_FORC_BOUNR_V = 'CST'
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn
+! --------------------------------------
+!
+ LRECYCL = .FALSE.
+ LRECYCLN = .FALSE.
+ LRECYCLW = .FALSE.
+ LRECYCLE = .FALSE.
+ LRECYCLS = .FALSE.
+ XDRECYCLN = 0.
+ XARECYCLN = 0.
+ XDRECYCLW = 0.
+ XARECYCLW = 0.
+ XDRECYCLS = 0.
+ XARECYCLS = 0.
+ XDRECYCLE = 0.
+ XARECYCLE = 0.
+ NTMOY = 0
+ NTMOYCOUNT = 0
+ NNUMBELT = 28
+ XRCOEFF = 0.2
+ XTBVTOP = 500.
+ XTBVBOT = 300.
+!
+!-------------------------------------------------------------------------------
+!
+!* 33. SET DEFAULT VALUES FOR MODD_FIRE_n
+! ----------------------------------
+!
+! Blaze fire model namelist
+!
+LBLAZE = .FALSE. ! Flag for Fire model use, default FALSE
+!
+CPROPAG_MODEL = 'SANTONI2011' ! Fire propagation model (default SANTONI2011)
+!
+CHEAT_FLUX_MODEL = 'EXS' ! Sensible heat flux injection model (default EXS)
+CLATENT_FLUX_MODEL = 'EXP' ! latent heat flux injection model (default EXP)
+XFERR = 0.8 ! Energy released in flamming stage (only for EXP)
+!
+CFIRE_CPL_MODE = '2WAYCPL' ! Coupling mode (default 2way coupled)
+CBMAPFILE = CINIFILE ! File name of BMAP for FIR2ATM mode
+LINTERPWIND = .TRUE. ! Horizontal interpolation of wind
+LSGBAWEIGHT = .FALSE. ! Flag for use of weighted average method for SubGrid Burning Area computation
+!
+NFIRE_WENO_ORDER = 3 ! Weno order (1,3,5)
+NFIRE_RK_ORDER = 3 ! Runge Kutta order (1,2,3,4)
+!
+NREFINX = 1 ! Refinement ratio X
+NREFINY = 1 ! Refinement ratio Y
+!
+XCFLMAXFIRE = 0.8 ! Max CFL on fire mesh
+XLSDIFFUSION = 0.1 ! Numerical diffusion of LevelSet
+XROSDIFFUSION = 0.05 ! Numerical diffusion of ROS
+!
+XFLUXZEXT = 3. ! Flux distribution on vertical caracteristic length
+XFLUXZMAX = 4. * XFLUXZEXT ! Flux distribution on vertical max injetion height
+!
+XFLXCOEFTMP = 1. ! Flux multiplicator. For testing
+!
+LWINDFILTER = .FALSE. ! Fire wind filtering flag
+CWINDFILTER = 'EWAM' ! Wind filter method (EWAM or WLIM)
+XEWAMTAU = 20. ! Time averaging constant for EWAM method (s)
+XWLIMUTH = 8. ! Thresehold wind value for WLIM method (m/s)
+XWLIMUTMAX = 9. ! Maximum wind value for WLIM method (m/s) (needs to be >= XWLIMUTH )
+!
+NNBSMOKETRACER = 1 ! Nb of smoke tracers
+!
+NWINDSLOPECPLMODE = 0 ! Flag for use of wind/slope in ROS (0 = wind + slope, 1 = wind only, 2 = slope only (U0=0))
+!
+!
+!
+!! DO NOT CHANGE BELOW PARAMETERS
+XFIREMESHSIZE(:) = 0. ! Fire mesh size (dxf,dyf)
+LRESTA_ASE = .FALSE. ! Flag for using ASE in RESTA file
+LRESTA_AWC = .FALSE. ! Flag for using AWC in RESTA file
+LRESTA_EWAM = .FALSE. ! Flag for using EWAM in RESTA file
+LRESTA_WLIM = .FALSE. ! Flag for using WLIM in RESTA file
+
+!-------------------------------------------------------------------------------
+END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/PHYEX/ext/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/endstep.f90 b/src/PHYEX/ext/endstep.f90
new file mode 100644
index 0000000000000000000000000000000000000000..97734d72bd8ecad1aa8e4163c203fbfe7ab5fe57
--- /dev/null
+++ b/src/PHYEX/ext/endstep.f90
@@ -0,0 +1,668 @@
+!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_ENDSTEP
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE ENDSTEP (PTSTEP,KRR,KSV,KTCOUNT,KMI, &
+ HUVW_ADV_SCHEME,HTEMP_SCHEME, PRHODJ, &
+ PUS,PVS,PWS,PDRYMASSS, &
+ PTHS,PRS,PTKES,PSVS, &
+ PLSUS,PLSVS,PLSWS, &
+ PLSTHS,PLSRVS,PLSZWSS, &
+ PLBXUS,PLBXVS,PLBXWS, &
+ PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, &
+ PLBYUS,PLBYVS,PLBYWS, &
+ PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, &
+ PUM,PVM,PWM,PZWS, &
+ PUT,PVT,PWT,PPABST,PDRYMASST, &
+ PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, &
+ PLSUM,PLSVM,PLSWM, &
+ PLSTHM,PLSRVM,PLSZWSM, &
+ PLBXUM,PLBXVM,PLBXWM, &
+ PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM, &
+ PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM )
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KRR ! Number of water var.
+INTEGER, INTENT(IN) :: KSV ! Number of scal. var.
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
+CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUS,PVS,PWS, & !
+ PTHS,PTKES ! variables at
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS,PSVS ! t+dt
+!
+REAL, INTENT(IN) :: PDRYMASSS ! Md source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUS,PLSVS,PLSWS,& ! Large Scale
+ PLSTHS,PLSRVS ! fields tendencies
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSS ! Large Scale fields tendencies
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS, & !
+ PLBXTHS,PLBXTKES ! LBX tendancy
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS,PLBXSVS !
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS,& !
+ PLBYTHS,PLBYTKES ! LBY tendancy
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS,PLBYSVS !
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM! Variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PPABST,PTHT,&!
+ PTKET ! Variables at
+REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRT,PSVT ! t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHM, PRCM,PPABSM ! Variables at t-Dt
+REAL, INTENT(INOUT):: PDRYMASST !
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields
+ PLSTHM,PLSRVM ! at t-dt
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! Large Scale fields at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXUM,PLBXVM,PLBXWM, & !
+ PLBXTHM,PLBXTKEM ! LBX fields
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM !
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & !
+ PLBYTHM,PLBYTKEM ! LBY fields
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM !
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant wave height
+!
+END SUBROUTINE ENDSTEP
+!
+END INTERFACE
+!
+END MODULE MODI_ENDSTEP
+!
+!
+!
+! ######################################################################
+ SUBROUTINE ENDSTEP (PTSTEP,KRR,KSV,KTCOUNT,KMI, &
+ HUVW_ADV_SCHEME,HTEMP_SCHEME, PRHODJ, &
+ PUS,PVS,PWS,PDRYMASSS, &
+ PTHS,PRS,PTKES,PSVS, &
+ PLSUS,PLSVS,PLSWS, &
+ PLSTHS,PLSRVS,PLSZWSS, &
+ PLBXUS,PLBXVS,PLBXWS, &
+ PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, &
+ PLBYUS,PLBYVS,PLBYWS, &
+ PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, &
+ PUM,PVM,PWM,PZWS, &
+ PUT,PVT,PWT,PPABST,PDRYMASST, &
+ PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, &
+ PLSUM,PLSVM,PLSWM, &
+ PLSTHM,PLSRVM,PLSZWSM, &
+ PLBXUM,PLBXVM,PLBXWM, &
+ PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM, &
+ PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM )
+! ######################################################################
+!
+!!**** *ENDSTEP* - temporal advance and asselin filter for all variables
+!! (replaces the previous endstep_dyn and endstep_scalar subroutines)
+!!
+!! PURPOSE
+!! -------
+!!
+!! The purpose of ENDSTEP is to apply the asselin filter, perform
+!! the time advance and thereby finalize the time step.
+!
+!
+!!** METHOD
+!! ------
+!!
+!! The filtered values of the prognostic variables at t is obtained
+!! by linear combination of variables at t-dt, t, and t+dt.
+!! This value is put into the array containing the t-dt value.
+!! To perform the time swapping, the t+dt values are put into the arrays
+!! containing the t values.
+!!
+!! In case of cold start (first time step), indicated by the value 'START'
+!! of CCONF in module MODD_CONF, a simple time advance is performed.
+!!
+!! The swapping for the absolute pressure function is only a copy of time t in
+!! time (t-dt).
+!!
+!! Temporal advances of large scale, lateral boundarie and SST fields
+!! are also made in this subroutine.
+!!
+!! The different sources terms are stored for the budget computations.
+!!
+!! EXTERNAL
+!! --------
+!! BUDGET : Stores the different budget components
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODULE MODD_DYN containing XASSELIN
+!! MODULE MODD_CONF containing CCONF
+!! MODULE MODD_CTURB containing XTKEMIN, XEPSMIN
+!! MODULE MODD_BUDGET:
+!! NBUMOD : model in which budget is calculated
+!! NBUTSHIFT : temporal shift for budgets writing
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation
+!!
+!! AUTHOR
+!! ------
+!! P. Bougeault Meteo France
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! original 22/06/94
+!! corrections 01/09/94 (J. P. Lafore)
+!! " 07/11/94 (J.Stein) pressure function swapping
+!! update 03/01/94 (J. P. Lafore) Total mass of dry air Md evolution
+!! 20/03/95 (J.Stein ) remove R from the historical variables
+!! + switch for TKE unused
+!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
+!! 30/08/95 (J.Stein) remove the positivity control and
+!! correct the bug for PRM and PSVM for the cold start
+!! 16/10/95 (J. Stein) change the budget calls
+!! 12/10/96 (J. Stein) add the SRC temporal evolution
+!! 20/12/96 (J.-P. Pinty) update the CALL BUDGET
+!! 03/09/96 (J. P. Lafore) temporal advance of LS scalar fields
+!! 22/06/97 (J. Stein) add the absolute pressure
+!! 13/03/97 (J. P. Lafore) add "surfacic" LS fields
+!! 24/09/97 (V. Masson) positive values for ls fields
+!! 10/01/98 (J. Stein) use the LB fields
+!! 20/04/98 (P. Josse) temporal evolution of SST
+!! 18/09/98 (P. Jabouille) merge endstep_dyn and endstep_scalar
+!! 08/12/00 (P. Jabouille) minimum values for hydrometeors
+!! 22/06/01 (P. Jabouille) use XSVMIN
+!! 06/11/02 (V. Masson) update the budget calls
+!! 01/2004 (V. Masson) surface externalization
+!! 05/2006 Remove KEPS
+!! 10/2006 (Maric, Lac) modification for PPM schemes
+!! 10/2009 (C.Lac) Correction on FIT temporal scheme for variables
+!! advected with PPM
+!! 04/2013 (C.Lac) FIT for all the variables
+!! 04/2014 (C.Lac) Check on the positivity of PSVT
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 02/2019 (S. Bielli) Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 02/2022: add sea salt
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, lbu_enable, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ nbustep, tbudgets
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_CONF
+USE MODD_TURB_n, ONLY: XTKEMIN
+USE MODD_DUST, ONLY: LDUST
+USE MODD_SALT, ONLY: LSALT
+USE MODD_DYN
+USE MODD_GRID_n
+USE MODD_LBC_n, ONLY: CLBCX, CLBCY
+USE MODD_NSV, ONLY: XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, &
+ NSV_AERBEG, NSV_AEREND,&
+ NSV_DSTBEG, NSV_DSTEND,&
+ NSV_SLTBEG, NSV_SLTEND,&
+ NSV_SNWBEG, NSV_SNWEND
+USE MODD_PARAM_C2R2, ONLY: LACTIT
+USE MODD_PARAM_LIMA, ONLY: LACTIT_LIMA=>LACTIT
+
+use mode_budget, only: Budget_store_end, Budget_store_init
+
+USE MODI_SHUMAN
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 DECLARATIONS OF ARGUMENTS
+!
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KRR ! Number of water var.
+INTEGER, INTENT(IN) :: KSV ! Number of scal. var.
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
+CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUS,PVS,PWS, & !
+ PTHS,PTKES ! variables at
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS,PSVS ! t+dt
+!
+REAL, INTENT(IN) :: PDRYMASSS ! Md source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUS,PLSVS,PLSWS,& ! Large Scale
+ PLSTHS,PLSRVS ! fields tendencies
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSS ! Large Scale fields tendencies
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS, & !
+ PLBXTHS,PLBXTKES ! LBX tendancy
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS,PLBXSVS !
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS,& !
+ PLBYTHS,PLBYTKES ! LBY tendancy
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS,PLBYSVS !
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM! Variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PPABST,PTHT,&!
+ PTKET ! Variables at
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHM, PRCM, PPABSM ! Variables at t-Dt
+REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRT,PSVT ! t
+REAL, INTENT(INOUT):: PDRYMASST !
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields
+ PLSTHM,PLSRVM ! at t-dt
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! Large Scale fields at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXUM,PLBXVM,PLBXWM, & !
+ PLBXTHM,PLBXTKEM ! LBX fields
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM !
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & !
+ PLBYTHM,PLBYTKEM ! LBY fields
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM !
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant wave height
+!
+!* 0.2 DECLARATIONS OF LOCAL VARIABLES
+!
+INTEGER:: JSV ! loop counters
+INTEGER :: IIB, IIE ! index of first and last inner mass points along x
+INTEGER :: IJB, IJE ! index of first and last inner mass points along y
+real, dimension(:,:,:), allocatable :: zrhodjontime
+real, dimension(:,:,:), allocatable :: zwork
+!
+!------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+!* 1. ASSELIN FILTER
+!
+IF ((HUVW_ADV_SCHEME(1:3)=='CEN').AND. (HTEMP_SCHEME == 'LEFR')) THEN
+ IF( KTCOUNT /= 1 .OR. CCONF /= 'START' ) THEN
+ PUM(:,:,:)=(1.-XASSELIN)*PUT(:,:,:)+0.5*XASSELIN*(PUM(:,:,:)+PUS(:,:,:))
+ PVM(:,:,:)=(1.-XASSELIN)*PVT(:,:,:)+0.5*XASSELIN*(PVM(:,:,:)+PVS(:,:,:))
+ PWM(:,:,:)=(1.-XASSELIN)*PWT(:,:,:)+0.5*XASSELIN*(PWM(:,:,:)+PWS(:,:,:))
+ END IF
+END IF
+
+!* 1. TEMPORAL ADVANCE OF PROGNOSTIC VARIABLES
+!
+PPABSM(:,:,:) = PPABST(:,:,:)
+!
+IF (LACTIT .OR. LACTIT_LIMA) THEN
+ PTHM(:,:,:) = PTHT(:,:,:)
+ PRCM(:,:,:) = PRT(:,:,:,2)
+END IF
+
+PUT(:,:,:)=PUS(:,:,:)
+PVT(:,:,:)=PVS(:,:,:)
+PWT(:,:,:)=PWS(:,:,:)
+!
+PDRYMASST = PDRYMASST + PTSTEP * PDRYMASSS
+!
+PTHT(:,:,:)=PTHS(:,:,:)
+!
+! Moisture
+!
+PRT(:,:,:,1:KRR)=PRS(:,:,:,1:KRR)
+!
+! Turbulence
+!
+IF (SIZE(PTKET,1) /= 0) PTKET(:,:,:)=PTKES(:,:,:)
+!
+! Other scalars
+!
+PSVT(:,:,:,1:KSV)=PSVS(:,:,:,1:KSV)
+!
+IF(LBLOWSNOW) THEN
+ DO JSV=1,(NBLOWSNOW_2D)
+ XSNWCANO(:,:,JSV) = XRSNWCANOS(:,:,JSV)
+ END DO
+!* MINIMUM VALUE FOR BLOWING SNOW
+!
+ WHERE(XSNWCANO(:,:,:)<1.E-20)
+ XSNWCANO(:,:,:)=0.
+ END WHERE
+
+ IF (SIZE(PSVT,4) > 1) THEN
+ WHERE(PSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND)<1.E-20)
+ PSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND)=0.
+ END WHERE
+ END IF
+!
+END IF
+!
+IF (LWEST_ll( ) .AND. CLBCX(1)=='OPEN') THEN
+ DO JSV=1,KSV
+ PSVT(IIB,:,:,JSV)=MAX(PSVT(IIB,:,:,JSV),XSVMIN(JSV))
+ PSVT(IIB-1,:,:,JSV)=MAX(PSVT(IIB-1,:,:,JSV),XSVMIN(JSV))
+ END DO
+END IF
+!
+IF (LEAST_ll( ) .AND. CLBCX(2)=='OPEN') THEN
+ DO JSV=1,KSV
+ PSVT(IIE,:,:,JSV)=MAX(PSVT(IIE,:,:,JSV),XSVMIN(JSV))
+ PSVT(IIE+1,:,:,JSV)=MAX(PSVT(IIE+1,:,:,JSV),XSVMIN(JSV))
+ END DO
+END IF
+!
+IF (LSOUTH_ll( ) .AND. CLBCY(1)=='OPEN') THEN
+ DO JSV=1,KSV
+ PSVT(:,IJB,:,JSV)=MAX(PSVT(:,IJB,:,JSV),XSVMIN(JSV))
+ PSVT(:,IJB-1,:,JSV)=MAX(PSVT(:,IJB-1,:,JSV),XSVMIN(JSV))
+ END DO
+END IF
+!
+IF (LNORTH_ll( ) .AND. CLBCY(2)=='OPEN') THEN
+ DO JSV=1,KSV
+ PSVT(:,IJE,:,JSV)=MAX(PSVT(:,IJE,:,JSV),XSVMIN(JSV))
+ PSVT(:,IJE+1,:,JSV)=MAX(PSVT(:,IJE+1,:,JSV),XSVMIN(JSV))
+ END DO
+END IF
+!------------------------------------------------------------------------------
+!
+!* 4. TEMPORAL ADVANCE OF THE LARGE SCALE FIELDS
+!
+!
+IF (SIZE(PLSUS,1) /= 0) THEN
+ PLSUM(:,:,:) = PLSUM(:,:,:) + PTSTEP * PLSUS(:,:,:)
+ PLSVM(:,:,:) = PLSVM(:,:,:) + PTSTEP * PLSVS(:,:,:)
+ PLSWM(:,:,:) = PLSWM(:,:,:) + PTSTEP * PLSWS(:,:,:)
+END IF
+!
+IF (SIZE(PLSTHS,1) /= 0) THEN
+ PLSTHM(:,:,:) = PLSTHM(:,:,:) + PTSTEP * PLSTHS(:,:,:)
+ENDIF
+!
+IF (SIZE(PLSRVS,1) /= 0) THEN
+ PLSRVM(:,:,:) = MAX( PLSRVM(:,:,:) + PTSTEP * PLSRVS(:,:,:) , 0.)
+ENDIF
+
+IF (SIZE(PLSZWSS,1) /= 0) THEN
+ PLSZWSM(:,:) = MAX( PLSZWSM(:,:) + PTSTEP * PLSZWSS(:,:) , 0.)
+ PZWS(:,:) = PLSZWSM(:,:)
+ENDIF
+!
+!------------------------------------------------------------------------------
+!
+!* 5. TEMPORAL ADVANCE OF THE LATERAL BOUNDARIES FIELDS
+!
+IF (SIZE(PLBXUS,1) /= 0) THEN
+ PLBXUM(:,:,:) = PLBXUM(:,:,:) + PTSTEP * PLBXUS(:,:,:)
+ PLBXVM(:,:,:) = PLBXVM(:,:,:) + PTSTEP * PLBXVS(:,:,:)
+ PLBXWM(:,:,:) = PLBXWM(:,:,:) + PTSTEP * PLBXWS(:,:,:)
+ENDIF
+IF (SIZE(PLBYUS,1) /= 0) THEN
+ PLBYUM(:,:,:) = PLBYUM(:,:,:) + PTSTEP * PLBYUS(:,:,:)
+ PLBYVM(:,:,:) = PLBYVM(:,:,:) + PTSTEP * PLBYVS(:,:,:)
+ PLBYWM(:,:,:) = PLBYWM(:,:,:) + PTSTEP * PLBYWS(:,:,:)
+ENDIF
+!
+IF (SIZE(PLBXTHS,1) /= 0) THEN
+ PLBXTHM(:,:,:) = PLBXTHM(:,:,:) + PTSTEP * PLBXTHS(:,:,:)
+END IF
+IF (SIZE(PLBYTHS,1) /= 0) THEN
+ PLBYTHM(:,:,:) = PLBYTHM(:,:,:) + PTSTEP * PLBYTHS(:,:,:)
+END IF
+!
+IF (SIZE(PLBXTKES,1) /= 0) THEN
+ PLBXTKEM(:,:,:) = MAX( PLBXTKEM(:,:,:) + PTSTEP * PLBXTKES(:,:,:), XTKEMIN)
+END IF
+IF (SIZE(PLBYTKES,1) /= 0) THEN
+ PLBYTKEM(:,:,:) = MAX( PLBYTKEM(:,:,:) + PTSTEP * PLBYTKES(:,:,:), XTKEMIN)
+END IF
+!
+IF (SIZE(PLBXRS,1) /= 0) THEN
+ PLBXRM(:,:,:,:) = MAX( PLBXRM(:,:,:,:) + PTSTEP * PLBXRS(:,:,:,:), 0.)
+END IF
+IF (SIZE(PLBYRS,1) /= 0) THEN
+ PLBYRM(:,:,:,:) = MAX( PLBYRM(:,:,:,:) + PTSTEP * PLBYRS(:,:,:,:), 0.)
+END IF
+!
+IF (SIZE(PLBXSVS,1) /= 0) THEN
+ DO JSV = 1,KSV
+ PLBXSVM(:,:,:,JSV) = MAX( PLBXSVM(:,:,:,JSV) + PTSTEP * PLBXSVS(:,:,:,JSV),XSVMIN(JSV))
+ ENDDO
+ENDIF
+IF (SIZE(PLBYSVS,1) /= 0) THEN
+ DO JSV = 1,KSV
+ PLBYSVM(:,:,:,JSV) = MAX( PLBYSVM(:,:,:,JSV) + PTSTEP * PLBYSVS(:,:,:,JSV),XSVMIN(JSV))
+ ENDDO
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 6. MINIMUM VALUE FOR HYDROMETEORS
+!
+IF (SIZE(PRT,4) > 1) THEN
+ WHERE(PRT(:,:,:,2:)<1.E-20)
+ PRT(:,:,:,2:)=0.
+ END WHERE
+END IF
+IF (SIZE(PLBXRM,4) > 1) THEN
+ WHERE(PLBXRM(:,:,:,2:)<1.E-20)
+ PLBXRM(:,:,:,2:)=0.
+ END WHERE
+END IF
+IF (SIZE(PLBYRM,4) > 1) THEN
+ WHERE(PLBYRM(:,:,:,2:)<1.E-20)
+ PLBYRM(:,:,:,2:)=0.
+ END WHERE
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 7. MINIMUM VALUE FOR CHEMISTRY
+!
+IF ((SIZE(PLBXSVM,4) > NSV_CHEMEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
+ DO JSV=NSV_CHEMBEG, NSV_CHEMEND
+ PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV))
+ END DO
+END IF
+IF ((SIZE(PLBYSVM,4) > NSV_CHEMEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN
+ DO JSV=NSV_CHEMBEG, NSV_CHEMEND
+ PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV))
+ END DO
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 8. MINIMUM VALUE FOR AEROSOLS
+!
+IF (LORILAM) THEN
+ IF ((SIZE(PLBXSVM,4) > NSV_AEREND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
+ DO JSV=NSV_AERBEG, NSV_AEREND
+ PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV))
+ END DO
+ END IF
+ IF ((SIZE(PLBYSVM,4) > NSV_AEREND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN
+ DO JSV=NSV_AERBEG, NSV_AEREND
+ PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV))
+ END DO
+ END IF
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 9. MINIMUM VALUE FOR DUSTS
+!
+IF (LDUST) THEN
+ IF ((SIZE(PLBXSVM,4) > NSV_DSTEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
+ DO JSV=NSV_DSTBEG, NSV_DSTEND
+ PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV))
+ END DO
+ END IF
+ IF ((SIZE(PLBYSVM,4) > NSV_DSTEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN
+ DO JSV=NSV_DSTBEG, NSV_DSTEND
+ PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV))
+ END DO
+ END IF
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 9. MINIMUM VALUE FOR SEA SALTS
+!
+IF (LSALT) THEN
+ IF ((SIZE(PLBXSVM,4) > NSV_SLTEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
+ DO JSV=NSV_SLTBEG, NSV_SLTEND
+ PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV))
+ END DO
+ END IF
+ IF ((SIZE(PLBYSVM,4) > NSV_SLTEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN
+ DO JSV=NSV_SLTBEG, NSV_SLTEND
+ PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV))
+ END DO
+ END IF
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 11. STORAGE IN BUDGET ARRAYS
+!
+IF (LBU_ENABLE) THEN
+ !Division by nbustep to compute average on the selected time period
+ if ( lbudget_u .or. lbudget_v .or. lbudget_w .or. lbudget_th &
+ .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr .or. lbudget_ri &
+ .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then
+ Allocate( zrhodjontime, mold = prhodj )
+ Allocate( zwork, mold = prhodj )
+ zrhodjontime(:, :, :) = prhodj(:, :, :) / ( ptstep * nbustep )
+ end if
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'AVEF', put (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'AVEF', pvt (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'AVEF', pwt (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'AVEF', ptht (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'AVEF', ptket(:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'AVEF', prt (:, :, :, 1) * zrhodjontime(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'AVEF', prt (:, :, :, 2) * zrhodjontime(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'AVEF', prt (:, :, :, 3) * zrhodjontime(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'AVEF', prt (:, :, :, 4) * zrhodjontime(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'AVEF', prt (:, :, :, 5) * zrhodjontime(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'AVEF', prt (:, :, :, 6) * zrhodjontime(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'AVEF', prt (:, :, :, 7) * zrhodjontime(:, :, :) )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'AVEF', psvt(:, :, :, jsv) * zrhodjontime(:, :, :) )
+ end do
+ end if
+
+ if ( lbudget_u ) then
+ zwork(:, :, :) = pus (:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep
+ call Budget_store_end( tbudgets(NBUDGET_U ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_U ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_v ) then
+ zwork(:, :, :) = pvs (:, :, :) * Mym( prhodj(:, :, :) ) / ptstep
+ call Budget_store_end( tbudgets(NBUDGET_V ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_V ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_w ) then
+ zwork(:, :, :) = pws (:, :, :) * Mzm( prhodj(:, :, :) ) / ptstep
+ call Budget_store_end( tbudgets(NBUDGET_W ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_W ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_th .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr &
+ .or. lbudget_ri .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then
+ zrhodjontime(:, :, :) = prhodj(:, :, :) / ptstep
+ end if
+
+ if ( lbudget_th ) then
+ zwork(:, :, :) = pths (:, :, :) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_TH ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_TH ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_tke ) then
+ zwork(:, :, :) = ptkes(:, :, :) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_TKE), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_TKE), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rv ) then
+ zwork(:, :, :) = prs (:, :, :, 1) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RV ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RV ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rc ) then
+ zwork(:, :, :) = prs (:, :, :, 2) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RC ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RC ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rr ) then
+ zwork(:, :, :) = prs (:, :, :, 3) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RR ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RR ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_ri ) then
+ zwork(:, :, :) = prs (:, :, :, 4) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RI ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RI ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rs ) then
+ zwork(:, :, :) = prs (:, :, :, 5) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RS ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RS ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rg ) then
+ zwork(:, :, :) = prs (:, :, :, 6) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RG ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RG ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rh ) then
+ zwork(:, :, :) = prs (:, :, :, 7) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RH ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RH ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ zwork(:, :, :) = psvs(:, :, :, jsv) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'ASSE', zwork )
+ end do
+ end if
+
+ if ( Allocated( zwork ) ) Deallocate( zwork )
+ if ( Allocated( zrhodjontime ) ) Deallocate( zrhodjontime )
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 12. COMPUTATION OF PHASE VELOCITY
+! -----------------------------
+!
+! It is temporarily set to a constant value
+!
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE ENDSTEP
diff --git a/src/PHYEX/ext/flash_geom_elec.f90 b/src/PHYEX/ext/flash_geom_elec.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e6eea2d03c113ae02451da51869d6ce8c6da983f
--- /dev/null
+++ b/src/PHYEX/ext/flash_geom_elec.f90
@@ -0,0 +1,2873 @@
+!MNH_LIC Copyright 2010-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_FLASH_GEOM_ELEC_n
+! #############################
+!
+INTERFACE
+ SUBROUTINE FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, PRSVS, PRS, PTHT, PPABST, &
+ PEFIELDU, PEFIELDV, PEFIELDW, PZZ, PSVS_LINOX, &
+ TPFILE_FGEOM_DIAG, TPFILE_FGEOM_COORD, TPFILE_LMA, &
+ PTOWN, PSEA )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KMI ! current model index
+INTEGER, INTENT(IN) :: KRR ! number of moist variables
+REAL, INTENT(IN) :: PTSTEP ! Double time step except for
+ ! cold start
+LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar variables source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! x-component of the electric field
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! y-component of the electric field
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDW ! z-component of the electric field
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variables vol. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVS_LINOX ! NOx source term
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_DIAG
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_COORD
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE_LMA
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+!
+END SUBROUTINE FLASH_GEOM_ELEC_n
+END INTERFACE
+END MODULE MODI_FLASH_GEOM_ELEC_n
+!
+!
+! ######################################################################################
+ SUBROUTINE FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, PTSTEP, OEXIT, &
+ PRHODJ, PRHODREF, PRT, PCIT, PRSVS, PRS, PTHT, PPABST, &
+ PEFIELDU, PEFIELDV, PEFIELDW, PZZ, PSVS_LINOX, &
+ TPFILE_FGEOM_DIAG, TPFILE_FGEOM_COORD, TPFILE_LMA, &
+ PTOWN, PSEA )
+! ######################################################################################
+!
+!!**** * -
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the lightning flash path,
+!! and to neutralize the electric charge along the lightning channel.
+!!
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe * LACy *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original : Jan. 2010
+!! Modifications:
+!! M. Chong * LA * Juin 2010 : add small ions
+!! J-P Pinty * LA * Feb. 2013 : add LMA storage
+!! J-P Pinty * LA * Nov. 2013 : add flash map storage
+!! M. Chong * LA * Juin 2010 : add LiNOx
+!! C. Barthe * LACy * Jan. 2015 : convert trig. pt into lat,lon in ascii file
+!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
+!! J.Escobar : 28/03/2018 : Correction of multiple // bug & compiler indepedent mnh_random_number
+!! J.Escobar : 20/06/2018 : Correction of computation of global index I8VECT
+!! J.Escobar : 10/12/2018 : // Correction , mpi_bcast CG & CG_POS parameter
+!! & initialize INBLIGHT on all proc for filling/saving AREA* arrays
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+! P. Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics!!
+! P. Wautelet 22/02/2019: use MOD intrinsics with same kind for all arguments (to respect Fortran standard)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 19/04/2019: use modd_precision kinds
+! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
+! 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 18/09/2019: correct support of 64bit integers (MNH_INT=8)
+! P. Wautelet 31/08/2022: remove ZXMASS and ZYMASS (use XXHATM and XYHATM instead)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_CONF, ONLY: CEXP, LCARTESIAN
+USE MODD_CST, ONLY: XAVOGADRO, XMD
+USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM, NSTOP
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_FLASH
+USE MODD_ELEC_PARAM, ONLY: XFQLIGHTR, XEXQLIGHTR, &
+ XFQLIGHTI, XEXQLIGHTI, &
+ XFQLIGHTS, XEXQLIGHTS, &
+ XFQLIGHTG, XEXQLIGHTG, &
+ XFQLIGHTH, XEXQLIGHTH, &
+ XFQLIGHTC
+USE MODD_GRID, ONLY: XLATORI,XLONORI
+USE MODD_GRID_n, ONLY: XXHATM, XYHATM, XZHAT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LMA_SIMULATOR
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZZ ! in linox_production
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND, NSV_ELEC
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+use MODD_PRECISION, only: MNHINT_MPI, MNHLOG_MPI, MNHREAL_MPI
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XLBR, XLBEXR, XLBS, XLBEXS, &
+ XLBG, XLBEXG, XLBH, XLBEXH, &
+ XRTMIN
+USE MODD_SUB_ELEC_n
+USE MODD_TIME_n
+USE MODD_VAR_ll, ONLY: NPROC,NMNH_COMM_WORLD
+!
+USE MODE_ELEC_ll
+USE MODE_GRIDPROJ
+USE MODE_ll
+USE MODE_MPPDB
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+!
+USE MODI_ION_ATTACH_ELEC
+USE MODI_SHUMAN
+USE MODI_TO_ELEC_FIELD_n
+!
+IMPLICIT NONE
+!
+!
+! 0.1 Declaration of arguments
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KMI ! current model index
+INTEGER, INTENT(IN) :: KRR ! number of moist variables
+REAL, INTENT(IN) :: PTSTEP ! Double time step except for
+ ! cold start
+LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar variables source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! x-component of the electric field
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! y-component of the electric field
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDW ! z-component of the electric field
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variables vol. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVS_LINOX ! NOx source term
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_DIAG
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_COORD
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE_LMA
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+!
+!
+! 0.2 Declaration of local variables
+!
+INTEGER :: IIB, IIE ! index values of the first and last inner mass points along x
+INTEGER :: IJB, IJE ! index values of the first and last inner mass points along y
+INTEGER :: IKB, IKE ! index values of the first and last inner mass points along z
+INTEGER :: II, IJ, IK, IL, IM, IPOINT ! loop indexes
+INTEGER :: IX, IY, IZ
+INTEGER :: IXOR, IYOR ! origin of the extended subdomain
+INTEGER :: INB_CELL ! Number of detected electrified cells
+INTEGER :: IPROC_CELL ! Proc with the center of the cell
+INTEGER :: IICOORD, IJCOORD, IKCOORD ! local indexes of the cell center / max electric field
+INTEGER :: IPROC ! my proc number
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: COUNT_BEF ! nb of pts in zcell before testing neighbour pts
+INTEGER :: COUNT_AFT ! nb of pts in zcell after testing neighbour pts
+INTEGER :: INBFTS_MAX ! Max number of flashes per time step / cell
+INTEGER :: IIBL_LOC ! local i index of the ongoing bi-leader segment
+INTEGER :: IJBL_LOC ! local j index of the ongoing bi-leader segment
+INTEGER :: IKBL ! k index of the ongoing bi-leader segment
+INTEGER :: II_TRIG_LOC ! local i index of the triggering point
+INTEGER :: IJ_TRIG_LOC ! local j index of the triggering point
+INTEGER :: II_TRIG_GLOB ! global i index of the potential triggering pt
+INTEGER :: IJ_TRIG_GLOB ! global j index of the potential triggering pt
+INTEGER :: IK_TRIG ! k index of the triggering point
+INTEGER :: ISIGN_LEADER ! sign of the leader
+INTEGER :: IPROC_AUX ! proc number for max_ll and min_ll
+INTEGER :: IIND_MAX ! max nb of indexes between the trig. pt and the possible branches
+INTEGER :: IIND_MIN ! min nb of indexes between the trig. pt and the possible branches
+INTEGER :: IDELTA_IND ! number of indexes between iind_max and iind_min
+INTEGER :: IPT_DIST ! nb of possible pts for branching on each proc
+INTEGER :: IPT_DIST_GLOB ! global nb of possible pts for branching
+INTEGER :: IFOUND ! if =1, then the random selection is successful
+INTEGER :: ICHOICE_LOCX ! local i indice for random choice
+INTEGER :: ICHOICE_LOCY ! local j indice for random choice
+INTEGER :: ICHOICE_Z ! k indice for random choice
+INTEGER :: INB_PROP ! nb of pts where the flash can propagate
+INTEGER :: INB_NEUT ! nb of pts to neutralize
+INTEGER :: INB_NEUT_OK ! nb of effective flash neutralization
+INTEGER :: ISTOP
+INTEGER :: IERR ! error status
+INTEGER :: IWORK
+INTEGER :: ICHOICE
+INTEGER :: IIMIN, IIMAX, IJMIN, IJMAX, IKMIN, IKMAX
+INTEGER :: IPOS_LEADER, INEG_LEADER
+INTEGER :: INBLIGHT
+INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: ITYPE ! flash type (IC, CGN or CGP)
+INTEGER, DIMENSION(:), ALLOCATABLE :: INBSEG_LEADER ! number of segments in the leader
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISIGNE_EZ ! sign of the vertical electric field
+ ! component at the trig. pt
+INTEGER, DIMENSION(:), ALLOCATABLE :: IPROC_TRIG ! proc that contains the triggering point
+INTEGER, DIMENSION(:), ALLOCATABLE :: INBSEG ! Number of segments per flash
+INTEGER, DIMENSION(:), ALLOCATABLE :: INBSEG_ALL ! Number of segments, all processes
+INTEGER, DIMENSION(NPROC) :: INBSEG_PROC ! ------------------ per process
+INTEGER, DIMENSION(:), ALLOCATABLE :: INB_FLASH ! Number of flashes per time step / cell
+INTEGER, DIMENSION(:), ALLOCATABLE :: INB_FL_REAL ! Effective Number of flashes per timestep/cell
+INTEGER, DIMENSION(:), ALLOCATABLE :: IHIST_LOC ! local nb of possible branches at [r,r+dr]
+INTEGER, DIMENSION(:), ALLOCATABLE :: IHIST_GLOB ! global nb of possible branches at [r,r+dr]
+ ! at [r,r+dr] on each proc
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMAX_BRANCH ! max nb of branches at [r,r+dr]
+ ! proportional to the percentage of
+ ! available pts / proc at this distance
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ISEG_LOC ! Local indexes of the flash segments
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ICELL_LOC ! local indexes + proc of the cell 'center'
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: IMASKQ_DIST ! contains the distance/indice
+ ! from the triggering pt
+!
+LOGICAL :: GPOSITIVE ! if T, positive charge regions where the negative part
+ ! of the leader propagates
+LOGICAL :: GEND_DOMAIN ! no more points with E > E_threshold
+LOGICAL :: GEND_CELL ! if T, end of the cell
+LOGICAL :: GCG ! if true, the flash is a CG
+LOGICAL :: GCG_POS ! if true, the flash is a +CG
+LOGICAL :: GNEUTRALIZATION
+LOGICAL :: GNEW_FLASH_GLOB
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GNEW_FLASH
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: GATTACH ! if T, ion recombination and
+ ! attachment
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: GPOSS ! if T, new cell possible at this pt
+LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE :: GPROP ! if T, propagation possible at this pt
+!
+REAL :: ZE_TRIG_THRES ! Triggering Electric field threshold corrected for
+ ! pressure
+REAL :: ZMAXE ! Max electric field module (V/m)
+REAL :: ZEMOD_BL ! E module at the tip of the last segment of the leader (V/m)
+REAL :: ZMEAN_GRID ! mean grid size
+REAL :: ZMAX_DIST ! max distance between the triggering pt and the possible branches
+REAL :: ZMIN_DIST ! min distance between the triggering pt and the possible branches
+REAL :: ZRANDOM ! random number
+REAL :: ZQNET ! net charge carried by the flash (C/kg)
+REAL :: ZCLOUDLIM ! cloud limit
+REAL :: ZSIGMIN ! min efficient cross section
+REAL :: ZLAT, ZLON ! lat,lon coordinates of the triggering points if not lcartesian
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZQMT ! mass charge density (C/kg)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCELL ! define the electrified cells
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIGMA ! efficient cross section of hydrometeors
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZDQDT ! charge to neutralize at each pt (C/kg)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFLASH ! = 1 if the flash leader reaches this pt
+ ! = 2 if the flash branch is concerned
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAR ! Lambda for rain
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAS ! Lambda for snow
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAG ! Lambda for graupel
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAH ! Lambda for hail
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQMTOT ! total mass charge density (C/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCLOUD ! total mixing ratio (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMODULE ! Electric field module (V/m)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIST ! distance between the trig. pt and the cell pts (m)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGLOB ! sum of the cross sections
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQFLASH ! total charge in excess of xqexcess (C/kg)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_TRIG ! Global coordinates of triggering point
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_SEG ! Global coordinates of segments
+REAL, DIMENSION(:), ALLOCATABLE :: ZEM_TRIG ! Electric field module at the triggering pt
+REAL, DIMENSION(:), ALLOCATABLE :: ZNEUT_POS ! Positive charge neutralized at each segment
+REAL, DIMENSION(:), ALLOCATABLE :: ZNEUT_NEG ! Negative charge neutralized at each segment
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ISEG_GLOB ! Global indexes of LMA segments
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ILMA_SEG_ALL ! Global indexes of LMA segments
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMA_QMT ! Particle charge at neutralization point
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMA_PRT ! Particle mixing ratio at neutralization point
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMA_NEUT_POS
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMA_NEUT_NEG
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_SEG_ALL
+REAL, DIMENSION(:), ALLOCATABLE :: ZEMAX ! Max electric field in each cell
+REAL, DIMENSION(:), ALLOCATABLE :: ZHIST_PERCENT ! percentage of possible branches at [r,r+dr] on each proc
+REAL, DIMENSION(:), ALLOCATABLE :: ZMAX_BRANCH ! max nb of branches at [r,r+dr]
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECT
+!
+! Storage for nflash_write flashes before writing output files (denoted xSxxx)
+INTEGER, SAVE :: ISAVE_STATUS ! 0: print and save
+ ! 1: save only
+ ! 2: print only
+!
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=> NULL() ! list of fields to exchange
+!
+! Storage for the localization of the flashes
+LOGICAL :: GFIRSTFLASH
+INTEGER,DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: IMAP2D
+!
+! Storage for the NOx production terms
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLNOX
+REAL :: ZLGHTLENGTH, ZCOEF
+INTEGER :: IFLASH_COUNT, IFLASH_COUNT_GLOB ! Total number of flashes within the timestep
+!
+REAL,DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: ZCELL_NEW
+!
+INTEGER :: ILJ
+INTEGER :: NIMAX_ll, NJMAX_ll,IIU_ll,IJU_ll ! dimensions of global domain
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATION
+! --------------
+CALL MYPROC_ELEC_ll(IPROC)
+!
+!* 1.1 subdomains indexes
+!
+! beginning and end indexes of the physical subdomain
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PRT,3) - JPVEXT
+!
+! global indexes of the local subdomains origin
+CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
+CALL GET_OR_ll('B',IXOR,IYOR)
+IIU_ll = NIMAX_ll + 2*JPHEXT
+IJU_ll = NJMAX_ll + 2*JPHEXT
+!
+!
+!* 1.2 allocations and initializations
+!
+!
+! from the litterature, the max number of flash per minute is ~ 1000
+! this value is used here as the max number of flash per minute per cell
+INBFTS_MAX = ANINT(1000 * PTSTEP / 60)
+!
+IF (GEFIRSTCALL) THEN
+ GEFIRSTCALL = .FALSE.
+ ALLOCATE (ZZMASS(SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3)))
+ ALLOCATE (ZPRES_COEF(SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3)))
+ IF(LLMA) THEN
+ ALLOCATE (ZLMA_LAT(NFLASH_WRITE, NBRANCH_MAX))
+ ALLOCATE (ZLMA_LON(NFLASH_WRITE, NBRANCH_MAX))
+ ALLOCATE (ZSLMA_NEUT_POS(NFLASH_WRITE, NBRANCH_MAX))
+ ALLOCATE (ZSLMA_NEUT_NEG(NFLASH_WRITE, NBRANCH_MAX))
+ ALLOCATE (ISLMA_SEG_GLOB(NFLASH_WRITE, NBRANCH_MAX, 3))
+ ALLOCATE (ZSLMA_QMT(NFLASH_WRITE, NBRANCH_MAX, SIZE(PRSVS,4)))
+ ALLOCATE (ZSLMA_PRT(NFLASH_WRITE, NBRANCH_MAX, SIZE(PRSVS,4)))
+ ISLMA_SEG_GLOB(:,:,:) = 0
+ END IF
+ ALLOCATE (ZSCOORD_SEG(NFLASH_WRITE, NBRANCH_MAX, 3)) ! NFLASH_WRITE nb of flash to be stored
+ ! before writing in files
+ ! NBRANCH_MAX=5000 default
+ ALLOCATE (ISFLASH_NUMBER(0:NFLASH_WRITE))
+ ALLOCATE (ISNB_FLASH(NFLASH_WRITE))
+ ALLOCATE (ISCELL_NUMBER(NFLASH_WRITE))
+ ALLOCATE (ISNBSEG(NFLASH_WRITE))
+ ALLOCATE (ISTCOUNT_NUMBER(NFLASH_WRITE))
+ ALLOCATE (ISTYPE(NFLASH_WRITE))
+ ALLOCATE (ZSEM_TRIG(NFLASH_WRITE))
+ ALLOCATE (ZSNEUT_POS(NFLASH_WRITE))
+ ALLOCATE (ZSNEUT_NEG(NFLASH_WRITE))
+!
+ ZZMASS = MZF(PZZ)
+ ZPRES_COEF = EXP(ZZMASS/8400.)
+ ZSCOORD_SEG(:,:,:) = 0.0
+ ISAVE_STATUS = 1
+ ISFLASH_NUMBER(:) = 0
+END IF
+!
+ALLOCATE (ZQMT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3),SIZE(PRSVS,4)))
+ALLOCATE (ZQMTOT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3)))
+ALLOCATE (ZCLOUD(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ALLOCATE (GPOSS(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ALLOCATE (ZEMODULE(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ALLOCATE (ZCELL(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMAX_CELL))
+
+!
+ZQMT(:,:,:,:) = 0.
+ZQMTOT(:,:,:) = 0.
+ZCLOUD(:,:,:) = 0.
+GPOSS(:,:,:) = .FALSE.
+GPOSS(IIB:IIE,IJB:IJE,IKB:IKE) = .TRUE.
+ZEMODULE(:,:,:) = 0.
+ZCELL(:,:,:,:) = 0.
+!
+!
+!* 1.3 point discharge (Corona)
+!
+PRSVS(:,:,:,1) = XECHARGE * PRSVS(:,:,:,1) ! C /(m3 s)
+PRSVS(:,:,:,NSV_ELEC) = -1. * XECHARGE * PRSVS(:,:,:,NSV_ELEC) ! C /(m3 s)
+!
+CALL PT_DISCHARGE
+!
+!
+!* 1.4 total charge density and mixing ratio
+!
+DO II = 1, NSV_ELEC
+! transform the source term (C/s) into the updated charge density (C/kg)
+ ZQMT(:,:,:,II) = PRSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:)
+!
+! total mass charge density (C/kg)
+ ZQMTOT(:,:,:) = ZQMTOT(:,:,:) + PRSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:)
+END DO
+!
+! total mixing ratio (g/kg)
+DO II = 2, KRR
+ ZCLOUD(:,:,:) = ZCLOUD(:,:,:) + PRT(:,:,:,II)
+END DO
+!
+!
+!* 1.5 constants
+!
+ZCLOUDLIM = 1.E-5
+ZSIGMIN = 1.E-12
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. FIND AND COUNT THE ELECTRIFIED CELLS
+! ------------------------------------
+!
+ALLOCATE (ZEMAX(NMAX_CELL))
+ALLOCATE (ICELL_LOC(4,NMAX_CELL))
+!
+ZEMAX(:) = 0.
+ICELL_LOC(:,:) = 0
+!
+WHERE (ZCLOUD(IIB:IIE,IJB:IJE,IKB:IKE) .LE. ZCLOUDLIM)
+ GPOSS(IIB:IIE,IJB:IJE,IKB:IKE) = .FALSE.
+END WHERE
+!
+!
+!* 2.1 find the maximum electric field
+!
+GEND_DOMAIN = .FALSE.
+GEND_CELL = .FALSE.
+INB_CELL = 0
+ZE_TRIG_THRES = XETRIG * (1. - XEBALANCE)
+!
+CALL MPPDB_CHECK3DM("flash:: PRHODJ,PRT",PRECISION,&
+ PRHODJ,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3),PRT(:,:,:,4),&
+ PRT(:,:,:,5),PRT(:,:,:,6))
+CALL MPPDB_CHECK3DM("flash:: ZQMT",PRECISION,&
+ ZQMT(:,:,:,1),ZQMT(:,:,:,2),ZQMT(:,:,:,3),ZQMT(:,:,:,4),&
+ ZQMT(:,:,:,5),ZQMT(:,:,:,6),ZQMT(:,:,:,7))
+
+CALL TO_ELEC_FIELD_n (PRT, ZQMT, PRHODJ, KTCOUNT, KRR, &
+ PEFIELDU, PEFIELDV, PEFIELDW)
+CALL MPPDB_CHECK3DM("flash:: PEFIELDU, PEFIELDV, PEFIELDW",PRECISION,&
+ PEFIELDU, PEFIELDV, PEFIELDW)
+!
+! electric field module including pressure effect
+ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE) = ZPRES_COEF(IIB:IIE,IJB:IJE,IKB:IKE)* &
+ (PEFIELDU(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
+ PEFIELDV(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
+ PEFIELDW(IIB:IIE,IJB:IJE,IKB:IKE)**2)**0.5
+!
+DO WHILE (.NOT. GEND_DOMAIN .AND. INB_CELL .LT. NMAX_CELL)
+!
+! find the maximum electric field on each proc
+ IF (COUNT(GPOSS(IIB:IIE,IJB:IJE,IKB:IKE)) .GT. 0) THEN
+ ZMAXE = MAXVAL(ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE), MASK=GPOSS(IIB:IIE,IJB:IJE,IKB:IKE))
+ ELSE
+ ZMAXE = 0.
+ END IF
+!
+! find the max electric field on the whole domain + the proc that contains this value
+ CALL MAX_ELEC_ll (ZMAXE, IPROC_CELL)
+!
+ IF (ZMAXE .GT. ZE_TRIG_THRES) THEN
+ INB_CELL = INB_CELL + 1 ! one cell is detected
+ ZEMAX(INB_CELL) = ZMAXE
+! local coordinates of the maximum electric field
+ ICELL_LOC(1:3,INB_CELL) = MAXLOC(ZEMODULE, MASK=GPOSS )
+ IICOORD = ICELL_LOC(1,INB_CELL)
+ IJCOORD = ICELL_LOC(2,INB_CELL)
+ ICELL_LOC(1,INB_CELL) = IICOORD + IXOR -1
+ ICELL_LOC(2,INB_CELL) = IJCOORD + IYOR -1
+ IKCOORD = ICELL_LOC(3,INB_CELL)
+ ICELL_LOC(4,INB_CELL) = IPROC_CELL
+!
+! Broadcast the center of the cell to all procs
+ CALL MPI_BCAST (ICELL_LOC(:,INB_CELL), 4, MNHINT_MPI, IPROC_CELL, &
+ NMNH_COMM_WORLD, IERR)
+!
+!
+!* 2.2 horizontal extension of the cell
+!
+ DO IK = IKB, IKE
+ IF (IPROC_CELL .EQ. IPROC) THEN
+ IF (GPOSS(IICOORD,IJCOORD,IK)) THEN
+ ZCELL(IICOORD,IJCOORD,IK,INB_CELL) = 1.
+ GPOSS(IICOORD,IJCOORD,IK) = .FALSE.
+ END IF
+ END IF
+!
+!* 2.2.1 do the neighbour points have q_tot > q_thresh?
+!
+ GEND_CELL = .FALSE.
+ DO WHILE (.NOT. GEND_CELL)
+!
+ CALL ADD2DFIELD_ll ( TZFIELDS_ll, ZCELL(:,:,IK,INB_CELL), 'FLASH_GEOM_ELEC_n::ZCELL(:,:,IK,INB_CELL)' )
+ CALL UPDATE_HALO_ll ( TZFIELDS_ll, IINFO_ll )
+ CALL CLEANLIST_ll ( TZFIELDS_ll )
+!
+ COUNT_BEF = COUNT(ZCELL(IIB:IIE,IJB:IJE,IK,INB_CELL) .EQ. 1.)
+ CALL SUM_ELEC_ll (COUNT_BEF)
+!
+ ZCELL_NEW = ZCELL(:,:,IK,INB_CELL)
+ DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ IF ((ZCELL(II,IJ,IK,INB_CELL) .EQ. 0.) .AND. &
+ (GPOSS(II,IJ,IK)) .AND. &
+ (ZCLOUD(II,IJ,IK) .GT. 1.E-5) .AND. &
+ ((ABS(ZQMT(II,IJ,IK,2)) * PRHODREF(II,IJ,IK) .GT. XQEXCES).OR. &
+ (ABS(ZQMT(II,IJ,IK,3)) * PRHODREF(II,IJ,IK) .GT. XQEXCES).OR. &
+ (ABS(ZQMT(II,IJ,IK,4)) * PRHODREF(II,IJ,IK) .GT. XQEXCES).OR. &
+ (ABS(ZQMT(II,IJ,IK,5)) * PRHODREF(II,IJ,IK) .GT. XQEXCES).OR. &
+ (ABS(ZQMT(II,IJ,IK,6)) * PRHODREF(II,IJ,IK) .GT. XQEXCES)) )THEN
+!
+ IF ((ZCELL(II-1,IJ, IK,INB_CELL) .EQ. 1.) .OR. &
+ (ZCELL(II+1,IJ, IK,INB_CELL) .EQ. 1.) .OR. &
+ (ZCELL(II, IJ-1,IK,INB_CELL) .EQ. 1.) .OR. &
+ (ZCELL(II, IJ+1,IK,INB_CELL) .EQ. 1.) .OR. &
+ (ZCELL(II-1,IJ-1,IK,INB_CELL) .EQ. 1.) .OR. &
+ (ZCELL(II-1,IJ+1,IK,INB_CELL) .EQ. 1.) .OR. &
+ (ZCELL(II+1,IJ+1,IK,INB_CELL) .EQ. 1.) .OR. &
+ (ZCELL(II+1,IJ-1,IK,INB_CELL) .EQ. 1.)) THEN
+ GPOSS(II,IJ,IK) = .FALSE.
+ ZCELL_NEW(II,IJ) = 1.
+ END IF
+ END IF
+ END DO
+ END DO
+ ZCELL(:,:,IK,INB_CELL) = ZCELL_NEW
+!
+ COUNT_AFT = COUNT(ZCELL(IIB:IIE,IJB:IJE,IK,INB_CELL) .EQ. 1.)
+ CALL SUM_ELEC_ll(COUNT_AFT)
+!
+ IF (COUNT_BEF .EQ. COUNT_AFT) THEN
+ GEND_CELL = .TRUE. ! no more point in the cell at this level
+ ELSE
+ GEND_CELL = .FALSE.
+ END IF
+ END DO ! end loop gend_cell
+ END DO ! end loop ik
+!
+! avoid cell detection in the colums where a previous cell is already present
+ DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKB, IKE
+ IF (ZCELL(II,IJ,IK,INB_CELL) .EQ. 1.) GPOSS(II,IJ,:) = .FALSE.
+ END DO
+ END DO
+ END DO
+ ELSE
+ GEND_DOMAIN = .TRUE. ! no more points with E > E_threshold
+ END IF ! max E
+END DO ! end loop gend_domain
+!
+DEALLOCATE (GPOSS)
+DEALLOCATE (ZEMAX)
+!
+!
+!* 2.3 if at least 1 cell, allocate arrays
+!
+IF (INB_CELL .GE. 1) THEN
+!
+! mean mesh size
+ ZMEAN_GRID = (XDXHATM**2 + XDYHATM**2 + &
+ ( ( XZHAT(UBOUND(XZHAT,1)) - XZHAT(1) ) / (SIZE(PRT,3)-1.) )**2 )**0.5
+! chaque proc calcule son propre zmean_grid
+! mais cette valeur peut etre differente sur chaque proc (ex: relief)
+! laisse tel quel pour le moment
+!
+ ALLOCATE (ISEG_LOC(3*SIZE(PRT,3), INB_CELL)) ! 3 coord indices of the leader
+ ALLOCATE (ZCOORD_TRIG(3, INB_CELL))
+ ALLOCATE (ZCOORD_SEG(NBRANCH_MAX*3, INB_CELL))
+ ! NBRANCH_MAX=5000 default
+ ! 3= 3 coord index
+ ALLOCATE (ZCOORD_SEG_ALL(NBRANCH_MAX*3, INB_CELL))
+ ALLOCATE (ISEG_GLOB(NBRANCH_MAX*3, INB_CELL))
+ ISEG_GLOB(:,:) = 0
+!
+ IF(LLMA) THEN
+ ALLOCATE (ILMA_SEG_ALL (NBRANCH_MAX*3, INB_CELL))
+ ALLOCATE (ZLMA_QMT(NBRANCH_MAX*NSV_ELEC, INB_CELL)) ! charge des part.
+ ! a neutraliser
+ ALLOCATE (ZLMA_PRT(NBRANCH_MAX*NSV_ELEC, INB_CELL)) ! mixing ratio
+ ALLOCATE (ZLMA_NEUT_POS(NBRANCH_MAX, INB_CELL))
+ ALLOCATE (ZLMA_NEUT_NEG(NBRANCH_MAX, INB_CELL))
+ ZLMA_QMT(:,:) = 0.
+ ZLMA_PRT(:,:) = 0.
+ ZLMA_NEUT_POS(:,:) = 0.
+ ZLMA_NEUT_NEG(:,:) = 0.
+ END IF
+!
+ IF (LLNOX_EXPLICIT) THEN
+ ALLOCATE (ZLNOX(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ ZLNOX(:,:,:) = 0.
+ END IF
+!
+ ALLOCATE (ZEM_TRIG(INB_CELL))
+ ALLOCATE (INB_FLASH(INB_CELL))
+ ALLOCATE (INB_FL_REAL(INB_CELL))
+ ALLOCATE (INBSEG(INB_CELL))
+ ALLOCATE (INBSEG_ALL(INB_CELL))
+ ALLOCATE (ITYPE(INB_CELL))
+ ALLOCATE (INBSEG_LEADER(INB_CELL))
+ ALLOCATE (ZDQDT(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)+1))
+ ALLOCATE (ZSIGMA(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)-1))
+ ALLOCATE (ZLBDAR(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ ALLOCATE (ZLBDAS(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ ALLOCATE (ZLBDAG(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ IF (KRR == 7) ALLOCATE (ZLBDAH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ ALLOCATE (ZSIGLOB(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ ALLOCATE (ZFLASH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),INB_CELL))
+ ALLOCATE (ZDIST(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ ALLOCATE (ZQFLASH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ ALLOCATE (GATTACH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+!
+ ISEG_LOC(:,:) = 0
+ ZCOORD_TRIG(:,:) = 0.
+ ZCOORD_SEG(:,:) = 0.
+ ZDQDT(:,:,:,:) = 0.
+ ZSIGMA(:,:,:,:) = 0.
+ ZLBDAR(:,:,:) = 0.
+ ZLBDAS(:,:,:) = 0.
+ ZLBDAG(:,:,:) = 0.
+ ZSIGLOB(:,:,:) = 0.
+ ZFLASH(:,:,:,:) = 0.
+ ZDIST(:,:,:) = 0.
+ ZQFLASH(:,:,:) = 0.
+ ZEM_TRIG(:) = 0.
+ INB_FLASH(:) = 0
+ INB_FL_REAL(:) = 0
+ INBSEG(:) = 0
+ INBSEG_ALL(:) = 0
+ INBSEG_PROC(:) = 0
+ INBSEG_LEADER(:) = 0
+ ITYPE(:) = 1 ! default = IC
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTE THE EFFICIENT CROSS SECTIONS OF HYDROMETEORS
+! ----------------------------------------------------
+!
+!* 3.1 for cloud droplets
+!
+ WHERE (PRT(:,:,:,2) > ZCLOUDLIM)
+ ZSIGMA(:,:,:,1) = XFQLIGHTC * PRHODREF(:,:,:) * PRT(:,:,:,2)
+ ENDWHERE
+!
+!
+!* 3.2 for raindrops
+!
+ WHERE (PRT(:,:,:,3) > 0.0)
+ ZLBDAR(:,:,:) = XLBR * (PRHODREF(:,:,:) * &
+ MAX(PRT(:,:,:,3),XRTMIN(3)))**XLBEXR
+ END WHERE
+!
+ WHERE (PRT(:,:,:,3) > ZCLOUDLIM .AND. ZLBDAR(:,:,:) < XLBDAR_MAXE .AND. &
+ ZLBDAR(:,:,:) > 0.)
+ ZSIGMA(:,:,:,2) = XFQLIGHTR * ZLBDAR(:,:,:)**XEXQLIGHTR
+ END WHERE
+!
+!
+!* 3.3 for ice crystals
+!
+ WHERE (PRT(:,:,:,4) > ZCLOUDLIM .AND. PCIT(:,:,:) > 1.E4)
+ ZSIGMA(:,:,:,3) = XFQLIGHTI * PCIT(:,:,:)**(1.-XEXQLIGHTI) * &
+ ((PRHODREF(:,:,:) * PRT(:,:,:,4))**XEXQLIGHTI)
+ ENDWHERE
+!
+!
+!* 3.4 for snow
+!
+ WHERE (PRT(:,:,:,5) > 0.0)
+ ZLBDAS(:,:,:) = MIN(XLBDAS_MAXE, &
+ XLBS * (PRHODREF(:,:,:) * &
+ MAX(PRT(:,:,:,5),XRTMIN(5)))**XLBEXS)
+ END WHERE
+!
+ WHERE (PRT(:,:,:,5) > ZCLOUDLIM .AND. ZLBDAS(:,:,:) < XLBDAS_MAXE .AND. &
+ ZLBDAS(:,:,:) > 0.)
+ ZSIGMA(:,:,:,4) = XFQLIGHTS * ZLBDAS(:,:,:)**XEXQLIGHTS
+ ENDWHERE
+!
+!
+!* 3.5 for graupel
+!
+ WHERE (PRT(:,:,:,6) > 0.0)
+ ZLBDAG(:,:,:) = XLBG * (PRHODREF(:,:,:) * MAX(PRT(:,:,:,6),XRTMIN(6)))**XLBEXG
+ END WHERE
+!
+ WHERE (PRT(:,:,:,6) > ZCLOUDLIM .AND. ZLBDAG(:,:,:) < XLBDAG_MAXE .AND. &
+ ZLBDAG(:,:,:) > 0.)
+ ZSIGMA(:,:,:,5) = XFQLIGHTG * ZLBDAG(:,:,:)**XEXQLIGHTG
+ ENDWHERE
+!
+!
+!* 3.6 for hail
+!
+ IF (KRR == 7) THEN
+ WHERE (PRT(:,:,:,7) > 0.0)
+ ZLBDAH(:,:,:) = XLBH * (PRHODREF(:,:,:) * &
+ MAX(PRT(:,:,:,7), XRTMIN(7)))**XLBEXH
+ END WHERE
+!
+ WHERE (PRT(:,:,:,7) > ZCLOUDLIM .AND. ZLBDAH(:,:,:) < XLBDAH_MAXE .AND. &
+ ZLBDAH(:,:,:) > 0.)
+ ZSIGMA(:,:,:,6) = XFQLIGHTH * ZLBDAH(:,:,:)**XEXQLIGHTH
+ ENDWHERE
+ END IF
+!
+!
+!* 3.7 sum of the efficient cross sections
+!
+ ZSIGLOB(:,:,:) = ZSIGMA(:,:,:,1) + ZSIGMA(:,:,:,2) + ZSIGMA(:,:,:,3) + &
+ ZSIGMA(:,:,:,4) + ZSIGMA(:,:,:,5)
+!
+ IF (KRR == 7) ZSIGLOB(:,:,:) = ZSIGLOB(:,:,:) + ZSIGMA(:,:,:,6)
+!
+IF (KRR == 7) THEN
+ CALL MPPDB_CHECK3DM("flash:: ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH",PRECISION,&
+ ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH,&
+ ZSIGMA(:,:,:,1),ZSIGMA(:,:,:,2),ZSIGMA(:,:,:,3),ZSIGMA(:,:,:,4),&
+ ZSIGMA(:,:,:,5),ZSIGMA(:,:,:,6))
+ELSE
+ CALL MPPDB_CHECK3DM("flash:: ZLBDAR,ZLBDAS,ZLBDAG",PRECISION,&
+ ZLBDAR,ZLBDAS,ZLBDAG,&
+ ZSIGMA(:,:,:,1),ZSIGMA(:,:,:,2),ZSIGMA(:,:,:,3),ZSIGMA(:,:,:,4),&
+ ZSIGMA(:,:,:,5))
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. FIND THE TRIGGERING POINT IN EACH CELL
+! --------------------------------------
+!
+ ALLOCATE (IPROC_TRIG(INB_CELL))
+ ALLOCATE (ISIGNE_EZ(INB_CELL))
+ ALLOCATE (GNEW_FLASH(INB_CELL))
+ ALLOCATE (ZNEUT_POS(INB_CELL))
+ ALLOCATE (ZNEUT_NEG(INB_CELL))
+!
+ IPROC_TRIG(:) = 0
+ ISIGNE_EZ(:) = 0
+ GNEW_FLASH(:) = .FALSE.
+ ZNEUT_POS(:) = 0.
+ ZNEUT_NEG(:) = 0.
+!
+ CALL TRIG_POINT
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. FLASH TRIGGERING
+! ----------------
+!
+ IFLASH_COUNT = 0
+ IFLASH_COUNT_GLOB = 0
+!
+ DO WHILE (GNEW_FLASH_GLOB)
+!
+ GATTACH(:,:,:) = .FALSE.
+!
+ DO IL = 1, INB_CELL
+ IF (GNEW_FLASH(IL)) THEN
+ ZFLASH(:,:,:,IL) = 0.
+! update lightning informations
+ INB_FLASH(IL) = INB_FLASH(IL) + 1 ! nb of flashes / cell / time step
+ INB_FL_REAL(IL) = INB_FL_REAL(IL) + 1 ! nb of flashes / cell / time step
+ INBSEG(IL) = 0 ! nb of segments / flash
+ ITYPE(IL) = 1
+!
+ IF (IPROC .EQ. IPROC_TRIG(IL)) THEN
+ ZEMOD_BL = ZEM_TRIG(IL)
+ IIBL_LOC = ISEG_LOC(1,IL)
+ IJBL_LOC = ISEG_LOC(2,IL)
+ IKBL = ISEG_LOC(3,IL)
+!
+ INBSEG(IL) = 1 ! nb of segments / flash
+ ZFLASH(IIBL_LOC,IJBL_LOC,IKBL,IL) = 1.
+ ENDIF
+!
+ GCG = .FALSE.
+ GCG_POS = .FALSE.
+
+ CALL MPPDB_CHECK3DM("flash:: 4. ZFLASH(IL)",PRECISION,&
+ ZFLASH(:,:,:,IL))
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. PROPAGATE THE BIDIRECTIONAL LEADER
+! ----------------------------------
+!
+! it is assumed that the leader propagates only along the vertical
+!
+!* 5.1 positive segments
+!
+! the positive leader propagates parallel to the electric field
+ ISIGN_LEADER = 1
+ CALL ONE_LEADER
+ IPOS_LEADER = INBSEG(IL) -1
+!
+!
+!* 5.2 negative segments
+!
+! the negative leader propagates anti-parallel to the electric field
+ ZEMOD_BL = ZEM_TRIG(IL)
+ IKBL = ISEG_LOC(3,IL)
+ ISIGN_LEADER = -1
+ CALL ONE_LEADER
+!
+ INBSEG_LEADER(IL) = INBSEG(IL)
+ INEG_LEADER = INBSEG_LEADER(IL) - IPOS_LEADER - 1
+!
+! Eliminate this flash if only positive or negative leader exists
+ IF (IPROC .EQ. IPROC_TRIG(IL)) THEN
+ IF (IPOS_LEADER .EQ. 0 .OR. INEG_LEADER .EQ. 0) THEN
+ ZFLASH(IIBL_LOC,IJBL_LOC,IKB:IKE,IL) = 0.
+ INB_FL_REAL(IL) = INB_FL_REAL(IL) - 1
+ GNEW_FLASH(IL) = .FALSE.
+ ELSE ! return to actual Triggering electrical field
+ IIBL_LOC = ISEG_LOC(1,IL)
+ IJBL_LOC = ISEG_LOC(2,IL)
+ IKBL = ISEG_LOC(3,IL)
+ ZEM_TRIG(IL) = ZEM_TRIG(IL)/ZPRES_COEF(IIBL_LOC,IJBL_LOC,IKBL)
+ ENDIF
+ ENDIF
+
+ CALL MPPDB_CHECK3DM("flash:: 5. ZFLASH(IL)",PRECISION,&
+ ZFLASH(:,:,:,IL))
+!
+ CALL MPI_BCAST (GNEW_FLASH(IL),1, MNHLOG_MPI, IPROC_TRIG(IL), &
+ NMNH_COMM_WORLD, IERR)
+ CALL MPI_BCAST (ZEM_TRIG(IL), 1, MNHREAL_MPI, IPROC_TRIG(IL), &
+ NMNH_COMM_WORLD, IERR)
+ CALL MPI_BCAST (INB_FL_REAL(IL), 1, MNHINT_MPI, IPROC_TRIG(IL), &
+ NMNH_COMM_WORLD, IERR)
+ END IF
+ END DO ! end loop il
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. POSITIVE AND NEGATIVE REGIONS WHERE THE FLASH CAN PROPAGATE
+! -----------------------------------------------------------
+!
+! Note: this is done to avoid branching in a third charge region:
+! the branches 'stay' in the 2 charge regions where the bileader started to propagate
+!
+!* 6.1 positive charge region associated to the negative leader
+!
+ ALLOCATE (GPROP(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),INB_CELL))
+ GPROP(:,:,:,:) = .FALSE.
+!
+ GPOSITIVE = .TRUE.
+ CALL CHARGE_POCKET
+!
+!
+!* 6.2 negative charge region associated to the positive leader
+!
+ GPOSITIVE = .FALSE.
+ CALL CHARGE_POCKET
+!
+! => a point can be added to the flash only if gprop = true
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. NUMBER OF POINTS TO REDISTRIBUTE AT DISTANCE D
+! ----------------------------------------------
+!
+!* 7.1 distance between the triggering point and each point of the mask
+!* global coordinates: only points possibly contributing to branches
+!
+ INB_NEUT_OK = 0
+!
+ DO IL = 1, INB_CELL
+ IF (GNEW_FLASH(IL)) THEN
+ INB_PROP = COUNT(GPROP(IIB:IIE,IJB:IJE,IKB:IKE,IL))
+ CALL SUM_ELEC_ll(INB_PROP)
+!
+ IF (INB_PROP .GT. 0) THEN
+ ZDIST(:,:,:) = 0.
+ DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKB, IKE
+ IF (GPROP(II,IJ,IK,IL)) THEN
+ ZDIST(II,IJ,IK) = ((XXHATM(II) - ZCOORD_TRIG(1,IL))**2 + &
+ (XYHATM(IJ) - ZCOORD_TRIG(2,IL))**2 + &
+ (ZZMASS(II,IJ,IK) - ZCOORD_TRIG(3,IL))**2)**0.5
+ END IF
+ END DO
+ END DO
+ END DO
+!
+!
+!* 7.3 compute the min and max distance from the triggering point - global
+!
+ ZMIN_DIST = 0.0
+ ZMAX_DIST = MAX_ll(ZDIST,IPROC_AUX)
+!
+! transform the min and max distances into min and max increments
+ IIND_MIN = 1
+ IIND_MAX = MAX(1, INT((ZMAX_DIST-ZMIN_DIST)/ZMEAN_GRID +1.))
+ IDELTA_IND = IIND_MAX + 1
+!
+ ALLOCATE (IHIST_LOC(IDELTA_IND))
+ ALLOCATE (ZHIST_PERCENT(IDELTA_IND))
+ ALLOCATE (IHIST_GLOB(IDELTA_IND))
+ ALLOCATE (ZMAX_BRANCH(IDELTA_IND))
+ ALLOCATE (IMAX_BRANCH(IDELTA_IND))
+ ALLOCATE (IMASKQ_DIST(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+!
+ IHIST_LOC(:) = 0
+ ZHIST_PERCENT(:) = 0.
+ IHIST_GLOB(:) = 0
+ ZMAX_BRANCH(:) = 0.
+ IMAX_BRANCH(:) = 0
+ IMASKQ_DIST(:,:,:) = 0
+!
+!
+!* 7.4 histogram: number of points between r and r+dr
+!* for each proc
+!
+! build an array with the possible points: IMASKQ_DIST contains the distance
+! rank of points contributing to branches, excluding the leader points
+!
+ DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKB, IKE
+ IF (ZDIST(II,IJ,IK) .NE. 0.) THEN
+ IM = INT( (ZDIST(II,IJ,IK)-ZMIN_DIST)/ZMEAN_GRID + 1.)
+ IHIST_LOC(IM) = IHIST_LOC(IM) + 1
+ IMASKQ_DIST(II,IJ,IK) = IM
+ ENDIF
+ END DO
+ END DO
+ END DO
+!
+!
+!* 7.5 global histogram
+!
+ IHIST_GLOB(:) = IHIST_LOC(:)
+ CALL SUM_ELEC_ll(IHIST_GLOB)
+!
+!
+!* 7.6 normalization
+!
+ ZHIST_PERCENT(:) = 0.
+ ZMAX_BRANCH(:) = 0.
+ IMAX_BRANCH(:) = 0
+!
+ DO IM = 1, IDELTA_IND
+ IF (IHIST_GLOB(IM) .GT. 0) THEN
+ ZHIST_PERCENT(IM) = REAL(IHIST_LOC(IM)) / REAL(IHIST_GLOB(IM))
+ END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. BRANCHES
+! --------
+!
+!* 8.1 max number of branches at distance d from the triggering point
+!
+ ZMAX_BRANCH(IM) = (XDFRAC_L / ZMEAN_GRID) * &
+ REAL(IIND_MIN+IM-1)**(XDFRAC_ECLAIR - 1.)
+ ZMAX_BRANCH(IM) = ANINT(ZMAX_BRANCH(IM))
+! all procs know the max total number of branches at distance d
+! => the max number of branches / proc is proportional to the percentage of
+! available points / proc at this distance
+!
+ IMAX_BRANCH(IM) = INT(ANINT(ZMAX_BRANCH(IM)))
+ END DO
+!
+ DEALLOCATE (IHIST_LOC)
+ DEALLOCATE (ZHIST_PERCENT)
+ DEALLOCATE (IHIST_GLOB)
+ DEALLOCATE (ZMAX_BRANCH)
+!
+!
+!* 8.3 distribute the branches
+!
+!
+ CALL BRANCH_GEOM(IKB, IKE)
+!
+ DEALLOCATE (IMAX_BRANCH)
+ DEALLOCATE (IMASKQ_DIST)
+ END IF ! end if count(gprop)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. NEUTRALIZATION
+! --------------
+ CALL MPPDB_CHECK3DM("flash:: 9. ZQMTOT",PRECISION,ZQMTOT)
+ CALL MPPDB_CHECK3DM("flash:: 9. ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
+!
+!* 9.1 charge carried by the lightning flash
+!
+ ZQFLASH(:,:,:) = 0.
+ WHERE (ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) .GT. 0. .AND. &
+ ABS(ZQMTOT(IIB:IIE,IJB:IJE,IKB:IKE) * &
+ PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)) .GT. XQNEUT .AND. &
+ ZSIGLOB(IIB:IIE,IJB:IJE,IKB:IKE) .GE. ZSIGMIN)
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) = -1. * &
+ (ABS(ZQMTOT(IIB:IIE,IJB:IJE,IKB:IKE)) / &
+ ZQMTOT(IIB:IIE,IJB:IJE,IKB:IKE)) * &
+ (ABS(ZQMTOT(IIB:IIE,IJB:IJE,IKB:IKE)) - &
+ (XQNEUT / PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)))
+ GATTACH(IIB:IIE,IJB:IJE,IKB:IKE) = .TRUE.
+
+ END WHERE
+!
+! net charge carried by the flash (for charge conservation / IC)
+ ZQNET = SUM3D_ll(ZQFLASH*PRHODJ, IINFO_ll)
+!
+!
+!* 9.2 number of points to neutralize
+!
+ INB_NEUT = COUNT(ZSIGLOB(IIB:IIE,IJB:IJE,IKB:IKE) .GE. ZSIGMIN .AND. &
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) .NE. 0.)
+ CALL SUM_ELEC_ll(INB_NEUT)
+
+!
+!
+!* 9.3 ensure total charge conservation for IC
+!
+ IF (INB_NEUT .GE. 3) THEN
+ GNEUTRALIZATION = .TRUE.
+ ELSE
+ GNEUTRALIZATION = .FALSE.
+ GNEW_FLASH(IL) = .FALSE.
+ INB_FL_REAL(IL) = INB_FL_REAL(IL) - 1
+ END IF
+!
+ IF (GNEUTRALIZATION .AND. (.NOT. GCG) .AND. ZQNET .NE. 0.) THEN
+ ZQNET = ZQNET / REAL(INB_NEUT)
+ WHERE (ZSIGLOB(IIB:IIE,IJB:IJE,IKB:IKE) .GE. ZSIGMIN .AND. &
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) .NE. 0.)
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) = ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) - &
+ ZQNET / PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE)
+ ENDWHERE
+ END IF
+!
+!
+!* 9.4 charge neutralization
+!
+ CALL MPPDB_CHECK3DM("flash:: 9.4 ZQFLASH,ZSIGLOB",PRECISION,&
+ ZQFLASH,ZSIGLOB)
+
+ ZDQDT(:,:,:,:) = 0.
+!
+ IF (GNEUTRALIZATION) THEN
+ IF (ITYPE(IL) .EQ. 1.) THEN
+ WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) < 0.)
+ ! increase negative ion charge
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_ELEC) = &
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_ELEC) + &
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)
+ ENDWHERE
+!
+ WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) > 0.)
+ ! Increase positive ion charge
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,1) = &
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,1) + &
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)
+ ENDWHERE
+!
+!
+!* 9.4.2 cloud-to-ground flashes
+!
+ ELSE
+!
+! Neutralization of the charge on positive CG flashes
+ IF (ITYPE(IL) .EQ. 3) THEN
+ DO II = 1, NSV_ELEC
+ WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) > 0.)
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,II) = &
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,II) - &
+ ZQMT(IIB:IIE,IJB:IJE,IKB:IKE,II)
+ END WHERE
+ ENDDO
+!
+ WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) > 0.)
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)=0.
+ END WHERE
+!
+ WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) < 0.)
+! Increase negative ion charge
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_ELEC) = &
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_ELEC) + &
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)
+ ENDWHERE
+ ELSE
+!
+! Neutralization of the charge on negative CG flashes
+!
+ DO II = 1, NSV_ELEC
+ WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) < 0.)
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,II) = &
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,II) - &
+ ZQMT(IIB:IIE,IJB:IJE,IKB:IKE,II)
+ END WHERE
+ ENDDO
+!
+ WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) < 0.)
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)=0.
+ END WHERE
+!
+ WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) > 0.)
+ ! Increase positive ion charge
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,1) = &
+ ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,1) + &
+ ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)
+ ENDWHERE
+ END IF ! GCG_POS
+ END IF ! NOT(GCG)
+!
+! Counting the total number of points neutralized in the cell
+ IF (IPROC .EQ. IPROC_TRIG(IL)) THEN
+ INB_NEUT_OK = INB_NEUT_OK + INB_NEUT
+ END IF
+!
+ CALL MPI_BCAST (INB_NEUT_OK,1, MNHINT_MPI, IPROC_TRIG(IL), &
+ NMNH_COMM_WORLD, IERR)
+!
+!* 9.5 Gather lightning information from all processes
+!* Save the particule charge and total pos/neg charge neutralization points.
+!* the coordinates of all flash branch points
+!
+ CALL MPI_ALLGATHER(INBSEG(IL), 1, MNHINT_MPI, &
+ INBSEG_PROC, 1, MNHINT_MPI, NMNH_COMM_WORLD, IERR)
+
+ INBSEG_ALL(IL) = INBSEG(IL)
+ CALL SUM_ELEC_ll(INBSEG_ALL(IL))
+
+ CALL GATHER_ALL_BRANCH
+!
+!* 9.6 update the source term
+!
+ CALL MPPDB_CHECK3DM("flash:: 9.6 PRSVS",PRECISION,&
+ PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
+ PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
+ CALL MPPDB_CHECK3DM("flash:: 9.6 ZDQDT",PRECISION,&
+ ZDQDT(:,:,:,1),ZDQDT(:,:,:,2),ZDQDT(:,:,:,3),ZDQDT(:,:,:,4),&
+ ZDQDT(:,:,:,5),ZDQDT(:,:,:,6),ZDQDT(:,:,:,7))
+
+ DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKB, IKE
+ DO IM = 1, NSV_ELEC
+ IF (ZDQDT(II,IJ,IK,IM) .NE. 0.) THEN
+ PRSVS(II,IJ,IK,IM) = PRSVS(II,IJ,IK,IM) + &
+ ZDQDT(II,IJ,IK,IM) * &
+ PRHODJ(II,IJ,IK) / PTSTEP
+ END IF
+!
+!
+!* 9.7 update the positive and negative charge neutralized
+!
+ IF (ZDQDT(II,IJ,IK,IM) .LT. 0.) THEN
+ ZNEUT_NEG(IL) = ZNEUT_NEG(IL) + ZDQDT(II,IJ,IK,IM) * &
+ PRHODJ(II,IJ,IK)
+ ELSE IF (ZDQDT(II,IJ,IK,IM) .GT. 0.) THEN
+ ZNEUT_POS(IL) = ZNEUT_POS(IL) + ZDQDT(II,IJ,IK,IM) * &
+ PRHODJ(II,IJ,IK)
+ END IF
+ END DO
+ END DO
+ END DO
+ END DO
+!
+ CALL SUM_ELEC_ll(ZNEUT_POS(IL))
+ CALL SUM_ELEC_ll(ZNEUT_NEG(IL))
+!
+!
+!* 9.8 compute the NOx production
+!
+!! The lightning length is first computed. The number of NOx molecules per
+!! meter of lightning flash is taken from Wang et al. (1998). It is a linear
+!! function of the pressure. No distinction is made between ICs and CGs.
+
+ IF (LLNOX_EXPLICIT) THEN
+ IFLASH_COUNT_GLOB = IFLASH_COUNT_GLOB + 1
+ IF (INBSEG(IL) .NE. 0) THEN
+ DO II = 0, INBSEG(IL)-1
+ IM = 3 * II
+ IX = ISEG_GLOB(IM+1,IL) - IXOR + 1
+ IY = ISEG_GLOB(IM+2,IL) - IYOR + 1
+ IZ = ISEG_GLOB(IM+3,IL)
+ ZLGHTLENGTH = (XDXX(IX,IY,IZ) * XDYY(IX,IY,IZ) * &
+ XDZZ(IX,IY,IZ))**(1./3.)
+ ZLNOX(IX, IY, IZ) = ZLNOX(IX, IY, IZ) + &
+ (XWANG_A + XWANG_B * PPABST(IX,IY,IZ)) * &
+ ZLGHTLENGTH
+ ENDDO
+ IFLASH_COUNT = IFLASH_COUNT + 1
+ END IF
+ END IF
+ END IF ! GNEUTRALIZATION
+ END IF ! end if gnew_flash
+ END DO ! end loop il
+!
+ DEALLOCATE (GPROP)
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 10. PRINT OR SAVE (before print) LIGHTNING INFORMATIONS
+! ---------------------------------------------------
+!
+! Synchronizing all processes
+! CALL MPI_BARRIER(NMNH_COMM_WORLD, IERR) ! A ACTIVER SI PB.
+!
+ INBLIGHT = COUNT(GNEW_FLASH(1:INB_CELL))
+ IF (IPROC .EQ. 0) THEN
+ IF (INBLIGHT .NE. 0) THEN
+ IF ((NNBLIGHT+INBLIGHT) .LE. NFLASH_WRITE) THEN ! SAVE
+ ISAVE_STATUS = 1
+ DO IL = 1, INB_CELL
+ IF (GNEW_FLASH(IL)) THEN
+ NNBLIGHT = NNBLIGHT + 1
+ ISFLASH_NUMBER(NNBLIGHT) = ISFLASH_NUMBER(NNBLIGHT-1) + 1
+ ISNB_FLASH(NNBLIGHT) = INB_FL_REAL(IL)
+ ISNBSEG(NNBLIGHT) = INBSEG_ALL(IL)
+ ISCELL_NUMBER(NNBLIGHT) = IL
+ ISTCOUNT_NUMBER(NNBLIGHT) = KTCOUNT
+ ISTYPE(NNBLIGHT) = ITYPE(IL)
+ ZSEM_TRIG(NNBLIGHT) = ZEM_TRIG(IL) / 1000.
+ ZSNEUT_POS(NNBLIGHT) = ZNEUT_POS(IL)
+ ZSNEUT_NEG(NNBLIGHT) = ZNEUT_NEG(IL)
+!
+ DO II = 1, INBSEG_ALL(IL)
+ IM = 3 * (II - 1)
+ ZSCOORD_SEG(NNBLIGHT,II,1:3) = ZCOORD_SEG_ALL(IM+1:IM+3,IL)
+ ENDDO
+!
+ IF(LLMA) THEN
+ DO II = 1, INBSEG_ALL(IL)
+ IM = 3 * (II - 1)
+ ISLMA_SEG_GLOB(NNBLIGHT,II,1:3) = ILMA_SEG_ALL(IM+1:IM+3,IL)
+ IM = NSV_ELEC * (II - 1)
+ ZSLMA_QMT(NNBLIGHT,II,2:6) = ZLMA_QMT(IM+2:IM+6,IL)
+ ZSLMA_PRT(NNBLIGHT,II,2:6) = ZLMA_PRT(IM+2:IM+6,IL)
+ ZSLMA_NEUT_POS(NNBLIGHT,II) = ZLMA_NEUT_POS(II,IL)
+ ZSLMA_NEUT_NEG(NNBLIGHT,II) = ZLMA_NEUT_NEG(II,IL)
+ END DO
+ END IF ! llma
+ END IF ! gnew_flash
+ END DO ! end loop il
+!
+ IF (NNBLIGHT .EQ. NFLASH_WRITE) ISAVE_STATUS = 0
+!
+ ELSE ! Print in output files
+ ISAVE_STATUS = 2
+ END IF
+!
+ IF (ISAVE_STATUS .EQ. 0 .OR. ISAVE_STATUS .EQ. 2) THEN
+ CALL WRITE_OUT_ASCII
+ IF(LLMA) THEN
+ CALL WRITE_OUT_LMA
+ END IF
+ ISFLASH_NUMBER(0) = ISFLASH_NUMBER(NNBLIGHT)
+ END IF
+!
+ IF (ISAVE_STATUS .EQ. 2) THEN ! Save flashes of the temporal loop
+ NNBLIGHT = 0
+ DO IL = 1, INB_CELL
+ IF (GNEW_FLASH(IL)) THEN
+ NNBLIGHT = NNBLIGHT + 1
+ ISFLASH_NUMBER(NNBLIGHT) = ISFLASH_NUMBER(NNBLIGHT-1) + 1
+ ISNB_FLASH(NNBLIGHT) = INB_FL_REAL(IL)
+ ISNBSEG(NNBLIGHT) = INBSEG_ALL(IL)
+ ISCELL_NUMBER(NNBLIGHT) = IL
+ ISTCOUNT_NUMBER(NNBLIGHT) = KTCOUNT
+ ISTYPE(NNBLIGHT) = ITYPE(IL)
+ ZSEM_TRIG(NNBLIGHT) = ZEM_TRIG(IL) / 1000.
+ ZSNEUT_POS(NNBLIGHT) = ZNEUT_POS(IL)
+ ZSNEUT_NEG(NNBLIGHT) = ZNEUT_NEG(IL)
+!
+ DO II = 1, INBSEG_ALL(IL)
+ IM = 3 * (II - 1)
+ ZSCOORD_SEG(NNBLIGHT, II, 1:3) = ZCOORD_SEG_ALL(IM+1:IM+3, IL)
+ ENDDO
+!
+ IF(LLMA) THEN
+ DO II = 1, INBSEG_ALL(IL)
+ IM = 3 * (II - 1)
+ ISLMA_SEG_GLOB(NNBLIGHT,II,1:3) = ILMA_SEG_ALL(IM+1:IM+3,IL)
+ IM = NSV_ELEC*(II-1)
+ ZSLMA_QMT(NNBLIGHT,II,2:6) = ZLMA_QMT(IM+2:IM+6,IL)
+ ZSLMA_PRT(NNBLIGHT,II,2:6) = ZLMA_PRT(IM+2:IM+6,IL)
+ ZSLMA_NEUT_POS(NNBLIGHT,II) = ZLMA_NEUT_POS(II,IL)
+ ZSLMA_NEUT_NEG(NNBLIGHT,II) = ZLMA_NEUT_NEG(II,IL)
+ END DO
+ END IF
+ END IF
+ ENDDO
+ END IF
+!
+ IF (ISAVE_STATUS .EQ. 0) THEN
+ NNBLIGHT = 0
+ END IF
+ END IF ! INBLIGHT
+ END IF ! IPROC
+!
+! Save flash location statistics in all processes
+ IF (INBLIGHT .NE. 0) THEN
+ DO IL = 1, INB_CELL
+ IF (GNEW_FLASH(IL)) THEN
+ IMAP2D(:,:) = 0
+ DO IK = IKB, IKE
+ IMAP2D(:,:) = IMAP2D(:,:) + ZFLASH(:,:,IK,IL)
+ END DO
+!
+! Detect Trig/Impact X,Y location
+ IX = 0
+ IY = 0
+ GFIRSTFLASH = .FALSE.
+ DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKB, IKE
+ IF (GFIRSTFLASH) EXIT
+ IF (ZFLASH(II,IJ,IK,IL)==1.) THEN
+ IX = II
+ IY = IJ
+ GFIRSTFLASH = .TRUE.
+ END IF
+ END DO
+ END DO
+ END DO
+!
+! Store
+ IF (ITYPE(IL)==1) THEN ! IC
+ IF (IX*IY/=0) NMAP_TRIG_IC(IX,IY) = NMAP_TRIG_IC(IX,IY) + 1
+ NMAP_2DAREA_IC(:,:) = NMAP_2DAREA_IC(:,:) + MIN(1,IMAP2D(:,:))
+ NMAP_3DIC(:,:,:) = NMAP_3DIC(:,:,:) + ZFLASH(:,:,:,IL)
+ ELSE ! CGN & CGP
+ IF (IX*IY/=0) NMAP_IMPACT_CG(IX,IY) = NMAP_IMPACT_CG(IX,IY) + 1
+ NMAP_2DAREA_CG(:,:) = NMAP_2DAREA_CG(:,:) + MIN(1,IMAP2D(:,:))
+ NMAP_3DCG(:,:,:) = NMAP_3DCG(:,:,:) + ZFLASH(:,:,:,IL)
+ END IF
+ END IF
+ ENDDO
+ END IF ! INBLIGHT
+!
+!------------------------------------------------------------------------------
+!
+!* 11. ATTACHMENT AFTER CHARGE NEUTRALIZATION
+! --------------------------------------
+!
+!* 11.1 ion attachment
+!
+ IF (INB_NEUT_OK .NE. 0) THEN
+
+ CALL MPPDB_CHECK3DM("flash:: PRSVS",PRECISION,&
+ PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
+ PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
+
+ PRSVS(:,:,:,1) = PRSVS(:,:,:,1) / XECHARGE
+ PRSVS(:,:,:,NSV_ELEC) = - PRSVS(:,:,:,NSV_ELEC) / XECHARGE
+!
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
+ PRHODJ, PRSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
+ PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
+!
+ PRSVS(:,:,:,1) = PRSVS(:,:,:,1) * XECHARGE
+ PRSVS(:,:,:,NSV_ELEC) = - PRSVS(:,:,:,NSV_ELEC) * XECHARGE
+
+ CALL MPPDB_CHECK3DM("flash:: after ION PRSVS",PRECISION,&
+ PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
+ PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
+ ENDIF
+!
+!
+!* 11.2 update the charge density to check if another flash can be triggered
+!
+ ZQMTOT(:,:,:) = 0.
+ DO II = 1, NSV_ELEC
+! transform the source term (C/s) into the updated charge density (C/kg)
+ ZQMT(:,:,:,II) = PRSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:)
+!
+! total charge density (C/kg)
+ ZQMTOT(:,:,:) = ZQMTOT(:,:,:) + PRSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:)
+ END DO
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. CHECK IF ANOTHER FLASH CAN BE TRIGGERED
+! ---------------------------------------
+!
+
+ IF ((MAXVAL(INB_FLASH(:))+1) < INBFTS_MAX) THEN
+ IF (INB_NEUT_OK .NE. 0) THEN
+ CALL MPPDB_CHECK3DM("flash:: PRHODJ,PRT",PRECISION,&
+ PRHODJ,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3),PRT(:,:,:,4),&
+ PRT(:,:,:,5),PRT(:,:,:,6))
+ CALL MPPDB_CHECK3DM("flash:: ZQMT",PRECISION,&
+ ZQMT(:,:,:,1),ZQMT(:,:,:,2),ZQMT(:,:,:,3),ZQMT(:,:,:,4),&
+ ZQMT(:,:,:,5),ZQMT(:,:,:,6),ZQMT(:,:,:,7))
+ CALL TO_ELEC_FIELD_n (PRT, ZQMT, PRHODJ, KTCOUNT, KRR, &
+ PEFIELDU, PEFIELDV, PEFIELDW)
+ CALL MPPDB_CHECK3DM("flash:: PEFIELDU, PEFIELDV, PEFIELDW",PRECISION,&
+ PEFIELDU, PEFIELDV, PEFIELDW)
+! electric field module including pressure effect
+ ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE) = ZPRES_COEF(IIB:IIE,IJB:IJE,IKB:IKE)* &
+ (PEFIELDU(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
+ PEFIELDV(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
+ PEFIELDW(IIB:IIE,IJB:IJE,IKB:IKE)**2)**0.5
+ ENDIF
+!
+ ISEG_LOC(:,:) = 0
+ ZCOORD_TRIG(:,:) = 0.
+ ZCOORD_SEG(:,:) = 0.
+ IPROC_TRIG(:) = 0
+ ISIGNE_EZ(:) = 0
+!
+ CALL TRIG_POINT
+ ELSE
+ GNEW_FLASH_GLOB = .FALSE.
+ END IF
+!
+ ZNEUT_POS(:) = 0.
+ ZNEUT_NEG(:) = 0.
+!
+ IF (LLMA) THEN
+ ZLMA_NEUT_POS(:,:) = 0.
+ ZLMA_NEUT_NEG(:,:) = 0.
+ END IF
+ END DO ! end loop do while
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. COMPUTE THE NOX SOURCE TERM
+! ---------------------------
+!
+ IF (LLNOX_EXPLICIT) THEN
+ IF (IFLASH_COUNT_GLOB .NE. 0) THEN
+ ZCOEF = XMD / XAVOGADRO
+ XLNOX_ECLAIR = 0.
+ IF (IFLASH_COUNT .NE. 0) THEN
+ XLNOX_ECLAIR = SUM(ZLNOX(:,:,:))
+ PSVS_LINOX(:,:,:) = PSVS_LINOX(:,:,:) + ZLNOX(:,:,:) * ZCOEF ! PRHODJ is
+ ! implicit
+ END IF
+ CALL SUM_ELEC_ll (XLNOX_ECLAIR)
+ XLNOX_ECLAIR = XLNOX_ECLAIR / (XAVOGADRO * REAL(IFLASH_COUNT_GLOB))
+ END IF
+ DEALLOCATE (ZLNOX)
+ END IF
+!
+ DEALLOCATE (ZNEUT_POS)
+ DEALLOCATE (ZNEUT_NEG)
+ DEALLOCATE (ZSIGMA)
+ DEALLOCATE (ZLBDAR)
+ DEALLOCATE (ZLBDAS)
+ DEALLOCATE (ZLBDAG)
+ IF (KRR == 7) DEALLOCATE (ZLBDAH)
+ DEALLOCATE (ZSIGLOB)
+ DEALLOCATE (ZDQDT)
+ DEALLOCATE (ZDIST)
+ DEALLOCATE (ZFLASH)
+ DEALLOCATE (ZQFLASH)
+ DEALLOCATE (IPROC_TRIG)
+ DEALLOCATE (ISIGNE_EZ)
+ DEALLOCATE (GNEW_FLASH)
+ DEALLOCATE (INBSEG)
+ DEALLOCATE (INBSEG_ALL)
+ DEALLOCATE (INBSEG_LEADER)
+ DEALLOCATE (INB_FLASH)
+ DEALLOCATE (INB_FL_REAL)
+ DEALLOCATE (ZEM_TRIG)
+ DEALLOCATE (ITYPE)
+ DEALLOCATE (ISEG_LOC)
+ DEALLOCATE (ZCOORD_TRIG)
+ DEALLOCATE (ZCOORD_SEG)
+ DEALLOCATE (ZCOORD_SEG_ALL)
+ DEALLOCATE (ISEG_GLOB)
+ DEALLOCATE (GATTACH)
+ IF(LLMA) THEN
+ DEALLOCATE (ILMA_SEG_ALL)
+ DEALLOCATE (ZLMA_QMT)
+ DEALLOCATE (ZLMA_PRT)
+ DEALLOCATE (ZLMA_NEUT_POS)
+ DEALLOCATE (ZLMA_NEUT_NEG)
+ END IF
+END IF ! (inb_cell .ge. 1)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. PRINT LIGHTNING INFORMATIONS FOR THE LAST TIMESTEP
+! OR LMA_TIME_SAVE IS REACHED IF LLMA OPTION IS USED
+! --------------------------------------------------
+!
+IF (LLMA) THEN
+ IF( IPROC .EQ. 0 .AND. TDTCUR%xtime >= TDTLMA%xtime - PTSTEP ) THEN
+ CALL WRITE_OUT_ASCII
+ CALL WRITE_OUT_LMA
+ ISFLASH_NUMBER(0) = ISFLASH_NUMBER(NNBLIGHT)
+ NNBLIGHT = 0
+ END IF
+END IF
+!
+IF (NNBLIGHT .NE. 0 .AND. ((IPROC .EQ. 0 .AND. OEXIT) .OR. &
+ (KTCOUNT == NSTOP .AND. KMI==1))) THEN
+ CALL WRITE_OUT_ASCII
+ IF(LLMA) CALL WRITE_OUT_LMA
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 14. DEALLOCATE
+! ----------
+!
+DEALLOCATE (ICELL_LOC)
+DEALLOCATE (ZQMT)
+DEALLOCATE (ZQMTOT)
+DEALLOCATE (ZCLOUD)
+DEALLOCATE (ZCELL)
+DEALLOCATE (ZEMODULE)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 14. BACK TO INPUT UNITS (per kg and per (m3 s)) FOR IONS
+! ----------------------------------------------------
+!
+PRSVS(:,:,:,1) = PRSVS(:,:,:,1) / XECHARGE ! 1 /(m3 s)
+PRSVS(:,:,:,NSV_ELEC) = -PRSVS(:,:,:,NSV_ELEC) / XECHARGE ! 1 /(m3 s)
+!
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE TRIG_POINT ()
+!
+! Goal : find randomly a triggering point where E > E_trig
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 declaration of dummy arguments
+!
+!* 0.2 declaration of local variables
+!
+LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),INB_CELL) :: &
+ GTRIG ! mask for the triggering pts
+INTEGER :: INB_TRIG ! Nb of pts where triggering is possible
+INTEGER :: IWEST_GLOB_TRIG ! western global limit of possible triggering
+INTEGER :: IEAST_GLOB_TRIG ! eastern global limit of possible triggering
+INTEGER :: ISOUTH_GLOB_TRIG ! southern global limit of possible triggering
+INTEGER :: INORTH_GLOB_TRIG ! northern global limit of possible triggering
+INTEGER :: IUP_TRIG ! upper limit of possible triggering
+INTEGER :: IDOWN_TRIG ! down limit of possible triggering
+!
+!
+!* 1. INITIALIZATIONS
+! -----------
+!
+GTRIG(:,:,:,:) = .FALSE.
+GNEW_FLASH(:) = .FALSE.
+GNEW_FLASH_GLOB = .FALSE.
+!
+!
+!* 2. FIND THE POSSIBLE TRIGGERING POINTS
+! -----------------------------------
+!
+DO IL = 1, INB_CELL
+ WHERE (ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE) > ZE_TRIG_THRES .AND. &
+ ZCELL(IIB:IIE,IJB:IJE,IKB:IKE,IL) .GT. 0.)
+ GTRIG(IIB:IIE,IJB:IJE,IKB:IKE,IL) = .TRUE.
+ ENDWHERE
+END DO
+!
+!
+!* 3. CHOICE OF THE TRIGGERING POINT
+! ------------------------------
+!
+!* 3.1 number and coordinates of the possible triggering points
+!
+INB_TRIG = 0
+DO IL = 1, INB_CELL
+ INB_TRIG = COUNT(GTRIG(IIB:IIE,IJB:IJE,IKB:IKE,IL))
+ CALL SUM_ELEC_ll(INB_TRIG)
+!
+!
+!* 3.2 random choice of the triggering point
+!
+ IF (INB_TRIG .GT. 0) THEN
+ IFOUND = 0
+!
+! find the global limits where GTRIG = T
+ CALL EXTREMA_ELEC_ll(GTRIG(:,:,:,IL), IWEST_GLOB_TRIG, IEAST_GLOB_TRIG, &
+ ISOUTH_GLOB_TRIG, INORTH_GLOB_TRIG, &
+ IDOWN_TRIG, IUP_TRIG)
+!
+ DO WHILE (IFOUND .NE. 1)
+!
+! random choice of the 3 global ind.
+ CALL MNH_RANDOM_NUMBER(ZRANDOM)
+ II_TRIG_GLOB = IWEST_GLOB_TRIG + &
+ INT(ANINT(ZRANDOM * (IEAST_GLOB_TRIG - IWEST_GLOB_TRIG)))
+ CALL MNH_RANDOM_NUMBER(ZRANDOM)
+ IJ_TRIG_GLOB = ISOUTH_GLOB_TRIG + &
+ INT(ANINT(ZRANDOM * (INORTH_GLOB_TRIG - ISOUTH_GLOB_TRIG)))
+ CALL MNH_RANDOM_NUMBER(ZRANDOM)
+ IK_TRIG = IDOWN_TRIG + INT(ANINT(ZRANDOM * (IUP_TRIG - IDOWN_TRIG)))
+!
+! global ind. --> local ind. of the potential triggering pt
+ II_TRIG_LOC = II_TRIG_GLOB - IXOR + 1
+ IJ_TRIG_LOC = IJ_TRIG_GLOB - IYOR + 1
+!
+! test if the randomly chosen pt meets all conditions for triggering
+ IF ((II_TRIG_LOC .LE. IIE) .AND. (II_TRIG_LOC .GE. IIB) .AND. &
+ (IJ_TRIG_LOC .LE. IJE) .AND. (IJ_TRIG_LOC .GE. IJB) .AND. &
+ (IK_TRIG .LE. IKE) .AND. (IK_TRIG .GE. IKB)) THEN
+ IF (GTRIG(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG,IL)) THEN
+ IFOUND = 1
+!
+! update the local coordinates of the flash segments
+ ISEG_LOC(1,IL) = II_TRIG_LOC
+ ISEG_LOC(2,IL) = IJ_TRIG_LOC
+ ISEG_LOC(3,IL) = IK_TRIG
+!
+ ISEG_GLOB(1,IL) = II_TRIG_GLOB
+ ISEG_GLOB(2,IL) = IJ_TRIG_GLOB
+ ISEG_GLOB(3,IL) = IK_TRIG
+!
+ ZCOORD_TRIG(1,IL) = XXHATM(II_TRIG_LOC)
+ ZCOORD_TRIG(2,IL) = XYHATM(IJ_TRIG_LOC)
+ ZCOORD_TRIG(3,IL) = ZZMASS(II_TRIG_LOC, IJ_TRIG_LOC, IK_TRIG)
+!
+ ZCOORD_SEG(1:3,IL) = ZCOORD_TRIG(1:3,IL)
+!
+! electric field module at the triggering point
+ ZEM_TRIG(IL) = ZEMODULE(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG)
+!
+! sign of Ez at the triggering point
+ ISIGNE_EZ(IL) = 0
+ IF (PEFIELDW(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG) .GT. 0.) THEN
+ ISIGNE_EZ(IL) = 1
+ ELSE IF (PEFIELDW(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG) .LT. 0.) THEN
+ ISIGNE_EZ(IL) = -1
+ END IF
+ END IF
+ END IF
+!
+! broadcast IFOUND and find the proc where IFOUND = 1
+ CALL MAX_ELEC_ll (IFOUND, IPROC_TRIG(IL))
+!
+ END DO
+!
+!
+!
+!* 4. BROADCAST USEFULL PARAMETERS
+! ----------------------------
+!
+ CALL MPI_BCAST (ZEM_TRIG(IL), 1, &
+ MNHREAL_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+ CALL MPI_BCAST (ISEG_LOC(:,IL), 3*SIZE(PRT,3), &
+ MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+ CALL MPI_BCAST (ZCOORD_TRIG(:,IL), 3, &
+ MNHREAL_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+ CALL MPI_BCAST (ISIGNE_EZ(IL), 1, &
+ MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+!
+!
+!* 5. CHECK IF THE FLASH CAN DEVELOP
+! ------------------------------
+!
+ IF (INB_FLASH(IL) < INBFTS_MAX) THEN
+ IF (IPROC.EQ.IPROC_TRIG(IL)) THEN
+ ZCELL(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG,IL) = 0.
+ END IF
+!
+ GNEW_FLASH(IL) = .TRUE.
+ GNEW_FLASH_GLOB = .TRUE.
+ CALL MPI_BCAST (GNEW_FLASH(IL),1, MNHLOG_MPI, IPROC_TRIG(IL), &
+ NMNH_COMM_WORLD, IERR)
+ CALL MPI_BCAST (GNEW_FLASH_GLOB,1, MNHLOG_MPI, IPROC_TRIG(IL), &
+ NMNH_COMM_WORLD, IERR)
+ END IF
+ END IF
+END DO
+!
+!
+END SUBROUTINE TRIG_POINT
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ONE_LEADER ()
+!
+!! Purpose: propagates the bidirectional leader along the vertical
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER :: IKSTEP, IIDECAL
+!
+!* 1. BUILD THE POSITIVE/NEGATIVE LEADER
+! ----------------------------------
+CALL MPPDB_CHECK3DM("flash:: one_leader ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
+!
+IKSTEP = ISIGN_LEADER * ISIGNE_EZ(IL)
+ ! the positive leader propagates parallel to the electric field
+ ! while the negative leader propagates anti// to the electric field
+ISTOP = 0
+!
+!
+IF (IPROC .EQ. IPROC_TRIG(IL)) THEN
+
+ DO WHILE (ZEMOD_BL > XEPROP .AND. IKBL > IKB .AND. &
+ IKBL < IKE .AND. ISTOP .EQ. 0 .AND. &
+ INBSEG(IL) .LE. (NLEADER_MAX-1))
+!
+! local coordinates of the new segment
+ IIBL_LOC = ISEG_LOC(1,IL)
+ IJBL_LOC = ISEG_LOC(2,IL)
+ IKBL = IKBL + IKSTEP
+ IIDECAL = INBSEG(IL) * 3
+!
+ ISEG_LOC(IIDECAL+1,IL) = IIBL_LOC
+ ISEG_LOC(IIDECAL+2,IL) = IJBL_LOC
+ ISEG_LOC(IIDECAL+3,IL) = IKBL
+!
+ ISEG_GLOB(IIDECAL+1,IL) = IIBL_LOC + IXOR - 1
+ ISEG_GLOB(IIDECAL+2,IL) = IJBL_LOC + IYOR - 1
+ ISEG_GLOB(IIDECAL+3,IL) = IKBL
+!
+ ZCOORD_SEG(IIDECAL+1,IL) = XXHATM(IIBL_LOC)
+ ZCOORD_SEG(IIDECAL+2,IL) = XYHATM(IJBL_LOC)
+ ZCOORD_SEG(IIDECAL+3,IL) = ZZMASS(IIBL_LOC, IJBL_LOC, IKBL)
+!
+ INBSEG(IL) = INBSEG(IL) + 1
+!
+!
+!* 1.3 test if Ez keeps the same sign
+!
+ IF (PEFIELDW(IIBL_LOC,IJBL_LOC,IKBL) .EQ. 0. .OR. &
+ INT(ABS(PEFIELDW(IIBL_LOC,IJBL_LOC,IKBL)) / &
+ PEFIELDW(IIBL_LOC,IJBL_LOC,IKBL)) /= ISIGNE_EZ(IL) .OR. &
+ ZCELL(IIBL_LOC,IJBL_LOC,IKBL,IL) .EQ. 0.) THEN
+ ISTOP = 1
+! then this segment is not part of the leader
+ INBSEG(IL) = INBSEG(IL) - 1
+ END IF
+!
+!
+!* 1.4 sign of the induced charge
+!
+ IF (ISTOP .EQ. 0) THEN
+ ZFLASH(IIBL_LOC,IJBL_LOC,IKBL,IL) = 1.
+ ZCELL(IIBL_LOC,IJBL_LOC,IKBL,IL) = 0.
+!
+!
+!* 1.6 electric field module at the tip of the leader
+!
+ ZEMOD_BL = ZEMODULE(IIBL_LOC,IJBL_LOC,IKBL)
+!
+!
+!* 1.7 test if the domain boundaries are reached
+!
+ IF ((IIBL_LOC < IIB .AND. LWEST_ll()) .OR. &
+ (IIBL_LOC > IIE .AND. LEAST_ll()) .OR. &
+ (IJBL_LOC < IJB .AND. LSOUTH_ll()) .OR. &
+ (IJBL_LOC > IJE .AND. LNORTH_ll())) THEN
+ PRINT*,'DOMAIN BOUNDARIES REACHED BY THE LIGHTNING '
+ ISTOP = 1
+ ENDIF
+!
+ IF (IKBL .LE. IKB) THEN
+ PRINT*,'THE LIGHTNING FLASH HAS REACHED THE GROUND '
+ ISTOP = 1
+ GCG = .TRUE.
+ NNB_CG = NNB_CG + 1
+ IF (ISIGN_LEADER > 0) THEN
+ GCG_POS = .TRUE.
+ ITYPE(IL) = 3 ! CGP
+ NNB_CG_POS = NNB_CG_POS + 1
+ ELSE
+ ITYPE(IL) = 2 ! CGN
+ END IF
+ ENDIF
+!
+ IF (IKBL .GE. IKE) THEN
+ PRINT*,'THE LIGHTNING FLASH HAS REACHED THE TOP OF THE DOMAIN '
+ ISTOP = 1
+ ENDIF
+!
+!
+!* 2. TEST IF THE FLASH IS A CG
+! -------------------------
+!
+ IF (.NOT. GCG) THEN
+ IF ( (ZZMASS(IIBL_LOC,IJBL_LOC,IKBL)-PZZ(IIBL_LOC,IJBL_LOC,IKB)) <= &
+ XALT_CG .AND. INBSEG(IL) .GT. 1 .AND. IKSTEP .LT. 0) THEN
+!
+!
+!* 2.1 the channel is prolongated to the ground if
+!* one segment reaches the altitude XALT_CG
+!
+ DO WHILE (IKBL > IKB)
+ IKBL = IKBL - 1
+!
+! local coordinates of the new segment
+ IIDECAL = INBSEG(IL) * 3
+!
+ ISEG_LOC(IIDECAL+1,IL) = IIBL_LOC
+ ISEG_LOC(IIDECAL+2,IL) = IJBL_LOC
+ ISEG_LOC(IIDECAL+3,IL) = IKBL
+!
+ ISEG_GLOB(IIDECAL+1:IIDECAL+2,IL) = ISEG_GLOB(IIDECAL-2:IIDECAL-1,IL)
+ ISEG_GLOB(IIDECAL+3,IL) = IKBL
+!
+ ZCOORD_SEG(IIDECAL+1:IIDECAL+2,IL) = ZCOORD_SEG(IIDECAL-2:IIDECAL-1,IL)
+ ZCOORD_SEG(IIDECAL+3,IL) = ZZMASS(IIBL_LOC, IJBL_LOC, IKBL)
+!
+! Increment number of segments
+ INBSEG(IL) = INBSEG(IL) + 1 ! Nb of segments
+ ZFLASH(IIBL_LOC,IJBL_LOC,IKBL,IL) = 1.
+ ZCELL(IIBL_LOC,IJBL_LOC,IKBL,IL) = 0.
+ END DO
+!
+!
+!* 2.2 update the number of CG flashes
+!
+ GCG = .TRUE.
+ NNB_CG = NNB_CG + 1
+ ISTOP = 1
+!
+ IF (ISIGN_LEADER > 0) THEN
+ GCG_POS = .TRUE.
+ NNB_CG_POS = NNB_CG_POS + 1
+ ITYPE(IL) = 3
+ ELSE
+ ITYPE(IL) = 2
+ END IF
+ END IF
+ END IF
+ END IF ! end if ISTOP=0
+ END DO ! end loop leader
+END IF ! only iproc_trig was working
+!
+!
+!* 3. BROADCAST THE INFORMATIONS TO ALL PROCS
+! ---------------------------------------
+!
+CALL MPI_BCAST (ISEG_LOC(:,IL), 3*SIZE(PRT,3), &
+ MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+CALL MPI_BCAST (ITYPE(IL), 1, &
+ MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+
+CALL MPI_BCAST (GCG, 1, &
+ MNHLOG_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+CALL MPI_BCAST (GCG_POS, 1, &
+ MNHLOG_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+CALL MPI_BCAST (NNB_CG, 1, &
+ MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+CALL MPI_BCAST (NNB_CG_POS, 1, &
+ MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+
+!
+CALL MPPDB_CHECK3DM("flash:: one_leader end ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
+!
+END SUBROUTINE ONE_LEADER
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE CHARGE_POCKET
+!
+!!
+!! Purpose: limit flash propagation into the positive and negative charge layers
+!! located immediatly above and below the triggering point
+!!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZSIGN_AREA,ZSIGN_AREA_NEW
+
+REAL, DIMENSION(INB_CELL) :: ZSIGN ! sign of the charge immediatly below/above the triggering pt
+!
+INTEGER, DIMENSION(INB_CELL) :: IEND ! if 1, no more neighbour pts meeting the conditions
+INTEGER, DIMENSION(INB_CELL) :: COUNT_BEF2
+INTEGER, DIMENSION(INB_CELL) :: COUNT_AFT2
+INTEGER :: IPROC_END
+INTEGER :: IEND_GLOB
+INTEGER :: IIDECAL, IKMIN, IKMAX
+REAL :: ZFACT
+!
+!
+!* 1. SEARCH THE POINTS BELONGING TO THE LAYERS
+! -----------------------------------------
+!
+ZFACT = -1.
+IF(GPOSITIVE) ZFACT = 1.
+
+ZSIGN_AREA(:,:,:) = 0.
+ZSIGN(:) = 0.
+IEND(:) = 0
+IEND_GLOB = 0
+!
+!
+DO IL = 1, INB_CELL
+ IF (.NOT. GNEW_FLASH(IL)) THEN
+ IEND(IL) = 1
+ IEND_GLOB = IEND_GLOB + IEND(IL)
+ END IF
+ IF (GNEW_FLASH(IL) .AND. IPROC .EQ. IPROC_TRIG(IL)) THEN
+ DO II = 1, INBSEG(IL)
+ IIDECAL = 3 * (II - 1)
+ IIBL_LOC = ISEG_LOC(IIDECAL+1,IL)
+ IJBL_LOC = ISEG_LOC(IIDECAL+2,IL)
+ IKBL = ISEG_LOC(IIDECAL+3,IL)
+!
+ IF (ZQMTOT(IIBL_LOC,IJBL_LOC,IKBL) .GT. 0. .AND. GPOSITIVE) THEN
+ ZSIGN_AREA(IIBL_LOC,IJBL_LOC,IKBL) = 1. * REAL(IL)
+ ZSIGN(IL) = ZSIGN_AREA(IIBL_LOC,IJBL_LOC,IKBL)
+ ELSE IF (ZQMTOT(IIBL_LOC,IJBL_LOC,IKBL) .LT. 0. .AND. .NOT.GPOSITIVE) THEN
+ ZSIGN_AREA(IIBL_LOC,IJBL_LOC,IKBL) = -1. * REAL(IL)
+ ZSIGN(IL) = ZSIGN_AREA(IIBL_LOC,IJBL_LOC,IKBL)
+ END IF
+ END DO
+ END IF
+!
+ CALL MPI_BCAST (ZSIGN(IL), 1, MNHREAL_MPI, IPROC_TRIG(IL), &
+ NMNH_COMM_WORLD, IERR)
+END DO
+!
+DO WHILE (IEND_GLOB .NE. INB_CELL)
+ DO IL = 1, INB_CELL
+ CALL ADD3DFIELD_ll ( TZFIELDS_ll, ZSIGN_AREA, 'FLASH_GEOM_ELEC_n::ZSIGN_AREA' )
+ CALL UPDATE_HALO_ll ( TZFIELDS_ll, IINFO_ll)
+ CALL CLEANLIST_ll ( TZFIELDS_ll)
+!
+ IF (GNEW_FLASH(IL) .AND. (IEND(IL) .NE. 1)) THEN
+ COUNT_BEF2(IL) = COUNT(ZSIGN_AREA(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. ZSIGN(IL))
+ CALL SUM_ELEC_ll (COUNT_BEF2(IL))
+!
+ IF (ISIGNE_EZ(IL).EQ.1) THEN
+ IF (GPOSITIVE) THEN
+ IKMIN = IKB
+ IKMAX = ISEG_LOC(3, IL)
+ ELSE
+ IKMIN = ISEG_LOC(3, IL)
+ IKMAX = IKE
+ ENDIF
+ ENDIF
+!
+ IF (ISIGNE_EZ(IL).EQ.-1) THEN
+ IF (GPOSITIVE) THEN
+ IKMIN = ISEG_LOC(3, IL)
+ IKMAX = IKE
+ ELSE
+ IKMIN = IKB
+ IKMAX = ISEG_LOC(3, IL)
+ ENDIF
+ ENDIF
+!
+ ZSIGN_AREA_NEW(:,:,IKMIN:IKMAX) = ZSIGN_AREA (:,:,IKMIN:IKMAX)
+ DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKMIN, IKMAX
+ IF ((ZSIGN_AREA(II, IJ, IK) .EQ. 0.) .AND. &
+ (ZCELL(II,IJ,IK,IL) .EQ. 1.) .AND. &
+ (.NOT. GPROP(II,IJ,IK,IL)) .AND. &
+ (ZQMTOT(II,IJ,IK)*ZFACT .GT. 0.) .AND. &
+ (ABS(ZQMTOT(II,IJ,IK) * &
+ PRHODREF(II,IJ,IK)) .GT. XQNEUT)) THEN
+!
+ IF ((ZSIGN_AREA(II-1,IJ, IK) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ, IK) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II, IJ-1,IK) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II, IJ+1,IK) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II-1,IJ-1,IK) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II-1,IJ+1,IK) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ+1,IK) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ-1,IK) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II, IJ, IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II-1,IJ, IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ, IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II, IJ-1,IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II, IJ+1,IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II-1,IJ-1,IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II-1,IJ+1,IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ+1,IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ-1,IK+1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II, IJ, IK-1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II-1,IJ, IK-1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ, IK-1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II, IJ-1,IK-1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II, IJ+1,IK-1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II-1,IJ-1,IK-1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II-1,IJ+1,IK-1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ+1,IK-1) .EQ. ZSIGN(IL)) .OR. &
+ (ZSIGN_AREA(II+1,IJ-1,IK-1) .EQ. ZSIGN(IL))) THEN
+ ZSIGN_AREA_NEW(II,IJ,IK) = ZSIGN(IL)
+ GPROP(II,IJ,IK,IL) = .TRUE.
+ END IF
+ END IF
+ END DO
+ END DO
+ END DO
+ ZSIGN_AREA (:,:,IKMIN:IKMAX) = ZSIGN_AREA_NEW(:,:,IKMIN:IKMAX)
+!
+ COUNT_AFT2(IL) = COUNT(ZSIGN_AREA(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. ZSIGN(IL))
+ CALL SUM_ELEC_ll(COUNT_AFT2(IL))
+!
+ IF (COUNT_BEF2(IL) .EQ. COUNT_AFT2(IL)) THEN
+ IEND(IL) = 1
+ ELSE
+ IEND(IL) = 0
+ END IF
+! broadcast IEND and find the proc where IEND = 1
+ CALL MAX_ELEC_ll (IEND(IL), IPROC_END)
+ IEND_GLOB = IEND_GLOB + IEND(IL)
+ END IF
+ END DO
+END DO ! end do while
+!
+END SUBROUTINE CHARGE_POCKET
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE BRANCH_GEOM (IKMIN, IKMAX)
+!
+! Goal : find randomly flash branch points
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_precision, only: MNHINT64, MNHINT64_MPI
+
+IMPLICIT NONE
+!
+!* 0.1 declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: IKMIN, IKMAX
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IIDECALB
+INTEGER :: IPLOOP ! loop index for the proc number
+INTEGER :: IMIN, IMAX
+INTEGER :: IAUX
+INTEGER :: INB_SEG_BEF ! nb of segments before branching
+INTEGER :: INB_SEG_AFT ! nb of segments after branching
+INTEGER :: INB_SEG_TO_BRANCH ! = NBRANCH_MAX-INB_SEG_BEF
+LOGICAL :: GRANDOM ! T = the gridpoints are chosen randomly
+INTEGER, DIMENSION(NPROC) :: INBPT_PROC
+REAL, DIMENSION(:), ALLOCATABLE :: ZAUX
+!
+INTEGER :: JI,JJ,JK,JIL , ICHOICE,IPOINT
+INTEGER, DIMENSION(NPROC+1) :: IDISPL
+INTEGER(kind=MNHINT64), DIMENSION(:), ALLOCATABLE :: I8VECT , I8VECT_LL
+INTEGER, DIMENSION(:), ALLOCATABLE :: IRANK , IRANK_LL , IORDER_LL
+!
+!
+!
+!* 1. ON EACH PROC, COUNT THE NUMBER OF POINTS AT DISTANCE D
+!* THAT CAN RECEIVE A BRANCH
+! ------------------------------------------------------
+CALL MPPDB_CHECK3DM("flash:: branch ZFLASH,IMASKQ_DIST",PRECISION,&
+ ZFLASH(:,:,:,IL),IMASKQ_DIST*1.0)
+!
+IM = 1
+ISTOP = 0
+INB_SEG_BEF = COUNT(ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) .NE. 0.)
+CALL SUM_ELEC_ll(INB_SEG_BEF)
+!
+INB_SEG_TO_BRANCH = NBRANCH_MAX - INB_SEG_BEF
+!
+DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
+! number of points that can receive a branch in each proc
+ IPT_DIST = COUNT(IMASKQ_DIST(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. IM)
+! global number of points that can receive a branch
+ IPT_DIST_GLOB = IPT_DIST
+ CALL SUM_ELEC_ll (IPT_DIST_GLOB)
+!
+ IF (IPT_DIST_GLOB .LE. INB_SEG_TO_BRANCH) THEN
+ IF (IPT_DIST_GLOB .LE. IMAX_BRANCH(IM)) THEN
+ GRANDOM = .FALSE.
+ ELSE
+ GRANDOM = .TRUE.
+ END IF
+ ELSE
+ GRANDOM = .TRUE.
+ END IF
+!
+!
+!* 2. DISTRIBUTE THE BRANCHES
+! -----------------------
+!
+ IF (IPT_DIST_GLOB .GT. 0 .AND. INB_SEG_TO_BRANCH .NE. 0) THEN
+ IF (.NOT. GRANDOM) THEN
+ INB_SEG_TO_BRANCH = INB_SEG_TO_BRANCH - IPT_DIST_GLOB
+!
+!* 2.1 all points are selected
+!
+ IF(IPT_DIST .GT. 0) THEN
+ WHERE (IMASKQ_DIST(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. IM)
+ ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) = 2.
+ ZCELL(IIB:IIE,IJB:IJE,IKB:IKE,IL) = 0.
+ END WHERE
+ END IF
+ ELSE
+!
+!* 2.2 the gridpoints are chosen randomly
+!
+ IF (IMAX_BRANCH(IM) .GT. 0) THEN
+ INBPT_PROC(:) = 0
+ CALL MPI_ALLGATHER(IPT_DIST, 1, MNHINT_MPI, &
+ INBPT_PROC, 1, MNHINT_MPI, NMNH_COMM_WORLD, IERR)
+!
+ IDISPL(1) = 0
+ DO JI=2, NPROC+1
+ IDISPL(JI) = IDISPL(JI-1)+INBPT_PROC(JI-1)
+ ENDDO
+!
+ ALLOCATE (I8VECT(IPT_DIST))
+ ALLOCATE (IRANK(IPT_DIST))
+ IF (IPT_DIST .GT. 0) THEN
+ JIL=0
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (IMASKQ_DIST(JI,JJ,JK) .EQ. IM) THEN
+ JIL = JIL + 1
+ I8VECT(JIL) = IJU_ll*IIU_ll*(JK-1) + IIU_ll*(JJ-1 +IYOR-1) + (JI +IXOR-1)
+ !print*,"IN => I8VECT(JIL )=",I8VECT(JIL),JI,JJ,JK,JIL
+ END IF
+ END DO
+ END DO
+ END DO
+ !
+ IRANK(:) = IPROC
+ END IF
+!
+ ALLOCATE(I8VECT_LL(IPT_DIST_GLOB))
+ ALLOCATE(IRANK_LL(IPT_DIST_GLOB))
+ ALLOCATE(IORDER_LL(IPT_DIST_GLOB))
+ CALL MPI_ALLGATHERV(I8VECT,IPT_DIST, MNHINT64_MPI,I8VECT_LL , &
+ INBPT_PROC, IDISPL, MNHINT64_MPI, NMNH_COMM_WORLD, IERR)
+ CALL MPI_ALLGATHERV(IRANK,IPT_DIST, MNHINT_MPI,IRANK_LL , &
+ INBPT_PROC, IDISPL, MNHINT_MPI, NMNH_COMM_WORLD, IERR)
+ CALL N8QUICK_SORT(I8VECT_LL, IORDER_LL)
+!
+ DO IPOINT = 1, MIN(IMAX_BRANCH(IM), INB_SEG_TO_BRANCH)
+ IFOUND = 0
+ DO WHILE (IFOUND .NE. 1)
+ ! randomly chose points in zvect
+ CALL MNH_RANDOM_NUMBER(ZRANDOM)
+ ICHOICE = INT(ANINT(ZRANDOM * IPT_DIST_GLOB))
+ IF (ICHOICE .EQ. 0) ICHOICE = 1
+ IF (I8VECT_LL(ICHOICE) .NE. 0 ) THEN
+ IFOUND = 1
+ ! The points is in this processors , get is coord and set it
+ IF (IRANK_LL(IORDER_LL(ICHOICE)) .EQ. IPROC) THEN
+ JK = 1 + (I8VECT_LL(ICHOICE)-1) / ( IJU_ll*IIU_ll )
+ JJ = 1 + ( (I8VECT_LL(ICHOICE)-1) - IJU_ll*IIU_ll*(JK-1) ) / IIU_ll - IYOR +1
+ JI = 1 + MOD((I8VECT_LL(ICHOICE)-1) , int(IIU_ll,kind(I8VECT_LL(1)))) - IXOR +1
+ !print*,"OUT => I8VECT_LL(ICHOICE)=",I8VECT_ll(ICHOICE),JI,JJ,JK,ICHOICE
+ ZFLASH(JI,JJ,JK,IL) = 2.
+ END IF
+ I8VECT_LL(ICHOICE) = 0
+ ENDIF
+ END DO
+ END DO
+!
+ INB_SEG_TO_BRANCH = INB_SEG_TO_BRANCH - MIN(IMAX_BRANCH(IM), INB_SEG_TO_BRANCH)
+!
+ DEALLOCATE(I8VECT,I8VECT_LL,IRANK,IRANK_LL,IORDER_LL)
+ CALL MPPDB_CHECK3DM("flash:: branch IPT_DIST ZFLASH",PRECISION,&
+ ZFLASH(:,:,:,IL))
+ END IF
+ END IF !IPT_DIST .LE. IMAX_BRANCH(IM)
+ ELSE
+! if no pt available at r, then no branching possible at r+dr !
+ ISTOP = 1
+ END IF ! end if ipt_dist > 0
+!
+! next distance
+ CALL MPPDB_CHECK3DM("flash:: branch IM+1 ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
+ IM = IM + 1
+END DO ! end loop / do while / radius IM
+!
+INB_SEG_AFT = COUNT (ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) .NE. 0.)
+CALL SUM_ELEC_ll(INB_SEG_AFT)
+!
+IF (INB_SEG_AFT .GT. INB_SEG_BEF) THEN
+ DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKB, IKE
+ IF (ZFLASH(II,IJ,IK,IL) .EQ. 2.) THEN
+ IIDECALB = INBSEG(IL) * 3
+!
+ ISEG_GLOB(IIDECALB+1,IL) = II + IXOR - 1
+ ISEG_GLOB(IIDECALB+2,IL) = IJ + IYOR - 1
+ ISEG_GLOB(IIDECALB+3,IL) = IK
+!
+ ZCOORD_SEG(IIDECALB+1,IL) = XXHATM(II)
+ ZCOORD_SEG(IIDECALB+2,IL) = XYHATM(IJ)
+ ZCOORD_SEG(IIDECALB+3,IL) = ZZMASS(II,IJ,IK)
+ INBSEG(IL) = INBSEG(IL) + 1
+ END IF
+ END DO
+ END DO
+ END DO
+END IF
+!
+CALL MPPDB_CHECK3DM("flash:: end branch ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
+!
+END SUBROUTINE BRANCH_GEOM
+!
+!--------------------------------------------------------------------------------
+!
+ SUBROUTINE GATHER_ALL_BRANCH
+!
+!!
+!! Purpose:
+!!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER :: INSEGPROC, INSEGCELL ! number of segments in the process,
+ ! and number of segments in the cell
+INTEGER :: ISAVEDECAL
+INTEGER :: INSEGTRIG, IPROCTRIG
+REAL, DIMENSION(:), ALLOCATABLE :: ZLMAQMT, ZLMAPRT, ZLMAPOS, ZLMANEG
+REAL, DIMENSION(:), ALLOCATABLE :: ZSEND, ZRECV
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISEND, IRECV
+INTEGER, DIMENSION(NPROC) :: IDECAL, IDECAL3, IDECALN
+INTEGER, DIMENSION(NPROC) :: INBSEG_PROC_X3, INBSEG_PROC_XNSV
+!
+!
+IPROCTRIG = IPROC_TRIG(IL)
+INSEGCELL = INBSEG_ALL(IL)
+INSEGPROC = INBSEG_PROC(IPROC+1)
+INSEGTRIG = INBSEG_PROC(IPROCTRIG+1)
+!
+IDECAL(1) = INSEGTRIG
+DO IK = 2, NPROC
+ IDECAL(IK) = IDECAL(IK-1) + INBSEG_PROC(IK-1)
+END DO
+!
+IF(IPROCTRIG .EQ. 0) ISAVEDECAL = IDECAL(IPROCTRIG+1)
+!
+IDECAL(IPROCTRIG+1) = 0
+DO IK = IPROCTRIG+2, NPROC
+ IF(IPROCTRIG .EQ. 0) THEN
+ IDECAL(IK) = IDECAL(IK) - ISAVEDECAL
+ ELSE
+ IDECAL(IK) = IDECAL(IK) - IDECAL(1)
+ END IF
+END DO
+!
+IDECAL3(:) = 3 * IDECAL(:)
+!
+!
+!* 1. BRANCH COORDINATES
+!
+ALLOCATE (ZRECV(INSEGCELL*3))
+ALLOCATE (ZSEND(INSEGPROC*3))
+!
+IF (INSEGPROC .NE. 0) THEN
+ ZSEND(1:3*INSEGPROC) = ZCOORD_SEG(1:3*INSEGPROC,IL)
+END IF
+!
+IF (IPROC .EQ. 0) THEN
+ INBSEG_PROC_X3(:) = 3 * INBSEG_PROC(:)
+END IF
+!
+CALL MPI_GATHERV (ZSEND, 3*INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC_X3, &
+ IDECAL3, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
+!
+IF (IPROC .EQ. 0) THEN
+ ZCOORD_SEG_ALL(1:3*INSEGCELL,IL) = ZRECV(1:3*INSEGCELL)
+END IF
+!
+DEALLOCATE (ZRECV)
+DEALLOCATE (ZSEND)
+!
+!
+!* 2. FOR LMA-LIKE RESULTS: Charge, mixing ratio,
+!* neutralized positive/negative charge
+!* and grid index
+!
+IF (LLMA) THEN
+ ALLOCATE (ISEND(3*INSEGPROC))
+ ALLOCATE (ZLMAQMT(INSEGPROC*NSV_ELEC))
+ ALLOCATE (ZLMAPRT(INSEGPROC*NSV_ELEC))
+ ALLOCATE (ZLMAPOS(INSEGPROC))
+ ALLOCATE (ZLMANEG(INSEGPROC))
+!
+ ISEND (:) = 0
+ ZLMAPOS(:) = 0.
+ ZLMANEG(:) = 0.
+ ZLMAQMT(:) = 0.
+ ZLMAPRT(:) = 0.
+!
+ IF (INSEGPROC .NE. 0) THEN
+ DO II = 1, INSEGPROC
+ IM = 3 * (II - 1)
+ IX = ISEG_GLOB(IM+1,IL) - IXOR + 1
+ IY = ISEG_GLOB(IM+2,IL) - IYOR + 1
+ IZ = ISEG_GLOB(IM+3,IL)
+!
+ IM = NSV_ELEC * (II - 1)
+ IF (IX .LE. IIE .AND. IX .GE. IIB .AND. &
+ IY .LE. IJE .AND. IY .GE. IJB) THEN
+ ZLMAQMT(IM+2:IM+6) = ZQMT(IX,IY,IZ,2:6)
+ ZLMAPRT(IM+2:IM+6) = PRT(IX,IY,IZ,2:6)
+ DO IJ = 1, NSV_ELEC
+ IF (ZDQDT(IX,IY,IZ,IJ) .GT. 0.) THEN
+ ZLMAPOS(II) = ZLMAPOS(II) + &
+ ZDQDT(IX,IY,IZ,IJ) * PRHODJ(IX,IY,IZ)
+ ELSE IF (ZDQDT(IX,IY,IZ,IJ) .LT. 0.) THEN
+ ZLMANEG(II) = ZLMANEG(II) + &
+ ZDQDT(IX,IY,IZ,IJ) * PRHODJ(IX,IY,IZ)
+ END IF
+ END DO
+ END IF
+ END DO
+!
+ ISEND(1:3*INSEGPROC) = ISEG_GLOB(1:3*INSEGPROC, IL)
+ END IF
+!
+! Grid Indexes
+!
+ ALLOCATE (IRECV(3*INSEGCELL))
+!
+ CALL MPI_GATHERV (ISEND, 3*INSEGPROC, MNHINT_MPI, IRECV, INBSEG_PROC_X3, &
+ IDECAL3, MNHINT_MPI, 0, NMNH_COMM_WORLD, IERR)
+!
+ IF (IPROC .EQ. 0) THEN
+ ILMA_SEG_ALL(1:3*INSEGCELL,IL) = IRECV(1:3*INSEGCELL)
+ END IF
+!
+ DEALLOCATE (IRECV)
+ DEALLOCATE (ISEND)
+!
+! Neutralized charge at grid points
+!
+ ALLOCATE (ZRECV(INSEGCELL))
+!
+ CALL MPI_GATHERV (ZLMAPOS, INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC, &
+ IDECAL, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
+!
+ IF (IPROC .EQ. 0) THEN
+ ZLMA_NEUT_POS(1:INSEGCELL,IL) = ZRECV(1:INSEGCELL)
+ END IF
+!
+ CALL MPI_GATHERV (ZLMANEG, INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC, &
+ IDECAL, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
+!
+ IF (IPROC .EQ. 0) THEN
+ ZLMA_NEUT_NEG(1:INSEGCELL,IL) = ZRECV(1:INSEGCELL)
+ END IF
+!
+ DEALLOCATE (ZLMAPOS)
+ DEALLOCATE (ZLMANEG)
+ DEALLOCATE (ZRECV)
+!
+! Charge and mixing ratios at neutralized points
+!
+ ALLOCATE (ZRECV(NSV_ELEC*INSEGCELL))
+!
+ IDECALN(:) = IDECAL(:) * NSV_ELEC
+!
+ IF (IPROC .EQ. 0) THEN
+ INBSEG_PROC_XNSV(:) = NSV_ELEC * INBSEG_PROC(:)
+ END IF
+!
+ CALL MPI_GATHERV (ZLMAQMT, NSV_ELEC*INSEGPROC, MNHREAL_MPI, ZRECV, &
+ INBSEG_PROC_XNSV, &
+ IDECALN, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR )
+!
+ IF (IPROC .EQ. 0) THEN
+ ZLMA_QMT(1:NSV_ELEC*INSEGCELL,IL) = ZRECV(1:NSV_ELEC*INSEGCELL)
+ END IF
+!
+ CALL MPI_GATHERV (ZLMAPRT, NSV_ELEC*INSEGPROC, MNHREAL_MPI, ZRECV, &
+ INBSEG_PROC_XNSV, &
+ IDECALN, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR )
+!
+ IF (IPROC .EQ. 0) THEN
+ ZLMA_PRT(1:NSV_ELEC*INSEGCELL,IL) = ZRECV(1:NSV_ELEC*INSEGCELL)
+ END IF
+!
+ DEALLOCATE (ZLMAQMT)
+ DEALLOCATE (ZLMAPRT)
+ DEALLOCATE (ZRECV)
+!
+END IF
+!
+END SUBROUTINE GATHER_ALL_BRANCH
+!
+!--------------------------------------------------------------------------------
+!
+ SUBROUTINE PT_DISCHARGE
+!
+!!
+!! Purpose:
+!!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+WHERE (ABS(PEFIELDW(:,:,IKB)) > XECORONA .AND. PEFIELDW(:,:,IKB) > 0.)
+ PRSVS(:,:,IKB,1) = PRSVS(:,:,IKB,1) + &
+ XFCORONA * PEFIELDW(:,:,IKB) * (ABS(PEFIELDW(:,:,IKB)) - &
+ XECORONA)**2 / (PZZ(:,:,IKB+1) - PZZ(:,:,IKB))
+ENDWHERE
+!
+WHERE (ABS(PEFIELDW(:,:,IKB)) > XECORONA .AND. PEFIELDW(:,:,IKB) < 0.)
+ PRSVS(:,:,IKB,NSV_ELEC) = PRSVS(:,:,IKB,NSV_ELEC) + &
+ XFCORONA * PEFIELDW(:,:,IKB) * (ABS(PEFIELDW(:,:,IKB)) - &
+ XECORONA)**2 / (PZZ(:,:,IKB+1) - PZZ(:,:,IKB))
+ENDWHERE
+!
+END SUBROUTINE PT_DISCHARGE
+!
+!----------------------------------------------------------------------------------
+!
+ SUBROUTINE WRITE_OUT_ASCII
+!
+!!
+!! Purpose:
+!!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER :: I1, I2
+INTEGER :: ILU ! unit number for IO
+!
+!
+!* 1. FLASH PARAMETERS
+! ----------------
+!
+ILU = TPFILE_FGEOM_DIAG%NLU
+!
+! Ecriture ascii dans CEXP//'_fgeom_diag.asc" defini dans RESOLVED_ELEC
+!
+IF (LCARTESIAN) THEN
+ DO I1 = 1, NNBLIGHT
+ WRITE (UNIT=ILU,FMT='(I8,F9.1,I4,I6,I4,I6,F9.3,F12.3,F12.3,F9.3,F8.2,F9.2,f9.4)') &
+ ISFLASH_NUMBER(I1), &
+ ISTCOUNT_NUMBER(I1) * PTSTEP, &
+ ISCELL_NUMBER(I1), &
+ ISNB_FLASH(I1), &
+ ISTYPE(I1), &
+ ISNBSEG(I1), &
+ ZSEM_TRIG(I1), &
+ ZSCOORD_SEG(I1,1,1)*1.E-3, &
+ ZSCOORD_SEG(I1,1,2)*1.E-3, &
+ ZSCOORD_SEG(I1,1,3)*1.E-3, &
+ ZSNEUT_POS(I1), &
+ ZSNEUT_NEG(I1), ZSNEUT_POS(I1)+ZSNEUT_NEG(I1)
+ END DO
+ELSE
+ DO I1 = 1, NNBLIGHT
+! compute latitude and longitude of the triggering point
+ CALL SM_LATLON(XLATORI,XLONORI,ZSCOORD_SEG(I1,1,1),&
+ ZSCOORD_SEG(I1,1,2),&
+ ZLAT,ZLON)
+!
+ WRITE (UNIT=ILU,FMT='(I8,F9.1,I4,I6,I4,I6,F9.3,F12.3,F12.3,F9.3,F8.2,F9.2,f9.4)') &
+ ISFLASH_NUMBER(I1), &
+ ISTCOUNT_NUMBER(I1) * PTSTEP, &
+ ISCELL_NUMBER(I1), &
+ ISNB_FLASH(I1), &
+ ISTYPE(I1), &
+ ISNBSEG(I1), &
+ ZSEM_TRIG(I1), &
+ ZLAT, &
+ ZLON, &
+ ZSCOORD_SEG(I1,1,3)*1.E-3, &
+ ZSNEUT_POS(I1), &
+ ZSNEUT_NEG(I1), ZSNEUT_POS(I1)+ZSNEUT_NEG(I1)
+ END DO
+END IF
+!
+FLUSH(UNIT=ILU)
+!
+!
+!* 2. FLASH SEGMENT COORDINATES
+! -------------------------
+!
+IF (LSAVE_COORD) THEN
+!
+! Ecriture ascii dans CEXP//'_fgeom_coord.asc" defini dans RESOLVED_ELEC
+!
+ ILU = TPFILE_FGEOM_COORD%NLU
+!
+ DO I1 = 1, NNBLIGHT
+ DO I2 = 1, ISNBSEG(I1)
+ WRITE (ILU, FMT='(I4,F9.1,I4,F12.3,F12.3,F12.3)') &
+ ISFLASH_NUMBER(I1), &
+ ISTCOUNT_NUMBER(I1) * PTSTEP, &
+ ISTYPE(I1), &
+ ZSCOORD_SEG(I1,I2,1)*1.E-3, &
+ ZSCOORD_SEG(I1,I2,2)*1.E-3, &
+ ZSCOORD_SEG(I1,I2,3)*1.E-3
+ END DO
+ END DO
+!
+ FLUSH(UNIT=ILU)
+END IF
+!
+END SUBROUTINE WRITE_OUT_ASCII
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE WRITE_OUT_LMA
+!
+!!
+!! Purpose:
+!!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER :: I1, I2
+INTEGER :: ILU ! unit number for IO
+!
+!
+!* 1. LMA SIMULATOR
+! -------------
+!
+CALL SM_LATLON(XLATORI,XLONORI,ZSCOORD_SEG(:,:,1),ZSCOORD_SEG(:,:,2), &
+ ZLMA_LAT(:,:),ZLMA_LON(:,:))
+!
+ILU = TPFILE_LMA%NLU
+!
+DO I1 = 1, NNBLIGHT
+ DO I2 = 1, ISNBSEG(I1)
+ WRITE (UNIT=ILU,FMT='(I6,F12.1,I6,2(F15.6),3(F15.3),3(I6),12(E15.4))') &
+ ISFLASH_NUMBER(I1), &
+ ISTCOUNT_NUMBER(I1) * PTSTEP, &
+ ISTYPE(I1), &
+ ZLMA_LAT(I1,I2), &
+ ZLMA_LON(I1,I2), &
+ ZSCOORD_SEG(I1,I2,1)*1.E-3, &
+ ZSCOORD_SEG(I1,I2,2)*1.E-3, &
+ ZSCOORD_SEG(I1,I2,3)*1.E-3, &
+ ISLMA_SEG_GLOB(I1,I2,1), &
+ ISLMA_SEG_GLOB(I1,I2,2), &
+ ISLMA_SEG_GLOB(I1,I2,3), &
+ ZSLMA_PRT(I1,I2,2), &
+ ZSLMA_PRT(I1,I2,3), &
+ ZSLMA_PRT(I1,I2,4), &
+ ZSLMA_PRT(I1,I2,5), &
+ ZSLMA_PRT(I1,I2,6), &
+ ZSLMA_QMT(I1,I2,2), &
+ ZSLMA_QMT(I1,I2,3), &
+ ZSLMA_QMT(I1,I2,4), &
+ ZSLMA_QMT(I1,I2,5), &
+ ZSLMA_QMT(I1,I2,6), &
+ ZSLMA_NEUT_POS(I1,I2), &
+ ZSLMA_NEUT_NEG(I1,I2)
+ END DO
+END DO
+!
+FLUSH(UNIT=ILU)
+!
+END SUBROUTINE WRITE_OUT_LMA
+!
+!-------------------------------------------------------------------------------
+!
+RECURSIVE SUBROUTINE N8QUICK_SORT(PLIST, KORDER)
+
+! Quick sort routine from:
+! Brainerd, W.S., Goldberg, C.H. & Adams, J.C. (1990) "Programmer's Guide to
+! Fortran 90", McGraw-Hill ISBN 0-07-000248-7, pages 149-150.
+! Modified by Alan Miller to include an associated integer array which gives
+! the positions of the elements in the original order.
+!
+use modd_precision, only: MNHINT64
+
+IMPLICIT NONE
+!
+INTEGER(kind=MNHINT64), DIMENSION (:), INTENT(INOUT) :: PLIST
+INTEGER, DIMENSION (:), INTENT(OUT) :: KORDER
+!
+! Local variable
+INTEGER :: JI
+
+DO JI = 1, SIZE(PLIST)
+ KORDER(JI) = JI
+END DO
+
+CALL N8QUICK_SORT_1(1, SIZE(PLIST), PLIST, KORDER)
+
+END SUBROUTINE N8QUICK_SORT
+!
+!-------------------------------------------------------------------------------
+!
+RECURSIVE SUBROUTINE N8QUICK_SORT_1(KLEFT_END, KRIGHT_END, PLIST1, KORDER1)
+
+use modd_precision, only: MNHINT64
+
+implicit none
+
+INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
+INTEGER(kind=MNHINT64), DIMENSION (:), INTENT(INOUT) :: PLIST1
+INTEGER, DIMENSION (:), INTENT(INOUT) :: KORDER1
+! Local variables
+INTEGER, PARAMETER :: IMAX_SIMPLE_SORT_SIZE = 6
+
+INTEGER :: JI, JJ, ITEMP
+INTEGER(kind=MNHINT64) :: ZREF, ZTEMP
+
+IF (KRIGHT_END < KLEFT_END + IMAX_SIMPLE_SORT_SIZE) THEN
+ ! Use interchange sort for small PLISTs
+ CALL N8INTERCHANGE_SORT(KLEFT_END, KRIGHT_END, PLIST1, KORDER1)
+ !
+ELSE
+ !
+ ! Use partition ("quick") sort
+ ! valeur au centre du tableau
+ ZREF = PLIST1((KLEFT_END + KRIGHT_END)/2)
+ JI = KLEFT_END - 1
+ JJ = KRIGHT_END + 1
+
+ DO
+ ! Scan PLIST from left end until element >= ZREF is found
+ DO
+ JI = JI + 1
+ IF (PLIST1(JI) >= ZREF) EXIT
+ END DO
+ ! Scan PLIST from right end until element <= ZREF is found
+ DO
+ JJ = JJ - 1
+ IF (PLIST1(JJ) <= ZREF) EXIT
+ END DO
+
+
+ IF (JI < JJ) THEN
+ ! Swap two out-of-order elements
+ ZTEMP = PLIST1(JI)
+ PLIST1(JI) = PLIST1(JJ)
+ PLIST1(JJ) = ZTEMP
+ ITEMP = KORDER1(JI)
+ KORDER1(JI) = KORDER1(JJ)
+ KORDER1(JJ) = ITEMP
+ ELSE IF (JI == JJ) THEN
+ JI = JI + 1
+ EXIT
+ ELSE
+ EXIT
+ END IF
+ END DO
+
+ IF ( KLEFT_END < JJ ) CALL N8QUICK_SORT_1( KLEFT_END, JJ, PLIST1, KORDER1 )
+ IF ( JI < KRIGHT_END ) CALL N8QUICK_SORT_1( JI, KRIGHT_END, PLIST1, KORDER1 )
+END IF
+
+END SUBROUTINE N8QUICK_SORT_1
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE N8INTERCHANGE_SORT(KLEFT_END, KRIGHT_END, PLIST2, KORDER2)
+
+use modd_precision, only: MNHINT64
+
+implicit none
+
+INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
+INTEGER(kind=MNHINT64), DIMENSION(:), INTENT(INOUT) :: PLIST2
+INTEGER, DIMENSION(:), INTENT(INOUT) :: KORDER2
+! Local variables
+INTEGER :: JI, JJ, ITEMP
+INTEGER(kind=MNHINT64) :: ZTEMP
+
+! boucle sur tous les points
+DO JI = KLEFT_END, KRIGHT_END - 1
+ !
+ ! boucle sur les points suivants le point JI
+ DO JJ = JI+1, KRIGHT_END
+ !
+ ! si la distance de JI au point est plus grande que celle de JJ
+ IF (PLIST2(JI) > PLIST2(JJ)) THEN
+ ! distance de JI au point (la plus grande)
+ ZTEMP = PLIST2(JI)
+ ! le point JJ est déplacé à l'indice JI dans le tableau
+ PLIST2(JI) = PLIST2(JJ)
+ ! le point JI est déplacé à l'indice JJ dans le tableau
+ PLIST2(JJ) = ZTEMP
+ ! indice du point JI dans le tableau
+ ITEMP = KORDER2(JI)
+ ! l'indice du point JJ est mis à la place JI
+ KORDER2(JI) = KORDER2(JJ)
+ ! l'indice du point JI est mis à la place JJ
+ KORDER2(JJ) = ITEMP
+ END IF
+ !
+ END DO
+ !
+END DO
+
+END SUBROUTINE N8INTERCHANGE_SORT
+!-------------------------------------------------------------------------------
+ SUBROUTINE MNH_RANDOM_NUMBER(ZRANDOM)
+
+ use modd_precision, only: MNHINT32
+
+ REAL, INTENT(OUT) :: ZRANDOM
+ INTEGER(kind=MNHINT32), SAVE :: NSEED_MNH = 26032012_MNHINT32
+
+ ZRANDOM = real( r8_uniform_01( NSEED_MNH ), kind(ZRANDOM) )
+
+ END SUBROUTINE MNH_RANDOM_NUMBER
+
+!------------------------------------------------------------------------------------------
+
+ FUNCTION r8_uniform_01 ( seed )
+
+ !*****************************************************************************80
+ !
+ !! R8_UNIFORM_01 returns a unit pseudorandom R8.
+ !
+ ! Discussion:
+ !
+ ! An R8 is a real ( kind = 8 ) value.
+ !
+ ! For now, the input quantity SEED is an integer variable.
+ !
+ ! This routine implements the recursion
+ !
+ ! seed = ( 16807 * seed ) mod ( 2^31 - 1 )
+ ! r8_uniform_01 = seed / ( 2^31 - 1 )
+ !
+ ! The integer arithmetic never requires more than 32 bits,
+ ! including a sign bit.
+ !
+ ! If the initial seed is 12345, then the first three computations are
+ !
+ ! Input Output R8_UNIFORM_01
+ ! SEED SEED
+ !
+ ! 12345 207482415 0.096616
+ ! 207482415 1790989824 0.833995
+ ! 1790989824 2035175616 0.947702
+ !
+ ! Licensing:
+ !
+ ! This code is distributed under the GNU LGPL license.
+ ! Souce here : https://people.sc.fsu.edu/~jburkardt/f_src/uniform/uniform.f90
+ !
+ ! Modified:
+ !
+ ! 31 May 2007
+ !
+ ! Author:
+ !
+ ! John Burkardt
+ !
+ ! Reference:
+ !
+ ! Paul Bratley, Bennett Fox, Linus Schrage,
+ ! A Guide to Simulation,
+ ! Second Edition,
+ ! Springer, 1987,
+ ! ISBN: 0387964673,
+ ! LC: QA76.9.C65.B73.
+ !
+ ! Bennett Fox,
+ ! Algorithm 647:
+ ! Implementation and Relative Efficiency of Quasirandom
+ ! Sequence Generators,
+ ! ACM Transactions on Mathematical Software,
+ ! Volume 12, Number 4, December 1986, pages 362-376.
+ !
+ ! Pierre L'Ecuyer,
+ ! Random Number Generation,
+ ! in Handbook of Simulation,
+ ! edited by Jerry Banks,
+ ! Wiley, 1998,
+ ! ISBN: 0471134031,
+ ! LC: T57.62.H37.
+ !
+ ! Peter Lewis, Allen Goodman, James Miller,
+ ! A Pseudo-Random Number Generator for the System/360,
+ ! IBM Systems Journal,
+ ! Volume 8, Number 2, 1969, pages 136-143.
+ !
+ ! Parameters:
+ !
+ ! Input/output, integer ( kind = MNHINT32 ) SEED, the "seed" value, which should
+ ! NOT be 0. On output, SEED has been updated.
+ !
+ ! Output, real ( kind = MNHREAL64 ) R8_UNIFORM_01, a new pseudorandom variate,
+ ! strictly between 0 and 1.
+ !
+ use modd_precision, only: MNHINT32, MNHREAL64
+
+ implicit none
+
+ integer(kind = MNHINT32), intent(inout) :: seed
+ real(kind=MNHREAL64) :: r8_uniform_01
+
+ integer(kind = MNHINT32), parameter :: i4_huge = 2147483647_MNHINT32
+
+ integer(kind = MNHINT32) :: k
+
+ if ( seed == 0_MNHINT32 ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'r8_uniform_01', 'seed dummy argument must be different of 0' )
+ end if
+
+ k = seed / 127773_MNHINT32
+
+ seed = 16807_MNHINT32 * ( seed - k * 127773_MNHINT32 ) - k * 2836_MNHINT32
+
+ if ( seed < 0_MNHINT32 ) then
+ seed = seed + i4_huge
+ end if
+
+ r8_uniform_01 = real(seed) * 4.656612875d-10
+
+ return
+ end function r8_uniform_01
+!
+END SUBROUTINE FLASH_GEOM_ELEC_n
+!
+!-------------------------------------------------------------------------------
diff --git a/src/PHYEX/ext/goto_model_wrapper.f90 b/src/PHYEX/ext/goto_model_wrapper.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e869230e24429a0a260fcba70bceade88bb9ea62
--- /dev/null
+++ b/src/PHYEX/ext/goto_model_wrapper.f90
@@ -0,0 +1,252 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!! MODIFICATIONS
+!! -------------
+!! 06/12 (Tomasini) Grid-nesting of ADVFRC and EDDY_FLUX
+!! 07/13 (Bosseur & Filippi) adds Forefire
+!! 2014 (Faivre)
+!! 2016 (Leriche) Add MODD_CH_ICE Suppress MODD_CH_DEP_n
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 10/2016 (F Brosse) Add prod/loss terms computation for chemistry
+!! 07/2017 (M.Leriche) Add DIAG chimical surface fluxes
+! 02/2018 Q.Libois ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! 2017 V.Vionnet blow snow
+! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! F. Auguste 02/21: add IBM
+! T. Nagel 02/21: add turbulence recycling
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
+! P. Wautelet 27/04/2022: add namelist for profilers
+! P. Wautelet 10/02/2023: add Blaze variables
+!-----------------------------------------------------------------
+MODULE MODI_GOTO_MODEL_WRAPPER
+
+INTERFACE
+SUBROUTINE GOTO_MODEL_WRAPPER(KFROM, KTO, ONOFIELDLIST)
+INTEGER, INTENT(IN) :: KFROM, KTO
+LOGICAL, OPTIONAL, INTENT(IN) :: ONOFIELDLIST
+END SUBROUTINE GOTO_MODEL_WRAPPER
+END INTERFACE
+
+END MODULE MODI_GOTO_MODEL_WRAPPER
+
+SUBROUTINE GOTO_MODEL_WRAPPER(KFROM, KTO, ONOFIELDLIST)
+! all USE modd*_n modules
+USE MODD_ADVFRC_n
+USE MODD_ADV_n
+USE MODD_ALLPROFILER_n
+USE MODD_ALLSTATION_n
+USE MODD_BIKHARDT_n
+USE MODD_BLANK_n
+USE MODD_BLOWSNOW_n
+USE MODD_CH_AERO_n
+USE MODD_CH_BUDGET_n
+USE MODD_CH_FLX_n
+USE MODD_CH_ICE_n
+USE MODD_CH_JVALUES_n
+USE MODD_CH_M9_n
+USE MODD_CH_MNHC_n
+USE MODD_CH_PH_n
+USE MODD_CH_PRODLOSSTOT_n
+USE MODD_CH_ROSENBROCK_n
+USE MODD_CH_SOLVER_n
+USE MODD_CLOUDPAR_n
+USE MODD_PARAM_ICE_n
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_ASSOCIATE !not yet a '_n' module
+USE MODD_RAIN_ICE_PARAM_n
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_CLOUD_MF_n
+USE MODD_CONF_n
+USE MODD_CURVCOR_n
+USE MODD_DIM_n
+USE MODD_DRAG_n
+USE MODD_DRAGTREE_n
+USE MODD_DRAGBLDG_n
+USE MODD_COUPLING_LEVELS_n
+USE MODD_DUMMY_GR_FIELD_n
+USE MODD_DYN_n
+USE MODD_DYNZD_n
+USE MODD_ELEC_n
+USE MODD_FIELD_n
+USE MODD_FIRE_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE_n
+#endif
+USE MODD_FRC_n
+USE MODD_GET_n
+USE MODD_GR_FIELD_n
+USE MODD_IBM_LSF
+USE MODD_IBM_PARAM_n
+USE MODD_IO_SURF_MNH
+USE MODD_LBC_n
+USE MODD_LES_n
+USE MODD_LSFIELD_n
+USE MODD_LUNIT_n
+USE MODD_MEAN_FIELD_n
+USE MODD_METRICS_n
+USE MODD_NEST_PGD_n
+USE MODD_NUDGING_n
+USE MODD_OUT_n
+USE MODD_PACK_GR_FIELD_n
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_MFSHALL_n
+USE MODD_PARAM_n
+USE MODD_PARAM_RAD_n
+USE MODD_PARAM_ECRAD_n
+USE MODD_PASPOL_n
+USE MODD_PAST_FIELD_n
+USE MODD_PRECIP_n
+USE MODD_PROFILER_n
+USE MODD_RADIATIONS_n
+USE MODD_RBK90_Global_n
+USE MODD_RBK90_JacobianSP_n
+USE MODD_RBK90_Parameters_n
+USE MODD_RECYCL_PARAM_n
+USE MODD_REF_n
+USE MODD_RELFRC_n
+USE MODD_SECPGD_FIELD_n
+USE MODD_SERIES_n
+USE MODD_SHADOWS_n
+USE MODD_STATION_n
+USE MODD_SUB_CH_FIELD_VALUE_n
+USE MODD_SUB_CH_MONITOR_n
+USE MODD_SUB_ELEC_n
+USE MODD_SUB_MODEL_n
+USE MODD_SUB_PASPOL_n
+USE MODD_SUB_PHYS_PARAM_n
+USE MODD_TIMEZ
+USE MODD_TURB_n
+USE MODD_NEB_n, ONLY: NEB_GOTO_MODEL
+!
+!
+use mode_field, only: Fieldlist_goto_model
+use mode_msg
+!
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFROM, KTO
+LOGICAL, OPTIONAL, INTENT(IN) :: ONOFIELDLIST
+!
+CHARACTER(LEN=64) :: YMSG
+LOGICAL :: GNOFIELDLIST
+!
+WRITE(YMSG,'( I4,"->",I4 )') KFROM,KTO
+CALL PRINT_MSG(NVERB_DEBUG,'GEN','GOTO_MODEL_WRAPPER',TRIM(YMSG))
+!
+IF (PRESENT(ONOFIELDLIST)) THEN
+ GNOFIELDLIST = ONOFIELDLIST
+ELSE
+ GNOFIELDLIST = .FALSE.
+END IF
+!
+! All calls to specific modd_*n goto_model routines
+!
+CALL ADV_GOTO_MODEL(KFROM, KTO)
+CALL BIKHARDT_GOTO_MODEL(KFROM, KTO)
+CALL BLANK_GOTO_MODEL(KFROM,KTO)
+CALL CH_AERO_GOTO_MODEL(KFROM,KTO)
+CALL CH_FLX_GOTO_MODEL(KFROM, KTO)
+CALL CH_JVALUES_GOTO_MODEL(KFROM, KTO)
+CALL CH_MNHC_GOTO_MODEL(KFROM, KTO)
+CALL CH_SOLVER_GOTO_MODEL(KFROM, KTO)
+CALL CLOUDPAR_GOTO_MODEL(KFROM, KTO)
+CALL PARAM_ICE_GOTO_MODEL(KFROM, KTO)
+CALL PARAM_LIMA_ASSOCIATE() !Not yet a goto_model but put here for simplicity and to prepare the transformation into a '_n' module
+CALL RAIN_ICE_PARAM_GOTO_MODEL(KFROM, KTO)
+CALL RAIN_ICE_DESCR_GOTO_MODEL(KFROM, KTO)
+CALL CLOUD_MF_GOTO_MODEL(KFROM, KTO)
+CALL CONF_GOTO_MODEL(KFROM, KTO)
+CALL CURVCOR_GOTO_MODEL(KFROM, KTO)
+!CALL DEEP_CONVECTION_GOTO_MODEL(KFROM, KTO)
+CALL DIM_GOTO_MODEL(KFROM, KTO)
+CALL DRAGTREE_GOTO_MODEL(KFROM, KTO)
+CALL DRAGBLDG_GOTO_MODEL(KFROM, KTO)
+CALL COUPLING_MULT_GOTO_MODEL(KFROM, KTO)
+CALL DUMMY_GR_FIELD_GOTO_MODEL(KFROM, KTO)
+CALL DYN_GOTO_MODEL(KFROM, KTO)
+CALL DYNZD_GOTO_MODEL(KFROM,KTO)
+CALL FIELD_GOTO_MODEL(KFROM, KTO)
+!CALL PAST_FIELD_GOTO_MODEL(KFROM, KTO)
+CALL GET_GOTO_MODEL(KFROM, KTO)
+!CALL GR_FIELD_GOTO_MODEL(KFROM, KTO)
+!$20140403 add grid_conf_proj_goto_model
+!CALL GRID_CONF_PROJ_GOTO_MODEL(KFROM,KTO)
+!$
+!CALL GRID_GOTO_MODEL(KFROM, KTO)
+!CALL HURR_FIELD_GOTO_MODEL(KFROM, KTO)
+!$20140403 add io_surf_mnh_goto_model!!
+CALL IO_SURF_MNH_GOTO_MODEL(KFROM, KTO)
+!$
+CALL LBC_GOTO_MODEL(KFROM, KTO)
+CALL LES_GOTO_MODEL(KFROM, KTO)
+CALL LSFIELD_GOTO_MODEL(KFROM, KTO)
+CALL LUNIT_GOTO_MODEL(KFROM, KTO)
+CALL MEAN_FIELD_GOTO_MODEL(KFROM, KTO)
+CALL METRICS_GOTO_MODEL(KFROM, KTO)
+CALL NEST_PGD_GOTO_MODEL(KFROM, KTO)
+CALL NUDGING_GOTO_MODEL(KFROM, KTO)
+CALL OUT_GOTO_MODEL(KFROM, KTO)
+CALL PACK_GR_FIELD_GOTO_MODEL(KFROM, KTO)
+CALL PARAM_KAFR_GOTO_MODEL(KFROM, KTO)
+CALL PARAM_MFSHALL_GOTO_MODEL(KFROM, KTO)
+CALL PARAM_GOTO_MODEL(KFROM, KTO)
+CALL PARAM_RAD_GOTO_MODEL(KFROM, KTO)
+#ifdef MNH_ECRAD
+CALL PARAM_ECRAD_GOTO_MODEL(KFROM, KTO)
+#endif
+CALL PASPOL_GOTO_MODEL(KFROM, KTO)
+#ifdef MNH_FOREFIRE
+CALL FOREFIRE_GOTO_MODEL(KFROM, KTO)
+#endif
+CALL FIRE_GOTO_MODEL( KFROM, KTO )
+!CALL PRECIP_GOTO_MODEL(KFROM, KTO)
+CALL ELEC_GOTO_MODEL(KFROM, KTO)
+CALL RADIATIONS_GOTO_MODEL(KFROM, KTO)
+CALL SHADOWS_GOTO_MODEL(KFROM, KTO)
+CALL REF_GOTO_MODEL(KFROM, KTO)
+CALL FRC_GOTO_MODEL(KFROM, KTO)
+CALL SECPGD_FIELD_GOTO_MODEL(KFROM, KTO)
+CALL SERIES_GOTO_MODEL(KFROM, KTO)
+CALL PROFILER_GOTO_MODEL(KFROM, KTO)
+CALL STATION_GOTO_MODEL(KFROM, KTO)
+CALL ALLPROFILER_GOTO_MODEL(KFROM, KTO)
+CALL ALLSTATION_GOTO_MODEL(KFROM, KTO)
+CALL SUB_CH_FIELD_VALUE_GOTO_MODEL(KFROM, KTO)
+CALL SUB_CH_MONITOR_GOTO_MODEL(KFROM, KTO)
+CALL SUB_MODEL_GOTO_MODEL(KFROM, KTO)
+CALL SUB_PHYS_PARAM_GOTO_MODEL(KFROM, KTO)
+CALL SUB_PASPOL_GOTO_MODEL(KFROM, KTO)
+CALL SUB_ELEC_GOTO_MODEL(KFROM, KTO)
+!CALL TIME_GOTO_MODEL(KFROM, KTO)
+CALL TURB_GOTO_MODEL(KFROM, KTO)
+CALL NEB_GOTO_MODEL(KFROM, KTO)
+CALL DRAG_GOTO_MODEL(KFROM, KTO)
+CALL TIMEZ_GOTO_MODEL(KFROM, KTO)
+CALL CH_PH_GOTO_MODEL(KFROM, KTO)
+CALL CH_ICE_GOTO_MODEL(KFROM, KTO)
+CALL CH_M9_GOTO_MODEL(KFROM, KTO)
+CALL CH_ROSENBROCK_GOTO_MODEL(KFROM, KTO)
+CALL RBK90_Global_GOTO_MODEL(KFROM, KTO)
+CALL RBK90_JacobianSP_GOTO_MODEL(KFROM, KTO)
+CALL RBK90_Parameters_GOTO_MODEL(KFROM, KTO)
+!
+!CALL LIMA_PRECIP_SCAVENGING_GOTO_MODEL(KFROM, KTO)
+!
+!CALL EDDY_FLUX_GOTO_MODEL(KFROM, KTO)
+!CALL EDDYUV_FLUX_GOTO_MODEL(KFROM, KTO)
+CALL ADVFRC_GOTO_MODEL(KFROM, KTO)
+CALL RELFRC_GOTO_MODEL(KFROM, KTO)
+CALL CH_PRODLOSSTOT_GOTO_MODEL(KFROM,KTO)
+CALL CH_BUDGET_GOTO_MODEL(KFROM,KTO)
+CALL BLOWSNOW_GOTO_MODEL(KFROM, KTO)
+CALL IBM_GOTO_MODEL(KFROM, KTO)
+CALL RECYCL_GOTO_MODEL(KFROM, KTO)
+CALL LSF_GOTO_MODEL(KFROM, KTO)
+!
+IF (.NOT.GNOFIELDLIST) CALL FIELDLIST_GOTO_MODEL(KFROM, KTO)
+!
+END SUBROUTINE GOTO_MODEL_WRAPPER
diff --git a/src/PHYEX/ext/ground_paramn.f90 b/src/PHYEX/ext/ground_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..598dcdeec67df2619ef469760a903376eaadd98a
--- /dev/null
+++ b/src/PHYEX/ext/ground_paramn.f90
@@ -0,0 +1,1521 @@
+!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########
+MODULE MODI_GROUND_PARAM_n
+! ##########
+!
+INTERFACE
+!
+ SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFTH_WALL, PSFTH_ROOF, PCD_ROOF, PSFRV, PSFRV_WALL, &
+ PSFRV_ROOF, PSFSV, PSFCO2, PSFU, PSFV, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSRAD, KTCOUNT, TPFILE )
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+!
+!* surface fluxes
+! --------------
+!
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! Total surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_WALL ! Wall surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_ROOF ! Roof surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCD_ROOF ! Drag coefficient for roofs (-)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! Total surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_WALL ! Wall surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_ROOF ! Roof 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. (ppv.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, PSFTH_WALL, PSFTH_ROOF, PCD_ROOF, PSFRV, &
+ PSFRV_WALL, PSFRV_ROOF, 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
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
+! A. Costes 12/2021: Blaze Fire model
+! P. Wautelet 09/02/2022: bugfix: add missing XCURRENT_LEI computation
+! P. Wautelet 30/09/2022: bugfix: missing communications for SWDIFF, SWDIR and LEI
+! P. Wautelet 30/09/2022: bugfix: use XUNDEF from SURFEX for surface variables computed by SURFEX
+! P. Wautelet 21/10/2022: bugfix: communicate halo values between processes for OUT variables
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
+USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD_STAT
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_BLOWSNOW, ONLY: LBLOWSNOW, NBLOWSNOW_2D, YPBLOWSNOW_2D
+USE MODD_BLOWSNOW_n, ONLY: XRSNWCANOS
+USE MODD_BUDGET, ONLY: LBUDGET_TH, LBUDGET_RV, NBUDGET_RV, NBUDGET_TH, TBUDGETS
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_CH_FLX_n, ONLY: XCHFLX
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM
+USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN, NHALO
+USE MODD_COUPLING_LEVELS_n
+USE MODD_CONF_n, ONLY: NRR
+USE MODD_CST, ONLY: XP00, XCPD, XRD, XRV, XRHOLW, XDAY, XPI, XMD, XAVOGADRO
+USE MODD_CSTS_DUST, ONLY: XMOLARWEIGHT_DUST
+USE MODD_CSTS_SALT, ONLY: XMOLARWEIGHT_SALT
+USE MODD_DEEP_CONVECTION_n, ONLY: XPRCONV, XPRSCONV
+USE MODD_DRAGBLDG_n, ONLY : LFLUXBLDG
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG
+USE MODD_DIAG_IN_RUN
+USE MODD_DIM_n, ONLY: NKMAX
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN_n, ONLY: XTSTEP
+USE MODD_FIELD_n, ONLY: XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS, XRTHS, XRRS
+USE MODD_FIRE_n, ONLY: XLSPHI, XBMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMIGNITION, XFMFUELTYPE, &
+ XFIRETAU, XFLUXPARAMH, XFLUXPARAMW, XFIRERW, XFMASE, XFMAWC, XFMWALKIG, &
+ XFMFLUXHDH, XFMFLUXHDW, XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW, XGRADLSPHIX, &
+ XGRADLSPHIY, XFIREWIND, XFMGRADOROX, XFMGRADOROY
+USE MODD_GRID, ONLY: XLON0, XRPK, XBETA
+USE MODD_GRID_n, ONLY: XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE, XSINSLOPE, XZS
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZZ
+USE MODD_MNH_SURFEX_n, ONLY: YSURF_CUR
+USE MODD_NSV, ONLY: CSV, NSV, NSV_AERBEG, NSV_AEREND, NSV_CHEMBEG, NSV_CHEMEND, NSV_DSTBEG, NSV_DSTEND, &
+ NSV_SLTBEG, NSV_SLTEND, NSV_SNWBEG, NSV_SNWEND
+USE MODD_PARAM_C2R2, ONLY: LSEDC
+USE MODD_PREP_SNOW, ONLY: NIMPUR
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_ICE_n, ONLY: LSEDIC
+USE MODD_PARAM_LIMA, ONLY: MSEDC=>LSEDC
+USE MODD_PARAM_n, ONLY: CDCONV, CCLOUD, CRAD, CTURB
+USE MODD_PRECIP_n, ONLY: XINPRC, XINPRR, XINPRS, XINPRG, XINPRH
+USE MODD_PRECISION, ONLY: MNHTIME
+USE MODD_PROFILER_n, ONLY: LPROFILER
+USE MODD_RADIATIONS_n, ONLY: XFLALWD, XCCO2, XTSIDER, &
+ XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, &
+ XZENITH, XAZIM, XAER, XSWU, XLWU
+USE MODD_REF_n, ONLY: XEXNREF, XRHODREF, XRHODJ
+USE MODD_SALT, ONLY: LSALT
+USE MODD_STATION_n, ONLY: LSTATION
+USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
+USE MODD_TIME, ONLY: TDTSEG
+USE MODD_TIME_n, ONLY: TDTCUR
+#ifdef CPLOASIS
+USE MODD_SFX_OASIS, ONLY: LOASIS
+USE MODD_DYN, ONLY: XSEGLEN
+USE MODD_DYN_n, ONLY: DYN_MODEL
+#endif
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+USE MODD_FOREFIRE_n
+#endif
+
+USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT, BUDGET_STORE_END
+USE MODE_DATETIME
+USE MODE_FIRE_MODEL
+USE MODE_ll
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
+USE MODE_MSG
+USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND
+
+USE MODI_COUPLING_SURF_ATM_n
+USE MODI_DIAG_SURF_ATM_n
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_NORMAL_INTERPOL
+USE MODI_SHUMAN
+#ifdef CPLOASIS
+USE MODI_GET_HALO
+USE MODI_MNH_OASIS_RECV
+USE MODI_MNH_OASIS_SEND
+#endif
+#ifdef MNH_FOREFIRE
+USE MODI_COUPLING_FOREFIRE_n
+#endif
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!* surface fluxes
+! --------------
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! Total surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_WALL ! Wall surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH_ROOF ! Roof surface flux of potential temperature (Km/s)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCD_ROOF ! Drag coefficient for roofs (-)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! Total surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_WALL ! Wall surface flux of water vapor (m/s*kg/kg)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV_ROOF ! Roof 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. (ppv.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)) :: 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)) :: ZPS ! Surface pressure
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Surface Exner function
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCO2 ! CO2 concentration (kg/kg)
+!
+! Variables for which multiple levels are sent to SURFEX and related ancilliary variables
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZREF ! Forcing height
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTA ! Temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVA ! vapor mixing ratio
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQA ! humidity (kg/m3)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPA ! Pressure
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNA ! Exner function
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHA ! potential temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUA ! u component of the wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVA ! v component of the wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU ! zonal wind
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV ! meridian wind
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWIND ! wind parallel to the orography
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHOA ! air density
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTKE ! Subgrid turbulent kinetic energy
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR ! wind direction (rad from N clockwise)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZALFA ! angle between the wind and the x axis
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU2D ! u and v component of the
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV2D ! wind at mass point
+!
+! SURFEX output fluxes
+!
+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)) :: ZSFTH ! Total turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_SURF ! Surface turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_WALL ! Wall turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH_ROOF ! Roof turbulent flux of heat
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCD_ROOF ! Drag coefficient for roofs
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Total turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_SURF ! Surface turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_WALL ! Wall turbulent flux of water
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ_ROOF ! Roof 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
+
+!
+! Anxiliary variables
+!
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF_DIST
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF_VERT
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWEIGHT_VERT
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLW_ILEV
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLW_ILEVP1
+REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZAGLSCAL_ILEV
+!
+!* 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
+! ------------------------
+!
+! Pure surface variables or variables forced at only one level
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level
+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_ZWS ! significant wave height (m)
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure
+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_ZS ! orography
+!
+! Variables that are forced at multiple levels
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZREF ! forcing height
+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_PA ! pressure at first atmospheric level
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_TKE ! Subgrid turbulent kinetic energy
+!
+! SURFEX output variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! Total water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_SURF ! Surface water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_WALL ! Wall water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ_ROOF ! Roof water vapor flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! Total potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_SURF ! Surface potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_WALL ! Wall potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH_ROOF ! Roof potential temperature flux
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_CD_ROOF ! Drag coefficient for roofs
+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)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZIMPWET ! wet deposit coefficient for each impurity type (g)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_ZIMPDRY ! dry deposit coefficient for each impurity type (g)
+
+TYPE(LIST_ll), POINTER :: TZFIELDSURF_ll ! list of fields to exchange
+INTEGER :: IINFO_ll ! return code of parallel routine
+!
+!
+CHARACTER(LEN=6) :: YJSV
+CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: YSV_SURF ! name of the scalar variables
+ ! sent to SURFEX
+!
+LOGICAL :: GSTATPROF_SURF ! TRUE if station or profiler need to write surface or radiation data
+REAL :: ZTIMEC
+INTEGER :: ILUOUT ! logical unit
+!
+! New variables for coupling at several levels
+!
+REAL :: ZAGLW_JK
+REAL :: ZAGLW_JKP1
+REAL :: ZAGLSCAL_JK
+INTEGER :: ICOUNT, ILEV
+!
+! Fire model
+REAL(KIND=MNHTIME), DIMENSION(2) :: ZFIRETIME1, ZFIRETIME2 ! CPU time for Blaze perf profiling
+REAL(KIND=MNHTIME), DIMENSION(2) :: ZGRADTIME1, ZGRADTIME2 ! CPU time for Blaze perf profiling
+REAL(KIND=MNHTIME), DIMENSION(2) :: ZPROPAGTIME1, ZPROPAGTIME2 ! CPU time for Blaze perf profiling
+REAL(KIND=MNHTIME), DIMENSION(2) :: ZFLUXTIME1, ZFLUXTIME2 ! CPU time for Blaze perf profiling
+REAL(KIND=MNHTIME), 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_SFX
+PSFTH_WALL = XUNDEF_SFX
+PSFTH_ROOF = XUNDEF_SFX
+PCD_ROOF = XUNDEF_SFX
+PSFRV = XUNDEF_SFX
+PSFRV_WALL = XUNDEF_SFX
+PSFRV_ROOF = XUNDEF_SFX
+!
+PSFSV = XUNDEF_SFX
+PSFCO2 = XUNDEF_SFX
+PSFU = XUNDEF_SFX
+PSFV = XUNDEF_SFX
+PDIR_ALB = XUNDEF_SFX
+PSCA_ALB = XUNDEF_SFX
+PEMIS = XUNDEF_SFX
+PTSRAD = XUNDEF_SFX
+!
+! Allocation of the local variables
+!
+ALLOCATE(ZZREF(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZTA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZRVA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZQA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZPA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZEXNA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZTHA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZUA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZVA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZU(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZV(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZWIND(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZRHOA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+IF(CTURB/='NONE') ALLOCATE(ZTKE(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZDIR(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZALFA(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZU2D(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+ALLOCATE(ZV2D(SIZE(PSFTH,1),SIZE(PSFTH,2),NLEV_COUPLE))
+!
+GSTATPROF_SURF = ( LPROFILER .AND. LDIAG_SURFRAD_PROF ) .OR. ( LSTATION .AND. LDIAG_SURFRAD_STAT )
+!
+!-------------------------------------------------------------------------------
+!
+!* 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+NLEV_COUPLE-1)))
+ZV2D(:,:,:)=MYF(XVT(:,:,IKB:(IKB+NLEV_COUPLE-1)))
+!
+!* angle between Y axis and wind (rad., clockwise)
+!
+ZALFA = 0.
+!
+DO ILEV=1,NLEV_COUPLE
+ !
+ WHERE(ZU2D(:,:,ILEV)/=0. .OR. ZV2D(:,:,ILEV)/=0.)
+ ZALFA(:,:,ILEV)=ATAN2(ZU2D(:,:,ILEV),ZV2D(:,:,ILEV))
+ END WHERE
+ !
+ WHERE(ZALFA(:,:,ILEV)<0.) ZALFA(:,:,ILEV) = ZALFA(:,:,ILEV) + 2. * XPI
+ !
+ !* angle between North and wind (rad., clockwise)
+ !
+ IF (.NOT. LCARTESIAN) THEN
+ ZDIR(:,:,ILEV) = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA(:,:,ILEV)
+ ELSE
+ ZDIR(:,:,ILEV) = - XBETA * XPI/180. + ZALFA(:,:,ILEV)
+ ENDIF
+ !
+ ! 1.3 Rotate the wind
+ ! Only for the first forcing level, used for friction force direction.
+ ! ---------------
+ !
+ IF (ILEV.EQ.1) THEN
+ !
+ CALL ROTATE_WIND(D,XUT,XVT,XWT, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE,XSINSLOPE, &
+ XDXX,XDYY,XDZZ, &
+ ZUA(:,:,ILEV),ZVA(:,:,ILEV) )
+ !
+ ELSE
+ !
+ ZUA(:,:,ILEV) = XUT(:,:,IKB+ILEV-1)
+ ZVA(:,:,ILEV) = XVT(:,:,IKB+ILEV-1)
+ !
+ ENDIF
+ !
+ ! 1.4 zonal and meridian components of the wind parallel to the slope
+ ! ---------------------------------------------------------------
+ !
+ ZWIND(:,:,ILEV) = SQRT( ZUA(:,:,ILEV)**2 + ZVA(:,:,ILEV)**2 )
+ !
+ ZU(:,:,ILEV) = ZWIND(:,:,ILEV) * SIN(ZDIR(:,:,ILEV))
+ ZV(:,:,ILEV) = ZWIND(:,:,ILEV) * COS(ZDIR(:,:,ILEV))
+ !
+ENDDO
+ !
+ ! 1.5 Horizontal interpolation of the thermodynamic fields
+ ! -------------------------------------------------
+ !
+ ! This horizontal interpolation is only made if the forcing is located at the first level
+ !
+IF (NLEV_COUPLE.EQ.1) THEN
+ !
+ CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+ XCOSSLOPE,XSINSLOPE, &
+ XDXX,XDYY,XDZZ, &
+ ZTHA(:,:,1),ZRVA(:,:,1),ZEXNA(:,:,1) )
+ !
+ELSE
+ !
+ ZEXNA (:,:,1:NLEV_COUPLE) = (XPABST(:,:,IKB:(IKB+NLEV_COUPLE-1))/XP00) ** (XRD/XCPD)
+ ZTHA (:,:,1:NLEV_COUPLE) = XTHT(:,:,IKB:(IKB+NLEV_COUPLE-1))
+ ZRVA (:,:,1:NLEV_COUPLE) = ZRV (:,:,IKB:(IKB+NLEV_COUPLE-1))
+ !
+ENDIF
+!
+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:(IKB+NLEV_COUPLE-1))
+!
+! 1.8 Temperature from the potential temperature
+! ------------------------------------------
+!
+ZTA(:,:,:) = ZTHA(:,:,:) * ZEXNA(:,:,:)
+!
+! 1.9 Air density
+! -----------
+!
+ZRHOA(:,:,:) = ZPA(:,:,:)/(XRD * ZTA(:,:,:) * &
+ ((1. + (XRD/XRV)*ZRVA(:,:,:)) / (1. + ZRVA(:,:,:))))
+!
+! Subgrid turbulent kinetic energy
+!
+IF(CTURB/='NONE') ZTKE(:,:,:) = XTKET(:,:,IKB:(IKB+NLEV_COUPLE-1))
+!
+! 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
+! -------------
+!
+! A smooth transition between vertical height above ground and
+! distance to the surface is implemented here.
+! We assume that for katabatic winds located in the first meters above
+! ground, the distance to the surface is the most relevant whereas
+! for most other processes it will be the vertical distance to the surface
+!
+DO ILEV=1,NLEV_COUPLE
+ !
+ ! Height above ground of w-levels
+ !
+ ZAGLW_ILEV (:,:) = XZZ(:,:,JPVEXT+ILEV ) - XZZ(:,:,1+JPVEXT)
+ ZAGLW_ILEVP1 (:,:) = XZZ(:,:,JPVEXT+ILEV+1) - XZZ(:,:,1+JPVEXT)
+ !
+ ! Height above ground of scalar variables and (u,v)
+ !
+ ZAGLSCAL_ILEV(:,:) = 0.5 * ( ZAGLW_ILEV(:,:) + ZAGLW_ILEVP1(:,:) )
+ !
+ ! Distance to the inclined surface and vertical distance
+ !
+ ZZREF_DIST(:,:) = ZAGLSCAL_ILEV(:,:) * XDIRCOSZW(:,:)
+ !
+ ZZREF_VERT(:,:) = ZAGLSCAL_ILEV(:,:)
+ !
+ ! Scaling between 5 m and 20 m height
+ !
+ ZWEIGHT_VERT(:,:) = MIN(1.0,MAX(ZZREF_VERT(:,:)-5.0,0.0)/15.0)
+ !
+ IF (MAXVAL(ZWEIGHT_VERT).GT.1.0) STOP ("Wrong weight")
+ IF (MINVAL(ZWEIGHT_VERT).LT.0.0) STOP ("Wrong weight")
+ !
+ ZZREF(:,:,ILEV) = ZWEIGHT_VERT(:,:) * ZZREF_VERT(:,:) + (1.0 - ZWEIGHT_VERT(:,:)) * ZZREF_DIST(:,:)
+ !
+ENDDO
+!
+! 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(1:NSV)
+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_MULTI_LEVEL_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, XTSTEP, &
+ TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
+ IDIM1D,KSV_SURF,SIZE(XSW_BANDS), NLEV_COUPLE, 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, ZP_ZIMPWET, ZP_ZIMPDRY, YSV_SURF, &
+ ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_TKE, ZP_SFTQ, ZP_SFTQ_SURF, ZP_SFTQ_WALL, ZP_SFTQ_ROOF, &
+ ZP_SFTH, ZP_SFTH_SURF, ZP_SFTH_WALL, ZP_SFTH_ROOF, ZP_CD_ROOF, 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. GSTATPROF_SURF ) THEN
+ CALL DIAG_SURF_ATM_n( YSURF_CUR, 'MESONH' )
+ IF ( CPROGRAM == 'DIAG' ) THEN
+ CALL MNHGET_SURF_PARAM_n(PZON10M=ZP_ZON10M, PMER10M=ZP_MER10M)
+ ELSE
+ 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
+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_SFX .AND. ZWIND(:,:,1)>0.)
+ PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:,1) / ZWIND(:,:,1) / XRHODREF(:,:,IKB)
+ PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:,1) / ZWIND(:,:,1) / XRHODREF(:,:,IKB)
+END WHERE
+!
+PCD_ROOF(:,:) = ZCD_ROOF(:,:)
+!
+
+!* 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
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'GROUND_PARAM_n', 'BLAZE-FIRE: WENO3 fire gradient calculation needs NHALO >= 2' )
+ ELSE IF (NHALO < 3 .AND. NFIRE_WENO_ORDER == 5) THEN
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'GROUND_PARAM_n', 'BLAZE-FIRE: WENO5 fire gradient calculation needs NHALO >= 3' )
+ 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
+ ! --------------
+ !
+ IF (LBUDGET_RV) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RV), 'BLAZE', XRRS(:,:,:,1))
+ IF (LBUDGET_TH) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_TH), 'BLAZE', XRTHS(:,:,:))
+ !
+ 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
+ !
+ IF (LBUDGET_RV) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RV), 'BLAZE', XRRS(:,:,:,1))
+ IF (LBUDGET_TH) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_TH), 'BLAZE', XRTHS(:,:,:))
+ !
+ ! 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'
+!
+! Unit conversions:
+!
+!* H: (W/m2) to w'Theta'
+!
+!* Water flux: (kg/m2/s) to w'rv'
+!
+IF (LFLUXBLDG) THEN
+ !
+ ! Robert: Here the wall and roof fluxes are substracted from the surface fluxes
+ ! since they will be applied in drag_bld.F90
+ !
+ PSFTH(:,:) = ( ZSFTH(:,:) - ZSFTH_WALL(:,:) - ZSFTH_ROOF(:,:) ) / XCPD / XRHODREF(:,:,IKB)
+ PSFRV(:,:) = ( ZSFTQ(:,:) - ZSFTQ_WALL(:,:) - ZSFTQ_ROOF(:,:) ) / XRHODREF(:,:,IKB)
+ !
+ ! Wall and roof fluxes are written on separate variables
+ !
+ PSFTH_WALL(:,:) = ZSFTH_WALL(:,:) / XCPD / XRHODREF(:,:,IKB)
+ PSFTH_ROOF(:,:) = ZSFTH_ROOF(:,:) / XCPD / XRHODREF(:,:,IKB)
+ !
+ PSFRV_WALL(:,:) = ZSFTQ_WALL(:,:) / XRHODREF(:,:,IKB)
+ PSFRV_ROOF(:,:) = ZSFTQ_ROOF(:,:) / XRHODREF(:,:,IKB)
+ !
+ ! Test conservation of fluxes
+ !
+ IF (MAXVAL(ABS(ZSFTH(:,:)/XCPD/XRHODREF(:,:,IKB) - PSFTH(:,:) - PSFTH_WALL(:,:)&
+ - PSFTH_ROOF(:,:))).GT.1.0E-6) STOP ("Wrong H flux partition")
+ IF (MAXVAL(ABS(ZSFTQ(:,:)/XRHODREF(:,:,IKB) - PSFRV(:,:) - PSFRV_WALL(:,:)&
+ - PSFRV_ROOF(:,:))).GT.1.0E-6) STOP ("Wrong Q flux partition")
+ !
+ELSE
+ !
+ ! Otherwise the full surface fluxes are taken
+ !
+ PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB)
+ PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB)
+ !
+ PSFTH_WALL(:,:) = 0.0
+ PSFTH_ROOF(:,:) = 0.0
+ !
+ PSFRV_WALL(:,:) = 0.0
+ PSFRV_ROOF(:,:) = 0.0
+ !
+ENDIF
+!
+!* 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 (ppv.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 (ppv.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 (ppv.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 (ppv.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(:,:,1))
+ END DO
+ !* Update tendency for blowing snow 2D fields
+ DO JSV=1,(NBLOWSNOW_2D)
+ XRSNWCANOS(:,:,JSV) = ZBLOWSNOW_2D(:,:,JSV)*XRHODJ(:,:,IKB)/(XTSTEP*ZRHOA(:,:,1))
+ 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)
+!
+! Communicate halo values
+!
+NULLIFY(TZFIELDSURF_ll)
+!The commented communications are done in PHYS_PARAM_n
+! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFTH, 'GROUND_PARAM_n::PSFTH' )
+! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFRV, 'GROUND_PARAM_n::PSFRV' )
+! DO JSV = 1, NSV
+! WRITE( YJSV, '( I6.6 )' ) JSV
+! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFSV(:,:,JSV), 'GROUND_PARAM_n::PSFSV'//YJSV )
+! END DO
+! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFCO2, 'GROUND_PARAM_n::PSFCO2' )
+! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFU, 'GROUND_PARAM_n::PSFU' )
+! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFV, 'GROUND_PARAM_n::PSFV' )
+DO JLAYER = 1, SIZE( PDIR_ALB, 3 )
+ WRITE( YJSV, '( I6.6 )' ) JLAYER
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PDIR_ALB(:,:,JLAYER), 'GROUND_PARAM_n::PDIR_ALB'//YJSV )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSCA_ALB(:,:,JLAYER), 'GROUND_PARAM_n::PSCA_ALB'//YJSV )
+END DO
+DO JLAYER = 1, SIZE( PEMIS, 3 )
+ WRITE( YJSV, '( I6.6 )' ) JLAYER
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PEMIS(:,:,JLAYER), 'GROUND_PARAM_n::PEMIS'//YJSV )
+END DO
+CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PTSRAD, 'GROUND_PARAM_n::PTSRAD' )
+
+CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDSURF_ll)
+!
+!* Diagnostics
+! -----------
+!
+!
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ XCURRENT_SFCO2(:,:) = ZSFCO2(:,:)
+ IF ( CRAD /= 'NONE' ) THEN
+ XCURRENT_LWD (:,:) = XFLALWD(:,:)
+ XCURRENT_SWD (:,:) = SUM( XDIRSRFSWD(:,:,:) + XSCAFLASWD(:,:,:), DIM=3 )
+ XCURRENT_LWU (:,:) = XLWU(:,:,IKB)
+ XCURRENT_SWU (:,:) = XSWU(:,:,IKB)
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ XCURRENT_SWDIR(:,:) = SUM( XDIRSRFSWD(:,:,:), DIM=3 )
+ XCURRENT_SWDIFF(:,:) = SUM( XSCAFLASWD(:,:,:), DIM=3 )
+ XCURRENT_DSTAOD(:,:) = 0.0
+ XCURRENT_SLTAOD(:,:) = 0.0
+ 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)
+ END DO
+ END DO
+ END DO
+ END IF
+ END IF
+ NULLIFY(TZFIELDSURF_ll)
+
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SFCO2, 'GROUND_PARAM_n::XCURRENT_SFCO2' )
+ IF ( CRAD /= 'NONE' ) THEN
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWD, 'GROUND_PARAM_n::XCURRENT_LWD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' )
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIR, 'GROUND_PARAM_n::XCURRENT_SWDIR' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIFF, 'GROUND_PARAM_n::XCURRENT_SWDIFF' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SLTAOD, 'GROUND_PARAM_n::XCURRENT_SLTAOD' )
+ END IF
+ END IF
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' )
+ IF ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) THEN
+ 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_LEI, 'GROUND_PARAM_n::XCURRENT_LEI' )
+ CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_GFLUX, 'GROUND_PARAM_n::XCURRENT_GFLUX' )
+ 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' )
+ END IF
+ ! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZWS, 'GROUND_PARAM_n::XCURRENT_ZWS' )
+
+ 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/)
+!
+! Variables that are coupled at multiple levels
+!
+ALLOCATE(ZP_ZREF (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_U (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_V (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_QA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_TA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_PA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_RHOA (KDIM1D,NLEV_COUPLE))
+ALLOCATE(ZP_TKE (KDIM1D,NLEV_COUPLE))
+!
+! 2D Variables and variables that are coupled at the surface only
+!
+ALLOCATE(ZP_TSUN (KDIM1D))
+ALLOCATE(ZP_ZENITH (KDIM1D))
+ALLOCATE(ZP_AZIM (KDIM1D))
+ALLOCATE(ZP_ZS (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_ZWS (KDIM1D))
+!
+! 2D SURFEX output fields
+!
+ALLOCATE(ZP_SFTQ (KDIM1D))
+ALLOCATE(ZP_SFTQ_SURF (KDIM1D))
+ALLOCATE(ZP_SFTQ_WALL (KDIM1D))
+ALLOCATE(ZP_SFTQ_ROOF (KDIM1D))
+ALLOCATE(ZP_SFTH (KDIM1D))
+ALLOCATE(ZP_SFTH_SURF (KDIM1D))
+ALLOCATE(ZP_SFTH_WALL (KDIM1D))
+ALLOCATE(ZP_SFTH_ROOF (KDIM1D))
+ALLOCATE(ZP_CD_ROOF (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))
+IF ( GSTATPROF_SURF ) THEN
+ 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))
+END IF
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ ALLOCATE(ZP_ZON10M (KDIM1D))
+ ALLOCATE(ZP_MER10M (KDIM1D))
+END IF
+!
+!* 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))
+!
+! 2D variables or surface only
+!
+ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_PS(:) = RESHAPE(ZPS(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_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1)
+!
+! Variables that are coupled on multiple levels
+!
+DO JLAYER=1,NLEV_COUPLE
+ ZP_ZREF(:,JLAYER) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_PA(:,JLAYER) = RESHAPE(ZPA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_TA(:,JLAYER) = RESHAPE(ZTA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_QA(:,JLAYER) = RESHAPE(ZQA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_RHOA(:,JLAYER) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ IF(CTURB/='NONE') ZP_TKE(:,JLAYER) = RESHAPE(ZTKE(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_U(:,JLAYER) = RESHAPE(ZU(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+ ZP_V(:,JLAYER) = RESHAPE(ZV(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
+END DO
+!
+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(:,1) / XMD
+END DO
+DO JLAYER=NSV_AERBEG,NSV_AEREND
+ ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:,1) / 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(:,1) / 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(:,1) / 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(:,1)
+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(:,1)
+ 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_SFX
+ZSFTH_SURF = XUNDEF_SFX
+ZSFTH_WALL = XUNDEF_SFX
+ZSFTH_ROOF = XUNDEF_SFX
+ZCD_ROOF = XUNDEF_SFX
+ZSFTQ = XUNDEF_SFX
+ZSFTQ_SURF = XUNDEF_SFX
+ZSFTQ_WALL = XUNDEF_SFX
+ZSFTQ_ROOF = XUNDEF_SFX
+!
+IF (NSV>0) ZSFTS = XUNDEF_SFX
+ZSFCO2 = XUNDEF_SFX
+ZSFU = XUNDEF_SFX
+ZSFV = XUNDEF_SFX
+!
+ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2)
+ZSFTH_SURF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_SURF(:), ISHAPE_2)
+ZSFTH_WALL (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_WALL(:), ISHAPE_2)
+ZSFTH_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH_ROOF(:), ISHAPE_2)
+ZCD_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_CD_ROOF(:), ISHAPE_2)
+ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2)
+ZSFTQ_SURF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_SURF(:), ISHAPE_2)
+ZSFTQ_WALL (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_WALL(:), ISHAPE_2)
+ZSFTQ_ROOF (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ_ROOF(:), 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 ( GSTATPROF_SURF .AND. CPROGRAM /= 'DIAG' ) 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)
+END IF
+IF ( GSTATPROF_SURF .OR. CPROGRAM == 'DIAG' ) THEN
+ 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)
+END IF
+!
+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_TKE )
+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_SFTQ_SURF)
+DEALLOCATE(ZP_SFTQ_WALL)
+DEALLOCATE(ZP_SFTQ_ROOF)
+DEALLOCATE(ZP_SFTH )
+DEALLOCATE(ZP_SFTH_SURF)
+DEALLOCATE(ZP_SFTH_WALL)
+DEALLOCATE(ZP_SFTH_ROOF)
+DEALLOCATE(ZP_CD_ROOF)
+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 )
+IF ( GSTATPROF_SURF ) THEN
+ DEALLOCATE(ZP_RN )
+ DEALLOCATE(ZP_H )
+ DEALLOCATE(ZP_LE )
+ DEALLOCATE(ZP_LEI )
+ DEALLOCATE(ZP_GFLUX )
+ DEALLOCATE(ZP_T2M )
+ DEALLOCATE(ZP_Q2M )
+ DEALLOCATE(ZP_HU2M )
+END IF
+IF ( CPROGRAM == 'DIAG' .OR. GSTATPROF_SURF ) THEN
+ DEALLOCATE(ZP_ZON10M )
+ DEALLOCATE(ZP_MER10M )
+END IF
+
+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..fee54c3e094d852b8eba6a7df25ce569c094b4f3
--- /dev/null
+++ b/src/PHYEX/ext/ibm_affectv.f90
@@ -0,0 +1,402 @@
+!MNH_LIC Copyright 2019-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_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: XDXHAT, XDYHAT
+ 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 = ( XDXHAT(JI) * XDYHAT(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/ibm_forcing.f90 b/src/PHYEX/ext/ibm_forcing.f90
new file mode 100644
index 0000000000000000000000000000000000000000..aebf45609f2e854eaedb797480f641390f21738b
--- /dev/null
+++ b/src/PHYEX/ext/ibm_forcing.f90
@@ -0,0 +1,314 @@
+!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_FORCING
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
+ !
+ END SUBROUTINE IBM_FORCING
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING
+!
+! ##########################################################
+SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ ! ##########################################################
+ !
+ !!**** *IBM_FORCING* - routine to force all desired fields
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! 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_CST
+ USE MODD_FIELD_n
+ USE MODD_REF
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XEXNREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_TURB_n, ONLY: XTKEMIN
+ USE MODD_PARAM_n
+ USE MODD_DYN_n, ONLY: XTSTEP
+ !
+ ! interface
+ USE MODI_IBM_AFFECTV
+ USE MODI_IBM_AFFECTP
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZTMP,ZXMU,ZDIV,ZTKE
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMU,ZTRY
+ INTEGER :: IIU,IJU,IKU,IKB,IKE
+ INTEGER :: JRR,JSV
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRVS,2)
+ IKU = SIZE(PRWS,3)
+ !
+ ALLOCATE(ZTMU(IIU,IJU,IKU,3),ZTMP(IIU,IJU,IKU),ZTRY(IIU,IJU,IKU,3), &
+ ZXMU(IIU,IJU,IKU),ZDIV(IIU,IJU,IKU),ZTKE(IIU,IJU,IKU))
+ !
+ ZTMU=0.
+ ZXMU=0.
+ ZDIV=0.
+ ZTMP=0.
+ ZTRY=0.
+ !
+ IKB = 1 + JPVEXT
+ IKE = IKU - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ IF (NSV>=1) THEN
+ !
+ DO JSV=1,NSV
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PSVS(:,:,:,JSV) = XIBM_EPSI**1.5
+ ENDDO
+ !
+ ENDIF
+ !
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTHS(:,:,:) = XTHVREF(:,:,:)
+ !
+ IF (NRR>=1) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI)
+ PRRS(:,:,:,1) = XRVREF(:,:,:)
+ PTHS(:,:,:) = XTHVREF(:,:,:)/(1.+XRD/XRV*XRVREF(:,:,:))
+ ENDWHERE
+ ENDIF
+ IF (NRR>=2) THEN
+ DO JRR=2,NRR
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PRRS(:,:,:,JRR) = XIBM_EPSI
+ ENDDO
+ ENDIF
+ !
+ WHERE (XIBM_LS(:,:,:,2).GT.XIBM_EPSI) PRUS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,3).GT.XIBM_EPSI) PRVS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,4).GT.XIBM_EPSI) PRWS(:,:,:) = XIBM_EPSI
+ IF (CTURB/='NONE') WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTKS(:,:,:) = XTKEMIN
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! ======================
+ ! === SCALAR FORCING ===
+ ! ======================
+ !
+ IF (CTURB/='NONE') THEN
+ ZTMP(:,:,:) = PTKS(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ ZXMU(:,:,:) = XIBM_XMUT(:,:,:)
+ ZDIV(:,:,:) = XIBM_CURV(:,:,:)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_E,XIBM_RADIUS_E,XIBM_POWERS_E,&
+ CIBM_MODE_INTE1_E,CIBM_MODE_INTE3_E,&
+ CIBM_TYPE_BOUND_E,CIBM_MODE_BOUND_E,&
+ CIBM_FORC_BOUND_E,XIBM_FORC_BOUND_E,ZXMU,ZDIV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=XTKEMIN
+ PTKS(:,:,:)=MAX(XTKEMIN,ZTMP(:,:,:))
+ ENDIF
+ !
+ ZTMP(:,:,:) = PTHS(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_T,XIBM_RADIUS_T,XIBM_POWERS_T,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE3_T,&
+ CIBM_TYPE_BOUND_T,CIBM_MODE_BOUND_T,&
+ CIBM_FORC_BOUND_T,XIBM_FORC_BOUND_T,ZXMU,ZDIV)
+ ZTMP(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PTHS(:,:,:) = MAX(ZTMP(:,:,:),250.)
+ !
+ IF (NRR>=1) THEN
+ DO JRR=1,NRR
+ ZTMP(:,:,:) = PRRS(:,:,:,JRR)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_R,XIBM_RADIUS_R,XIBM_POWERS_R,&
+ CIBM_MODE_INTE1_R,CIBM_MODE_INTE3_R,&
+ CIBM_TYPE_BOUND_R,CIBM_MODE_BOUND_R,&
+ CIBM_FORC_BOUND_R,XIBM_FORC_BOUND_R,ZXMU,ZDIV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PRRS(:,:,:,JRR) = ZTMP(:,:,:)
+ ENDDO
+ ENDIF
+ !
+ IF (NSV>=1) THEN
+ DO JSV=1,NSV
+ ZTMP(:,:,:) = PSVS(:,:,:,JSV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_S,XIBM_RADIUS_S,XIBM_POWERS_S,&
+ CIBM_MODE_INTE1_S,CIBM_MODE_INTE3_S,&
+ CIBM_TYPE_BOUND_S,CIBM_MODE_BOUND_S,&
+ CIBM_FORC_BOUND_S,XIBM_FORC_BOUND_S,ZXMU,ZDIV)
+ ZTMP(:,:,:) = MAX(XIBM_EPSI**1.5,ZTMP(:,:,:))
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PSVS(:,:,:,JSV) = ZTMP(:,:,:)
+ ENDDO
+ ENDIF
+ !
+ !=======================
+ ! === VECTOR FORCING ===
+ ! ======================
+ !
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ ZTMU(:,:,:,1) = PRUS(:,:,:)
+ ZTMU(:,:,:,2) = PRVS(:,:,:)
+ ZTMU(:,:,:,3) = PRWS(:,:,:)
+ !
+ ZTMP(:,:,:) = PRUS(:,:,:)
+ ZXMU(:,:,:) = MXM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MXM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'U',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRUS(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,:) = PRVS(:,:,:)
+ ZXMU(:,:,:) = MYM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MYM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'V',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRVS(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,:) = PRWS(:,:,:)
+ ZXMU(:,:,:) = MZM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MZM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'W',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRWS(:,:,:) = ZTMP(:,:,:)
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ !**** 3. COMMUNICATIONS
+ ! -----------------
+ !
+ IF (.NOT. LIBM_TROUBLE) THEN
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING::PTHS')
+ IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING::PTKS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING::PRWS')
+ IF (NRR>=1) THEN
+ DO JRR=1,NRR
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JRR),'IBM_FORCING::PRRS')
+ ENDDO
+ ENDIF
+ IF (NSV>=1) THEN
+ DO JSV=1,NSV
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JSV),'IBM_FORCING::PSVS')
+ ENDDO
+ ENDIF
+ !
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ENDIF
+ !
+ !**** 4. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZTMP,ZTMU,ZTRY,ZXMU,ZDIV,ZTKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING
diff --git a/src/PHYEX/ext/ibm_forcing_tr.f90 b/src/PHYEX/ext/ibm_forcing_tr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c14ac2aa61fadced5c1759f7043002c727492670
--- /dev/null
+++ b/src/PHYEX/ext/ibm_forcing_tr.f90
@@ -0,0 +1,410 @@
+!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_FORCING_TR
+ ! ##########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
+ !
+ END SUBROUTINE IBM_FORCING_TR
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING_TR
+!
+!
+! #############################################################
+SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ ! #############################################################
+ !
+ !!**** *IBM_FORCING_TR* - routine to force all desired fields
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! 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_CST, ONLY: XRD,XRV
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_TURB_n, ONLY: XTKEMIN
+ USE MODD_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JI2,JJ2,JK2,IIU,IJU,IKU,JL
+ INTEGER :: JIM1,JJM1,JKM1,JIP1,JJP1,JKP1
+ INTEGER :: IIE,IIB,IJE,IJB,IKB,IKE
+ REAL :: ZSUM1,ZSUM2,ZSUM4
+ REAL, DIMENSION(:), ALLOCATABLE :: ZSUM3,ZSUM5
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRUS,2)
+ IKU = SIZE(PRUS,3)
+ IKB = 1 + JPVEXT
+ IKE = SIZE(PRUS,3) - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Problems in GCT ? => imposition of the adjacent value
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+ DO JK=IKB,IKE
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,1).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ IF (NSV>=1) ALLOCATE(ZSUM3(NSV))
+ ZSUM3 = 0.
+ ZSUM4 = 0.
+ IF (NRR>=1) ALLOCATE(ZSUM5(NRR))
+ ZSUM5 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ !
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,1))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTHS(JI2,JJ2,JK2)
+ IF (NRR>=1) THEN
+ DO JL = 1,NRR
+ ZSUM5(JL) = ZSUM5(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PRRS(JI2,JJ2,JK2,JL)
+ ENDDO
+ ENDIF
+ IF (NSV>=1) THEN
+ DO JL = 1,NSV
+ ZSUM3(JL) = ZSUM3(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PSVS(JI2,JJ2,JK2,JL)
+ ENDDO
+ ENDIF
+ IF (CTURB/='NONE') ZSUM4 = ZSUM4 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTKS(JI2,JJ2,JK2)
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)
+ IF (NRR>=1) PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)/(1.+XRD/XRV*XRVREF(JI,JJ,JK))
+ IF (ZSUM1.GT.XIBM_EPSI) PTHS(JI,JJ,JK) = ZSUM2/ZSUM1
+ IF (NRR>=1) THEN
+ PRRS(JI,JJ,JK,1) = XRVREF(JI,JJ,JK)
+ IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,1) = ZSUM5(1)/ZSUM1
+ IF (NRR>=2) THEN
+ DO JL = 2,NRR
+ PRRS(JI,JJ,JK,JL) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,JL) = ZSUM5(JL)/ZSUM1
+ ENDDO
+ ENDIF
+ ENDIF
+ !
+ IF (NSV>=1) THEN
+ DO JL = 1,NSV
+ PSVS(JI,JJ,JK,JL) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PSVS(JI,JJ,JK,JL) = ZSUM3(JL)/ZSUM1
+ ENDDO
+ ENDIF
+ !
+ IF (CTURB/='NONE') PTKS(JI,JJ,JK) = XTKEMIN
+ IF (ZSUM1.GT.XIBM_EPSI.AND.(CTURB/='NONE')) PTKS(JI,JJ,JK) = ZSUM4/ZSUM1
+ IF (NSV>=1) DEALLOCATE(ZSUM3)
+ IF (NRR>=1) DEALLOCATE(ZSUM5)
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,2).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,2))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,2))*PRUS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRUS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,3).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,3))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,3))*PRVS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRVS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRVS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,4).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,4))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,4))*PRWS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRWS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRWS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PTHS(:,:,IKB-1)=PTHS(:,:,IKB)
+ PTHS(:,:,IKE+1)=PTHS(:,:,IKE)
+ IF (CTURB/='NONE') PTKS(:,:,IKB-1)=PTKS(:,:,IKB)
+ IF (CTURB/='NONE') PTKS(:,:,IKE+1)=PTKS(:,:,IKE)
+ IF (NSV>=1) PSVS(:,:,IKB-1,:)=PSVS(:,:,IKB,:)
+ IF (NSV>=1) PSVS(:,:,IKE+1,:)=PSVS(:,:,IKE,:)
+ IF (NRR>=1) PRRS(:,:,IKB-1,:)=PRRS(:,:,IKB,:)
+ IF (NRR>=1) PRRS(:,:,IKE+1,:)=PRRS(:,:,IKE,:)
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING_TR::PTHS')
+ IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING_TR::PTKS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
+ IF (NSV>=1) THEN
+ DO JL=1,NSV
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JL),'IBM_FORCING_TR::PSVS')
+ ENDDO
+ ENDIF
+ IF (NRR>=1) THEN
+ DO JL=1,NRR
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JL),'IBM_FORCING_TR::PRRS')
+ ENDDO
+ ENDIF
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ! Problems on corners ? => imposition of the adjacent value
+ !
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+ DO JK=IKB,IKE
+ !
+ IF (XIBM_LS(JI,JJ,JK,2).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI-1,JJ,JK))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRUS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(JI,JJ,JK) = (1.-ZSUM1)*PRUS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ !
+ IF (XIBM_LS(JI,JJ,JK,3).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ-1,JK))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRVS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRVS(JI,JJ,JK) = (1.-ZSUM1)*PRVS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ !
+ IF (XIBM_LS(JI,JJ,JK,4).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ,JK-1))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRWS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRWS(JI,JJ,JK) = (1.-ZSUM1)*PRWS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING_TR
diff --git a/src/PHYEX/ext/ibm_generls.f90 b/src/PHYEX/ext/ibm_generls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f8d7f9d7f079de236167627a7fc3add8c9152baf
--- /dev/null
+++ b/src/PHYEX/ext/ibm_generls.f90
@@ -0,0 +1,541 @@
+!MNH_LIC Copyright 2021-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_IBM_GENERLS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_GENERLS(PIBM_FACES,PNORM_FACES,PV1,PV2,PV3,PX_MIN,PY_MIN,PX_MAX,PY_MAX,PPHI)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PIBM_FACES
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PNORM_FACES,PV1,PV2,PV3
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ REAL ,INTENT(IN) :: PX_MIN,PY_MIN,PX_MAX,PY_MAX
+ !
+ END SUBROUTINE IBM_GENERLS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_GENERLS
+!
+! #####################################
+SUBROUTINE IBM_GENERLS(PIBM_FACES,PNORM_FACES,PV1,PV2,PV3,PX_MIN,PY_MIN,PX_MAX,PY_MAX,PPHI)
+ ! #####################################
+ !
+ !
+ !**** IBM_GENERLS computes the Level Set function for any surface
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the level set
+ ! containing XYZ minimalisation interface locations
+
+ ! METHOD
+ ! ------
+ !**** Iterative system and minimization of the interface distance
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ ! The method is based on '3D Distance from a Point to a Triangle'
+ ! a technical report from Mark W. Jones, University of Wales Swansea
+ !
+ ! AUTHORS
+ ! ------
+ ! Tim Nagel, Valéry Masson & Robert Schoetter
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/06/2021
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 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_IBM_LSF
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT,XUNDEF
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CST, ONLY: XMNH_EPSILON
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_DETECT
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PIBM_FACES !faces coordinates
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PNORM_FACES !normal
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PV1,PV2,PV3
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ REAL ,INTENT(IN) :: PX_MIN,PY_MIN,PX_MAX,PY_MAX
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM,JI2,JJ2,JK2 ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX,IIU,IJU,IKU ! loop boundaries
+ REAL :: Z_DIST_TEST1,Z_DIST_TEST2 ! saving distances
+ REAL :: Z_DIST_TEST3,Z_DIST_TEST4,ZDIST_REF0
+ INTEGER :: INUMB_FACES ! number of faces
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM,ZDP0PP0PAST
+ CHARACTER(LEN=1) :: YPOS
+ REAL, DIMENSION(3) :: ZP1P0,ZP1P2,ZP0PP0,ZP1PP0,ZP2PP0,ZP3PP0,ZPP0P1,ZPP0P2,ZPP0P3
+ REAL, DIMENSION(3) :: ZPP0PPP0,ZPPP0P1,ZPPP0P2,ZP2P1,ZP2P0,ZP2P3,ZP3P2,ZP3P1
+ REAL, DIMENSION(3) :: ZPP0,ZFT1,ZFT2,ZFT3,ZFT1B,ZFT2B,ZFT3B,ZR,ZPPP0,ZP3P0,ZP0P1
+ REAL, DIMENSION(3) :: ZPPP0P3,ZP1P3,ZPCP0,ZR0
+ REAL, DIMENSION(:), ALLOCATABLE :: ZSTEMP,ZRDIR,ZVECTDISTPLUS,ZVECTDISTMOINS,ZVECTDIST!,ZFACE
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZC
+ REAL :: ZF1,ZF2,ZF3,ZF1B,ZF2B,ZF3B,ZDPP0PPP0
+ REAL :: ZT,ZSIGN,ZS,ZDIST,ZDP0PP0,ZNNORM,ZRN,ZPHI_OLD
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll,IMI ! return code of parallel routine
+ INTEGER :: IIE,IIB,IJB,IJE,IKE,IKB,ZBPLUS
+ LOGICAL :: GABOVE_ROOF,LFACE,LDZ
+ LOGICAL, DIMENSION(:), ALLOCATABLE :: ZFACE
+ INTEGER :: ZCOUNT,ZIDX,ZII,ZCHANGE,ZCHANGE1
+ REAL :: ZDIFF,ZMIN_DIFF,ZDX
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ NULLIFY(TZFIELDS_ll)
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ !
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ CALL GET_INDICE_ll (JI_MIN,JJ_MIN,JI_MAX,JJ_MAX)
+ !
+ ALLOCATE(ZXHATM(IIU,IJU,IKU))
+ ALLOCATE(ZYHATM(IIU,IJU,IKU))
+ ALLOCATE(ZZHATM(IIU,IJU,IKU))
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ INUMB_FACES = SIZE(PIBM_FACES,1)
+ ALLOCATE(ZC(INUMB_FACES,3))
+ ALLOCATE(ZSTEMP(1))
+ ALLOCATE(ZRDIR(1))
+ PPHI = -XUNDEF
+ ALLOCATE(ZDP0PP0PAST(IIU,IJU,IKU))
+ ZDP0PP0PAST = 0.
+ ALLOCATE(ZVECTDIST(10000))
+ ALLOCATE(ZVECTDISTPLUS(10000))
+ ALLOCATE(ZVECTDISTMOINS(10000))
+ ALLOCATE(ZFACE(10000))
+ ZFACE=.FALSE.
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ JM=1
+ YPOS = 'P'
+ !
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ ZDX = ZXHATM(JI_MIN+1,JJ_MIN,JK_MIN)-ZXHATM(JI_MIN,JJ_MIN,JK_MIN)
+ !
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ ZCOUNT = 1
+ ZVECTDIST = -999.
+ DO JN = 1,INUMB_FACES
+ LFACE=.FALSE.
+ !***Calcul of the face center
+ ZC(JN,1)=(PIBM_FACES(JN,1,1)+PIBM_FACES(JN,2,1)+PIBM_FACES(JN,3,1))/3.
+ ZC(JN,2)=(PIBM_FACES(JN,1,2)+PIBM_FACES(JN,2,2)+PIBM_FACES(JN,3,2))/3.
+ ZC(JN,3)=(PIBM_FACES(JN,1,3)+PIBM_FACES(JN,2,3)+PIBM_FACES(JN,3,3))/3.
+ !***Norm normalization
+ ZNNORM = SQRT(PNORM_FACES(JN,1)**2+PNORM_FACES(JN,2)**2+PNORM_FACES(JN,3)**2)
+ !***Vector between the face center and the current grid point
+ ZPCP0(1) = ZXHATM(JI,JJ,JK)-ZC(JN,1)
+ ZPCP0(2) = ZYHATM(JI,JJ,JK)-ZC(JN,2)
+ ZPCP0(3) = ZZHATM(JI,JJ,JK)-ZC(JN,3)
+ ZSIGN = ZPCP0(1)*PNORM_FACES(JN,1)+ &
+ ZPCP0(2)*PNORM_FACES(JN,2)+ &
+ ZPCP0(3)*PNORM_FACES(JN,3)
+ !***Various vectors
+ ZP1P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,1,1)
+ ZP1P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,1,2)
+ ZP1P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,1,3)
+ ZP3P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,3,1)
+ ZP3P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,3,2)
+ ZP3P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,3,3)
+ ZP0P1(1) = PIBM_FACES(JN,1,1)-ZXHATM(JI,JJ,JK)
+ ZP0P1(2) = PIBM_FACES(JN,1,2)-ZYHATM(JI,JJ,JK)
+ ZP0P1(3) = PIBM_FACES(JN,1,3)-ZZHATM(JI,JJ,JK)
+ ZP2P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,2,1)
+ ZP2P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,2,2)
+ ZP2P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,2,3)
+ !***Equation (3) of Jones (1995)
+ IF(ZP1P0(1)==0.AND.ZP1P0(2)==0.AND.ZP1P0(3)==0) THEN
+ WRITE(*,*) 'ZP1P0(1,2,3)',ZP1P0(1),ZP1P0(2),ZP1P0(3)
+ ZDP0PP0 = 0.
+ ELSE
+ ZDP0PP0 = SQRT(ZP0P1(1)**2+ZP0P1(2)**2+ZP0P1(3)**2)* &
+ ((ZP1P0(1)*PNORM_FACES(JN,1)+ZP1P0(2)*PNORM_FACES(JN,2)+&
+ ZP1P0(3)*PNORM_FACES(JN,3))/( &
+ SQRT((ZP1P0(1))**2+(ZP1P0(2))**2+(ZP1P0(3))**2)*ZNNORM))
+ END IF
+ !***Equation (4) of Jones (1995)
+ ZP0PP0(1) = -ZDP0PP0*(PNORM_FACES(JN,1)/ZNNORM)
+ ZP0PP0(2) = -ZDP0PP0*(PNORM_FACES(JN,2)/ZNNORM)
+ ZP0PP0(3) = -ZDP0PP0*(PNORM_FACES(JN,3)/ZNNORM)
+ !***Equation (5) of Jones (1995)
+ ZPP0(1) = ZXHATM(JI,JJ,JK)+ZP0PP0(1)
+ ZPP0(2) = ZYHATM(JI,JJ,JK)+ZP0PP0(2)
+ ZPP0(3) = ZZHATM(JI,JJ,JK)+ZP0PP0(3)
+ !
+ ZP1PP0(1)=ZPP0(1)-PIBM_FACES(JN,1,1)
+ ZP1PP0(2)=ZPP0(2)-PIBM_FACES(JN,1,2)
+ ZP1PP0(3)=ZPP0(3)-PIBM_FACES(JN,1,3)
+ !
+ ZP2PP0(1)=ZPP0(1)-PIBM_FACES(JN,2,1)
+ ZP2PP0(2)=ZPP0(2)-PIBM_FACES(JN,2,2)
+ ZP2PP0(3)=ZPP0(3)-PIBM_FACES(JN,2,3)
+ !
+ ZP3PP0(1)=ZPP0(1)-PIBM_FACES(JN,3,1)
+ ZP3PP0(2)=ZPP0(2)-PIBM_FACES(JN,3,2)
+ ZP3PP0(3)=ZPP0(3)-PIBM_FACES(JN,3,3)
+ !
+ ZPP0P1(1)=PIBM_FACES(JN,1,1)-ZPP0(1)
+ ZPP0P1(2)=PIBM_FACES(JN,1,2)-ZPP0(2)
+ ZPP0P1(3)=PIBM_FACES(JN,1,3)-ZPP0(3)
+ !
+ ZPP0P2(1)=PIBM_FACES(JN,2,1)-ZPP0(1)
+ ZPP0P2(2)=PIBM_FACES(JN,2,2)-ZPP0(2)
+ ZPP0P2(3)=PIBM_FACES(JN,2,3)-ZPP0(3)
+ !
+ ZPP0P3(1)=PIBM_FACES(JN,3,1)-ZPP0(1)
+ ZPP0P3(2)=PIBM_FACES(JN,3,2)-ZPP0(2)
+ ZPP0P3(3)=PIBM_FACES(JN,3,3)-ZPP0(3)
+ !
+ !***Calculation of f1,f2,f3 (Jones (1995))
+ ZFT1= CROSSPRODUCT(PV1(JN,:),ZP1PP0)
+ ZFT2= CROSSPRODUCT(PV2(JN,:),ZP2PP0)
+ ZFT3= CROSSPRODUCT(PV3(JN,:),ZP3PP0)
+
+ ZF1 =ZFT1(1)*PNORM_FACES(JN,1)+ &
+ ZFT1(2)*PNORM_FACES(JN,2)+ &
+ ZFT1(3)*PNORM_FACES(JN,3)
+
+ ZF2 =ZFT2(1)*PNORM_FACES(JN,1)+ &
+ ZFT2(2)*PNORM_FACES(JN,2)+ &
+ ZFT2(3)*PNORM_FACES(JN,3)
+
+ ZF3 =ZFT3(1)*PNORM_FACES(JN,1)+ &
+ ZFT3(2)*PNORM_FACES(JN,2)+ &
+ ZFT3(3)*PNORM_FACES(JN,3)
+ !***Point anticlockwise of V1 and clockwise of V2
+ IF (ZF1.GE.0.AND.ZF2.LE.0) THEN
+ ZFT1B = CROSSPRODUCT(ZPP0P1,ZPP0P2)
+ ZF1B = ZFT1B(1)*PNORM_FACES(JN,1)+ &
+ ZFT1B(2)*PNORM_FACES(JN,2)+ &
+ ZFT1B(3)*PNORM_FACES(JN,3)
+ IF (ZF1B<0) THEN
+ ZP1P2(:) = PIBM_FACES(JN,2,:)-PIBM_FACES(JN,1,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P2,ZPP0P1),ZP1P2)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ !***Eq. (10) of Jones(1995)
+ ZDPP0PPP0 = SQRT(ZPP0P1(1)**2+ZPP0P1(2)**2+ZPP0P1(3)**2)* &
+ ((ZPP0P1(1)*ZR(1)+ZPP0P1(2)*ZR(2)+ZPP0P1(3)*ZR(3))/( &
+ SQRT(ZPP0P1(1)**2+ZPP0P1(2)**2+ZPP0P1(3)**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P1 = PIBM_FACES(JN,1,:)-ZPPP0
+ ZP2P1 = PIBM_FACES(JN,1,:)-PIBM_FACES(JN,2,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P1,ZP2P1))
+ ZT = SQRT(ZPPP0P1(1)**2+ZPPP0P1(2)**2+ZPPP0P1(3)**2)/ &
+ SQRT(ZP2P1(1)**2+ZP2P1(2)**2+ZP2P1(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST =SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP1P0(1)**2+ZP1P0(2)**2+ZP1P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP2P0(1)**2+ZP2P0(2)**2+ZP2P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ !***Point anticlockwise of V2 and clockwise of V3
+ ELSEIF (ZF2.GE.0.AND.ZF3.LE.0) THEN
+ ZFT2B = CROSSPRODUCT(ZPP0P2,ZPP0P3)
+ ZF2B = ZFT2B(1)*PNORM_FACES(JN,1)+ &
+ ZFT2B(2)*PNORM_FACES(JN,2)+ &
+ ZFT2B(3)*PNORM_FACES(JN,3)
+ IF (ZF2B<0) THEN
+ ZP2P3(:) = PIBM_FACES(JN,3,:)-PIBM_FACES(JN,2,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P3,ZPP0P2),ZP2P3)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ ZDPP0PPP0 = SQRT(ZPP0P2(1)**2+ZPP0P2(2)**2+ZPP0P2(3)**2)* &
+ ((ZPP0P2(1)*ZR(1)+ZPP0P2(2)*ZR(2)+ZPP0P2(3)*ZR(3))/( &
+ SQRT(ZPP0P2(1)**2+ZPP0P2(2)**2+ZPP0P2(3)**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P2 = PIBM_FACES(JN,2,:)-ZPPP0
+ ZP3P2 = PIBM_FACES(JN,2,:)-PIBM_FACES(JN,3,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P2,ZP3P2))
+ ZT = SQRT(ZPPP0P2(1)**2+ZPPP0P2(2)**2+ZPPP0P2(3)**2)/ &
+ SQRT(ZP3P2(1)**2+ZP3P2(2)**2+ZP3P2(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST = SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP2P0(1)**2+ZP2P0(2)**2+ZP2P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP3P0(1)**2+ZP3P0(2)**2+ZP3P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ !***Point anticlockwise of V3 and clockwise of V1
+ ELSEIF (ZF3.GE.0.AND.ZF1.LE.0) THEN
+ ZFT3B = CROSSPRODUCT(ZPP0P3,ZPP0P1)
+ ZF3B = ZFT3B(1)*PNORM_FACES(JN,1)+ &
+ ZFT3B(2)*PNORM_FACES(JN,2)+ &
+ ZFT3B(3)*PNORM_FACES(JN,3)
+ IF (ZF3B<0) THEN
+ ZP3P1(:) = PIBM_FACES(JN,1,:)-PIBM_FACES(JN,3,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P1,ZPP0P3),ZP3P1)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ ZDPP0PPP0 = SQRT(ZPP0P3(1)**2+ZPP0P3(2)**2+ZPP0P3(3)**2)* &
+ ((ZPP0P3(1)*ZR(1)+ZPP0P3(2)*ZR(2)+ZPP0P3(3)*ZR(3))/( &
+ SQRT((ZPP0P3(1))**2+(ZPP0P3(2))**2+(ZPP0P3(3))**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P3 = PIBM_FACES(JN,3,:)-ZPPP0
+ ZP1P3 = PIBM_FACES(JN,3,:)-PIBM_FACES(JN,1,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P3,ZP1P3))
+ ZT = SQRT(ZPPP0P3(1)**2+ZPPP0P3(2)**2+ZPPP0P3(3)**2)/ &
+ SQRT(ZP1P3(1)**2+ZP1P3(2)**2+ZP1P3(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST = SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP3P0(1)**2+ZP3P0(2)**2+ZP3P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP1P0(1)**2+ZP1P0(2)**2+ZP1P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZF instruction' )
+ ENDIF
+ ZDIST = SIGN(ZDIST,-ZSIGN)
+ ZDIST = ANINT(ZDIST*10.E5) / 10.E5
+ PPHI(JI,JJ,JK,JM) = ANINT(PPHI(JI,JJ,JK,JM)*10.E5) / 10.E5
+ IF (ABS(ZDIST).LE.ABS(PPHI(JI,JJ,JK,JM))) THEN
+ ZPHI_OLD = PPHI(JI,JJ,JK,JM)
+ IF (ABS(ZDIST)==ABS(PPHI(JI,JJ,JK,JM))) THEN
+ IF (ABS(ZDP0PP0).GT.ABS(ZDP0PP0PAST(JI,JJ,JK))) THEN
+ PPHI(JI,JJ,JK,JM) = ZDIST
+ ZDP0PP0PAST(JI,JJ,JK) = ZDP0PP0
+ ENDIF
+ ELSE
+ PPHI(JI,JJ,JK,JM) = ZDIST
+ ENDIF
+ IF (ABS(ZDIST).LT.ABS(ZPHI_OLD)) THEN
+ ZDP0PP0PAST(JI,JJ,JK) = ZDP0PP0
+ ENDIF
+ ENDIF
+ IF (ABS(PPHI(JI,JJ,JK,JM)).GT.(SQRT(3.)*4.)) THEN
+ PPHI(JI,JJ,JK,JM) = -999.
+ ENDIF
+ IF (ABS(ZDIST).LT.(SQRT(3.)*4.)) THEN
+ ZVECTDIST(ZCOUNT)=ZDIST
+ ZFACE(ZCOUNT)=LFACE
+ ZCOUNT = ZCOUNT +1
+ ENDIF
+ ENDDO
+ ZVECTDISTPLUS=ZVECTDIST
+ ZVECTDISTMOINS=ZVECTDIST
+ WHERE (ZVECTDIST.GT.0)
+ ZVECTDISTMOINS=-999.
+ ENDWHERE
+ WHERE (ZVECTDIST.LT.0)
+ ZVECTDISTPLUS=999.
+ ENDWHERE
+ IF (ANY(ZVECTDIST.GT.0.).AND.(ABS(ABS(MINVAL(ZVECTDISTPLUS))-ABS(MAXVAL(ZVECTDISTMOINS))).LT.10.E-6)) THEN
+ ZMIN_DIFF = 1.
+ ZIDX = 0
+ DO ZII = 1, SIZE(ZVECTDIST)
+ ZDIFF = ABS(ZVECTDIST(ZII)-MINVAL(ZVECTDISTPLUS))
+ IF ( ZDIFF < ZMIN_DIFF) THEN
+ ZIDX = ZII
+ ZMIN_DIFF = ZDIFF
+ ENDIF
+ ENDDO
+ IF (ZFACE(ZIDX)) THEN
+ PPHI(JI,JJ,JK,JM) = MINVAL(ZVECTDISTPLUS)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+
+DO JJ=JJ_MIN,JJ_MAX
+DO JI=JI_MIN,JI_MAX
+GABOVE_ROOF=.FALSE.
+DO JK=IKB, IKE
+ ! check if point is flagged as not calculated
+ IF (PPHI(JI,JJ,JK,JM)==-999.) THEN
+ ! check if point is already above a point that encountered a point near the
+ ! surface (that can be outside or inside a building)
+ ! check if that point was inside (if outside, the value of the levelset
+ ! stays at -999.)
+ IF (GABOVE_ROOF .AND. PPHI(JI,JJ,JK-1,JM) > XIBM_EPSI) THEN
+ PPHI(JI,JJ,JK,JM) = 999.
+ CYCLE
+ END IF
+ ! check if the point of the column have not encoutered a near-building
+ ! surface point with a physical value of the level set
+ IF (.NOT. GABOVE_ROOF) THEN
+ ! if the point above has a physical value for the level set, then the
+ ! status inside (999) or outside (-999) is given to all points below,
+ ! depending if this point above (that needs not to be the point at the top
+ ! of the model!) is inside or outside
+ ! checks if the point above has a physical value for the levelset
+ IF (JK<IKE .AND. ABS (PPHI(JI,JJ,JK+1,JM)) < 900.) THEN
+ ! if the point above is inside, all points below are set inside
+ IF (PPHI(JI,JJ,JK+1,JM)>XIBM_EPSI) PPHI(JI,JJ,IKB:JK,JM) = 999.
+ ! indicate for further processing of points above the current point
+ ! that we have encountered a physical value of the level set, near the
+ ! surface building
+ GABOVE_ROOF = .TRUE.
+ END IF
+ CYCLE
+ ENDIF
+ END IF
+ ! if we have never encoutered a roof or point near a building form above,
+ ! then, we are outside, and nothing is changed (value -999 kept)
+ END DO
+ PPHI(JI,JJ,IKB-1,JM) = PPHI(JI,JJ,IKB,JM)
+ PPHI(JI,JJ,IKE+1,JM) = PPHI(JI,JJ,IKE,JM)
+END DO
+END DO
+
+
+JN=1
+PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+
+PPHI(:,:,:,2)=MXM(PPHI(:,:,:,1))
+PPHI(:,:,:,3)=MYM(PPHI(:,:,:,1))
+PPHI(:,:,:,4)=MZM(PPHI(:,:,:,1))
+
+NULLIFY(TZFIELDS_ll)
+DO JN=2,4
+ PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+ PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+ PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+ PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+ PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+ PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+ENDDO
+
+PPHI(:,:,:,5)=MYM(PPHI(:,:,:,2))
+PPHI(:,:,:,6)=MXM(PPHI(:,:,:,4))
+PPHI(:,:,:,7)=MYM(PPHI(:,:,:,4))
+NULLIFY(TZFIELDS_ll)
+DO JN=5,7
+ PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+ PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+ PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+ PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+ PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+ PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+ENDDO
+WHERE (ABS(PPHI(:,:,:,:)).LT.XIBM_EPSI) PPHI(:,:,:,:)=2.*XIBM_EPSI
+
+
+ !COMPLETE PPHI ON THE HALO OF EACH SUBDOMAINS
+ DO JN=1,7
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,JN),'IBM_GENERLS::PPHI')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ !DEALLOCATE(ZDP0PP0,ZDIST,ZC,ZSTEMP)
+ DEALLOCATE(ZC,ZSTEMP)
+ DEALLOCATE(ZXHATM,ZYHATM,ZZHATM)
+ !
+ RETURN
+ !
+CONTAINS
+ !
+ FUNCTION CROSSPRODUCT(PA,PB) RESULT(CROSS)
+ !
+ REAL, DIMENSION(3) :: CROSS
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+ CROSS(1) = PA(2) * PB(3) - PA(3) * PB(2)
+ CROSS(2) = PA(3) * PB(1) - PA(1) * PB(3)
+ CROSS(3) = PA(1) * PB(2) - PA(2) * PB(1)
+ END FUNCTION CROSSPRODUCT
+
+ FUNCTION SCALPRODUCT(PA,PB) RESULT(SCAL)
+ !
+ REAL :: SCAL
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+ SCAL = PA(1)*PB(1)+PA(2)*PB(2)+PA(3)*PB(3)
+ END FUNCTION SCALPRODUCT
+
+END SUBROUTINE IBM_GENERLS
diff --git a/src/PHYEX/ext/ice_adjust_bis.f90 b/src/PHYEX/ext/ice_adjust_bis.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e530d5c21f91b7e143b2d7240f669e4df7c181bd
--- /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_n, ONLY : NEBN
+!
+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, NEBN, 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_budget.f90 b/src/PHYEX/ext/ini_budget.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6e8895afca14422904c7d7c6af66ad6a8063dd10
--- /dev/null
+++ b/src/PHYEX/ext/ini_budget.f90
@@ -0,0 +1,4898 @@
+!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 17/08/2020: add Budget_preallocate subroutine
+!-----------------------------------------------------------------
+module mode_ini_budget
+
+ use mode_msg
+
+ implicit none
+
+ private
+
+ public :: Budget_preallocate, Ini_budget
+
+ integer, parameter :: NSOURCESMAX = 60 !Maximum number of sources in a budget
+
+contains
+
+subroutine Budget_preallocate()
+
+use modd_budget, only: nbudgets, tbudgets, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, &
+ NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, &
+ NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
+use modd_nsv, only: nsv, tsvlist
+
+integer :: ibudget
+integer :: jsv
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_preallocate', 'called' )
+
+if ( allocated( tbudgets ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Budget_preallocate', 'tbudgets already allocated' )
+ return
+end if
+
+nbudgets = NBUDGET_SV1 - 1 + nsv
+allocate( tbudgets( nbudgets ) )
+
+tbudgets(NBUDGET_U)%cname = "UU"
+tbudgets(NBUDGET_U)%ccomment = "Budget for U"
+tbudgets(NBUDGET_U)%nid = NBUDGET_U
+
+tbudgets(NBUDGET_V)%cname = "VV"
+tbudgets(NBUDGET_V)%ccomment = "Budget for V"
+tbudgets(NBUDGET_V)%nid = NBUDGET_V
+
+tbudgets(NBUDGET_W)%cname = "WW"
+tbudgets(NBUDGET_W)%ccomment = "Budget for W"
+tbudgets(NBUDGET_W)%nid = NBUDGET_W
+
+tbudgets(NBUDGET_TH)%cname = "TH"
+tbudgets(NBUDGET_TH)%ccomment = "Budget for potential temperature"
+tbudgets(NBUDGET_TH)%nid = NBUDGET_TH
+
+tbudgets(NBUDGET_TKE)%cname = "TK"
+tbudgets(NBUDGET_TKE)%ccomment = "Budget for turbulent kinetic energy"
+tbudgets(NBUDGET_TKE)%nid = NBUDGET_TKE
+
+tbudgets(NBUDGET_RV)%cname = "RV"
+tbudgets(NBUDGET_RV)%ccomment = "Budget for water vapor mixing ratio"
+tbudgets(NBUDGET_RV)%nid = NBUDGET_RV
+
+tbudgets(NBUDGET_RC)%cname = "RC"
+tbudgets(NBUDGET_RC)%ccomment = "Budget for cloud water mixing ratio"
+tbudgets(NBUDGET_RC)%nid = NBUDGET_RC
+
+tbudgets(NBUDGET_RR)%cname = "RR"
+tbudgets(NBUDGET_RR)%ccomment = "Budget for rain water mixing ratio"
+tbudgets(NBUDGET_RR)%nid = NBUDGET_RR
+
+tbudgets(NBUDGET_RI)%cname = "RI"
+tbudgets(NBUDGET_RI)%ccomment = "Budget for cloud ice mixing ratio"
+tbudgets(NBUDGET_RI)%nid = NBUDGET_RI
+
+tbudgets(NBUDGET_RS)%cname = "RS"
+tbudgets(NBUDGET_RS)%ccomment = "Budget for snow/aggregate mixing ratio"
+tbudgets(NBUDGET_RS)%nid = NBUDGET_RS
+
+tbudgets(NBUDGET_RG)%cname = "RG"
+tbudgets(NBUDGET_RG)%ccomment = "Budget for graupel mixing ratio"
+tbudgets(NBUDGET_RG)%nid = NBUDGET_RG
+
+tbudgets(NBUDGET_RH)%cname = "RH"
+tbudgets(NBUDGET_RH)%ccomment = "Budget for hail mixing ratio"
+tbudgets(NBUDGET_RH)%nid = NBUDGET_RH
+
+do jsv = 1, nsv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+ tbudgets(ibudget)%cname = Trim( tsvlist(jsv)%cmnhname )
+ tbudgets(ibudget)%ccomment = 'Budget for scalar variable ' // Trim( tsvlist(jsv)%cmnhname )
+ tbudgets(ibudget)%nid = ibudget
+end do
+
+
+end subroutine Budget_preallocate
+
+
+! #################################################################
+ SUBROUTINE Ini_budget(KLUOUT,PTSTEP,KSV,KRR, &
+ ONUMDIFU,ONUMDIFTH,ONUMDIFSV, &
+ OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
+ OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
+ OHORELAX_SV, OVE_RELAX, ove_relax_grd, OCHTRANS, &
+ ONUDGING,ODRAGTREE,ODEPOTREE, ODRAGBLDG, OAERO_EOL, &
+ HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
+! #################################################################
+!
+!!**** *INI_BUDGET* - routine to initialize the parameters for the budgets
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to set or compute the parameters used
+! by the MESONH budgets. Names of files for budget recording are processed
+! and storage arrays are initialized.
+!
+!!** METHOD
+!! ------
+!! The essential of information is passed by modules. The choice of budgets
+!! and processes set by the user as integers is converted in "actions"
+!! readable by the subroutine BUDGET under the form of string characters.
+!! For each complete process composed of several elementary processes, names
+!! of elementary processes are concatenated in order to have an explicit name
+!! in the comment of the recording file for budget.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Modules MODD_*
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine INI_BUDGET)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/03/95
+!! J. Stein 25/06/95 put the sources in phase with the code
+!! J. Stein 20/07/95 reset to FALSE of all the switches when
+!! CBUTYPE /= MASK or CART
+!! J. Stein 26/06/96 add the new sources + add the increment between
+!! 2 active processes
+!! J.-P. Pinty 13/12/96 Allowance of multiple SVs
+!! J.-P. Pinty 11/01/97 Includes deep convection ice and forcing processes
+!! J.-P. Lafore 10/02/98 Allocation of the RHODJs for budget
+!! V. Ducrocq 04/06/99 //
+!! N. Asencio 18/06/99 // MASK case : delete KIMAX and KJMAX arguments,
+!! GET_DIM_EXT_ll initializes the dimensions of the
+!! extended local domain.
+!! LBU_MASK and NBUSURF are allocated on the extended
+!! local domain.
+!! add 3 local variables IBUDIM1,IBUDIM2,IBUDIM3
+!! to define the dimensions of the budget arrays
+!! in the different cases CART and MASK
+!! J.-P. Pinty 23/09/00 add budget for C2R2
+!! V. Masson 18/11/02 add budget for 2way nesting
+!! O.Geoffroy 03/2006 Add KHKO scheme
+!! J.-P. Pinty 22/04/97 add the explicit hail processes
+!! C.Lac 10/08/07 Add ADV for PPM without contribution
+!! of each direction
+!! C. Barthe 19/11/09 Add atmospheric electricity
+!! C.Lac 01/07/11 Add vegetation drag
+!! P. Peyrille, M. Tomasini : include in the forcing term the 2D forcing
+!! terms in term 2DFRC search for modif PP . but Not very clean!
+!! C .Lac 27/05/14 add negativity corrections for chemical species
+!! C.Lac 29/01/15 Correction for NSV_USER
+!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
+!! C.Lac 04/12/15 Correction for LSUPSAT
+! C. Lac 04/2016: negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+! C. Barthe 01/2016: add budget for LIMA
+! C. Lac 10/2016: add budget for droplet deposition
+! S. Riette 11/2016: new budgets for ICE3/ICE4
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 15/11/2019: remove unused CBURECORD variable
+! P. Wautelet 24/02/2020: bugfix: corrected condition for budget NCDEPITH
+! P. Wautelet 26/02/2020: bugfix: rename CEVA->REVA for budget for raindrop evaporation in C2R2 (necessary after commit 4ed805fc)
+! P. Wautelet 26/02/2020: bugfix: add missing condition on OCOLD for NSEDIRH budget in LIMA case
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! B. Vie 02/03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! P .Wautelet 09/03/2020: add missing budgets for electricity
+! P. Wautelet 25/03/2020: add missing ove_relax_grd
+! P. Wautelet 23/04/2020: add nid in tbudgetdata datatype
+! P. Wautelet + Benoit Vié 11/06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 30/06/2020: use NADVSV when possible
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! P. Wautelet 06/07/2020: bugfix: add condition on HTURB for NETUR sources for SV budgets
+! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite
+! P. Wautelet 11/01/2021: ignore xbuwri for cartesian boxes (write at every xbulen interval)
+! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
+! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget
+! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
+! P. Wautelet 02/03/2021: budgets: add terms for blowing snow
+! P. Wautelet 04/03/2021: budgets: add terms for drag due to buildings
+! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
+! C. Barthe 14/03/2022: budgets: add terms for CIBU and RDSF in LIMA
+! M. Taufour 01/07/2022: budgets: add concentration for snow, graupel, hail
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_2d_frc, only: l2d_adv_frc, l2d_rel_frc
+use modd_blowsnow, only: lblowsnow
+use modd_blowsnow_n, only: lsnowsubl
+use modd_budget
+use modd_ch_aerosol, only: lorilam
+use modd_conf, only: l1d, lcartesian, lforcing, lthinshell, nmodel
+use modd_dim_n, only: nimax_ll, njmax_ll, nkmax
+use modd_dragbldg_n, only: ldragbldg
+use modd_dust, only: ldust
+use modd_dyn, only: lcorio, xseglen
+use modd_dyn_n, only: xtstep, locean
+use modd_elec_descr, only: linductive, lrelax2fw_ion
+use modd_field, only: TYPEREAL
+use modd_fire_n, only: lblaze
+use modd_nsv, only: nsv_aerbeg, nsv_aerend, nsv_aerdepbeg, nsv_aerdepend, nsv_c2r2beg, nsv_c2r2end, &
+ nsv_chembeg, nsv_chemend, nsv_chicbeg, nsv_chicend, nsv_csbeg, nsv_csend, &
+ nsv_dstbeg, nsv_dstend, nsv_dstdepbeg, nsv_dstdepend, nsv_elecbeg, nsv_elecend, &
+#ifdef MNH_FOREFIRE
+ nsv_ffbeg, nsv_ffend, &
+#endif
+ nsv_lgbeg, nsv_lgend, &
+ nsv_lima_beg, nsv_lima_end, nsv_lima_ccn_acti, nsv_lima_ccn_free, nsv_lima_hom_haze, &
+ nsv_lima_ifn_free, nsv_lima_ifn_nucl, nsv_lima_imm_nucl, &
+ nsv_lima_nc, nsv_lima_nr, nsv_lima_ni, nsv_lima_ns, nsv_lima_ng, nsv_lima_nh, &
+ nsv_lima_scavmass, nsv_lima_spro, &
+ nsv_lnoxbeg, nsv_lnoxend, nsv_ppbeg, nsv_ppend, &
+ nsv_sltbeg, nsv_sltend, nsv_sltdepbeg, nsv_sltdepend, nsv_snwbeg, nsv_snwend, &
+ nsv_user, tsvlist
+use modd_parameters, only: jphext
+use modd_param_c2r2, only: ldepoc_c2r2 => ldepoc, lrain_c2r2 => lrain, lsedc_c2r2 => lsedc, lsupsat_c2r2 => lsupsat
+use modd_param_ice_n, only: ladj_after, ladj_before, ldeposc_ice => ldeposc, lred, lsedic_ice => lsedic, lwarm_ice => lwarm
+use modd_param_n, only: cactccn, celec
+use modd_param_lima, only: laero_mass_lima => laero_mass, lacti_lima => lacti, ldepoc_lima => ldepoc, &
+ lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, &
+ lptsplit, &
+ lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, &
+ lspro_lima => lspro, lcibu, lrdsf, &
+ nmom_c, nmom_r, nmom_i, nmom_s, nmom_g, nmom_h, nmod_ccn, nmod_ifn, nmod_imm
+use modd_ref, only: lcouples
+use modd_salt, only: lsalt
+use modd_neb_n, only: lsubg_cond
+use modd_viscosity, only: lvisc, lvisc_r, lvisc_sv, lvisc_th, lvisc_uvw
+
+USE MODE_ll
+
+IMPLICIT NONE
+!
+!* 0.1 declarations of argument
+!
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+REAL, INTENT(IN) :: PTSTEP ! time step
+INTEGER, INTENT(IN) :: KSV ! number of scalar variables
+INTEGER, INTENT(IN) :: KRR ! number of moist variables
+LOGICAL, INTENT(IN) :: ONUMDIFU ! switch to activate the numerical
+ ! diffusion for momentum
+LOGICAL, INTENT(IN) :: ONUMDIFTH ! for meteorological scalar variables
+LOGICAL, INTENT(IN) :: ONUMDIFSV ! for tracer scalar variables
+LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the
+ ! horizontal relaxation for U,V,W,TH
+LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the
+ ! horizontal relaxation for Rv
+LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the
+ ! horizontal relaxation for Rc
+LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the
+ ! horizontal relaxation for Rr
+LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the
+ ! horizontal relaxation for Ri
+LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the
+ ! horizontal relaxation for Rs
+LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the
+ ! horizontal relaxation for Rg
+LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the
+ ! horizontal relaxation for Rh
+LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
+ ! horizontal relaxation for tke
+LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
+ ! horizontal relaxation for scalar variables
+LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical
+ ! relaxation
+logical, intent(in) :: ove_relax_grd ! switch to activate the vertical
+ ! relaxation to the lowest verticals
+LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
+ !transport for SV
+LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
+LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
+LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree
+LOGICAL, INTENT(IN) :: ODRAGBLDG ! switch to activate building drag
+LOGICAL, INTENT(IN) :: OAERO_EOL ! switch to activate wind turbine wake
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
+CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
+CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the shallow convection scheme
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme
+CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
+ ! scheme
+CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
+!
+!* 0.2 declarations of local variables
+!
+real, parameter :: ITOL = 1e-6
+
+INTEGER :: JI, JJ ! loop indices
+INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
+INTEGER :: IIU, IJU ! size along x and y directions
+ ! of the extended subdomain
+INTEGER :: IBUDIM1 ! first dimension of the budget arrays
+ ! = NBUIMAX in CART case
+ ! = NBUKMAX in MASK case
+INTEGER :: IBUDIM2 ! second dimension of the budget arrays
+ ! = NBUJMAX in CART case
+ ! = nbusubwrite in MASK case
+INTEGER :: IBUDIM3 ! third dimension of the budget arrays
+ ! = NBUKMAX in CART case
+ ! = NBUMASK in MASK case
+INTEGER :: JSV ! loop indice for the SVs
+INTEGER :: IINFO_ll ! return status of the interface routine
+integer :: ibudget
+logical :: gtmp
+type(tbusourcedata) :: tzsource ! Used to prepare metadate of source terms
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget', 'called' )
+!
+!* 1. COMPUTE BUDGET VARIABLES
+! ------------------------
+!
+NBUSTEP = NINT (XBULEN / PTSTEP)
+NBUTSHIFT=0
+!
+! common dimension for all CBUTYPE values
+!
+IF (LBU_KCP) THEN
+ NBUKMAX = 1
+ELSE
+ NBUKMAX = NBUKH - NBUKL +1
+END IF
+!
+if ( cbutype == 'CART' .or. cbutype == 'MASK' ) then
+ !Check if xbulen is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbulen / xtstep ) * xtstep - xbulen ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbulen is not a multiple of xtstep' )
+
+ if ( cbutype == 'CART' ) then
+ !Check if xseglen is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xseglen / xbulen ) * xbulen - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbulen' )
+
+ !Write cartesian budgets every xbulen time period (do not take xbuwri into account)
+ xbuwri = xbulen
+
+ nbusubwrite = 1 !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbulen ) !Total number of budget time average periods
+ else if ( cbutype == 'MASK' ) then
+ !Check if xbuwri is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbuwri / xtstep ) * xtstep - xbuwri ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xtstep' )
+
+ !Check if xbuwri is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xbuwri / xbulen ) * xbulen - xbuwri ) > ( ITOL * xbulen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xbulen' )
+
+ !Check if xseglen is a multiple of xbuwri (within tolerance)
+ if ( Abs( Nint( xseglen / xbuwri ) * xbuwri - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbuwri' )
+
+ nbusubwrite = Nint ( xbuwri / xbulen ) !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbuwri ) !Total number of budget time average periods
+ end if
+end if
+
+IF (CBUTYPE=='CART') THEN ! cartesian case only
+!
+ IF ( NBUIL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too small (<1)' )
+ IF ( NBUIL > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too large (>NIMAX)' )
+ IF ( NBUIH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too small (<1)' )
+ IF ( NBUIH > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too large (>NIMAX)' )
+ IF ( NBUIH < NBUIL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH < NBUIL' )
+ IF (LBU_ICP) THEN
+ NBUIMAX_ll = 1
+ ELSE
+ NBUIMAX_ll = NBUIH - NBUIL +1
+ END IF
+
+ IF ( NBUJL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too small (<1)' )
+ IF ( NBUJL > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too large (>NJMAX)' )
+ IF ( NBUJH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too small (<1)' )
+ IF ( NBUJH > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too large (>NJMAX)' )
+ IF ( NBUJH < NBUJL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH < NBUJL' )
+ IF (LBU_JCP) THEN
+ NBUJMAX_ll = 1
+ ELSE
+ NBUJMAX_ll = NBUJH - NBUJL +1
+ END IF
+
+ IF ( NBUKL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too small (<1)' )
+ IF ( NBUKL > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too large (>NKMAX)' )
+ IF ( NBUKH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too small (<1)' )
+ IF ( NBUKH > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too large (>NKMAX)' )
+ IF ( NBUKH < NBUKL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH < NBUKL' )
+
+ CALL GET_INTERSECTION_ll(NBUIL+JPHEXT,NBUJL+JPHEXT,NBUIH+JPHEXT,NBUJH+JPHEXT, &
+ NBUSIL,NBUSJL,NBUSIH,NBUSJH,"PHYS",IINFO_ll)
+ IF ( IINFO_ll /= 1 ) THEN !
+ IF (LBU_ICP) THEN
+ NBUIMAX = 1
+ ELSE
+ NBUIMAX = NBUSIH - NBUSIL +1
+ END IF
+ IF (LBU_JCP) THEN
+ NBUJMAX = 1
+ ELSE
+ NBUJMAX = NBUSJH - NBUSJL +1
+ END IF
+ ELSE ! the intersection is void
+ CBUTYPE='SKIP' ! no budget on this processor
+ NBUIMAX = 0 ! in order to allocate void arrays
+ NBUJMAX = 0
+ ENDIF
+! three first dimensions of budget arrays in cart and skip cases
+ IBUDIM1=NBUIMAX
+ IBUDIM2=NBUJMAX
+ IBUDIM3=NBUKMAX
+! these variables are not be used
+ NBUMASK=-1
+!
+ELSEIF (CBUTYPE=='MASK') THEN ! mask case only
+!
+ LBU_ENABLE=.TRUE.
+ ! result on the FM_FILE
+ NBUTIME = 1
+
+ CALL GET_DIM_EXT_ll ('B', IIU,IJU)
+ ALLOCATE( LBU_MASK( IIU ,IJU, NBUMASK) )
+ LBU_MASK(:,:,:)=.FALSE.
+ ALLOCATE( NBUSURF( IIU, IJU, NBUMASK, nbusubwrite) )
+ NBUSURF(:,:,:,:) = 0
+!
+! three first dimensions of budget arrays in mask case
+! the order of the dimensions are the order expected in WRITE_DIACHRO routine:
+! x,y,z,time,mask,processus and in this case x and y are missing
+! first dimension of the arrays : dimension along K
+! second dimension of the arrays : number of the budget time period
+! third dimension of the arrays : number of the budget masks zones
+ IBUDIM1=NBUKMAX
+ IBUDIM2=nbusubwrite
+ IBUDIM3=NBUMASK
+! these variables are not used in this case
+ NBUIMAX=-1
+ NBUJMAX=-1
+! the beginning and the end along x and y direction : global extended domain
+ ! get dimensions of the physical global domain
+ CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
+ NBUIL=1
+ NBUIH=IIMAX_ll + 2 * JPHEXT
+ NBUJL=1
+ NBUJH=IJMAX_ll + 2 * JPHEXT
+!
+ELSE ! default case
+!
+ LBU_ENABLE=.FALSE.
+ NBUIMAX = -1
+ NBUJMAX = -1
+ LBU_RU = .FALSE.
+ LBU_RV = .FALSE.
+ LBU_RW = .FALSE.
+ LBU_RTH= .FALSE.
+ LBU_RTKE= .FALSE.
+ LBU_RRV= .FALSE.
+ LBU_RRC= .FALSE.
+ LBU_RRR= .FALSE.
+ LBU_RRI= .FALSE.
+ LBU_RRS= .FALSE.
+ LBU_RRG= .FALSE.
+ LBU_RRH= .FALSE.
+ LBU_RSV= .FALSE.
+!
+! three first dimensions of budget arrays in default case
+ IBUDIM1=0
+ IBUDIM2=0
+ IBUDIM3=0
+!
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ALLOCATE MEMORY FOR BUDGET ARRAYS AND INITIALIZE
+! ------------------------------------------------
+!
+LBU_BEG =.TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITALIZE VARIABLES
+! -------------------
+!
+!Create intermediate variable to store rhodj for scalar variables
+if ( lbu_rth .or. lbu_rtke .or. lbu_rrv .or. lbu_rrc .or. lbu_rrr .or. &
+ lbu_rri .or. lbu_rrs .or. lbu_rrg .or. lbu_rrh .or. lbu_rsv ) then
+ allocate( tburhodj )
+
+ tburhodj%cmnhname = 'RhodJS'
+ tburhodj%cstdname = ''
+ tburhodj%clongname = 'RhodJS'
+ tburhodj%cunits = 'kg'
+ tburhodj%ccomment = 'RhodJ for Scalars variables'
+ tburhodj%ngrid = 1
+ tburhodj%ntype = TYPEREAL
+ tburhodj%ndims = 3
+
+ allocate( tburhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tburhodj%xdata(:, :, :) = 0.
+end if
+
+
+tzsource%ntype = TYPEREAL
+tzsource%ndims = 3
+
+! Budget of RU
+tbudgets(NBUDGET_U)%lenabled = lbu_ru
+
+if ( lbu_ru ) then
+ allocate( tbudgets(NBUDGET_U)%trhodj )
+
+ tbudgets(NBUDGET_U)%trhodj%cmnhname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_U)%trhodj%clongname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_U)%trhodj%ccomment = 'RhodJ for momentum along X axis'
+ tbudgets(NBUDGET_U)%trhodj%ngrid = 2
+ tbudgets(NBUDGET_U)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_U)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_U)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_U)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_U)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_U)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_U)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along X axis'
+ tzsource%ngrid = 2
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_U) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_U), cbulist_ru )
+end if
+
+! Budget of RV
+tbudgets(NBUDGET_V)%lenabled = lbu_rv
+
+if ( lbu_rv ) then
+ allocate( tbudgets(NBUDGET_V)%trhodj )
+
+ tbudgets(NBUDGET_V)%trhodj%cmnhname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_V)%trhodj%clongname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_V)%trhodj%ccomment = 'RhodJ for momentum along Y axis'
+ tbudgets(NBUDGET_V)%trhodj%ngrid = 3
+ tbudgets(NBUDGET_V)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_V)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_V)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_V)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_V)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_V)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_V)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Y axis'
+ tzsource%ngrid = 3
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_V) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_V), cbulist_rv )
+end if
+
+! Budget of RW
+tbudgets(NBUDGET_W)%lenabled = lbu_rw
+
+if ( lbu_rw ) then
+ allocate( tbudgets(NBUDGET_W)%trhodj )
+
+ tbudgets(NBUDGET_W)%trhodj%cmnhname = 'RhodJZ'
+ tbudgets(NBUDGET_W)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_W)%trhodj%clongname = 'RhodJZ'
+ tbudgets(NBUDGET_W)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_W)%trhodj%ccomment = 'RhodJ for momentum along Z axis'
+ tbudgets(NBUDGET_W)%trhodj%ngrid = 4
+ tbudgets(NBUDGET_W)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_W)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_W)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_W)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_W)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_W)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_W)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Z axis'
+ tzsource%ngrid = 4
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio .and. .not.l1d .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'GRAV'
+ tzsource%clongname = 'gravity'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_W) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_W), cbulist_rw )
+end if
+
+! Budget of RTH
+tbudgets(NBUDGET_TH)%lenabled = lbu_rth
+
+if ( lbu_rth ) then
+ tbudgets(NBUDGET_TH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of potential temperature'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'K'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'K s-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'PREF'
+ tzsource%clongname = 'reference pressure'
+ tzsource%lavailable = krr > 0 .and. .not.l1d
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RAD'
+ tzsource%clongname = 'radiation'
+ tzsource%lavailable = hrad /= 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'BLAZE'
+ tzsource%clongname = 'blaze fire model contribution'
+ tzsource%lavailable = lblaze
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'heat released by buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DISSH'
+ tzsource%clongname = 'dissipation'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_th
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'OCEAN'
+ tzsource%clongname = 'radiative tendency due to SW penetrating ocean'
+ tzsource%lavailable = locean .and. (.not. lcouples)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'heat transport by hydrometeors sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. nmom_r.ge.1 ) .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. (hcloud == 'LIMA' .and. nmom_i == 1)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'raindrop homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. nmom_h.ge.1 ) ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit &
+ .or. ( nmom_s.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TH), cbulist_rth )
+end if
+
+! Budget of RTKE
+tbudgets(NBUDGET_TKE)%lenabled = lbu_rtke
+
+if ( lbu_rtke ) then
+ tbudgets(NBUDGET_TKE)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TKE)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TKE)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TKE)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TKE)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of turbulent kinetic energy'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'm2 s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm2 s-3'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_tke
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DP'
+ tzsource%clongname = 'dynamic production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TP'
+ tzsource%clongname = 'thermal production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DISS'
+ tzsource%clongname = 'dissipation of TKE'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TR'
+ tzsource%clongname = 'turbulent transport'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TKE) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TKE), cbulist_rtke )
+end if
+
+! Budget of RRV
+tbudgets(NBUDGET_RV)%lenabled = lbu_rrv .and. krr >= 1
+
+if ( tbudgets(NBUDGET_RV)%lenabled ) then
+ tbudgets(NBUDGET_RV)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RV)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RV)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RV)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RV)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of water vapor mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rv
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'vapor released by buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'BLAZE'
+ tzsource%clongname = 'blaze fire model contribution'
+ tzsource%lavailable = lblaze
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+ .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. ( hcloud == 'LIMA' .and. nmom_i == 1 )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on HAIL'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. nmom_h.ge.1 ) &
+ .or. hcloud == 'ICE4' )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RV) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RV), cbulist_rrv )
+end if
+
+! Budget of RRC
+tbudgets(NBUDGET_RC)%lenabled = lbu_rrc .and. krr >= 2
+
+if ( tbudgets(NBUDGET_RC)%lenabled ) then
+ if ( hcloud(1:3) == 'ICE' .and. lred .and. lsedic_ice .and. ldeposc_ice ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'lred=T + lsedic=T + ldeposc=T:'// &
+ 'DEPO and SEDI source terms are mixed and stored in SEDI' )
+
+ tbudgets(NBUDGET_RC)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RC)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RC)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RC)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RC)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rc
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of cloud'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lsedc_lima ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lsedic_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lsedc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lsedc_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. ldepoc_lima ) &
+ .or. ( hcloud == 'C2R2' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. ldeposc_ice .and. celec == 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection by snow and conversion into rain with T>XTT on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RC) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RC), cbulist_rrc )
+end if
+
+! Budget of RRR
+tbudgets(NBUDGET_RR)%lenabled = lbu_rrr .and. krr >= 3
+
+if ( tbudgets(NBUDGET_RR)%lenabled ) then
+ tbudgets(NBUDGET_RR)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RR)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RR)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RR)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RR)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of rain water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rr
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
+ .or. hcloud == 'KESS' &
+ .or. hcloud(1:3) == 'ICE' &
+ .or. hcloud == 'C2R2' &
+ .or. hcloud == 'KHKO'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection of droplets by snow and conversion into rain'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+!PW: a documenter
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RR) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RR), cbulist_rrr )
+end if
+
+! Budget of RRI
+tbudgets(NBUDGET_RI)%lenabled = lbu_rri .and. krr >= 4
+
+if ( tbudgets(NBUDGET_RI)%lenabled ) then
+ tbudgets(NBUDGET_RI)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RI)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RI)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RI)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RI)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud ice mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_ri
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lsedi_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HIN'
+ tzsource%clongname = 'heterogeneous ice nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .or. ( hcloud == 'LIMA' .and. nmom_i == 1)
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RI) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RI), cbulist_rri )
+end if
+
+! Budget of RRS
+tbudgets(NBUDGET_RS)%lenabled = lbu_rrs .and. krr >= 5
+
+if ( tbudgets(NBUDGET_RS)%lenabled ) then
+ tbudgets(NBUDGET_RS)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RS)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RS)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RS)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RS)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of snow/aggregate mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rs
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RS), tzsource nneturrs )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RS) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RS), cbulist_rrs )
+end if
+
+! Budget of RRG
+tbudgets(NBUDGET_RG)%lenabled = lbu_rrg .and. krr >= 6
+
+if ( tbudgets(NBUDGET_RG)%lenabled ) then
+ tbudgets(NBUDGET_RG)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RG)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RG)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RG)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RG)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of graupel mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rg
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RG), tzsource nneturrg )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
+ .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion of hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. (lptsplit .or. (nmom_h.ge.1 .and. nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RG) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RG), cbulist_rrg )
+end if
+
+! Budget of RRH
+tbudgets(NBUDGET_RH)%lenabled = lbu_rrh .and. krr >= 7
+
+if ( tbudgets(NBUDGET_RH)%lenabled ) then
+ tbudgets(NBUDGET_RH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of hail mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rh
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RH), tzsource nneturrh )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_i.ge.1 .and. nmom_h.ge.1 ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DEPH'
+ tzsource%clongname = 'deposition on hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_h.ge.1 )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_h.ge.1 &
+ .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
+ .or. ( hcloud == 'ICE4' .and. ( .not. lred .or. celec /= 'NONE' ) )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion from hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1) )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not. lptsplit .and. nmom_h.ge.1 .and. nmom_i.ge.1 &
+ .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RH), cbulist_rrh )
+end if
+
+! Budgets of RSV (scalar variables)
+
+if ( ksv > 999 ) call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'number of scalar variables > 999' )
+
+SV_BUDGETS: do jsv = 1, ksv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+
+ tbudgets(ibudget)%lenabled = lbu_rsv
+
+ if ( lbu_rsv ) then
+ tbudgets(ibudget)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(ibudget)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(ibudget)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(ibudget)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(ibudget)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of scalar variable ' // tsvlist(jsv)%cmnhname
+ tzsource%ngrid = 1
+
+ tzsource%cunits = '1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifsv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_sv( jsv ) .or. ( celec /= 'NONE' .and. lrelax2fw_ion &
+ .and. (jsv == nsv_elecbeg .or. jsv == nsv_elecend ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = ( hdconv == 'KAFR' .or. hsconv == 'KAFR' ) .and. ochtrans
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_sv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA2'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Add specific source terms to different scalar variables
+ SV_VAR: if ( jsv <= nsv_user ) then
+ ! nsv_user case
+ ! Nothing to do
+
+ else if ( jsv >= nsv_c2r2beg .and. jsv <= nsv_c2r2end ) then SV_VAR
+ ! C2R2 or KHKO Case
+
+ ! Source terms in common for all C2R2/KHKO budgets
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Source terms specific to each budget
+ SV_C2R2: select case( jsv - nsv_c2r2beg + 1 )
+ case ( 1 ) SV_C2R2
+ ! Concentration of activated nuclei
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_C2R2
+ ! Concentration of cloud droplets
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource)
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ldepoc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_C2R2
+ ! Concentration of raindrops
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = hcloud /= 'KHKO'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 4 ) SV_C2R2
+ ! Supersaturation
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end select SV_C2R2
+
+
+ else if ( jsv >= nsv_lima_beg .and. jsv <= nsv_lima_end ) then SV_VAR
+ ! LIMA case
+
+ ! Source terms in common for all LIMA budgets (except supersaturation)
+ if ( jsv /= nsv_lima_spro ) then
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+ end if
+
+
+ ! Source terms specific to each budget
+ SV_LIMA: if ( jsv == nsv_lima_nc ) then
+ ! Cloud droplets concentration
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lsedc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = nmom_c.ge.1 .and. ldepoc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_nr ) then SV_LIMA
+ ! Rain drops concentration
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_r.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. nmom_r.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_free .and. jsv <= nsv_lima_ccn_free + nmod_ccn - 1 ) then SV_LIMA
+ ! Free CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_acti .and. jsv <= nsv_lima_ccn_acti + nmod_ccn - 1 ) then SV_LIMA
+ ! Activated CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = nmom_c.ge.1 .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_c.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_scavmass ) then SV_LIMA
+ ! Scavenged mass variable
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_ni ) then SV_LIMA
+ ! Pristine ice crystals concentration
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. nmom_i.ge.1 .and. nmom_s.ge.1
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lsedi_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = lptsplit .or. nmom_h.ge.1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_ns ) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'break up of snow'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'heavy riming of cloud droplet on snow'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = nmom_s.ge.2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SSC'
+ tzsource%clongname = 'snow self collection'
+ tzsource%lavailable = ( nmom_s.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_ng ) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( nmom_g.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'heavy riming of cloud droplet on snow'
+ tzsource%lavailable = ( nmom_g.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = ( nmom_g.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = ( nmom_g.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of raindrop'
+ tzsource%lavailable = ( nmom_g.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( nmom_g.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( nmom_g.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = nmom_g.ge.2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion hail graupel'
+ tzsource%lavailable = nmom_g.ge.2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv == nsv_lima_nh .and. nmom_h.ge.1) then SV_LIMA
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( nmom_h.ge.2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = nmom_h.ge.2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion hail graupel'
+ tzsource%lavailable = nmom_h.ge.2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'hail melting'
+ tzsource%lavailable = nmom_h.ge.2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv >= nsv_lima_ifn_free .and. jsv <= nsv_lima_ifn_free + nmod_ifn - 1 ) then SV_LIMA
+ ! Free IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ifn_nucl .and. jsv <= nsv_lima_ifn_nucl + nmod_ifn - 1 ) then SV_LIMA
+ ! Nucleated IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima &
+ .and. ( ( lmeyers_lima .and. jsv == nsv_lima_ifn_nucl ) .or. .not. lmeyers_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. lmeyers_lima .and. jsv == nsv_lima_ifn_nucl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_imm_nucl .and. jsv <= nsv_lima_imm_nucl + nmod_imm - 1 ) then SV_LIMA
+ ! Nucleated IMM concentration
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_hom_haze ) then SV_LIMA
+ ! Homogeneous freezing of CCN
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima .and. &
+ ( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. ( .not.lptsplit .and. nmom_c.ge.1 ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_spro ) then SV_LIMA
+ ! Supersaturation
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end if SV_LIMA
+
+
+ else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR
+ ! Electricity case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ SV_ELEC: select case( jsv - nsv_elecbeg + 1 )
+ case ( 1 ) SV_ELEC
+ ! volumetric charge of water vapor
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_ELEC
+ ! volumetric charge of cloud droplets
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedic_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_ELEC
+ ! volumetric charge of rain drops
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ case ( 4 ) SV_ELEC
+ ! volumetric charge of ice crystals
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 5 ) SV_ELEC
+ ! volumetric charge of snow
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 6 ) SV_ELEC
+ ! volumetric charge of graupel
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 7: ) SV_ELEC
+ if ( ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) ) then
+ ! volumetric charge of hail
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( ( hcloud == 'ICE3' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) &
+ .or. ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 8 ) ) then
+ ! Negative ions (NSV_ELECEND case)
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown electricity budget' )
+ end if
+
+ end select SV_ELEC
+
+
+ else if ( jsv >= nsv_lgbeg .and. jsv <= nsv_lgend ) then SV_VAR
+ !Lagrangian variables
+
+
+ else if ( jsv >= nsv_ppbeg .and. jsv <= nsv_ppend ) then SV_VAR
+ !Passive pollutants
+
+
+#ifdef MNH_FOREFIRE
+ else if ( jsv >= nsv_ffbeg .and. jsv <= nsv_ffend ) then SV_VAR
+ !Forefire
+
+#endif
+ else if ( jsv >= nsv_csbeg .and. jsv <= nsv_csend ) then SV_VAR
+ !Conditional sampling
+
+
+ else if ( jsv >= nsv_chembeg .and. jsv <= nsv_chemend ) then SV_VAR
+ !Chemical case
+ tzsource%cmnhname = 'CHEM'
+ tzsource%clongname = 'chemistry activity'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_chicbeg .and. jsv <= nsv_chicend ) then SV_VAR
+ !Ice phase chemistry
+
+
+ else if ( jsv >= nsv_aerbeg .and. jsv <= nsv_aerend ) then SV_VAR
+ !Chemical aerosol case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = lorilam
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv >= nsv_aerdepbeg .and. jsv <= nsv_aerdepend ) then SV_VAR
+ !Aerosol wet deposition
+
+ else if ( jsv >= nsv_dstbeg .and. jsv <= nsv_dstend ) then SV_VAR
+ !Dust
+
+ else if ( jsv >= nsv_dstdepbeg .and. jsv <= nsv_dstdepend ) then SV_VAR
+ !Dust wet deposition
+
+ else if ( jsv >= nsv_sltbeg .and. jsv <= nsv_sltend ) then SV_VAR
+ !Salt
+
+ else if ( jsv >= nsv_sltdepbeg .and. jsv <= nsv_sltdepend ) then SV_VAR
+ !Salt wet deposition
+
+ else if ( jsv >= nsv_snwbeg .and. jsv <= nsv_snwend ) then SV_VAR
+ !Snow
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SNSED'
+ tzsource%clongname = 'blowing snow sedimentation'
+ tzsource%lavailable = lblowsnow
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lnoxbeg .and. jsv <= nsv_lnoxend ) then SV_VAR
+ !LiNOX passive tracer
+
+ else SV_VAR
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown scalar variable' )
+ end if SV_VAR
+
+
+ call Sourcelist_sort_compact( tbudgets(ibudget) )
+
+ call Sourcelist_scan( tbudgets(ibudget), cbulist_rsv )
+ end if
+end do SV_BUDGETS
+
+call Ini_budget_groups( tbudgets, ibudim1, ibudim2, ibudim3 )
+
+if ( tbudgets(NBUDGET_U) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_U), cbulist_ru )
+if ( tbudgets(NBUDGET_V) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_V), cbulist_rv )
+if ( tbudgets(NBUDGET_W) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_W), cbulist_rw )
+if ( tbudgets(NBUDGET_TH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TH), cbulist_rth )
+if ( tbudgets(NBUDGET_TKE)%lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TKE), cbulist_rtke )
+if ( tbudgets(NBUDGET_RV) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RV), cbulist_rrv )
+if ( tbudgets(NBUDGET_RC) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RC), cbulist_rrc )
+if ( tbudgets(NBUDGET_RR) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RR), cbulist_rrr )
+if ( tbudgets(NBUDGET_RI) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RI), cbulist_rri )
+if ( tbudgets(NBUDGET_RS) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RS), cbulist_rrs )
+if ( tbudgets(NBUDGET_RG) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RG), cbulist_rrg )
+if ( tbudgets(NBUDGET_RH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RH), cbulist_rrh )
+if ( lbu_rsv ) call Sourcelist_sv_nml_compact( cbulist_rsv )
+end subroutine Ini_budget
+
+
+subroutine Budget_source_add( tpbudget, tpsource, odonotinit, ooverwrite )
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ type(tbusourcedata), intent(in) :: tpsource ! Metadata basis
+ logical, optional, intent(in) :: odonotinit
+ logical, optional, intent(in) :: ooverwrite
+
+ character(len=4) :: ynum
+ integer :: isourcenumber
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_add', 'called for ' // Trim( tpbudget%cname ) &
+ // ': ' // Trim( tpsource%cmnhname ) )
+
+ isourcenumber = tpbudget%nsources + 1
+ if ( isourcenumber > tpbudget%nsourcesmax ) then
+ Write( ynum, '( i4 )' ) tpbudget%nsourcesmax
+ cmnhmsg(1) = 'Insufficient max number of source terms (' // Trim(ynum) // ') for budget ' // Trim( tpbudget%cname )
+ cmnhmsg(2) = 'Please increaze value of parameter NSOURCESMAX'
+ call Print_msg( NVERB_FATAL, 'BUD', 'Budget_source_add' )
+ else
+ tpbudget%nsources = tpbudget%nsources + 1
+ end if
+
+ ! Copy metadata from provided tpsource
+ ! Modifications to source term metadata done with the other dummy arguments
+ tpbudget%tsources(isourcenumber) = tpsource
+
+ if ( present( odonotinit ) ) tpbudget%tsources(isourcenumber)%ldonotinit = odonotinit
+
+ if ( present( ooverwrite ) ) tpbudget%tsources(isourcenumber)%loverwrite = ooverwrite
+end subroutine Budget_source_add
+
+
+subroutine Ini_budget_groups( tpbudgets, kbudim1, kbudim2, kbudim3 )
+ use modd_budget, only: tbudgetdata
+ use modd_field, only: TYPEINT, TYPEREAL
+ use modd_parameters, only: NMNHNAMELGTMAX, NSTDNAMELGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX, NCOMMENTLGTMAX
+
+ use mode_tools, only: Quicksort
+
+ type(tbudgetdata), dimension(:), intent(inout) :: tpbudgets
+ integer, intent(in) :: kbudim1
+ integer, intent(in) :: kbudim2
+ integer, intent(in) :: kbudim3
+
+ character(len=NMNHNAMELGTMAX) :: ymnhname
+ character(len=NSTDNAMELGTMAX) :: ystdname
+ character(len=NLONGNAMELGTMAX) :: ylongname
+ character(len=NUNITLGTMAX) :: yunits
+ character(len=NCOMMENTLGTMAX) :: ycomment
+ integer :: ji, jj, jk
+ integer :: isources ! Number of source terms in a budget
+ integer :: inbgroups ! Number of budget groups
+ integer :: ival
+ integer :: icount
+ integer :: ivalmax, ivalmin
+ integer :: igrid
+ integer :: itype
+ integer :: idims
+ integer, dimension(:), allocatable :: igroups ! Temporary array to store sorted group numbers
+ integer, dimension(:), allocatable :: ipos ! Temporary array to store initial position of group numbers
+ real :: zval
+ real :: zvalmax, zvalmin
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget_groups', 'called' )
+
+ BUDGETS: do ji = 1, size( tpbudgets )
+ ENABLED: if ( tpbudgets(ji)%lenabled ) then
+ isources = size( tpbudgets(ji)%tsources )
+ do jj = 1, isources
+ ! Check if ngroup is an allowed value
+ if ( tpbudgets(ji)%tsources(jj)%ngroup < 0 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'negative group value is not allowed' )
+ tpbudgets(ji)%tsources(jj)%ngroup = 0
+ end if
+
+ if ( tpbudgets(ji)%tsources(jj)%ngroup > 0 ) tpbudgets(ji)%tsources(jj)%lenabled = .true.
+ end do
+
+ !Count the number of groups of source terms
+ !ngroup=1 is for individual entries, >1 values are groups
+ allocate( igroups(isources ) )
+ allocate( ipos (isources ) )
+ igroups(:) = tpbudgets(ji)%tsources(:)%ngroup
+ ipos(:) = [ ( jj, jj = 1, isources ) ]
+
+ !Sort the group list number
+ call Quicksort( igroups, 1, isources, ipos )
+
+ !Count the number of different groups
+ !and renumber the entries (from 1 to inbgroups)
+ inbgroups = 0
+ ival = igroups(1)
+ if ( igroups(1) /= 0 ) then
+ inbgroups = 1
+ igroups(1) = inbgroups
+ end if
+ do jj = 2, isources
+ if ( igroups(jj) == 1 ) then
+ inbgroups = inbgroups + 1
+ igroups(jj) = inbgroups
+ else if ( igroups(jj) > 0 ) then
+ if ( igroups(jj) /= ival ) then
+ ival = igroups(jj)
+ inbgroups = inbgroups + 1
+ end if
+ igroups(jj) = inbgroups
+ end if
+ end do
+
+ !Write the igroups values to the budget structure
+ do jj = 1, isources
+ tpbudgets(ji)%tsources(ipos(jj))%ngroup = igroups(jj)
+ end do
+
+ !Allocate the group structure + populate it
+ tpbudgets(ji)%ngroups = inbgroups
+ allocate( tpbudgets(ji)%tgroups(inbgroups) )
+
+ do jj = 1, inbgroups
+ !Search the list of sources for each group
+ !not the most efficient algorithm but do the job
+ icount = 0
+ do jk = 1, isources
+ if ( tpbudgets(ji)%tsources(jk)%ngroup == jj ) then
+ icount = icount + 1
+ ipos(icount) = jk !ipos is reused as a temporary work array
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nsources = icount
+
+ allocate( tpbudgets(ji)%tgroups(jj)%nsourcelist(icount) )
+ tpbudgets(ji)%tgroups(jj)%nsourcelist(:) = ipos(1 : icount)
+
+ ! Set the name of the field
+ ymnhname = tpbudgets(ji)%tsources(ipos(1))%cmnhname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ymnhname = trim( ymnhname ) // '_' // trim( tpbudgets(ji)%tsources(ipos(jk))%cmnhname )
+ end do
+ tpbudgets(ji)%tgroups(jj)%cmnhname = ymnhname
+
+ ! Set the standard name (CF convention)
+ if ( tpbudgets(ji)%tgroups(jj)%nsources == 1 ) then
+ ystdname = tpbudgets(ji)%tsources(ipos(1))%cstdname
+ else
+ ! The CF standard name is probably wrong if combining several source terms => set to ''
+ ystdname = ''
+ end if
+ tpbudgets(ji)%tgroups(jj)%cstdname = ystdname
+
+ ! Set the long name (CF convention)
+ ylongname = tpbudgets(ji)%tsources(ipos(1))%clongname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ylongname = trim( ylongname ) // ' + ' // tpbudgets(ji)%tsources(ipos(jk))%clongname
+ end do
+ tpbudgets(ji)%tgroups(jj)%clongname = ylongname
+
+ ! Set the units
+ yunits = tpbudgets(ji)%tsources(ipos(1))%cunits
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( trim( yunits ) /= trim( tpbudgets(ji)%tsources(ipos(jk))%cunits ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'incompatible units for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ yunits = 'unknown'
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%cunits = yunits
+
+ ! Set the comment
+ ! It is composed of the source comment followed by the clongnames of the different sources
+ ycomment = trim( tpbudgets(ji)%tsources(ipos(1))%ccomment ) // ': '// trim( tpbudgets(ji)%tsources(ipos(1))%clongname )
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ycomment = trim( ycomment ) // ', ' // trim( tpbudgets(ji)%tsources(ipos(jk))%clongname )
+ end do
+ ycomment = trim( ycomment ) // ' source term'
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) ycomment = trim( ycomment ) // 's'
+ tpbudgets(ji)%tgroups(jj)%ccomment = ycomment
+
+ ! Set the Arakawa grid
+ igrid = tpbudgets(ji)%tsources(ipos(1))%ngrid
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( igrid /= tpbudgets(ji)%tsources(ipos(jk))%ngrid ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different Arakawa grid positions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ngrid = igrid
+
+ ! Set the data type
+ itype = tpbudgets(ji)%tsources(ipos(1))%ntype
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( itype /= tpbudgets(ji)%tsources(ipos(jk))%ntype ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible data types for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ntype = itype
+
+ ! Set the number of dimensions
+ idims = tpbudgets(ji)%tsources(ipos(1))%ndims
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( idims /= tpbudgets(ji)%tsources(ipos(jk))%ndims ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible number of dimensions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ndims = idims
+
+ ! Set the fill values
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ival = tpbudgets(ji)%tsources(ipos(1))%nfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( ival /= tpbudgets(ji)%tsources(ipos(jk))%nfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (integer) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nfillvalue = ival
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zval = tpbudgets(ji)%tsources(ipos(1))%xfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( zval /= tpbudgets(ji)%tsources(ipos(jk))%xfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (real) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%xfillvalue = zval
+ end if
+
+ ! Set the valid min/max values
+ ! Take the min or max of all the sources
+ ! Maybe, it would be better to take the sum? (if same sign, if not already the maximum allowed value for this type)
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ivalmin = tpbudgets(ji)%tsources(ipos(1))%nvalidmin
+ ivalmax = tpbudgets(ji)%tsources(ipos(1))%nvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ivalmin = min( ivalmin, tpbudgets(ji)%tsources(ipos(jk))%nvalidmin )
+ ivalmax = max( ivalmax, tpbudgets(ji)%tsources(ipos(jk))%nvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%nvalidmin = ivalmin
+ tpbudgets(ji)%tgroups(jj)%nvalidmax = ivalmax
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zvalmin = tpbudgets(ji)%tsources(ipos(1))%xvalidmin
+ zvalmax = tpbudgets(ji)%tsources(ipos(1))%xvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ zvalmin = min( zvalmin, tpbudgets(ji)%tsources(ipos(jk))%xvalidmin )
+ zvalmax = max( zvalmax, tpbudgets(ji)%tsources(ipos(jk))%xvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%xvalidmin = zvalmin
+ tpbudgets(ji)%tgroups(jj)%xvalidmax = zvalmax
+ end if
+
+ allocate( tpbudgets(ji)%tgroups(jj)%xdata(kbudim1, kbudim2, kbudim3 ) )
+ tpbudgets(ji)%tgroups(jj)%xdata(:, :, :) = 0.
+ end do
+
+ deallocate( igroups )
+ deallocate( ipos )
+
+ !Check that a group does not contain more than 1 source term with ldonotinit=.true.
+ do jj = 1, inbgroups
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) then
+ do jk = 1, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%ldonotinit ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with ldonotinit=true' )
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%loverwrite ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with loverwrite=true' )
+ end do
+ end if
+ end do
+
+ end if ENABLED
+ end do BUDGETS
+
+end subroutine Ini_budget_groups
+
+
+subroutine Sourcelist_sort_compact( tpbudget )
+ !Sort the list of sources to put the non-available source terms at the end of the list
+ !and compact the list
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+
+ integer :: ji
+ integer :: isrc_avail, isrc_notavail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_avail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_notavail
+
+ isrc_avail = 0
+ isrc_notavail = 0
+
+ Allocate( tzsources_avail (tpbudget%nsources) )
+ Allocate( tzsources_notavail(tpbudget%nsources) )
+
+ !Separate source terms available or not during the execution
+ !(based on the criteria provided to Budget_source_add and stored in lavailable field)
+ do ji = 1, tpbudget%nsources
+ if ( tpbudget%tsources(ji)%lavailable ) then
+ isrc_avail = isrc_avail + 1
+ tzsources_avail(isrc_avail) = tpbudget%tsources(ji)
+ else
+ isrc_notavail = isrc_notavail + 1
+ tzsources_notavail(isrc_notavail) = tpbudget%tsources(ji)
+ end if
+ end do
+
+ !Reallocate/compact the source list
+ if ( Allocated( tpbudget%tsources ) ) Deallocate( tpbudget%tsources )
+ Allocate( tpbudget%tsources( tpbudget%nsources ) )
+
+ tpbudget%nsourcesmax = tpbudget%nsources
+ !Limit the number of sources to the available list
+ tpbudget%nsources = isrc_avail
+
+ !Fill the source list beginning with the available sources and finishing with the non-available ones
+ do ji = 1, isrc_avail
+ tpbudget%tsources(ji) = tzsources_avail(ji)
+ end do
+
+ do ji = 1, isrc_notavail
+ tpbudget%tsources(isrc_avail + ji) = tzsources_notavail(ji)
+ end do
+
+end subroutine Sourcelist_sort_compact
+
+
+subroutine Sourcelist_scan( tpbudget, hbulist )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ character(len=*), dimension(:), intent(in) :: hbulist
+
+ character(len=:), allocatable :: yline
+ character(len=:), allocatable :: ysrc
+ character(len=:), dimension(:), allocatable :: ymsg
+ integer :: idx
+ integer :: igroup
+ integer :: igroup_idx
+ integer :: ipos
+ integer :: istart
+ integer :: ji
+
+ istart = 1
+
+ ! Case 'LIST_AVAIL': list all the available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_AVAIL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsources + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Available source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsources
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsources + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'LIST_ALL': list all the source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_ALL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsourcesmax + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsourcesmax
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsourcesmax + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'ALL': enable all available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'ALL' ) then
+ do ji = 1, tpbudget%nsources
+ tpbudget%tsources(ji)%ngroup = 1
+ end do
+ return
+ end if
+ end if
+
+ !Always enable INIF, ENDF and AVEF terms
+ ipos = Source_find( tpbudget, 'INIF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': INIF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'ENDF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ENDF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'AVEF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': AVEF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ !igroup_idx start at 2 because 1 is reserved for individually stored source terms
+ igroup_idx = 2
+
+ do ji = istart, Size( hbulist )
+ if ( Len_trim( hbulist(ji) ) > 0 ) then
+ ! Scan the line and separate the different sources (separated by + signs)
+ yline = Trim(hbulist(ji))
+
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ igroup = 1
+ else
+ igroup = igroup_idx
+ igroup_idx = igroup_idx + 1
+ end if
+
+ do
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ ysrc = yline
+ else
+ ysrc = yline(1 : idx - 1)
+ yline = yline(idx + 1 :)
+ end if
+
+ !Check if the source is known
+ if ( Len_trim( ysrc ) > 0 ) then
+ ipos = Source_find( tpbudget, ysrc )
+
+ if ( ipos > 0 ) then
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' found' )
+
+ if ( .not. tpbudget%tsources(ipos)%lavailable ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not available' )
+ tpbudget%tsources(ipos)%ngroup = 0
+ else
+ tpbudget%tsources(ipos)%ngroup = igroup
+ end if
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not found' )
+ end if
+ end if
+
+ if ( idx < 1 ) exit
+ end do
+ end if
+ end do
+end subroutine Sourcelist_scan
+
+
+subroutine Sourcelist_nml_compact( tpbudget, hbulist )
+ !This subroutine reduce the size of the hbulist to the minimum
+ !The list is generated from the group list
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=NBULISTMAXLEN), dimension(:), allocatable, intent(inout) :: hbulist
+
+ integer :: idx
+ integer :: isource
+ integer :: jg
+ integer :: js
+
+ if ( Allocated( hbulist ) ) Deallocate( hbulist )
+
+ if ( tpbudget%ngroups < 3 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'ngroups is too small' )
+ return
+ end if
+
+ Allocate( character(len=NBULISTMAXLEN) :: hbulist(tpbudget%ngroups - 3) )
+ hbulist(:) = ''
+
+ idx = 0
+ do jg = 1, tpbudget%ngroups
+ if ( tpbudget%tgroups(jg)%nsources < 1 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'no source for group' )
+ cycle
+ end if
+
+ !Do not put 'INIF', 'ENDF', 'AVEF' in hbulist because their presence is automatic if the corresponding budget is enabled
+ isource = tpbudget%tgroups(jg)%nsourcelist(1)
+ if ( Any( tpbudget%tsources(isource)%cmnhname == [ 'INIF', 'ENDF', 'AVEF' ] ) ) cycle
+
+ idx = idx + 1
+#if 0
+ !Do not do this way because the group cmnhname may be truncated (NMNHNAMELGTMAX is smaller than NBULISTMAXLEN)
+ !and the name separator is different ('_')
+ hbulist(idx) = Trim( tpbudget%tgroups(jg)%cmnhname )
+#else
+ do js = 1, tpbudget%tgroups(jg)%nsources
+ isource = tpbudget%tgroups(jg)%nsourcelist(js)
+ hbulist(idx) = Trim( hbulist(idx) ) // Trim( tpbudget%tsources(isource)%cmnhname )
+ if ( js < tpbudget%tgroups(jg)%nsources ) hbulist(idx) = Trim( hbulist(idx) ) // '+'
+ end do
+#endif
+ end do
+end subroutine Sourcelist_nml_compact
+
+
+subroutine Sourcelist_sv_nml_compact( hbulist )
+ !This subroutine reduce the size of the hbulist
+ !For SV variables the reduction is simpler than for other variables
+ !because it is too complex to do this cleanly (the enabled source terms are different for each scalar variable)
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ character(len=*), dimension(:), allocatable, intent(inout) :: hbulist
+
+ character(len=NBULISTMAXLEN), dimension(:), allocatable :: ybulist_new
+ integer :: ilines
+ integer :: ji
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) ilines = ilines + 1
+ end do
+
+ Allocate( ybulist_new(ilines) )
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) then
+ ilines = ilines + 1
+ ybulist_new(ilines) = Trim( hbulist(ji) )
+ end if
+ end do
+
+ call Move_alloc( from = ybulist_new, to = hbulist )
+end subroutine Sourcelist_sv_nml_compact
+
+
+pure function Source_find( tpbudget, hsource ) result( ipos )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=*), intent(in) :: hsource
+ integer :: ipos
+
+ integer :: ji
+ logical :: gfound
+
+ ipos = -1
+ gfound = .false.
+ do ji = 1, tpbudget%nsourcesmax
+ if ( Trim( hsource ) == Trim ( tpbudget%tsources(ji)%cmnhname ) ) then
+ gfound = .true.
+ ipos = ji
+ exit
+ end if
+ end do
+
+end function Source_find
+
+end module mode_ini_budget
diff --git a/src/PHYEX/ext/ini_elecn.f90 b/src/PHYEX/ext/ini_elecn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e00ea14d3a6f0eff266625c09fc945a1c7805d80
--- /dev/null
+++ b/src/PHYEX/ext/ini_elecn.f90
@@ -0,0 +1,327 @@
+!MNH_LIC Copyright 2009-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_INI_ELEC_n
+! ######################
+!
+INTERFACE
+ SUBROUTINE INI_ELEC_n (KLUOUT, HELEC, HCLOUD, TPINIFILE, &
+ PTSTEP, PZZ, &
+ PDXX, PDYY, PDZZ, PDZX, PDZY )
+!
+USE MODD_IO, ONLY : TFILEDATA
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! atmospheric electricity scheme
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
+REAL, INTENT(IN) :: PTSTEP ! Time STEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX ! metric coefficient dzx
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZY ! metric coefficient dzy
+!
+END SUBROUTINE INI_ELEC_n
+END INTERFACE
+END MODULE MODI_INI_ELEC_n
+!
+! #########################################################
+ SUBROUTINE INI_ELEC_n(KLUOUT, HELEC, HCLOUD, TPINIFILE, &
+ PTSTEP, PZZ, &
+ PDXX, PDYY, PDZZ, PDZX, PDZY )
+! #########################################################
+!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the variables
+! of the atmospheric electricity scheme
+!
+!! METHOD
+!! ------
+!! The initialization of the scheme is performed as follows :
+!!
+!! EXTERNAL
+!! --------
+!! CLEANLIST_ll : deaalocate a list
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe * Laboratoire de l'Atmosphère et des Cyclones *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/11/09
+!! M. Chong 13/05/11 Add computation of specific parameters for solving
+!! the electric field equation (elements of tri-diag
+!! matrix)
+!! J.-P. Pinty 13/04/12 Add elec_trid to initialise the tridiagonal syst.
+!! J.-P. Pinty 01/07/12 Add a non-homogeneous Neuman fair-weather
+!! boundary condition at the top
+!! J.-P. Pinty 15/11/13 Initialize the flash maps
+!! 10/2016 (C.Lac) Add droplet deposition
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CLOUDPAR_n, ONLY : NSPLITR
+USE MODD_CONF, ONLY : CEQNSYS,CCONF,CPROGRAM
+USE MODD_CONF_n, ONLY : NRR
+USE MODD_CST
+USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
+USE MODD_DYN
+USE MODD_DYN_n, ONLY : XRHOM, XTRIGSX, XTRIGSY, XAF, XCF, XBFY, XBFB, XDXHATM, &
+ XDYHATM, NIFAXX, NIFAXY, XBF_SXP2_YP1_Z
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_FLASH
+USE MODD_ELEC_n, ONLY : XRHOM_E, XAF_E, XCF_E, XBFY_E, XBFB_E, XBF_SXP2_YP1_Z_E
+USE MODD_GET_n, ONLY : CGETINPRC, CGETINPRR, CGETINPRS, CGETINPRG, CGETINPRH, &
+ CGETCLOUD, CGETSVT
+USE MODD_GRID_n, ONLY : XMAP, XDXHAT, XDYHAT
+USE MODD_IO, ONLY : TFILEDATA
+USE MODD_LBC_n, ONLY : CLBCX, CLBCY
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAM_C2R2, ONLY : LDEPOC
+USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT
+USE MODD_PARAM_ICE_n, ONLY : LDEPOSC
+USE MODD_PRECIP_n, ONLY : XINPRR, XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, &
+ XINPRH, XACPRH, XINPRC, XACPRC, XINPRR3D, XEVAP3D,&
+ XINDEP,XACDEP
+USE MODD_REF
+USE MODD_REF_n, ONLY : XRHODJ, XTHVREF
+USE MODD_TIME
+!
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODE_ll
+use mode_msg
+!
+USE MODI_ELEC_TRIDZ
+USE MODI_INI_CLOUD
+USE MODI_INI_FIELD_ELEC
+USE MODI_INI_FLASH_GEOM_ELEC
+USE MODI_INI_PARAM_ELEC
+USE MODI_INI_RAIN_ICE_ELEC
+USE MODI_READ_PRECIP_FIELD
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of dummy arguments
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! atmospheric electricity scheme
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
+REAL, INTENT(IN) :: PTSTEP ! Time STEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX ! metric coefficient dzx
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZY ! metric coefficient dzy
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILUOUT ! Logical unit number of output-listing
+!
+INTEGER :: IIU ! Upper dimension in x direction (local)
+INTEGER :: IJU ! Upper dimension in y direction (local)
+INTEGER :: IKU ! Upper dimension in z direction
+INTEGER :: IKB, IKE
+INTEGER :: JK ! Loop vertical index
+INTEGER :: IINFO_ll ! Return code of // routines
+INTEGER :: IINTVL ! Number of intervals to integrate the kernels
+REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
+!
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZDZMIN
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZ ! mesh size
+CHARACTER (LEN=3) :: YEQNSYS
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. PROLOGUE
+! --------
+!
+ILUOUT = TLUOUT%NLU
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU = SIZE(PZZ,3)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. ALLOCATE Module MODD_PRECIP_n
+! -----------------------------
+!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ALLOCATE( XINPRR(IIU,IJU) )
+ ALLOCATE( XINPRR3D(IIU,IJU,IKU) )
+ ALLOCATE( XEVAP3D(IIU,IJU,IKU) )
+ ALLOCATE( XACPRR(IIU,IJU) )
+ XINPRR(:,:) = 0.0
+ XACPRR(:,:) = 0.0
+ XINPRR3D(:,:,:) = 0.0
+ XEVAP3D(:,:,:) = 0.0
+ ALLOCATE( XINPRC(IIU,IJU) )
+ ALLOCATE( XACPRC(IIU,IJU) )
+ XINPRC(:,:) = 0.0
+ XACPRC(:,:) = 0.0
+ ALLOCATE( XINPRS(IIU,IJU) )
+ ALLOCATE( XACPRS(IIU,IJU) )
+ XINPRS(:,:) = 0.0
+ XACPRS(:,:) = 0.0
+ ALLOCATE( XINPRG(IIU,IJU) )
+ ALLOCATE( XACPRG(IIU,IJU) )
+ XINPRG(:,:) = 0.0
+ XACPRG(:,:) = 0.0
+END IF
+!
+IF (HCLOUD == 'ICE4') THEN
+ ALLOCATE( XINPRH(IIU,IJU) )
+ ALLOCATE( XACPRH(IIU,IJU) )
+ XINPRH(:,:) = 0.0
+ XACPRH(:,:) = 0.0
+ELSE
+ ALLOCATE( XINPRH(0,0) )
+ ALLOCATE( XACPRH(0,0) )
+END IF
+!
+IF ( LDEPOSC) THEN
+ ALLOCATE(XINDEP(IIU,IJU))
+ ALLOCATE(XACDEP(IIU,IJU))
+ XINDEP(:,:)=0.0
+ XACDEP(:,:)=0.0
+ELSE
+ ALLOCATE(XINDEP(0,0))
+ ALLOCATE(XACDEP(0,0))
+END IF
+!
+IF(SIZE(XINPRR) == 0) RETURN
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Initialize MODD_PRECIP_n variables
+! -----------------------------------
+!
+CALL READ_PRECIP_FIELD (TPINIFILE, CPROGRAM, CCONF, &
+ CGETINPRC,CGETINPRR,CGETINPRS,CGETINPRG,CGETINPRH, &
+ XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
+ XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, XINPRH, XACPRH)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITIALIZE THE PARAMETERS
+!* FOR THE MICROPHYSICS AND THE ELECTRICITY
+! ----------------------------------------
+!
+!* 3.1 Compute the minimun vertical mesh size
+!
+ALLOCATE( ZDZ(IIU,IJU,IKU) )
+ZDZ(:,:,:) = 0.
+!
+IKB = 1 + JPVEXT
+IKE = SIZE(PZZ,3) - JPVEXT
+!
+DO JK = IKB, IKE
+ ZDZ(:,:,JK) = PZZ(:,:,JK+1) - PZZ(:,:,JK)
+END DO
+ZDZMIN = MIN_ll (ZDZ,IINFO_ll,1,1,IKB,NIMAX_ll+2*JPHEXT,NJMAX_ll+2*JPHEXT,IKE )
+!
+DEALLOCATE(ZDZ)
+!
+!
+IF (HELEC(1:3) == 'ELE') THEN
+!
+!
+!* 3.2 initialize the parameters for the mixed-phase microphysics
+!* and the electrification
+!
+ CALL INI_RAIN_ICE_ELEC (KLUOUT, PTSTEP, ZDZMIN, NSPLITR, HCLOUD, &
+ IINTVL, ZFDINFTY)
+!
+!
+!* 3.3 initialize the electrical parameters
+!
+ ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+!
+ CALL INI_PARAM_ELEC (TPINIFILE, CGETSVT, ZRHO00, NRR, IINTVL, &
+ ZFDINFTY, IIU, IJU, IKU)
+!
+!
+!* 3.4 initialize the parameters for the electric field
+!
+ IF (LINDUCTIVE .OR. ((.NOT. LOCG) .AND. LELEC_FIELD)) THEN
+ CALL INI_FIELD_ELEC (PDXX, PDYY, PDZZ, PDZX, PDZY, PZZ)
+ END IF
+!
+!
+!* 3.5 initialize the parameters for the lightning flashes
+!
+ IF (.NOT. LOCG) THEN
+ IF (LFLASH_GEOM) THEN
+ CALL INI_FLASH_GEOM_ELEC
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'INI_LIGHTNING_ELEC not yet developed' )
+ END IF
+ END IF
+!
+ELSE IF (HELEC /= 'NONE') THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'not yet developed for CELEC='//trim(HELEC) )
+END IF
+!
+!* 3.6 initialize the parameters for the resolution of the electric field
+!
+YEQNSYS = CEQNSYS
+CEQNSYS = 'LHE'
+! Force any CEQNSYS (DUR, MAE, LHE) to LHE to obtain a unique set of coefficients
+! for the flat laplacian operator and Return to the original CEQNSYS
+
+ALLOCATE (XRHOM_E(SIZE(XRHOM)))
+ALLOCATE (XAF_E(SIZE(XAF)))
+ALLOCATE (XCF_E(SIZE(XCF)))
+ALLOCATE (XBFY_E(SIZE(XBFY,1),SIZE(XBFY,2),SIZE(XBFY,3)))
+ALLOCATE (XBFB_E(SIZE(XBFB,1),SIZE(XBFB,2),SIZE(XBFB,3)))
+ALLOCATE (XBF_SXP2_YP1_Z_E(SIZE(XBF_SXP2_YP1_Z,1),SIZE(XBF_SXP2_YP1_Z,2),&
+ SIZE(XBF_SXP2_YP1_Z,3)))
+!
+CALL ELEC_TRIDZ (CLBCX,CLBCY, &
+ XMAP,XDXHAT,XDYHAT,XDXHATM,XDYHATM,XRHOM_E,XAF_E, &
+ XCF_E,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, &
+ XRHODJ,XTHVREF,PZZ,XBFY_E,XEPOTFW_TOP, &
+ XBFB_E,XBF_SXP2_YP1_Z_E)
+!
+CEQNSYS=YEQNSYS
+!
+!* 3.7 initialize the flash maps
+!
+ALLOCATE( NMAP_TRIG_IC(IIU,IJU) ); NMAP_TRIG_IC(:,:) = 0
+ALLOCATE( NMAP_IMPACT_CG(IIU,IJU) ); NMAP_IMPACT_CG(:,:) = 0
+ALLOCATE( NMAP_2DAREA_IC(IIU,IJU) ); NMAP_2DAREA_IC(:,:) = 0
+ALLOCATE( NMAP_2DAREA_CG(IIU,IJU) ); NMAP_2DAREA_CG(:,:) = 0
+ALLOCATE( NMAP_3DIC(IIU,IJU,IKU) ); NMAP_3DIC(:,:,:) = 0
+ALLOCATE( NMAP_3DCG(IIU,IJU,IKU) ); NMAP_3DCG(:,:,:) = 0
+!
+!-------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE INI_ELEC_n
diff --git a/src/PHYEX/ext/ini_flash_geom_elec.f90 b/src/PHYEX/ext/ini_flash_geom_elec.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3c5faece3492d78a958b5bfe54b815164611abde
--- /dev/null
+++ b/src/PHYEX/ext/ini_flash_geom_elec.f90
@@ -0,0 +1,148 @@
+!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_INI_FLASH_GEOM_ELEC
+! ###############################
+!
+INTERFACE
+!
+ SUBROUTINE INI_FLASH_GEOM_ELEC
+!
+END SUBROUTINE INI_FLASH_GEOM_ELEC
+END INTERFACE
+END MODULE MODI_INI_FLASH_GEOM_ELEC
+!
+! ##############################
+ SUBROUTINE INI_FLASH_GEOM_ELEC
+! ##############################
+!
+!!**** *INI_FLASH_GEOM_ELEC* - routine to initialize the lightning flashes
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the variables
+! of the lightning flashes routine
+!
+!!** METHOD
+!! ------
+!! The initialization of the scheme is performed as follows :
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 29/11/02
+!!
+!! Modifications
+!! J.-P. Pinty jan 2015 : add LMA simulator
+!! J.Escobar 20/06/2018 : truly set NBRANCH_MAX = 5000 !
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XPI
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_PARAM
+USE MODD_DIM_n, ONLY : NKMAX
+USE MODD_TIME_n, ONLY : TDTCUR
+USE MODD_LMA_SIMULATOR, ONLY : LLMA, TDTLMA, LWRITE_LMA, XDTLMA, CLMA_FILE
+!
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+!
+!* 0.2 Declaration of local variables
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 1. SOME CONSTANTS FOR NEUTRALIZATION
+! ---------------------------------
+!
+XFQLIGHTC = 660. * MOMG(3.,3.,2.) / MOMG(3.,3.,3.) ! PI/A*lbda^(b-2) = 660.
+!
+XFQLIGHTR = XPI * XCCR * MOMG(XALPHAR,XNUR,2.)
+XEXQLIGHTR = XCXR - 2.
+!
+XEXQLIGHTI = 2. / XBI
+XFQLIGHTI = XPI / 4. * MOMG(XALPHAI,XNUI,2.) * &
+ (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XEXQLIGHTI)
+!
+XFQLIGHTS = XPI * XCCS * MOMG(XALPHAS,XNUS,2.)
+XEXQLIGHTS = XCXS - 2.
+!
+XFQLIGHTG = XPI * XCCG * MOMG(XALPHAG,XNUG,2.)
+XEXQLIGHTG = XCXG - 2.
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 2. INITIALIZE SOME THRESHOLDS
+! --------------------------
+!
+! electric field threshold for cell detection
+! from Marshall et al. (1995) JGR, the breakeven electric field is
+! 200 kV/m at the ground, ~ 33 kV/m at 15 km, and ~ 18 kV/m at 20 km height.
+! To be sure all the electrified cells are detected, this threshold is set to
+! 20 kV/m
+XE_THRESH = 35.E3 ! (V/m)
+!
+! the maximum of segments in the bi-leader corresponds to the number of
+! altitude levels in the domain since the bi-leader is hypothesized to
+! propagate only along the vertical
+NLEADER_MAX = NKMAX
+!
+! the maximum number of branches is arbitriraly set to 5000
+NBRANCH_MAX = 5000
+!
+! the maximum number of electrified cells in the domain is arbitrarily
+! set to 10
+NMAX_CELL = 10
+!
+! the altitude for CG to be prolongated to the ground is set to 2 km
+! this threshold could be modified once ions will be taken into account
+XALT_CG = 2000. ! m
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 3. INITIALIZATIONS
+! ---------------
+!
+NNBLIGHT = 0
+NNB_CG = 0
+NNB_CG_POS = 0
+!
+!
+!----------------------------------------------------------------------------
+!
+!* 4. INITIALIZE LMA RECORDS
+! ----------------------
+!
+! needs LLMA = .TRUE. to operate
+XDTLMA = 600.
+TDTLMA = TDTCUR
+LWRITE_LMA = .FALSE.
+CLMA_FILE(1:5) = "BEGIN"
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE INI_FLASH_GEOM_ELEC
diff --git a/src/PHYEX/ext/ini_lb.f90 b/src/PHYEX/ext/ini_lb.f90
new file mode 100644
index 0000000000000000000000000000000000000000..faa09698bf58497f08539e7305b5f0fc0d01487c
--- /dev/null
+++ b/src/PHYEX/ext/ini_lb.f90
@@ -0,0 +1,730 @@
+!MNH_LIC Copyright 1998-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_INI_LB
+! ######################
+!
+INTERFACE
+!
+SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, &
+ KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
+ KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
+ KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
+ HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
+ HGETRGM,HGETRHM,HGETSVM, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ PLBXUMM,PLBXVMM,PLBXWMM,PLBXTHMM,PLBXTKEMM,PLBXRMM,PLBXSVMM, &
+ PLBYUMM,PLBYVMM,PLBYWMM,PLBYTHMM,PLBYTKEMM,PLBYRMM,PLBYSVMM, &
+ PLENG )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+LOGICAL, INTENT(IN) :: OLSOURCE ! switch for the source term
+! Larger Scale fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
+INTEGER, INTENT(IN) :: KSV ! number of passive variables
+! sizes of the West-east total LB area
+INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
+INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
+INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV
+! sizes of the North-south total LB area
+INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
+INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
+INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
+! Get indicators
+CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM, &
+ HGETRVM,HGETRCM,HGETRRM, &
+ HGETRIM,HGETRSM,HGETRGM,HGETRHM
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
+! LB fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! LB arrays at time t-dt (if OLSOURCE=T) :
+REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLBXUMM,PLBXVMM,PLBXWMM ! Wind
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTHMM ! Mass
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYUMM,PLBYVMM,PLBYWMM ! Wind
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTHMM ! Mass
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTKEMM ! TKE
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTKEMM
+REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBXRMM ,PLBXSVMM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBYRMM ,PLBYSVMM ! in x and y-dir.
+REAL, INTENT(IN), OPTIONAL :: PLENG ! Interpolation length
+!
+END SUBROUTINE INI_LB
+!
+END INTERFACE
+!
+END MODULE MODI_INI_LB
+! ############################################################
+SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, &
+ KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
+ KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
+ KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
+ HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
+ HGETRGM,HGETRHM,HGETSVM, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ PLBXUMM,PLBXVMM,PLBXWMM,PLBXTHMM,PLBXTKEMM,PLBXRMM,PLBXSVMM, &
+ PLBYUMM,PLBYVMM,PLBYWMM,PLBYTHMM,PLBYTKEMM,PLBYRMM,PLBYSVMM, &
+ PLENG )
+! ############################################################
+!
+!!**** *INI_LB* - routine to initialize LB fields
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to read the LB fields and to distribute
+! on subdomain which have a non-nul intersection with the LB areas.
+! In case of OLSOURCE=T, it initializes the LB sources instead of the
+! LB fields at time t-dt
+!
+!!** METHOD
+!! ------
+!! The LB fields are read in file and distributed by FMREAD_LB
+!!
+!! In case of OLSOURCE=T (INI_LB called by INI_CPL or LS_COUPLING), the LB sources
+!! are computed
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FMREAD : to read data in LFIFM file
+!! FMREAD_LB : to read LB data in LFIFM file
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CONF : NVERB
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine INI_LB)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!! D. Gazen L.A.
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 22/09/98 FMREAD_LB handle LBs fields
+!! J. Stein 18/09/99 problem with the dry case
+!! D. Gazen 22/01/01 treat NSV_* with floating indices
+!! F Gheusi 29/10/03 bug in LB sources for NSV
+!! J.-P. Pinty 06/05/04 treat NSV_* for C1R3 and ELEC
+!! 20/05/06 Remove KEPS
+!! C.Lac 20/03/08 Add passive pollutants
+!! M.Leriche 16/07/10 Add ice phase chemical species
+!! Pialat/tulet 15/02/12 Add ForeFire scalars
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Leriche 09/02/16 Treat gas and aq. chemicals separately
+!! J.Escobar : 27/04/2016 : bug , test only on ANY(HGETSVM({{1:KSV}})=='READ'
+!! J.-P. Pinty 09/02/16 Add LIMA that is LBC for CCN and IFN
+!! M.Leriche 09/02/16 Treat gas and aq. chemicals separately
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/02/2019: initialize PLBXSVM and PLBYSVM in all cases
+! S. Bielli 02/2019: Sea salt: significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_TURB_n, ONLY: XTKEMIN
+USE MODD_CONF, ONLY: LCPL_AROME
+use modd_field, only: NMNHDIM_UNKNOWN, tfieldmetadata, TYPELOG, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY: NSV, NSV_CS, NSV_CSBEG, NSV_CSEND, NSV_LIMA_BEG, NSV_LIMA_END, &
+#ifdef MNH_FOREFIRE
+ NSV_FF, NSV_FFBEG, NSV_FFEND, &
+#endif
+ NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, NSV_PP, NSV_PPBEG, NSV_PPEND, &
+ NSV_SNWBEG, NSV_SNWEND, NSV_USER, TSVLIST
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPSVNAMELGTMAX, NLONGNAMELGTMAX, NMNHNAMELGTMAX
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN
+!
+USE MODE_IO_FIELD_READ, only: IO_Field_read, IO_Field_read_lb
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+LOGICAL, INTENT(IN) :: OLSOURCE ! switch for the source term
+! Larger Scale fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
+INTEGER, INTENT(IN) :: KSV ! number of passive variables
+! sizes of the West-east total LB area
+INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
+INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
+INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV
+! sizes of the North-south total LB area
+INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
+INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
+INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
+! Get indicators
+CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM, &
+ HGETRVM,HGETRCM,HGETRRM, &
+ HGETRIM,HGETRSM,HGETRGM,HGETRHM
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
+! LB fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM !
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! LB arrays at time t-dt (if OLSOURCE=T) :
+REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLBXUMM,PLBXVMM,PLBXWMM ! Wind
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTHMM ! Mass
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYUMM,PLBYVMM,PLBYWMM ! Wind
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTHMM ! Mass
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTKEMM ! TKE
+REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTKEMM
+REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBXRMM ,PLBXSVMM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBYRMM ,PLBYSVMM ! in x and y-dir.
+REAL, INTENT(IN), OPTIONAL :: PLENG ! Interpolation length
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILBSIZEX,ILBSIZEY ! depth of the LB area in the RIM direction
+ ! written in FM file
+INTEGER :: IL3DX,IL3DY ! Size of the LB arrays in FM file
+ ! in the RIM direction
+INTEGER :: IL3DXU,IL3DYV ! Size of the LB arrays in FM file
+ ! in the RIM direction for the normal wind
+INTEGER :: IRIMX,IRIMY ! Total size of the LB area (for the RIM direction)
+INTEGER :: IRIMXU,IRIMYV ! Total size of the LB area (for the RIM direction)
+ ! for the normal wind (spatial gradient needed)
+
+INTEGER :: JSV,JRR ! Loop index for MOIST AND
+ ! additional scalar variables
+INTEGER :: IRR ! counter for moist variables
+INTEGER :: IRESP
+LOGICAL :: GHORELAX_UVWTH ! switch for the horizontal relaxation for U,V,W,TH in the FM file
+LOGICAL :: GHORELAX_TKE ! switch for the horizontal relaxation for tke in the FM file
+LOGICAL :: GHORELAX_R, GHORELAX_SV ! switch for the horizontal relaxation
+ ! for moist and scalar variables
+LOGICAL :: GIS551 ! True if file was written with MNH 5.5.1
+LOGICAL :: GOLDFILEFORMAT
+CHARACTER (LEN= LEN(HGETRVM)), DIMENSION (7) :: YGETRXM ! Arrays with the get indicators
+ ! for the moist variables
+CHARACTER (LEN=1), DIMENSION (7) :: YC ! array with the prefix of the moist variables
+CHARACTER(LEN=NMNHNAMELGTMAX) :: YMNHNAME_BASE
+CHARACTER(LEN=NLONGNAMELGTMAX) :: YLONGNAME_BASE
+TYPE(TFIELDMETADATA) :: TZFIELD
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. READ CPL_AROME to know which LB_fileds there are to read
+! --------------------
+IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>8) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
+ CALL IO_Field_read(TPINIFILE,'CPL_AROME',LCPL_AROME)
+ELSE
+ LCPL_AROME=.FALSE.
+ENDIF
+!
+!
+!* 1. SOME INITIALIZATIONS
+! --------------------
+!
+!If TPINIFILE file was written with a MesoNH version < 5.6, some variables had different names or were not available
+GOLDFILEFORMAT = ( TPINIFILE%NMNHVERSION(1) < 5 &
+ .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 6 ) )
+GIS551 = TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 .AND. TPINIFILE%NMNHVERSION(3) == 1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. READ 2D "surfacic" LB fields
+! ----------------------------
+!
+!* 2.1 read the number of available points for the horizontal relaxation
+! for basic variables
+CALL IO_Field_read(TPINIFILE,'RIMX',ILBSIZEX)
+CALL IO_Field_read(TPINIFILE,'RIMY',ILBSIZEY)
+!
+!* 2.2 Basic variables
+!
+CALL IO_Field_read(TPINIFILE,'HORELAX_UVWTH',GHORELAX_UVWTH)
+ !
+IF (GHORELAX_UVWTH) THEN
+ IRIMX =(KSIZELBX_ll-2*JPHEXT)/2
+ IRIMXU=(KSIZELBXU_ll-2*JPHEXT)/2
+ IRIMY =(KSIZELBY_ll-2*JPHEXT)/2
+ IRIMYV=(KSIZELBYV_ll-2*JPHEXT)/2
+ IL3DX=2*ILBSIZEX+2*JPHEXT
+ IL3DXU=IL3DX
+ IL3DY=2*ILBSIZEY+2*JPHEXT
+ IL3DYV=IL3DY
+ELSE
+ IRIMX=0
+ IRIMXU=1
+ IRIMY=0
+ IRIMYV=1
+ IL3DX=2*JPHEXT ! 2
+ IL3DY=2*JPHEXT ! 2
+ IL3DXU=2 + 2*JPHEXT ! 4
+ IL3DYV=2 + 2*JPHEXT ! 4
+ENDIF
+!
+IF ( KSIZELBXU_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBXUM', IL3DXU, IRIMXU, PLBXUM )
+IF ( KSIZELBX_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBXVM', IL3DX, IRIMX, PLBXVM )
+IF ( KSIZELBX_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBXWM', IL3DX, IRIMX, PLBXWM )
+IF ( KSIZELBY_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBYUM', IL3DY, IRIMY, PLBYUM )
+IF ( KSIZELBYV_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBYVM', IL3DYV, IRIMYV, PLBYVM )
+IF ( KSIZELBY_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBYWM', IL3DY, IRIMY, PLBYWM )
+IF ( KSIZELBX_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBXTHM', IL3DX, IRIMX, PLBXTHM )
+IF ( KSIZELBY_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBYTHM', IL3DY, IRIMY, PLBYTHM )
+!
+!* 2.3 LB-TKE
+!
+SELECT CASE(HGETTKEM)
+CASE('READ')
+ IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN
+ IF (PRESENT(PLBXTKEMM).AND.PRESENT(PLBYTKEMM)) THEN
+ CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'LBXTKES and LBYTKE are initialized to PLBXTKEMM and PLBYTKEMM' )
+ PLBXTKEM(:,:,:) = PLBXTKEMM(:,:,:)
+ PLBYTKEM(:,:,:) = PLBYTKEMM(:,:,:)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize LBXTKES and LBYTKES')
+ ENDIF
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'HORELAX_TKE',GHORELAX_TKE)
+ IF (GHORELAX_TKE) THEN
+ IRIMX=(KSIZELBXTKE_ll-2*JPHEXT)/2
+ IRIMY=(KSIZELBYTKE_ll-2*JPHEXT)/2
+ IL3DX=2*ILBSIZEX+2*JPHEXT
+ IL3DY=2*ILBSIZEY+2*JPHEXT
+ ELSE
+ IRIMX=0
+ IRIMY=0
+ IL3DX=2*JPHEXT ! 2
+ IL3DY=2*JPHEXT ! 2
+ ENDIF
+!
+ IF (KSIZELBXTKE_ll /= 0) THEN
+ CALL IO_Field_read_lb(TPINIFILE,'LBXTKEM',IL3DX,IRIMX,PLBXTKEM)
+ END IF
+!
+ IF (KSIZELBYTKE_ll /= 0) THEN
+ CALL IO_Field_read_lb(TPINIFILE,'LBYTKEM',IL3DY,IRIMY,PLBYTKEM)
+ END IF
+ ENDIF
+CASE('INIT')
+ IF (SIZE(PLBXTKEM,1) /= 0) PLBXTKEM(:,:,:) = XTKEMIN
+ IF (SIZE(PLBYTKEM,1) /= 0) PLBYTKEM(:,:,:) = XTKEMIN
+END SELECT
+!
+!
+!* 2.5 LB-Rx
+!
+IF(KSIZELBXR_ll > 0 ) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HORELAX_R', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HORELAX_R', &
+ CUNITS = '', &
+ CDIR = '--', &
+ CCOMMENT = 'Switch to activate the HOrizontal RELAXation', &
+ CLBTYPE = 'NONE', &
+ NGRID = 1, &
+ NTYPE = TYPELOG, &
+ NDIMS = 0, &
+ LTIMEDEP = .FALSE. )
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,GHORELAX_R)
+ !
+ YGETRXM(:)=(/HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM,HGETRGM,HGETRHM/)
+ YC(:)=(/"V","C","R","I","S","G","H"/)
+ IF (GHORELAX_R) THEN
+ IRIMX=(KSIZELBXR_ll-2*JPHEXT)/2
+ IRIMY= (KSIZELBYR_ll-2*JPHEXT)/2
+ IL3DX=2*ILBSIZEX+2*JPHEXT
+ IL3DY=2*ILBSIZEY+2*JPHEXT
+ ELSE
+ IRIMX=0
+ IRIMY=0
+ IL3DX=2*JPHEXT ! 2
+ IL3DY=2*JPHEXT ! 2
+ END IF
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CUNITS = 'kg kg-1', &
+ CDIR = '', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ IRR=0
+ JRR=1
+ SELECT CASE(YGETRXM(1))
+ CASE('READ')
+ IRR=IRR+1
+ IF ( KSIZELBXR_ll /= 0 ) THEN
+ TZFIELD%CMNHNAME = 'LBXR'//YC(JRR)//'M'
+ TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M'
+ TZFIELD%CLBTYPE = 'LBX'
+ TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M'
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR))
+ END IF
+ !
+ IF ( KSIZELBYR_ll /= 0 ) THEN
+ TZFIELD%CMNHNAME = 'LBYR'//YC(JRR)//'M'
+ TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M'
+ TZFIELD%CLBTYPE = 'LBY'
+ TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M'
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR))
+ END IF
+ CASE('INIT')
+ IRR=IRR+1
+ IF ( SIZE(PLBXRM,1) /= 0 ) PLBXRM(:,:,:,IRR) = 0.
+ IF ( SIZE(PLBYRM,1) /= 0 ) PLBYRM(:,:,:,IRR) = 0.
+ END SELECT
+ !
+ !
+ DO JRR=2,7
+ SELECT CASE(YGETRXM(JRR))
+ CASE('READ')
+ IRR=IRR+1
+ IF ( KSIZELBXR_ll /= 0 ) THEN
+ IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN
+ IF (PRESENT(PLBXRMM)) THEN
+ PLBXRM(:,:,:,IRR)=PLBXRMM(:,:,:,IRR)
+ CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'PLBXRM is initialized to PLBXRMM for LBXR'//YC(JRR)//'M' )
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize PLBXRM for LBXR'//YC(JRR)//'M')
+ ENDIF
+ ELSE
+ TZFIELD%CMNHNAME = 'LBXR'//YC(JRR)//'M'
+ TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M'
+ TZFIELD%CLBTYPE = 'LBX'
+ TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M'
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR))
+ ENDIF
+ END IF
+ !
+ IF ( KSIZELBYR_ll /= 0 ) THEN
+ IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN
+ IF (PRESENT(PLBYRMM)) THEN
+ PLBYRM(:,:,:,IRR)=PLBYRMM(:,:,:,IRR)
+ CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'PLBYRM is initialized to PLBYRMM for LBYR'//YC(JRR)//'M' )
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize PLBYRM for LBYR'//YC(JRR)//'M')
+ ENDIF
+ ELSE
+ TZFIELD%CMNHNAME = 'LBYR'//YC(JRR)//'M'
+ TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M'
+ TZFIELD%CLBTYPE = 'LBY'
+ TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M'
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR))
+ ENDIF
+ END IF
+ CASE('INIT')
+ IRR=IRR+1
+ IF ( SIZE(PLBXRM,1) /= 0 ) PLBXRM(:,:,:,IRR) = 0.
+ IF ( SIZE(PLBYRM,1) /= 0 ) PLBYRM(:,:,:,IRR) = 0.
+ END SELECT
+ END DO
+END IF
+!
+!* 2.6 LB-Scalar Variables
+!
+IF (KSV > 0) THEN
+ IF (ANY(HGETSVM(1:KSV)=='READ')) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HORELAX_SV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HORELAX_SV', &
+ CUNITS = '', &
+ CDIR = '--', &
+ CCOMMENT = '', &
+ CLBTYPE = 'NONE', &
+ NGRID = 0, &
+ NTYPE = TYPELOG, &
+ NDIMS = 0, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read( TPINIFILE, TZFIELD, GHORELAX_SV )
+
+ IF ( GHORELAX_SV ) THEN
+ IRIMX=(KSIZELBXSV_ll-2*JPHEXT)/2
+ IRIMY=(KSIZELBYSV_ll-2*JPHEXT)/2
+ IL3DX=2*ILBSIZEX+2*JPHEXT
+ IL3DY=2*ILBSIZEY+2*JPHEXT
+ ELSE
+ IRIMX=0
+ IRIMY=0
+ IL3DX=2*JPHEXT
+ IL3DY=2*JPHEXT
+ END IF
+ END IF
+END IF
+
+! Scalar variables
+DO JSV = 1, NSV
+ SELECT CASE( HGETSVM(JSV) )
+ CASE ( 'READ' )
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CDIR = ''
+ TZFIELD%NDIMLIST(:) = NMNHDIM_UNKNOWN
+ YMNHNAME_BASE = TRIM( TZFIELD%CMNHNAME )
+ YLONGNAME_BASE = TRIM( TZFIELD%CLONGNAME )
+
+ IF ( KSIZELBXSV_ll /= 0 ) THEN
+ TZFIELD%CMNHNAME = 'LBX_' // TRIM( YMNHNAME_BASE )
+ TZFIELD%CLONGNAME = 'LBX_' // TRIM( YLONGNAME_BASE )
+
+ !Some variables were written with an other name in MesoNH < 5.6
+ IF ( GOLDFILEFORMAT ) THEN
+ IF ( JSV >= 1 .AND. JSV <= NSV_USER ) THEN
+ WRITE( TZFIELD%CMNHNAME, '( A6, I3.3 )' ) 'LBXSVM',JSV
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM( TZFIELD%CMNHNAME )
+ ELSE IF ( JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END ) THEN
+ ! Name was corrected in MNH 5.5.1
+ IF ( .NOT. GIS551 ) CALL OLD_CMNHNAME_GENERATE_INTERN( TZFIELD%CMNHNAME, TZFIELD%CLONGNAME )
+ TZFIELD%CSTDNAME = ''
+ ELSE IF ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) THEN
+ TZFIELD%CMNHNAME = 'LBX_PP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LBX_PP'
+ IF ( JSV == NSV_PPBEG .AND. NSV_PP > 1 ) THEN
+ CMNHMSG(1) = 'reading older file (<5.6) for LBX_PP scalar variables'
+ CMNHMSG(2) = 'they are bugged: there should be several LBX_PP variables'
+ CMNHMSG(3) = 'but they were all written with the same name ''LBX_PP'''
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
+ END IF
+#ifdef MNH_FOREFIRE
+ ELSE IF ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) THEN
+ TZFIELD%CMNHNAME = 'LBX_FF'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LBX_FF'
+ IF ( JSV == NSV_FFBEG .AND. NSV_FF > 1 ) THEN
+ CMNHMSG(1) = 'reading older file (<5.6) for LBX_FF scalar variables'
+ CMNHMSG(2) = 'they are bugged: there should be several LBX_FF variables'
+ CMNHMSG(3) = 'but they were all written with the same name ''LBX_FF'''
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
+ END IF
+#endif
+ ELSE IF ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) THEN
+ TZFIELD%CMNHNAME = 'LBX_CS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LBX_CS'
+ IF ( JSV == NSV_CSBEG .AND. NSV_CS > 1 ) THEN
+ CMNHMSG(1) = 'reading older file (<5.6) for LBX_CS scalar variables'
+ CMNHMSG(2) = 'they are bugged: there should be several LBX_CS variables'
+ CMNHMSG(3) = 'but they were all written with the same name ''LBX_CS'''
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
+ END IF
+ END IF
+ END IF
+
+ WRITE( TZFIELD%CCOMMENT, '( A6, A6, I3.3 )' ) '2_Y_Z_', 'LBXSVM', JSV
+ TZFIELD%CLBTYPE = 'LBX'
+
+ CALL IO_Field_read_lb( TPINIFILE, TZFIELD, IL3DX, IRIMX, PLBXSVM(:,:,:,JSV), IRESP )
+
+ IF ( IRESP /= 0 ) THEN
+ IF ( PRESENT( PLBXSVMM ) ) THEN
+ PLBXSVM(:,:,:,JSV) = PLBXSVMM(:,:,:,JSV)
+ CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'PLBXSVM is initialized to PLBXSVMM for ' // TRIM( YMNHNAME_BASE ) )
+ ELSE
+ IF ( JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END ) THEN
+ PLBXSVM(:,:,:,JSV) = 0.
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB', 'PLBXSVM is initialized to 0 for ' // TRIM( YMNHNAME_BASE ) )
+ ELSE IF ( ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) .OR. &
+#ifdef MNH_FOREFIRE
+ ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) .OR. &
+#endif
+ ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) .OR. &
+ ( JSV >= NSV_SNWBEG .AND. JSV <= NSV_SNWEND .AND. GOLDFILEFORMAT ) ) THEN !Snow was not written in <5.6
+ PLBXSVM(:,:,:,JSV) = 0.
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB', 'PLBXSVM is initialized to 0 for ' // TRIM( YMNHNAME_BASE ) )
+ ELSE
+ CALL PRINT_MSG( NVERB_FATAL, 'IO', 'INI_LB', 'problem to initialize PLBXSVM for ' // TRIM( YMNHNAME_BASE ) )
+ END IF
+ END IF
+ END IF
+ END IF
+
+ IF ( KSIZELBYSV_ll /= 0 ) THEN
+ TZFIELD%CMNHNAME = 'LBY_' // TRIM( YMNHNAME_BASE )
+ TZFIELD%CLONGNAME = 'LBY_' // TRIM( YLONGNAME_BASE )
+
+ !Some variables were written with an other name in MesoNH < 5.6
+ IF ( GOLDFILEFORMAT ) THEN
+ IF ( JSV >= 1 .AND. JSV <= NSV_USER ) THEN
+ WRITE( TZFIELD%CMNHNAME, '( A6, I3.3 )' ) 'LBYSVM',JSV
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM( TZFIELD%CMNHNAME )
+ ELSE IF ( JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END ) THEN
+ ! Name was corrected in MNH 5.5.1
+ IF ( .NOT. GIS551 ) CALL OLD_CMNHNAME_GENERATE_INTERN( TZFIELD%CMNHNAME, TZFIELD%CLONGNAME )
+ TZFIELD%CSTDNAME = ''
+ ELSE IF ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) THEN
+ TZFIELD%CMNHNAME = 'LBY_PP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LBY_PP'
+ IF ( JSV == NSV_PPBEG .AND. NSV_PP > 1 ) THEN
+ CMNHMSG(1) = 'reading older file (<5.6) for LBY_PP scalar variables'
+ CMNHMSG(2) = 'they are bugged: there should be several LBY_PP variables'
+ CMNHMSG(3) = 'but they were all written with the same name ''LBY_PP'''
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
+ END IF
+#ifdef MNH_FOREFIRE
+ ELSE IF ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) THEN
+ TZFIELD%CMNHNAME = 'LBY_FF'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LBY_FF'
+ IF ( JSV == NSV_FFBEG .AND. NSV_FF > 1 ) THEN
+ CMNHMSG(1) = 'reading older file (<5.6) for LBY_FF scalar variables'
+ CMNHMSG(2) = 'they are bugged: there should be several LBY_FF variables'
+ CMNHMSG(3) = 'but they were all written with the same name ''LBY_FF'''
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
+ END IF
+#endif
+ ELSE IF ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) THEN
+ TZFIELD%CMNHNAME = 'LBY_CS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'LBY_CS'
+ IF ( JSV == NSV_CSBEG .AND. NSV_CS > 1 ) THEN
+ CMNHMSG(1) = 'reading older file (<5.6) for LBY_CS scalar variables'
+ CMNHMSG(2) = 'they are bugged: there should be several LBY_CS variables'
+ CMNHMSG(3) = 'but they were all written with the same name ''LBY_CS'''
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
+ END IF
+ END IF
+ END IF
+ WRITE( TZFIELD%CCOMMENT, '( A6, A6, I3.3 )' ) 'X_2_Z_', 'LBYSVM', JSV
+ TZFIELD%CLBTYPE = 'LBY'
+
+ CALL IO_Field_read_lb( TPINIFILE, TZFIELD, IL3DY, IRIMY, PLBYSVM(:,:,:,JSV), IRESP )
+
+ IF ( IRESP /= 0 ) THEN
+ IF ( PRESENT( PLBYSVMM ) ) THEN
+ PLBYSVM(:,:,:,JSV) = PLBYSVMM(:,:,:,JSV)
+ CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'PLBYSVM is initialized to PLBYSVMM for ' // TRIM( YMNHNAME_BASE ) )
+ ELSE
+ IF ( JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END ) THEN
+ PLBYSVM(:,:,:,JSV) = 0.
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB', 'PLBYSVM is initialized to 0 for ' // TRIM( YMNHNAME_BASE ) )
+ ELSE IF ( ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) .OR. &
+#ifdef MNH_FOREFIRE
+ ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) .OR. &
+#endif
+ ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) .OR. &
+ ( JSV >= NSV_SNWBEG .AND. JSV <= NSV_SNWEND .AND. GOLDFILEFORMAT ) ) THEN !Snow was not written in <5.6
+ PLBYSVM(:,:,:,JSV) = 0.
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB', 'PLBYSVM is initialized to 0 for ' // TRIM( YMNHNAME_BASE ) )
+ ELSE
+ CALL PRINT_MSG( NVERB_FATAL, 'IO', 'INI_LB', 'problem to initialize PLBYSVM for ' // TRIM( YMNHNAME_BASE ) )
+ END IF
+ END IF
+ END IF
+ END IF
+
+ CASE( 'INIT' )
+ IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0.
+ IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0.
+ END SELECT
+END DO
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTE THE LB SOURCES
+! -----------------------
+!
+! IN case of initialization of LB source terms (OLSOURCE=T) :
+! xxxM are LB source terms
+! xxxMM are LB fields at time t -dt
+IF (OLSOURCE) THEN
+ IF (PRESENT(PLBXUMM).AND.PRESENT(PLBYUMM)) THEN
+ PLBXUM(:,:,:) = (PLBXUM(:,:,:) - PLBXUMM(:,:,:)) / PLENG
+ PLBYUM(:,:,:) = (PLBYUM(:,:,:) - PLBYUMM(:,:,:)) / PLENG
+ ENDIF
+ IF (PRESENT(PLBXVMM).AND.PRESENT(PLBYVMM)) THEN
+ PLBXVM(:,:,:) = (PLBXVM(:,:,:) - PLBXVMM(:,:,:)) / PLENG
+ PLBYVM(:,:,:) = (PLBYVM(:,:,:) - PLBYVMM(:,:,:)) / PLENG
+ ENDIF
+ IF (PRESENT(PLBXWMM).AND.PRESENT(PLBYWMM)) THEN
+ PLBXWM(:,:,:) = (PLBXWM(:,:,:) - PLBXWMM(:,:,:)) / PLENG
+ PLBYWM(:,:,:) = (PLBYWM(:,:,:) - PLBYWMM(:,:,:)) / PLENG
+ ENDIF
+ IF (PRESENT(PLBXTHMM).AND.PRESENT(PLBYTHMM)) THEN
+ PLBXTHM(:,:,:) = (PLBXTHM(:,:,:) - PLBXTHMM(:,:,:)) / PLENG
+ PLBYTHM(:,:,:) = (PLBYTHM(:,:,:) - PLBYTHMM(:,:,:)) / PLENG
+ ENDIF
+ IF (HGETTKEM =='READ') THEN
+ IF (PRESENT(PLBXTKEMM).AND.PRESENT(PLBYTKEMM)) THEN
+ PLBXTKEM(:,:,:) = (PLBXTKEM(:,:,:) - PLBXTKEMM(:,:,:)) / PLENG
+ PLBYTKEM(:,:,:) = (PLBYTKEM(:,:,:) - PLBYTKEMM(:,:,:)) / PLENG
+ ENDIF
+ ENDIF
+ IF (HGETTKEM =='INIT') THEN
+ PLBXTKEM(:,:,:) = 0.
+ PLBYTKEM(:,:,:) = 0.
+ ENDIF
+! LB moist variables
+ IRR=0
+ IF (PRESENT(PLBXRMM).AND.PRESENT(PLBYRMM)) THEN
+ DO JRR=1,7
+ IF (YGETRXM(JRR) == 'READ') THEN
+ IRR=IRR+1
+ PLBXRM(:,:,:,IRR) = (PLBXRM(:,:,:,IRR) - PLBXRMM(:,:,:,IRR)) / PLENG
+ PLBYRM(:,:,:,IRR) = (PLBYRM(:,:,:,IRR) - PLBYRMM(:,:,:,IRR)) / PLENG
+ ENDIF
+ END DO
+ ENDIF
+! LB-scalar variables
+ DO JSV=1,KSV
+ IF (HGETSVM(JSV) == 'READ') THEN
+ PLBXSVM(:,:,:,JSV) = (PLBXSVM(:,:,:,JSV) - PLBXSVMM(:,:,:,JSV)) / PLENG
+ PLBYSVM(:,:,:,JSV) = (PLBYSVM(:,:,:,JSV) - PLBYSVMM(:,:,:,JSV)) / PLENG
+ ENDIF
+ END DO
+!
+ENDIF
+!
+CONTAINS
+
+ SUBROUTINE OLD_CMNHNAME_GENERATE_INTERN( YMNHNAME, YLONGNAME )
+
+ CHARACTER(LEN=*), INTENT(INOUT) :: YMNHNAME
+ CHARACTER(LEN=*), INTENT(INOUT) :: YLONGNAME
+
+ INTEGER :: IPOS
+ INTEGER :: JI
+
+ !Try to generate CMNHNAME with old format
+ !In the old format, an indice of 2 numbers was written after the name but without trimming it
+ IPOS = SCAN( YMNHNAME, '0123456789' )
+
+ !Unmodified part YMNHNAME(1:IPOS-1) = YMNHNAME(1:IPOS-1)
+
+ !Move number part at the new end
+ IF ( 4+JPSVNAMELGTMAX+2 > LEN( YMNHNAME ) ) &
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','OLD_CMNHNAME_GENERATE_INTERN','CMNHNAME too small')
+ YMNHNAME(4+JPSVNAMELGTMAX+1 : 4+JPSVNAMELGTMAX+2) = YMNHNAME(IPOS : IPOS+1)
+ DO JI = IPOS, 4+JPSVNAMELGTMAX
+ YMNHNAME(JI:JI) = ' '
+ END DO
+
+ YLONGNAME = TRIM( YMNHNAME )
+
+ END SUBROUTINE OLD_CMNHNAME_GENERATE_INTERN
+
+END SUBROUTINE INI_LB
diff --git a/src/PHYEX/ext/ini_lesn.f90 b/src/PHYEX/ext/ini_lesn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7caf12b44211de2f69700fbab021a42486aa40a7
--- /dev/null
+++ b/src/PHYEX/ext/ini_lesn.f90
@@ -0,0 +1,1995 @@
+!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_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
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZ_LES ! LES altitudes 3D array
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZ_SPEC! " for spectra
+!
+!
+REAL, DIMENSION(:), POINTER :: ZXHAT_ll ! father model coordinates
+REAL, DIMENSION(:), POINTER :: ZYHAT_ll !
+INTEGER :: IMI
+!
+!-------------------------------------------------------------------------------
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+ZXHAT_ll => NULL()
+ZYHAT_ll => NULL()
+!
+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
+ ZXHAT_ll => XXHAT_ll !Use current (IMI) model XXHAT_ll
+ ZYHAT_ll => XYHAT_ll
+!
+ 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)
+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_micron.f90 b/src/PHYEX/ext/ini_micron.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a4934ed55d020c7cdee8d443fa663083e790f54d
--- /dev/null
+++ b/src/PHYEX/ext/ini_micron.f90
@@ -0,0 +1,327 @@
+!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_INI_MICRO_n
+! ########################
+!
+INTERFACE
+ SUBROUTINE INI_MICRO_n ( TPINIFILE,KLUOUT )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+!
+END SUBROUTINE INI_MICRO_n
+!
+END INTERFACE
+!
+END MODULE MODI_INI_MICRO_n
+! ############################################
+ SUBROUTINE INI_MICRO_n ( TPINIFILE,KLUOUT )
+! ############################################
+!
+!
+!!**** *INI_MICRO_n* allocates and fills MODD_PRECIP_n variables
+!! and initialize parameter for microphysical scheme
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! P. Jabouille
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/11/02
+!! O.Geoffroy (03/2006) : Add KHKO scheme
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! C.LAc 10/2016 Add budget for droplet deposition
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 01/2019: bugfix: add missing allocations
+! C. Lac 02/2020: add missing allocation of INPRC and ACPRC with deposition
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 04/06/2020: bugfix: correct bounds of passed arrays
+! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_CONF, ONLY : CCONF,CPROGRAM
+USE MODD_IO, ONLY : TFILEDATA
+USE MODD_GET_n, ONLY : CGETRCT,CGETRRT, CGETRST, CGETRGT, CGETRHT, CGETCLOUD
+USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
+USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_PRECIP_n, ONLY : XINPRR, XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, &
+ XINPRH, XACPRH, XINPRC, XACPRC, XINPRR3D, XEVAP3D,&
+ XINDEP,XACDEP
+USE MODD_FIELD_n, ONLY : XRT, XSVT, XTHT, XPABST, XTHM, XRCM
+USE MODD_GRID_n, ONLY : XZZ
+USE MODD_METRICS_n, ONLY : XDXX,XDYY,XDZZ,XDZX,XDZY
+USE MODD_REF_n, ONLY : XRHODREF
+USE MODD_DYN_n, ONLY : XTSTEP
+USE MODD_CLOUDPAR_n, ONLY : NSPLITR, NSPLITG
+USE MODD_PARAM_n, ONLY : CELEC
+USE MODD_PARAM_ICE_n, ONLY : LSEDIC, LDEPOSC
+USE MODD_PARAM_C2R2, ONLY : LSEDC, LACTIT, LDEPOC
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+!
+USE MODI_READ_PRECIP_FIELD
+USE MODI_INI_CLOUD
+USE MODE_INI_RAIN_ICE, ONLY: INI_RAIN_ICE
+USE MODI_INI_RAIN_C2R2
+USE MODI_INI_ICE_C1R3
+USE MODI_CLEAN_CONC_RAIN_C2R2
+USE MODI_SET_CONC_RAIN_C2R2
+USE MODI_CLEAN_CONC_ICE_C1R3
+USE MODI_SET_CONC_ICE_C1R3
+!
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+USE MODE_BLOWSNOW_SEDIM_LKT
+USE MODE_SET_CONC_LIMA
+!
+USE MODD_NSV, ONLY : NSV,NSV_CHEM,NSV_C2R2BEG,NSV_C2R2END, &
+ NSV_C1R3BEG,NSV_C1R3END, &
+ NSV_LIMA_BEG, NSV_LIMA_END
+USE MODD_PARAM_LIMA, ONLY : LSCAV, MSEDC=>LSEDC, MACTIT=>LACTIT, MDEPOC=>LDEPOC
+USE MODD_LIMA_PRECIP_SCAVENGING_n
+!
+USE MODI_INIT_AEROSOL_CONCENTRATION
+USE MODE_INI_LIMA, ONLY: INI_LIMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+!
+! 0.2 declaration of local variables
+!
+!
+!
+INTEGER :: IIU ! Upper dimension in x direction (local)
+INTEGER :: IJU ! Upper dimension in y direction (local)
+INTEGER :: IKU ! Upper dimension in z direction
+INTEGER :: JK ! loop vertical index
+INTEGER :: IINFO_ll! Return code of //routines
+INTEGER :: IKB,IKE
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZ ! mesh size
+REAL :: ZDZMIN
+INTEGER :: IMI
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PROLOGUE
+!
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU=SIZE(XZZ,3)
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!
+!* 2. ALLOCATE Module MODD_PRECIP_n
+! ------------------------------
+!
+IF (CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE') THEN
+ ALLOCATE(XINPRR(IIU,IJU))
+ ALLOCATE(XINPRR3D(IIU,IJU,IKU))
+ ALLOCATE(XEVAP3D(IIU,IJU,IKU))
+ ALLOCATE(XACPRR(IIU,IJU))
+ XINPRR(:,:)=0.0
+ XACPRR(:,:)=0.0
+ XINPRR3D(:,:,:)=0.0
+ XEVAP3D(:,:,:)=0.0
+ELSE
+ ALLOCATE(XINPRR(0,0))
+ ALLOCATE(XINPRR3D(0,0,0))
+ ALLOCATE(XEVAP3D(0,0,0))
+ ALLOCATE(XACPRR(0,0))
+END IF
+!
+IF (( CCLOUD(1:3) == 'ICE' .AND.(LSEDIC .OR. LDEPOSC)) .OR. &
+ ((CCLOUD=='C2R2' .OR. CCLOUD=='C3R5' .OR. CCLOUD=='KHKO').AND.(LSEDC .OR. LDEPOC)) .OR. &
+ ( CCLOUD=='LIMA' .AND.(MSEDC .OR. MDEPOC))) THEN
+ ALLOCATE(XINPRC(IIU,IJU))
+ ALLOCATE(XACPRC(IIU,IJU))
+ XINPRC(:,:)=0.0
+ XACPRC(:,:)=0.0
+ELSE
+ ALLOCATE(XINPRC(0,0))
+ ALLOCATE(XACPRC(0,0))
+END IF
+!
+IF (( CCLOUD(1:3) == 'ICE' .AND.LDEPOSC) .OR. &
+ ((CCLOUD=='C2R2' .OR. CCLOUD=='KHKO').AND.LDEPOC) .OR. &
+ ( CCLOUD=='LIMA' .AND.MDEPOC)) THEN
+ ALLOCATE(XINDEP(IIU,IJU))
+ ALLOCATE(XACDEP(IIU,IJU))
+ XINDEP(:,:)=0.0
+ XACDEP(:,:)=0.0
+ELSE
+ ALLOCATE(XINDEP(0,0))
+ ALLOCATE(XACDEP(0,0))
+END IF
+!
+IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
+ ALLOCATE(XINPRS(IIU,IJU))
+ ALLOCATE(XACPRS(IIU,IJU))
+ XINPRS(:,:)=0.0
+ XACPRS(:,:)=0.0
+ELSE
+ ALLOCATE(XINPRS(0,0))
+ ALLOCATE(XACPRS(0,0))
+ END IF
+!
+IF (CCLOUD == 'C3R5' .OR. CCLOUD(1:3) == 'ICE'.OR. CCLOUD == 'LIMA') THEN
+ ALLOCATE(XINPRG(IIU,IJU))
+ ALLOCATE(XACPRG(IIU,IJU))
+ XINPRG(:,:)=0.0
+ XACPRG(:,:)=0.0
+ELSE
+ ALLOCATE(XINPRG(0,0))
+ ALLOCATE(XACPRG(0,0))
+END IF
+!
+IF (CCLOUD =='ICE4' .OR. CCLOUD == 'LIMA') THEN
+ ALLOCATE(XINPRH(IIU,IJU))
+ ALLOCATE(XACPRH(IIU,IJU))
+ XINPRH(:,:)=0.0
+ XACPRH(:,:)=0.0
+ELSE
+ ALLOCATE(XINPRH(0,0))
+ ALLOCATE(XACPRH(0,0))
+END IF
+!
+IF(LBLOWSNOW) THEN
+ ALLOCATE(XSNWSUBL3D(IIU,IJU,IKU))
+ XSNWSUBL3D(:,:,:) = 0.0
+ IF(CSNOWSEDIM=='TABC') THEN
+!Read in look up tables of snow particles properties
+!No arguments, all look up tables are defined in module
+!mode_snowdrift_sedim_lkt
+ CALL BLOWSNOW_SEDIM_LKT_SET
+ END IF
+ELSE
+ ALLOCATE(XSNWSUBL3D(0,0,0))
+END IF
+!
+!* 2b. ALLOCATION for Radiative cooling
+! ------------------------------
+IF (LACTIT .OR. MACTIT) THEN
+ ALLOCATE( XTHM(IIU,IJU,IKU) )
+ ALLOCATE( XRCM(IIU,IJU,IKU) )
+ XTHM = XTHT
+ XRCM(:,:,:) = XRT(:,:,:,2)
+ELSE
+ ALLOCATE( XTHM(0,0,0) )
+ ALLOCATE( XRCM(0,0,0) )
+END IF
+!
+!* 2.bis ALLOCATE Module MODD_PRECIP_SCAVENGING_n
+! ------------------------------
+!
+IF ( (CCLOUD=='LIMA') .AND. LSCAV ) THEN
+ ALLOCATE(XINPAP(IIU,IJU))
+ ALLOCATE(XACPAP(IIU,IJU))
+ XINPAP(:,:)=0.0
+ XACPAP(:,:)=0.0
+ELSE
+ ALLOCATE(XINPAP(0,0))
+ ALLOCATE(XACPAP(0,0))
+END IF
+!
+IF(SIZE(XINPRR) == 0) RETURN
+!
+!* 3. INITIALIZE MODD_PRECIP_n variables
+! ----------------------------------
+!
+CALL READ_PRECIP_FIELD(TPINIFILE,CPROGRAM,CCONF, &
+ CGETRCT,CGETRRT,CGETRST,CGETRGT,CGETRHT, &
+ XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D,&
+ XACPRR,XINPRS,XACPRS,XINPRG,XACPRG, XINPRH,XACPRH )
+!
+!
+!* 4. INITIALIZE THE PARAMETERS FOR THE MICROPHYSICS
+! ----------------------------------------------
+!
+!
+!* 4.1 Compute the minimun vertical mesh size
+!
+ALLOCATE(ZDZ(IIU,IJU,IKU))
+ZDZ=0.
+IKB = 1 + JPVEXT
+IKE = SIZE(XZZ,3)- JPVEXT
+DO JK = IKB,IKE
+ ZDZ(:,:,JK) = XZZ(:,:,JK+1) - XZZ(:,:,JK)
+END DO
+ZDZMIN = MIN_ll (ZDZ,IINFO_ll,1,1,IKB,NIMAX_ll+2*JPHEXT,NJMAX_ll+2*JPHEXT,IKE )
+DEALLOCATE(ZDZ)
+!
+IF (CCLOUD(1:3) == 'KES') THEN
+ CALL INI_CLOUD(XTSTEP,ZDZMIN,NSPLITR) ! Warm cloud only
+ELSE IF (CCLOUD(1:3) == 'ICE' ) THEN
+ CALL INI_RAIN_ICE(KLUOUT,XTSTEP,ZDZMIN,NSPLITR,CCLOUD) ! Mixed phase cloud
+ ! including hail
+ELSE IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
+ CALL INI_RAIN_C2R2(XTSTEP,ZDZMIN,NSPLITR,CCLOUD) ! 1/2 spectral warm cloud
+ IF (CCLOUD == 'C3R5') THEN
+ CALL INI_ICE_C1R3(XTSTEP,ZDZMIN,NSPLITG) ! 1/2 spectral cold cloud
+ END IF
+ELSE IF (CCLOUD == 'LIMA') THEN
+ IF (CGETCLOUD /= 'READ') CALL INIT_AEROSOL_CONCENTRATION( XRHODREF, XSVT(:, :, :, :), XZZ(:, :, :) )
+ CALL INI_LIMA(XTSTEP,ZDZMIN,NSPLITR, NSPLITG) ! 1/2 spectral warm cloud
+END IF
+!
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
+ IF (CGETCLOUD=='READ') THEN
+ CALL CLEAN_CONC_RAIN_C2R2 (XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C2R2END))
+ ELSE IF (CGETCLOUD=='INI1'.OR.CGETCLOUD=='INI2') THEN
+ CALL SET_CONC_RAIN_C2R2 (CGETCLOUD,XRHODREF,&
+ &XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C2R2END))
+ ENDIF
+ IF (CCLOUD == 'C3R5' ) THEN
+ IF (CGETCLOUD=='READ') THEN
+ CALL CLEAN_CONC_ICE_C1R3 (XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C1R3END))
+ ELSE
+ CALL SET_CONC_ICE_C1R3 (XRHODREF,XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C1R3END))
+ ENDIF
+ ENDIF
+ENDIF
+!
+IF (CCLOUD == 'LIMA') THEN
+ IF (CGETCLOUD/='READ') THEN
+ CALL SET_CONC_LIMA(IMI,CGETCLOUD,XRHODREF,XRT,XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END))
+ END IF
+END IF
+!
+!
+!* 5. INITIALIZE ATMOSPHERIC ELECTRICITY
+! ----------------------------------
+!
+!
+!IF (CELEC /= 'NONE') THEN
+! CALL INI_ELEC(IMI,TPINIFILE,XTSTEP,ZDZMIN,NSPLITR, &
+! XDXX,XDYY,XDZZ,XDZX,XDZY )
+!END IF
+!
+!
+END SUBROUTINE INI_MICRO_n
diff --git a/src/PHYEX/ext/ini_modeln.f90 b/src/PHYEX/ext/ini_modeln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f1b7d80691b9cfcba7d1951f2fd54abace79fd96
--- /dev/null
+++ b/src/PHYEX/ext/ini_modeln.f90
@@ -0,0 +1,2919 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_INI_MODEL_n
+! #######################
+!
+INTERFACE
+!
+ SUBROUTINE INI_MODEL_n(KMI,TPINIFILE)
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KMI ! Model Index
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+!
+END SUBROUTINE INI_MODEL_n
+!
+END INTERFACE
+!
+END MODULE MODI_INI_MODEL_n
+! ############################################
+ SUBROUTINE INI_MODEL_n(KMI,TPINIFILE)
+! ############################################
+!
+!!**** *INI_MODEL_n* - routine to initialize the nested model _n
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the variables
+! of the nested model _n.
+!
+!!** METHOD
+!! ------
+!! The initialization of the model _n is performed as follows :
+!! - Memory for arrays are then allocated :
+!! * If turbulence kinetic energy variable is not needed
+!! (CTURB='NONE'), XTKET, XTKEM and XTKES are zero-size arrays.
+!! * If dissipation of TKE variable is not needed
+!! (CTURBLEN /='KEPS'), XEPST, XEPSM and XREPSS are zero-size arrays.
+!! * Memory for mixing ratio arrays is allocated according to the
+!! value of logicals LUSERn (the number NRR of moist variables is deduced).
+!! * The latitude (XLAT), longitude (XLON) and map factor (XMAP)
+!! arrays are zero-size arrays if Cartesian geometry (LCARTESIAN=.TRUE.)
+!! * Memory for reference state without orography ( XRHODREFZ and
+!! XTHVREFZ) is only allocated in INI_MODEL1
+!! * The horizontal Coriolis parameters (XCORIOX and XCORIOY) arrays
+!! are zero-size arrays if thinshell approximation (LTHINSHELL=.TRUE.)
+!! * The Curvature coefficients (XCURVX and XCURVY) arrays
+!! are zero-size arrays if Cartesian geometry (LCARTESIAN=.TRUE.)
+!! * Memory for the Jacobian (ZJ) local array is allocated
+!! (This variable is computed in SET_GRID and used in SET_REF).
+!! - The spatial and temporal grid variables are initialized by SET_GRID.
+!! - The metric coefficients are computed by METRICS (they are using in
+!! the SET-REF call).
+!! - The prognostic variables and are read in initial
+!! LFIFM file (in READ_FIELD)
+!! - The reference state variables are initialized by SET_REF.
+!! - The temporal indexes of the outputs are computed by SET_OUTPUT_TIMES
+!! - The large scale sources are computed in case of coupling case by
+!! INI_CPL.
+!! - The initialization of the parameters needed for the dynamics
+!! of the model n is realized in INI_DYNAMICS.
+!! - Then the initial file (DESFM+LFIFM files) is closed by IO_File_close.
+!! - The initialization of the parameters needed for the ECMWF radiation
+!! code is realized in INI_RADIATIONS.
+!! - The contents of the scalar variables are overwritten by
+!! the chemistry initialization subroutine CH_INIT_FIELDn when
+!! the flags LUSECHEM and LCH_INIT_FIELD are set to TRUE.
+!! This allows easy initialization of the chemical fields at a
+!! restart of the model.
+!!
+!! EXTERNAL
+!! --------
+!! SET_DIM : to initialize dimensions
+!! SET_GRID : to initialize grid
+!! METRICS : to compute metric coefficients
+!! READ_FIELD : to initialize field
+!! FMCLOS : to close a FM-file
+!! SET_REF : to initialize reference state for anelastic approximation
+!! INI_DYNAMICS: to initialize parameters for the dynamics
+!! INI_TKE_EPS : to initialize the TKE
+!! SET_DIRCOS : to compute the director cosinus of the orography
+!! INI_RADIATIONS : to initialize radiation computations
+!! CH_INIT_CCS: to initialize the chemical core system
+!! CH_INIT_FIELDn: to (re)initialize the scalar variables
+!! INI_DEEP_CONVECTION : to initialize the deep convection scheme
+!! CLEANLIST_ll : deaalocate a list
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_PARAMETERS : contains declaration of parameter variables
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!!
+!! Module MODD_MODD_DYN : contains declaration of parameters
+!! for the dynamics
+!! Module MODD_CONF : contains declaration of configuration variables
+!! for all models
+!! NMODEL : Number of nested models
+!! NVERB : Level of informations on output-listing
+!! 0 for minimum prints
+!! 5 for intermediate level of prints
+!! 10 for maximum prints
+!!
+!! Module MODD_REF : contains declaration of reference state
+!! variables for all models
+!! Module MODD_FIELD_n : contains declaration of prognostic fields
+!! Module MODD_LSFIELD_n : contains declaration of Larger Scale fields
+!! Module MODD_GRID_n : contains declaration of spatial grid variables
+!! Module MODD_TIME_n : contains declaration of temporal grid variables
+!! Module MODD_REF_n : contains declaration of reference state
+!! variables
+!! Module MODD_CURVCOR_n : contains declaration of curvature and Coriolis
+!! variables
+!! Module MODD_BUDGET : contains declarations of the budget parameters
+!! Module MODD_RADIATIONS_n:contains declaration of the variables of the
+!! radiation interface scheme
+!! Module MODD_STAND_ATM : contains declaration of the 5 standard
+!! atmospheres used for the ECMWF-radiation code
+!! Module MODD_FRC : contains declaration of the control variables
+!! and of the forcing fields
+!! Module MODD_CH_MNHC_n : contains the control parameters for chemistry
+!! Module MODD_DEEP_CONVECTION_n: contains declaration of the variables of
+!! the deep convection scheme
+!!
+!!
+!!
+!!
+!! Module MODN_CONF_n : contains declaration of namelist NAM_CONFn and
+!! uses module MODD_CONF_n (configuration variables)
+!! Module MODN_LUNIT_n : contains declaration of namelist NAM_LUNITn and
+!! uses module MODD_LUNIT_n (Logical units)
+!! Module MODN_DYN_n : contains declaration of namelist NAM_DYNn and
+!! uses module MODD_DYN_n (control of dynamics)
+!! Module MODN_PARAM_n : contains declaration of namelist NAM_PARAMn and
+!! uses module MODD_PARAM_n (control of physical
+!! parameterization)
+!! Module MODN_LBC_n : contains declaration of namelist NAM_LBCn and
+!! uses module MODD_LBC_n (lateral boundaries)
+!! Module MODN_TURB_n : contains declaration of namelist NAM_TURBn and
+!! uses module MODD_TURB_n (turbulence scheme)
+!! Module MODN_PARAM_RAD_n: contains declaration of namelist NAM_PARAM_RADn
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine INI_MODEL_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 10/06/94
+!! Modification 17/10/94 (Stein) For LCORIO
+!! Modification 20/10/94 (Stein) For SET_GRID and NAMOUTN
+!! Modification 26/10/94 (Stein) Modifications of the namelist names
+!! Modification 10/11/94 (Lafore) allocatation of tke fields
+!! Modification 22/11/94 (Stein) change the READ_FIELDS call ( add
+!! pressure function
+!! Modification 06/12/94 (Stein) add the LS fields
+!! 12/12/94 (Stein) rename END_INI in INI_DYNAMICS
+!! Modification 09/01/95 (Stein) add the turbulence scheme
+!! Modification Jan 19, 1995 (J. Cuxart) add the TKE initialization
+!! Jan 23, 1995 (J. Stein ) remove the condition
+!! LTHINSHELL=T LCARTESIAN=T => stop
+!! Modification Feb 16, 1995 (I.Mallet) add the METRICS call and
+!! change the SET_REF call (add
+!! the lineic mass)
+!! Modification Mar 10, 1995 (I. Mallet) add the COUPLING initialization
+!! June 29,1995 (Ph. Hereil, J. Stein) add the budget init.
+!! Modification Sept. 1, 1995 (S. Belair) Reading of the surface variables
+!! and parameters for ISBA (i.e., add a
+!! CALL READ_GR_FIELD)
+!! Modification 18/08/95 (J.P.Lafore) time step change case
+!! 25/09/95 (J. Cuxart and J.Stein) add LES variables
+!! and the diachronic file initialization
+!! Modification Sept 20,1995 (Lafore) coupling for the dry mass Md
+!! Modification Sept. 12, 1995 (J.-P. Pinty) add the initialization of
+!! the ECMWF radiation code
+!! Modification Sept. 13, 1995 (J.-P. Pinty) control the allocation of the
+!! arrays of MODD_GR_FIELD_n
+!! Modification Nove. 17, 1995 (J.Stein) control of the control !!
+!! March 01, 1996 (J. Stein) add the cloud fraction
+!! April 03, 1996 (J. Stein) unify the ISBA and TSZ0 cases
+!! Modification 13/12/95 (M. Georgelin) add the forcing variables in
+!! the call read_field, and their
+!! allocation.
+!! Mai 23, 1996 (J. Stein) allocate XSEA in the TSZ0 case
+!! June 11, 1996 (V. Masson) add XSILT and XLAKE of
+!! MODD_GR_FIELD_n
+!! August 7, 1996 (K. Suhre) add (re)initialization of
+!! chemistry
+!! Octo. 11, 1996 (J. Stein ) add XSRCT and XSRCM
+!! October 8, 1996 (J. Cuxart, E. Sanchez) Moist LES diagnostics
+!! and control on TKE initialization.
+!! Modification 19/12/96 (J.-P. Pinty) add the ice parameterization and
+!! the precipitation fields
+!! Modification 11/01/97 (J.-P. Pinty) add the deep convection
+!! Nov. 1, 1996 (V. Masson) Read the vertical grid kind
+!! Nov. 20, 1996 (V. Masson) control of convection calling time
+!! July 16, 1996 (J.P.Lafore) update of EXSEG file reading
+!! Oct. 08, 1996 (J.P.Lafore, V.Masson)
+!! MY_NAME and DAD_NAME reading and check
+!! Oct. 30, 1996 (J.P.Lafore) resolution ratio reading for nesting
+!! and Bikhardt interpolation coef. initialization
+!! Nov. 22, 1996 (J.P.Lafore) allocation of LS sources for nesting
+!! Feb. 26, 1997 (J.P.Lafore) allocation of "surfacic" LS fields
+!! March 10, 1997 (J.P.Lafore) forcing only for model 1
+!! June 22, 1997 (J. Stein) add the absolute pressure
+!! July 09, 1997 (V. Masson) add directional z0 and SSO
+!! Aug. 18, 1997 (V. Masson) consistency between storage
+!! type and CCONF
+!! Dec. 22, 1997 (J. Stein) add the LS field spawning
+!! Jan. 24, 1998 (P.Bechtold) change MODD_FRC and MODD_DEEP_CONVECTION
+!! Dec. 24, 1997 (V.Masson) directional z0 parameters
+!! Aug. 13, 1998 (V. Ducrocq P Jabouille) //
+!! Mai. 26, 1998 (J. Stein) remove NXEND,NYEND
+!! Feb. 1, 1999 (J. Stein) compute the Bikhardt
+!! interpolation coeff. before the call to set_grid
+!! April 5, 1999 (V. Ducrocq) change the DXRATIO_ALL init.
+!! April 12, 1999 (J. Stein) cleaning + INI_SPAWN_LS
+!! Apr. 7, 1999 (P Jabouille) store the metric coefficients
+!! in modd_metrics_n
+!! Jui. 15,1999 (P Jabouille) split the routines in two parts
+!! Jan. 04,2000 (V. Masson) removes the TSZ0 case
+!! Apr. 15,2000 (P Jabouille) parallelization of grid nesting
+!! Aug. 20,2000 (J Stein ) tranpose XBFY
+!! Jui 01,2000 (F.solmon ) adapatation for patch approach
+!! Jun. 15,2000 (J.-P. Pinty) add C2R2 initialization
+!! Nov. 15,2000 (V.Masson) use of ini_modeln in prep_real_case
+!! Nov. 15,2000 (V.Masson) call of LES routines
+!! Nov. 15,2000 (V.Masson) aircraft and balloon initialization routines
+!! Jan. 22,2001 (D.Gazen) update_nsv set NSV_* var. for current model
+!! Mar. 04,2002 (V.Ducrocq) initialization to temporal series
+!! Mar. 15,2002 (F.Solmon) modification of ini_radiation interface
+!! Nov. 29,2002 (JP Pinty) add C3R5, ICE2, ICE4, ELEC
+!! Jan. 2004 (V.Masson) externalization of surface
+!! May 2006 Remove KEPS
+!! Apr. 2010 (M. Leriche) add pH for aqueous phase chemistry
+!! Jul. 2010 (M. Leriche) add Ice phase chemistry
+!! Oct. 2010 (J.Escobar) check if local domain not to small for NRIMX NRIMY
+!! Nov. 2010 (J.Escobar) PGI BUG , add SIZE(CSV) to init_ground routine
+!! Nov. 2009 (C. Barthe) add call to INI_ELEC_n
+!! Mar. 2010 (M. Chong) add small ions
+!! Apr. 2011 (M. Chong) correction of RESTART (ELEC)
+!! June 2011 (B.Aouizerats) Prognostic aerosols
+!! June 2011 (P.Aumond) Drag of the vegetation
+!! + Mean fields
+!! July 2013 (Bosseur & Filippi) Adds Forefire
+!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
+!! JAn. 2015 (F. Brosse) bug in allocate XACPRAQ
+!! Dec 2014 (C.Lac) : For reproducibility START/RESTA
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! V. Masson Feb 2015 replaces, for aerosols, cover fractions by sea, town, bare soil fractions
+!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
+!! J.Escobar : 01/06/2016 : correct check limit of NRIM versus local subdomain size IDIM
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Aug. 2016 (J.Pianezze) Add SFX_OASIS_READ_NAM function from SurfEx
+!! M.Leriche 2016 Chemistry
+!! 10/2016 M.Mazoyer New KHKO output fields
+!! 10/2016 (C.Lac) Add max values
+!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry
+!! M.Leriche 2016 Chemistry
+!! M.Leriche 10/02/17 prevent negative values in LBX(Y)SVS
+!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
+!! 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
+!! V. Vionnet : 18/07/2017 : add blowing snow scheme
+!! 01/18 J.Colin Add DRAG
+! P. Wautelet 29/01/2019: bug: add missing zero-size allocations
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 13/02/2019: initialize XALBUV even if no radiation (needed in CH_INTERP_JVALUES)
+! P. Wautelet 13/02/2019: removed PPABSM and PTSTEP dummy arguments of READ_FIELD
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 14/02/2019: remove HINIFILE dummy argument from INI_RADIATIONS_ECMWF/ECRAD
+!! 02/2019 C.Lac add rain fraction as an output field
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 14/03/2019: correct ZWS when variable not present in file (set to XZWS_DEFAULT)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! P. Wautelet 07/06/2019: allocate lookup tables for optical properties only when needed
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! S. Riette 04/2020: XHL* fields
+! F. Auguste 02/2021: add IBM
+! T.Nigel 02/2021: add turbulence recycling
+! J.L.Redelsperger 06/2011: OCEAN case
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
+! R. Schoetter 12/2021 adds humidity and other mean diagnostics
+! A. Costes 12/2021: Blaze fire model
+!---------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+#ifdef MNH_ECRAD
+USE YOERDI, only: RCCO2
+#endif
+
+USE MODD_2D_FRC
+USE MODD_ADVFRC_n
+USE MODD_ADV_n
+use MODD_AEROSET, only: POLYTAU, POLYSSA, POLYG
+USE MODD_ARGSLIST_ll, only: LIST_ll
+USE MODD_BIKHARDT_n
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+USE MODD_BUDGET
+USE MODD_CH_AERO_n, only: XSOLORG,XMI
+USE MODD_CH_AEROSOL, only: LORILAM
+USE MODD_CH_BUDGET_n
+USE MODD_CH_FLX_n, only: XCHFLX
+USE MODD_CH_M9_n, only:NNONZEROTERMS
+USE MODD_CH_MNHC_n, only: LUSECHEM, LUSECHAQ, LUSECHIC, LCH_INIT_FIELD, &
+ LCH_CONV_LINOX, XCH_TUV_DOBNEW, LCH_PH
+USE MODD_CH_PH_n
+USE MODD_CH_PRODLOSSTOT_n
+USE MODD_CLOUD_MF_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_CTURB
+USE MODD_CURVCOR_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_DEF_EDDY_FLUX_n ! for VT and WT fluxes
+USE MODD_DEF_EDDYUV_FLUX_n ! FOR UV
+USE MODD_DIAG_FLAG, only: LCHEMDIAG, CSPEC_BU_DIAG
+USE MODD_DIM_n
+USE MODD_DRAG_n
+USE MODD_DRAGTREE_n
+USE MODD_DRAGBLDG_n
+USE MODD_DUST
+use MODD_DUST_OPT_LKT, only: NMAX_RADIUS_LKT_DUST=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_DUST=>NMAX_SIGMA_LKT, &
+ NMAX_WVL_SW_DUST=>NMAX_WVL_SW, &
+ XEXT_COEFF_WVL_LKT_DUST=>XEXT_COEFF_WVL_LKT, XEXT_COEFF_550_LKT_DUST=>XEXT_COEFF_550_LKT, &
+ XPIZA_LKT_DUST=>XPIZA_LKT, XCGA_LKT_DUST=>XCGA_LKT
+USE MODD_DYN
+USE MODD_DYN_n
+USE MODD_DYNZD
+USE MODD_DYNZD_n
+USE MODD_ELEC_n, only: XCION_POS_FW, XCION_NEG_FW
+USE MODD_EOL_MAIN
+USE MODD_FIELD_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+USE MODD_FOREFIRE_n
+#endif
+USE MODD_FRC
+USE MODD_FRC_n
+USE MODD_GET_n
+USE MODD_GRID_n
+USE MODD_GRID, only: XLONORI,XLATORI
+USE MODD_IBM_PARAM_n, only: LIBM, XIBM_IEPS, XIBM_LS, XIBM_XMUT
+USE MODD_IO, only: CIO_DIR, TFILEDATA, TFILE_DUMMY
+USE MODD_IO_SURF_MNH, only: IO_SURF_MNH_MODEL
+USE MODD_LATZ_EDFLX
+USE MODD_LBC_n, only: CLBCX, CLBCY
+use modd_les
+USE MODD_LSFIELD_n
+USE MODD_LUNIT_n
+USE MODD_MEAN_FIELD
+USE MODD_MEAN_FIELD_n
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING, only: CDAD_NAME, NDAD, NDT_2_WAY, NDTRATIO, NDXRATIO_ALL, NDYRATIO_ALL
+USE MODD_NSV
+USE MODD_NSV
+USE MODD_NUDGING_n, only: LNUDGING
+USE MODD_OCEANH
+USE MODD_OUT_n
+USE MODD_PARAMETERS
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_MFSHALL_n
+USE MODD_PARAM_n
+USE MODD_PARAM_RAD_n, only: CAER, CAOP, CLW
+USE MODD_PASPOL
+USE MODD_PASPOL_n
+USE MODD_PAST_FIELD_n
+use modd_precision, only: LFIINT
+USE MODD_RADIATIONS_n
+USE MODD_RECYCL_PARAM_n
+USE MODD_REF
+USE MODD_REF_n
+USE MODD_RELFRC_n
+use MODD_SALT, only: LSALT
+use MODD_SALT_OPT_LKT, only: NMAX_RADIUS_LKT_SALT=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_SALT=>NMAX_SIGMA_LKT, &
+ NMAX_WVL_SW_SALT=>NMAX_WVL_SW, &
+ XEXT_COEFF_WVL_LKT_SALT=>XEXT_COEFF_WVL_LKT, XEXT_COEFF_550_LKT_SALT=>XEXT_COEFF_550_LKT, &
+ XPIZA_LKT_SALT=>XPIZA_LKT, XCGA_LKT_SALT=>XCGA_LKT
+USE MODD_SERIES, only: LSERIES
+USE MODD_SHADOWS_n
+USE MODD_STAND_ATM, only: XSTROATM, XSMLSATM, XSMLWATM, XSPOSATM, XSPOWATM
+USE MODD_SURF_PAR, only: XUNDEF_SFX => XUNDEF
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_TURB_n
+USE MODD_NEB_n, only: LSUBG_COND, LSTATNW
+USE MODD_VAR_ll, only: IP
+
+USE MODE_GATHER_ll
+USE MODE_INI_AIRCRAFT_BALLOON, only: INI_AIRCRAFT_BALLOON
+use mode_ini_budget, only: Budget_preallocate, Ini_budget
+USE MODE_INI_ONE_WAY_n
+USE MODE_IO
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FILE, only: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_MSG
+USE MODE_SET_GRID
+USE MODE_SPLITTINGZ_ll, only: GET_DIM_EXTZ_ll
+USE MODE_TYPE_ZDIFFU
+USE MODE_FIELD, ONLY: INI_FIELD_LIST
+
+USE MODI_CH_AER_MOD_INIT
+USE MODI_CH_INIT_BUDGET_n
+USE MODI_CH_INIT_FIELD_n
+USE MODI_CH_INIT_JVALUES
+USE MODI_CH_INIT_PRODLOSSTOT_n
+USE MODI_GET_SIZEX_LB
+USE MODI_GET_SIZEY_LB
+USE MODI_INI_AEROSET1
+USE MODI_INI_AEROSET2
+USE MODI_INI_AEROSET3
+USE MODI_INI_AEROSET4
+USE MODI_INI_AEROSET5
+USE MODI_INI_AEROSET6
+USE MODI_INI_BIKHARDT_n
+USE MODI_INI_CPL
+USE MODI_INI_DEEP_CONVECTION
+USE MODI_INI_DRAG
+USE MODI_INI_DYNAMICS
+USE MODI_INI_ELEC_n
+USE MODI_INI_EOL_ADNR
+USE MODI_INI_EOL_ALM
+USE MODI_INI_LES_N
+USE MODI_INI_LG
+USE MODI_INI_LW_SETUP
+USE MODI_INI_MICRO_n
+USE MODE_INI_TURB, ONLY: INI_TURB
+USE MODE_INI_MFSHALL, ONLY: INI_MFSHALL
+USE MODI_INI_POSPROFILER_n
+USE MODI_INI_RADIATIONS
+USE MODI_INI_RADIATIONS_ECMWF
+USE MODI_INI_RADIATIONS_ECRAD
+USE MODI_INI_SERIES_N
+USE MODI_INI_SPAWN_LS_n
+USE MODI_INI_SURF_RAD
+USE MODI_INI_SURFSTATION_n
+USE MODI_INI_SW_SETUP
+USE MODE_INIT_AEROSOL_PROPERTIES, ONLY: INIT_AEROSOL_PROPERTIES
+#ifdef MNH_FOREFIRE
+USE MODI_INIT_FOREFIRE_n
+#endif
+USE MODI_INIT_GROUND_PARAM_n
+USE MODI_INI_TKE_EPS
+USE MODI_METRICS
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_MNHREAD_ZS_DUMMY_n
+USE MODI_READ_FIELD
+USE MODI_SET_DIRCOS
+USE MODI_SET_REF
+#ifdef CPLOASIS
+USE MODI_SFX_OASIS_READ_NAM
+#endif
+USE MODI_SUNPOS_n
+USE MODI_SURF_SOLAR_GEOM
+USE MODI_UPDATE_METRICS
+USE MODI_UPDATE_NSV
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE YOERDI , ONLY :RCCO2
+#endif
+#endif
+!
+USE MODD_FIRE_n
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+INTEGER, INTENT(IN) :: KMI ! Model Index
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+!
+!* 0.2 declarations of local variables
+!
+REAL, PARAMETER :: NALBUV_DEFAULT = 0.01 ! Arbitrary low value for XALBUV
+!
+INTEGER :: JSV ! Loop index
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! Logical unit number of output-listing
+CHARACTER(LEN=28) :: YNAME
+INTEGER :: IIU ! Upper dimension in x direction (local)
+INTEGER :: IJU ! Upper dimension in y direction (local)
+INTEGER :: IIU_ll ! Upper dimension in x direction (global)
+INTEGER :: IJU_ll ! Upper dimension in y direction (global)
+INTEGER :: IKU ! Upper dimension in z direction
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ ! Jacobian
+LOGICAL :: GINIDCONV ! logical switch for the deep convection
+ ! initialization
+LOGICAL :: GINIRAD ! logical switch for the radiation
+ ! initialization
+logical :: gles ! Logical to determine if LES diagnostics are enabled
+!
+!
+TYPE(LIST_ll), POINTER :: TZINITHALO2D_ll ! pointer for the list of 2D fields
+ ! which must be communicated in INIT
+TYPE(LIST_ll), POINTER :: TZINITHALO3D_ll ! pointer for the list of 3D fields
+ ! which must be communicated in INIT
+!
+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 :: IINFO_ll ! Return code of //routines
+INTEGER :: IIY,IJY
+INTEGER :: IIU_B,IJU_B
+INTEGER :: IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCO2 ! CO2 concentration near the surface
+!
+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 :: ZIBM_LS ! LevelSet IBM
+!
+!
+INTEGER, DIMENSION(:,:),ALLOCATABLE :: IINDEX ! indices of non-zero terms
+INTEGER, DIMENSION(:),ALLOCATABLE :: IIND
+INTEGER :: JM, JT
+!
+!------------------------------------------
+! Dummy pointers needed to correct an ifort Bug
+REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
+REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
+!
+INTEGER :: IIB,IJB,IIE,IJE,IDIMX,IDIMY,IMI
+! Fire model
+INTEGER :: INBPARAMSENSIBLE, INBPARAMLATENT
+!-------------------------------------------------------------------------------
+!
+!* 0. PROLOGUE
+! --------
+! Compute relaxation coefficients without changing INI_DYNAMICS nor RELAXDEF
+!
+IF (CCLOUD == 'LIMA') THEN
+ LHORELAX_SVC1R3=LHORELAX_SVLIMA
+END IF
+!
+! UPDATE CONSTANTS FOR OCEAN MODEL
+IF (LOCEAN) THEN
+ XP00=XP00OCEAN
+ XTH00=XTH00OCEAN
+END IF
+!
+!
+NULLIFY(TZINITHALO2D_ll)
+NULLIFY(TZINITHALO3D_ll)
+!
+!* 1. RETRIEVE LOGICAL UNIT NUMBER
+! ----------------------------
+!
+ILUOUT = TLUOUT%NLU
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. END OF READING
+! --------------
+!* 2.1 Read number of forcing fields
+!
+IF (LFORCING) THEN ! Retrieve the number of time-dependent forcings.
+ CALL IO_Field_read(TPINIFILE,'FRC',NFRC,IRESP)
+ IF ( (IRESP /= 0) .OR. (NFRC <=0) ) THEN
+ WRITE(ILUOUT,'(A/A)') &
+ "INI_MODEL_n ERROR: you want to read forcing variables from FMfile", &
+ " but no fields have been found by IO_Field_read"
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
+ END IF
+END IF
+!
+! Modif PP for time evolving adv forcing
+ IF ( L2D_ADV_FRC ) THEN ! Retrieve the number of time-dependent forcings.
+ WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER ADV_FORCING"
+ CALL IO_Field_read(TPINIFILE,'NADVFRC1',NADVFRC,IRESP)
+ IF ( (IRESP /= 0) .OR. (NADVFRC <=0) ) THEN
+ WRITE(ILUOUT,'(A/A)') &
+ "INI_MODELn ERROR: you want to read forcing ADV variables from FMfile", &
+ " but no fields have been found by IO_Field_read"
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
+ END IF
+ WRITE(ILUOUT,*) 'NADVFRC = ', NADVFRC
+END IF
+!
+IF ( L2D_REL_FRC ) THEN ! Retrieve the number of time-dependent forcings.
+ WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER REL_FORCING"
+ CALL IO_Field_read(TPINIFILE,'NRELFRC1',NRELFRC,IRESP)
+ IF ( (IRESP /= 0) .OR. (NRELFRC <=0) ) THEN
+ WRITE(ILUOUT,'(A/A)') &
+ "INI_MODELn ERROR: you want to read forcing REL variables from FMfile", &
+ " but no fields have been found by IO_Field_read"
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
+ END IF
+ WRITE(ILUOUT,*) 'NRELFRC = ', NRELFRC
+END IF
+!* 2.2 Checks the position of vertical absorbing layer
+!
+IKU=NKMAX+2*JPVEXT
+!
+ALLOCATE(XZHAT(IKU))
+CALL IO_Field_read(TPINIFILE,'ZHAT',XZHAT)
+CALL IO_Field_read(TPINIFILE,'ZTOP',XZTOP)
+IF (XALZBOT>=XZHAT(IKU) .AND. LVE_RELAX) THEN
+ WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR: you want to use vertical relaxation"
+ WRITE(ILUOUT,FMT=*) " but bottom of layer XALZBOT(",XALZBOT,")"
+ WRITE(ILUOUT,FMT=*) " is upper than model top (",XZHAT(IKU),")"
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
+END IF
+IF (LVE_RELAX) THEN
+ IF (XALZBOT>=XZHAT(IKU-4) ) THEN
+ WRITE(ILUOUT,FMT=*) "INI_MODEL_n WARNING: you want to use vertical relaxation"
+ WRITE(ILUOUT,FMT=*) " but the layer defined by XALZBOT(",XALZBOT,")"
+ WRITE(ILUOUT,FMT=*) " contains less than 5 model levels"
+ END IF
+END IF
+DEALLOCATE(XZHAT)
+!
+!* 2.3 Compute sizes of arrays of the extended sub-domain
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IIU_ll=NIMAX_ll + 2 * JPHEXT
+IJU_ll=NJMAX_ll + 2 * JPHEXT
+! initialize NIMAX and NJMAX for not updated versions regarding the parallelism
+! spawning,...
+CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
+!
+CALL GET_INDICE_ll( IIB,IJB,IIE,IJE)
+IDIMX = IIE - IIB + 1
+IDIMY = IJE - IJB + 1
+!
+NRR=0
+NRRL=0
+NRRI=0
+IF (CGETRVT /= 'SKIP' ) THEN
+ NRR = NRR+1
+ IDX_RVT = NRR
+END IF
+IF (CGETRCT /= 'SKIP' ) THEN
+ NRR = NRR+1
+ NRRL = NRRL+1
+ IDX_RCT = NRR
+END IF
+IF (CGETRRT /= 'SKIP' ) THEN
+ NRR = NRR+1
+ NRRL = NRRL+1
+ IDX_RRT = NRR
+END IF
+IF (CGETRIT /= 'SKIP' ) THEN
+ NRR = NRR+1
+ NRRI = NRRI+1
+ IDX_RIT = NRR
+END IF
+IF (CGETRST /= 'SKIP' ) THEN
+ NRR = NRR+1
+ NRRI = NRRI+1
+ IDX_RST = NRR
+END IF
+IF (CGETRGT /= 'SKIP' ) THEN
+ NRR = NRR+1
+ NRRI = NRRI+1
+ IDX_RGT = NRR
+END IF
+IF (CGETRHT /= 'SKIP' ) THEN
+ NRR = NRR+1
+ NRRI = NRRI+1
+ IDX_RHT = NRR
+END IF
+IF (NVERB >= 5) THEN
+ WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," WATER VARIABLES")') NRR
+ WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," LIQUID VARIABLES")') NRRL
+ WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," SOLID VARIABLES")') NRRI
+END IF
+!
+!* 2.4 Update NSV and floating indices for the current model
+!
+!
+CALL UPDATE_NSV(KMI)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. ALLOCATE MEMORY
+! -----------------
+! * Module RECYCL
+!
+IF (LRECYCL) THEN
+!
+ NR_COUNT = 0
+!
+ ALLOCATE(XUMEANW(IJU,IKU,NNUMBELT)) ; XUMEANW = 0.0
+ ALLOCATE(XVMEANW(IJU,IKU,NNUMBELT)) ; XVMEANW = 0.0
+ ALLOCATE(XWMEANW(IJU,IKU,NNUMBELT)) ; XWMEANW = 0.0
+ ALLOCATE(XUMEANN(IIU,IKU,NNUMBELT)) ; XUMEANN = 0.0
+ ALLOCATE(XVMEANN(IIU,IKU,NNUMBELT)) ; XVMEANN = 0.0
+ ALLOCATE(XWMEANN(IIU,IKU,NNUMBELT)) ; XWMEANN = 0.0
+ ALLOCATE(XUMEANE(IJU,IKU,NNUMBELT)) ; XUMEANE = 0.0
+ ALLOCATE(XVMEANE(IJU,IKU,NNUMBELT)) ; XVMEANE = 0.0
+ ALLOCATE(XWMEANE(IJU,IKU,NNUMBELT)) ; XWMEANE = 0.0
+ ALLOCATE(XUMEANS(IIU,IKU,NNUMBELT)) ; XUMEANS = 0.0
+ ALLOCATE(XVMEANS(IIU,IKU,NNUMBELT)) ; XVMEANS = 0.0
+ ALLOCATE(XWMEANS(IIU,IKU,NNUMBELT)) ; XWMEANS = 0.0
+ ALLOCATE(XTBV(IIU,IJU,IKU)) ; XTBV = 0.0
+ELSE
+ ALLOCATE(XUMEANW(0,0,0))
+ ALLOCATE(XVMEANW(0,0,0))
+ ALLOCATE(XWMEANW(0,0,0))
+ ALLOCATE(XUMEANN(0,0,0))
+ ALLOCATE(XVMEANN(0,0,0))
+ ALLOCATE(XWMEANN(0,0,0))
+ ALLOCATE(XUMEANE(0,0,0))
+ ALLOCATE(XVMEANE(0,0,0))
+ ALLOCATE(XWMEANE(0,0,0))
+ ALLOCATE(XUMEANS(0,0,0))
+ ALLOCATE(XVMEANS(0,0,0))
+ ALLOCATE(XWMEANS(0,0,0))
+ ALLOCATE(XTBV (0,0,0))
+END IF
+!
+!
+!* 3.1 Module MODD_FIELD_n
+!
+IF (LMEAN_FIELD) THEN
+!
+ MEAN_COUNT = 0
+!
+ ALLOCATE(XUM_MEAN(IIU,IJU,IKU)) ; XUM_MEAN = 0.0
+ ALLOCATE(XVM_MEAN(IIU,IJU,IKU)) ; XVM_MEAN = 0.0
+ ALLOCATE(XWM_MEAN(IIU,IJU,IKU)) ; XWM_MEAN = 0.0
+ ALLOCATE(XTHM_MEAN(IIU,IJU,IKU)) ; XTHM_MEAN = 0.0
+ ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU)) ; XTEMPM_MEAN = 0.0
+ ALLOCATE(XSVT_MEAN(IIU,IJU,IKU)) ; XSVT_MEAN = 0.0
+ IF (CTURB/='NONE') THEN
+ ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
+ XTKEM_MEAN = 0.0
+ ELSE
+ ALLOCATE(XTKEM_MEAN(0,0,0))
+ END IF
+ ALLOCATE(XPABSM_MEAN(IIU,IJU,IKU)) ; XPABSM_MEAN = 0.0
+ ALLOCATE(XQ_MEAN(IIU,IJU,IKU)) ; XQ_MEAN = 0.0
+ ALLOCATE(XRH_W_MEAN(IIU,IJU,IKU)) ; XRH_W_MEAN = 0.0
+ ALLOCATE(XRH_I_MEAN(IIU,IJU,IKU)) ; XRH_I_MEAN = 0.0
+ ALLOCATE(XRH_P_MEAN(IIU,IJU,IKU)) ; XRH_P_MEAN = 0.0
+ ALLOCATE(XRH_W_MAXCOL_MEAN(IIU,IJU)) ; XRH_W_MAXCOL_MEAN = 0.0
+ ALLOCATE(XRH_I_MAXCOL_MEAN(IIU,IJU)) ; XRH_I_MAXCOL_MEAN = 0.0
+ ALLOCATE(XRH_P_MAXCOL_MEAN(IIU,IJU)) ; XRH_P_MAXCOL_MEAN = 0.0
+ ALLOCATE(XWIFF_MEAN(IIU,IJU,IKU)) ; XWIFF_MEAN = 0.0
+ ALLOCATE(XWIDD_MEAN(IIU,IJU,IKU)) ; XWIDD_MEAN = 0.0
+ ALLOCATE(XWIFF_MAX (IIU,IJU,IKU)) ; XWIFF_MAX = 0.0
+ ALLOCATE(XWIDD_MAX (IIU,IJU,IKU)) ; XWIDD_MAX = 0.0
+!
+ ALLOCATE(XU2_M2(IIU,IJU,IKU)) ; XU2_M2 = 0.0
+!
+ ALLOCATE(XU2_M2(IIU,IJU,IKU)) ; XU2_M2 = 0.0
+ ALLOCATE(XV2_M2(IIU,IJU,IKU)) ; XV2_M2 = 0.0
+ ALLOCATE(XW2_M2(IIU,IJU,IKU)) ; XW2_M2 = 0.0
+ ALLOCATE(XTH2_M2(IIU,IJU,IKU)) ; XTH2_M2 = 0.0
+ ALLOCATE(XTEMP2_M2(IIU,IJU,IKU)) ; XTEMP2_M2 = 0.0
+ ALLOCATE(XPABS2_M2(IIU,IJU,IKU)) ; XPABS2_M2 = 0.0
+!
+ IF (LCOV_FIELD) THEN
+ ALLOCATE(XUV_MEAN(IIU,IJU,IKU)) ; XUV_MEAN = 0.0
+ ALLOCATE(XUW_MEAN(IIU,IJU,IKU)) ; XUW_MEAN = 0.0
+ ALLOCATE(XVW_MEAN(IIU,IJU,IKU)) ; XVW_MEAN = 0.0
+ ALLOCATE(XWTH_MEAN(IIU,IJU,IKU)) ; XWTH_MEAN = 0.0
+ END IF
+!
+ ALLOCATE(XUM_MAX(IIU,IJU,IKU)) ; XUM_MAX = -1.E20
+ ALLOCATE(XVM_MAX(IIU,IJU,IKU)) ; XVM_MAX = -1.E20
+ ALLOCATE(XWM_MAX(IIU,IJU,IKU)) ; XWM_MAX = -1.E20
+ ALLOCATE(XTHM_MAX(IIU,IJU,IKU)) ; XTHM_MAX = 0.0
+ ALLOCATE(XTEMPM_MAX(IIU,IJU,IKU)) ; XTEMPM_MAX = 0.0
+ IF (CTURB/='NONE') THEN
+ ALLOCATE(XTKEM_MAX(IIU,IJU,IKU))
+ XTKEM_MAX = 0.0
+ ELSE
+ ALLOCATE(XTKEM_MAX(0,0,0))
+ END IF
+ ALLOCATE(XPABSM_MAX(IIU,IJU,IKU)) ; XPABSM_MAX = 0.0
+ELSE
+!
+ ALLOCATE(XUM_MEAN(0,0,0))
+ ALLOCATE(XVM_MEAN(0,0,0))
+ ALLOCATE(XWM_MEAN(0,0,0))
+ ALLOCATE(XTHM_MEAN(0,0,0))
+ ALLOCATE(XTEMPM_MEAN(0,0,0))
+ ALLOCATE(XSVT_MEAN(0,0,0))
+ ALLOCATE(XTKEM_MEAN(0,0,0))
+ ALLOCATE(XPABSM_MEAN(0,0,0))
+!
+ ALLOCATE(XU2_M2(0,0,0))
+ ALLOCATE(XV2_M2(0,0,0))
+ ALLOCATE(XW2_M2(0,0,0))
+ ALLOCATE(XTH2_M2(0,0,0))
+ ALLOCATE(XTEMP2_M2(0,0,0))
+ ALLOCATE(XPABS2_M2(0,0,0))
+!
+ IF (LCOV_FIELD) THEN
+ ALLOCATE(XUV_MEAN(0,0,0))
+ ALLOCATE(XUW_MEAN(0,0,0))
+ ALLOCATE(XVW_MEAN(0,0,0))
+ ALLOCATE(XWTH_MEAN(0,0,0))
+ END IF
+!
+ ALLOCATE(XUM_MAX(0,0,0))
+ ALLOCATE(XVM_MAX(0,0,0))
+ ALLOCATE(XWM_MAX(0,0,0))
+ ALLOCATE(XTHM_MAX(0,0,0))
+ ALLOCATE(XTEMPM_MAX(0,0,0))
+ ALLOCATE(XTKEM_MAX(0,0,0))
+ ALLOCATE(XPABSM_MAX(0,0,0))
+END IF
+!
+IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
+ ALLOCATE(XUM(IIU,IJU,IKU))
+ ALLOCATE(XVM(IIU,IJU,IKU))
+ ALLOCATE(XWM(IIU,IJU,IKU))
+ ALLOCATE(XDUM(IIU,IJU,IKU))
+ ALLOCATE(XDVM(IIU,IJU,IKU))
+ ALLOCATE(XDWM(IIU,IJU,IKU))
+ IF (CCONF == 'START') THEN
+ XUM = 0.0
+ XVM = 0.0
+ XWM = 0.0
+ XDUM = 0.0
+ XDVM = 0.0
+ XDWM = 0.0
+ END IF
+ELSE
+ ALLOCATE(XUM(0,0,0))
+ ALLOCATE(XVM(0,0,0))
+ ALLOCATE(XWM(0,0,0))
+ ALLOCATE(XDUM(0,0,0))
+ ALLOCATE(XDVM(0,0,0))
+ ALLOCATE(XDWM(0,0,0))
+END IF
+!
+ALLOCATE(XUT(IIU,IJU,IKU)) ; XUT = 0.0
+ALLOCATE(XVT(IIU,IJU,IKU)) ; XVT = 0.0
+ALLOCATE(XWT(IIU,IJU,IKU)) ; XWT = 0.0
+ALLOCATE(XTHT(IIU,IJU,IKU)) ; XTHT = 0.0
+ALLOCATE(XRUS(IIU,IJU,IKU)) ; XRUS = 0.0
+ALLOCATE(XRVS(IIU,IJU,IKU)) ; XRVS = 0.0
+ALLOCATE(XRWS(IIU,IJU,IKU)) ; XRWS = 0.0
+ALLOCATE(XRUS_PRES(IIU,IJU,IKU)); XRUS_PRES = 0.0
+ALLOCATE(XRVS_PRES(IIU,IJU,IKU)); XRVS_PRES = 0.0
+ALLOCATE(XRWS_PRES(IIU,IJU,IKU)); XRWS_PRES = 0.0
+ALLOCATE(XRTHS(IIU,IJU,IKU)) ; XRTHS = 0.0
+ALLOCATE(XRTHS_CLD(IIU,IJU,IKU)); XRTHS_CLD = 0.0
+
+IF ( LIBM ) THEN
+ ALLOCATE(ZIBM_LS(IIU,IJU,IKU)) ; ZIBM_LS = 0.0
+ ALLOCATE(XIBM_XMUT(IIU,IJU,IKU)); XIBM_XMUT = 0.0
+ELSE
+ ALLOCATE(ZIBM_LS (0,0,0))
+ ALLOCATE(XIBM_XMUT(0,0,0))
+END IF
+
+IF ( LRECYCL ) THEN
+ ALLOCATE(XFLUCTUNW(IJU,IKU)) ; XFLUCTUNW = 0.0
+ ALLOCATE(XFLUCTVNN(IIU,IKU)) ; XFLUCTVNN = 0.0
+ ALLOCATE(XFLUCTUTN(IIU,IKU)) ; XFLUCTUTN = 0.0
+ ALLOCATE(XFLUCTVTW(IJU,IKU)) ; XFLUCTVTW = 0.0
+ ALLOCATE(XFLUCTUNE(IJU,IKU)) ; XFLUCTUNE = 0.0
+ ALLOCATE(XFLUCTVNS(IIU,IKU)) ; XFLUCTVNS = 0.0
+ ALLOCATE(XFLUCTUTS(IIU,IKU)) ; XFLUCTUTS = 0.0
+ ALLOCATE(XFLUCTVTE(IJU,IKU)) ; XFLUCTVTE = 0.0
+ ALLOCATE(XFLUCTWTW(IJU,IKU)) ; XFLUCTWTW = 0.0
+ ALLOCATE(XFLUCTWTN(IIU,IKU)) ; XFLUCTWTN = 0.0
+ ALLOCATE(XFLUCTWTE(IJU,IKU)) ; XFLUCTWTE = 0.0
+ ALLOCATE(XFLUCTWTS(IIU,IKU)) ; XFLUCTWTS = 0.0
+ELSE
+ ALLOCATE(XFLUCTUNW(0,0))
+ ALLOCATE(XFLUCTVNN(0,0))
+ ALLOCATE(XFLUCTUTN(0,0))
+ ALLOCATE(XFLUCTVTW(0,0))
+ ALLOCATE(XFLUCTUNE(0,0))
+ ALLOCATE(XFLUCTVNS(0,0))
+ ALLOCATE(XFLUCTUTS(0,0))
+ ALLOCATE(XFLUCTVTE(0,0))
+ ALLOCATE(XFLUCTWTW(0,0))
+ ALLOCATE(XFLUCTWTN(0,0))
+ ALLOCATE(XFLUCTWTE(0,0))
+ ALLOCATE(XFLUCTWTS(0,0))
+END IF
+!
+IF (CTURB /= 'NONE') THEN
+ ALLOCATE(XTKET(IIU,IJU,IKU))
+ ALLOCATE(XRTKES(IIU,IJU,IKU))
+ ALLOCATE(XRTKEMS(IIU,IJU,IKU)); XRTKEMS = 0.0
+ ALLOCATE(XWTHVMF(IIU,IJU,IKU))
+ ALLOCATE(XDYP(IIU,IJU,IKU))
+ ALLOCATE(XTHP(IIU,IJU,IKU))
+ ALLOCATE(XTR(IIU,IJU,IKU))
+ ALLOCATE(XDISS(IIU,IJU,IKU))
+ ALLOCATE(XLEM(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XTKET(0,0,0))
+ ALLOCATE(XRTKES(0,0,0))
+ ALLOCATE(XRTKEMS(0,0,0))
+ ALLOCATE(XWTHVMF(0,0,0))
+ ALLOCATE(XDYP(0,0,0))
+ ALLOCATE(XTHP(0,0,0))
+ ALLOCATE(XTR(0,0,0))
+ ALLOCATE(XDISS(0,0,0))
+ ALLOCATE(XLEM(0,0,0))
+END IF
+IF (CTOM == 'TM06') THEN
+ ALLOCATE(XBL_DEPTH(IIU,IJU))
+ELSE
+ ALLOCATE(XBL_DEPTH(0,0))
+END IF
+IF (LRMC01) THEN
+ ALLOCATE(XSBL_DEPTH(IIU,IJU))
+ELSE
+ ALLOCATE(XSBL_DEPTH(0,0))
+END IF
+!
+ALLOCATE(XPABSM(IIU,IJU,IKU)) ; XPABSM = 0.0
+ALLOCATE(XPABST(IIU,IJU,IKU)) ; XPABST = 0.0
+!
+ALLOCATE(XRT(IIU,IJU,IKU,NRR)) ; XRT = 0.0
+ALLOCATE(XRRS(IIU,IJU,IKU,NRR)) ; XRRS = 0.0
+ALLOCATE(XRRS_CLD(IIU,IJU,IKU,NRR)); XRRS_CLD = 0.0
+!
+IF (CTURB /= 'NONE' .AND. NRR>1) THEN
+ ALLOCATE(XSRCT(IIU,IJU,IKU))
+ ALLOCATE(XSIGS(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XSRCT(0,0,0))
+ ALLOCATE(XSIGS(0,0,0))
+END IF
+IF (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') THEN
+ ALLOCATE(XHLC_HRC(IIU,IJU,IKU))
+ ALLOCATE(XHLC_HCF(IIU,IJU,IKU))
+ ALLOCATE(XHLI_HRI(IIU,IJU,IKU))
+ ALLOCATE(XHLI_HCF(IIU,IJU,IKU))
+ XHLC_HRC(:,:,:)=0.
+ XHLC_HCF(:,:,:)=0.
+ XHLI_HRI(:,:,:)=0.
+ XHLI_HCF(:,:,:)=0.
+ELSE
+ ALLOCATE(XHLC_HRC(0,0,0))
+ ALLOCATE(XHLC_HCF(0,0,0))
+ ALLOCATE(XHLI_HRI(0,0,0))
+ ALLOCATE(XHLI_HCF(0,0,0))
+END IF
+!
+IF (NRR>1) THEN
+ ALLOCATE(XCLDFR(IIU,IJU,IKU)); XCLDFR (:, :, :) = 0.
+ ALLOCATE(XICEFR(IIU,IJU,IKU)); XICEFR (:, :, :) = 0.
+ ALLOCATE(XRAINFR(IIU,IJU,IKU)); XRAINFR(:, :, :) = 0.
+ELSE
+ ALLOCATE(XCLDFR(0,0,0))
+ ALLOCATE(XICEFR(0,0,0))
+ ALLOCATE(XRAINFR(0,0,0))
+END IF
+!
+ALLOCATE(XSVT(IIU,IJU,IKU,NSV)) ; XSVT = 0.
+ALLOCATE(XRSVS(IIU,IJU,IKU,NSV)); XRSVS = 0.
+ALLOCATE(XRSVS_CLD(IIU,IJU,IKU,NSV)); XRSVS_CLD = 0.0
+ALLOCATE(XZWS(IIU,IJU)) ; XZWS(:,:) = XZWS_DEFAULT
+!
+IF (LPASPOL) THEN
+ ALLOCATE( XATC(IIU,IJU,IKU,NSV_PP) )
+ XATC = 0.
+ELSE
+ ALLOCATE( XATC(0,0,0,0))
+END IF
+!
+IF(LBLOWSNOW) THEN
+ ALLOCATE(XSNWCANO(IIU,IJU,NBLOWSNOW_2D))
+ ALLOCATE(XRSNWCANOS(IIU,IJU,NBLOWSNOW_2D))
+ XSNWCANO(:,:,:) = 0.0
+ XRSNWCANOS(:,:,:) = 0.0
+ELSE
+ ALLOCATE(XSNWCANO(0,0,0))
+ ALLOCATE(XRSNWCANOS(0,0,0))
+END IF
+!
+!* 3.2 Module MODD_GRID_n and MODD_METRICS_n
+!
+IF (LCARTESIAN) THEN
+ ALLOCATE(XLON(0,0))
+ ALLOCATE(XLAT(0,0))
+ ALLOCATE(XMAP(0,0))
+ELSE
+ ALLOCATE(XLON(IIU,IJU))
+ ALLOCATE(XLAT(IIU,IJU))
+ ALLOCATE(XMAP(IIU,IJU))
+END IF
+ALLOCATE(XXHAT(IIU))
+ALLOCATE(XDXHAT(IIU))
+ALLOCATE(XYHAT(IJU))
+ALLOCATE(XDYHAT(IJU))
+ALLOCATE(XXHATM(IIU))
+ALLOCATE(XYHATM(IJU))
+ALLOCATE(XZS(IIU,IJU))
+ALLOCATE(XZSMT(IIU,IJU))
+ALLOCATE(XZZ(IIU,IJU,IKU))
+ALLOCATE(XZHAT(IKU))
+ALLOCATE(XZHATM(IKU))
+ALLOCATE(XDIRCOSZW(IIU,IJU))
+ALLOCATE(XDIRCOSXW(IIU,IJU))
+ALLOCATE(XDIRCOSYW(IIU,IJU))
+ALLOCATE(XCOSSLOPE(IIU,IJU))
+ALLOCATE(XSINSLOPE(IIU,IJU))
+!
+ALLOCATE(XDXX(IIU,IJU,IKU))
+ALLOCATE(XDYY(IIU,IJU,IKU))
+ALLOCATE(XDZX(IIU,IJU,IKU))
+ALLOCATE(XDZY(IIU,IJU,IKU))
+ALLOCATE(XDZZ(IIU,IJU,IKU))
+!
+!* 3.3 Modules MODD_REF and MODD_REF_n
+!
+! Different reference states for Ocean and Atmosphere models
+! For the moment, same reference states for O and A
+!IF ((KMI == 1).OR.LCOUPLES) THEN
+IF (KMI==1) THEN
+ ALLOCATE(XRHODREFZ(IKU),XTHVREFZ(IKU))
+ELSE IF (LCOUPLES) THEN
+! in coupled O-A case, need different variables for ocean
+ ALLOCATE(XRHODREFZO(IKU),XTHVREFZO(IKU))
+ELSE
+ !Do not allocate XRHODREFZ and XTHVREFZ because they are the same on all grids (not 'n' variables)
+END IF
+!
+ALLOCATE(XPHIT(IIU,IJU,IKU))
+ALLOCATE(XRHODREF(IIU,IJU,IKU))
+ALLOCATE(XTHVREF(IIU,IJU,IKU))
+ALLOCATE(XEXNREF(IIU,IJU,IKU))
+ALLOCATE(XRHODJ(IIU,IJU,IKU))
+IF (CEQNSYS=='DUR' .AND. LUSERV) THEN
+ ALLOCATE(XRVREF(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XRVREF(0,0,0))
+END IF
+!
+!* 3.4 Module MODD_CURVCOR_n
+!
+IF (LTHINSHELL) THEN
+ ALLOCATE(XCORIOX(0,0))
+ ALLOCATE(XCORIOY(0,0))
+ELSE
+ ALLOCATE(XCORIOX(IIU,IJU))
+ ALLOCATE(XCORIOY(IIU,IJU))
+END IF
+ ALLOCATE(XCORIOZ(IIU,IJU))
+IF (LCARTESIAN) THEN
+ ALLOCATE(XCURVX(0,0))
+ ALLOCATE(XCURVY(0,0))
+ELSE
+ ALLOCATE(XCURVX(IIU,IJU))
+ ALLOCATE(XCURVY(IIU,IJU))
+END IF
+!
+!* 3.5 Module MODD_DYN_n
+!
+CALL GET_DIM_EXT_ll('Y',IIY,IJY)
+IF (L2D) THEN
+ ALLOCATE(XBFY(IIY,IJY,IKU))
+ELSE
+ ALLOCATE(XBFY(IJY,IIY,IKU)) ! transposition needed by the optimisation of the
+ ! FFT solver
+END IF
+CALL GET_DIM_EXT_ll('B',IIU_B,IJU_B)
+ALLOCATE(XBFB(IIU_B,IJU_B,IKU))
+CALL GET_DIM_EXTZ_ll('SXP2_YP1_Z',IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll)
+ALLOCATE(XBF_SXP2_YP1_Z(IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll))
+ALLOCATE(XAF(IKU),XCF(IKU))
+ALLOCATE(XTRIGSX(3*IIU_ll))
+ALLOCATE(XTRIGSY(3*IJU_ll))
+ALLOCATE(XRHOM(IKU))
+ALLOCATE(XALK(IKU))
+ALLOCATE(XALKW(IKU))
+ALLOCATE(XALKBAS(IKU))
+ALLOCATE(XALKWBAS(IKU))
+!
+IF ( LHORELAX_UVWTH .OR. LHORELAX_RV .OR. &
+ LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI .OR. LHORELAX_RS .OR. &
+ LHORELAX_RG .OR. LHORELAX_RH .OR. LHORELAX_TKE .OR. &
+ ANY(LHORELAX_SV) ) THEN
+ ALLOCATE(XKURELAX(IIU,IJU))
+ ALLOCATE(XKVRELAX(IIU,IJU))
+ ALLOCATE(XKWRELAX(IIU,IJU))
+ ALLOCATE(LMASK_RELAX(IIU,IJU))
+ELSE
+ ALLOCATE(XKURELAX(0,0))
+ ALLOCATE(XKVRELAX(0,0))
+ ALLOCATE(XKWRELAX(0,0))
+ ALLOCATE(LMASK_RELAX(0,0))
+END IF
+!
+! Additional fields for truly horizontal diffusion (Module MODD_DYNZD$n)
+IF (LZDIFFU) THEN
+ CALL INIT_TYPE_ZDIFFU_HALO2(XZDIFFU_HALO2)
+ELSE
+ CALL INIT_TYPE_ZDIFFU_HALO2(XZDIFFU_HALO2,0)
+ENDIF
+!
+!* 3.6 Larger Scale variables (Module MODD_LSFIELD$n)
+!
+!
+! upper relaxation part
+!
+ALLOCATE(XLSUM(IIU,IJU,IKU)) ; XLSUM = 0.0
+ALLOCATE(XLSVM(IIU,IJU,IKU)) ; XLSVM = 0.0
+ALLOCATE(XLSWM(IIU,IJU,IKU)) ; XLSWM = 0.0
+ALLOCATE(XLSTHM(IIU,IJU,IKU)) ; XLSTHM = 0.0
+IF ( NRR > 0 ) THEN
+ ALLOCATE(XLSRVM(IIU,IJU,IKU)) ; XLSRVM = 0.0
+ELSE
+ ALLOCATE(XLSRVM(0,0,0))
+END IF
+ALLOCATE(XLSZWSM(IIU,IJU)) ; XLSZWSM = -1.
+!
+! lbc part
+!
+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
+!
+ 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))
+!
+ CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
+ IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
+ IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
+!
+ IF ( LHORELAX_UVWTH ) THEN
+ NSIZELBX_ll=2*NRIMX+2*JPHEXT
+ NSIZELBXU_ll=2*NRIMX+2*JPHEXT
+ ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,IKU))
+ ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,IKU))
+ ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,IKU))
+ ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,IKU))
+ ELSE
+ NSIZELBX_ll=2*JPHEXT ! 2
+ NSIZELBXU_ll=2*(JPHEXT+1) ! 4
+ ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,IKU))
+ ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,IKU))
+ ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,IKU))
+ ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,IKU))
+ END IF
+!
+ IF (CTURB /= 'NONE') THEN
+ IF ( LHORELAX_TKE) THEN
+ NSIZELBXTKE_ll=2* NRIMX+2*JPHEXT
+ ALLOCATE(XLBXTKEM(IISIZEXF,IJSIZEXF,IKU))
+ ELSE
+ NSIZELBXTKE_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXTKEM(IISIZEX2,IJSIZEX2,IKU))
+ END IF
+ ELSE
+ NSIZELBXTKE_ll=0
+ ALLOCATE(XLBXTKEM(0,0,0))
+ 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
+ ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,IKU,NRR))
+ ELSE
+ NSIZELBXR_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,IKU,NRR))
+ ENDIF
+ ELSE
+ NSIZELBXR_ll=0
+ ALLOCATE(XLBXRM(0,0,0,0))
+ END IF
+ !
+ IF ( NSV > 0 ) THEN
+ IF ( ANY( LHORELAX_SV(:)) ) THEN
+ NSIZELBXSV_ll=2* NRIMX+2*JPHEXT
+ ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,IKU,NSV))
+ ELSE
+ NSIZELBXSV_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,IKU,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)
+!
+! check if local domain not to small for NRIMX NRIMY
+!
+ IF ( CLBCX(1) /= 'CYCL' ) THEN
+ IF ( NRIMX .GT. IDIMX ) THEN
+ WRITE(*,'(A,I8,A/A,2I8,/A)') "Processor=", IP-1, &
+ " :: INI_MODEL_n ERROR: ( NRIMX > IDIMX ) ", &
+ " Local domain to small for relaxation NRIMX,IDIMX ", &
+ NRIMX,IDIMX ,&
+ " change relaxation parameters or number of processors "
+ call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','')
+ END IF
+ END IF
+ IF ( CLBCY(1) /= 'CYCL' ) THEN
+ IF ( NRIMY .GT. IDIMY ) THEN
+ WRITE(*,'(A,I8,A/A,2I8,/A)') "Processor=", IP-1, &
+ " :: INI_MODEL_n ERROR: ( NRIMY > IDIMY ) ", &
+ " Local domain to small for relaxation NRIMY,IDIMY ", &
+ NRIMY,IDIMY ,&
+ " change relaxation parameters or number of processors "
+ call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','')
+ END IF
+ END IF
+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,IKU))
+ ALLOCATE(XLBYUM(IISIZEYF,IJSIZEYF,IKU))
+ ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,IKU))
+ ALLOCATE(XLBYVM(IISIZEYFV,IJSIZEYFV,IKU))
+ ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,IKU))
+ ALLOCATE(XLBYWM(IISIZEYF,IJSIZEYF,IKU))
+ ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,IKU))
+ ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,IKU))
+ 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,IKU))
+ ALLOCATE(XLBYUM(IISIZEY2,IJSIZEY2,IKU))
+ ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,IKU))
+ ALLOCATE(XLBYVM(IISIZEY4,IJSIZEY4,IKU))
+ ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,IKU))
+ ALLOCATE(XLBYWM(IISIZEY2,IJSIZEY2,IKU))
+ ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,IKU))
+ ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,IKU))
+ END IF
+ !
+ IF (CTURB /= 'NONE') THEN
+ IF ( LHORELAX_TKE) THEN
+ NSIZELBXTKE_ll=2*NRIMX+2*JPHEXT
+ NSIZELBYTKE_ll=2*NRIMY+2*JPHEXT
+ ALLOCATE(XLBXTKEM(IISIZEXF,IJSIZEXF,IKU))
+ ALLOCATE(XLBYTKEM(IISIZEYF,IJSIZEYF,IKU))
+ ELSE
+ NSIZELBXTKE_ll=2*JPHEXT ! 2
+ NSIZELBYTKE_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXTKEM(IISIZEX2,IJSIZEX2,IKU))
+ ALLOCATE(XLBYTKEM(IISIZEY2,IJSIZEY2,IKU))
+ END IF
+ ELSE
+ NSIZELBXTKE_ll=0
+ NSIZELBYTKE_ll=0
+ ALLOCATE(XLBXTKEM(0,0,0))
+ ALLOCATE(XLBYTKEM(0,0,0))
+ 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,IKU,NRR))
+ ALLOCATE(XLBYRM(IISIZEYF,IJSIZEYF,IKU,NRR))
+ ELSE
+ NSIZELBXR_ll=2*JPHEXT ! 2
+ NSIZELBYR_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,IKU,NRR))
+ ALLOCATE(XLBYRM(IISIZEY2,IJSIZEY2,IKU,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,IKU,NSV))
+ ALLOCATE(XLBYSVM(IISIZEYF,IJSIZEYF,IKU,NSV))
+ ELSE
+ NSIZELBXSV_ll=2*JPHEXT ! 2
+ NSIZELBYSV_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,IKU,NSV))
+ ALLOCATE(XLBYSVM(IISIZEY2,IJSIZEY2,IKU,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 ! END OF THE IF STRUCTURE ON THE MODEL DIMENSION
+!
+!
+IF ( KMI > 1 ) THEN
+ ! it has been assumed that the THeta field used the largest rim area compared
+ ! to the others prognostic variables, if it is not the case, you must change
+ ! these lines
+ ALLOCATE(XCOEFLIN_LBXM(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3)))
+ ALLOCATE( NKLIN_LBXM(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3)))
+ ALLOCATE(XCOEFLIN_LBYM(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3)))
+ ALLOCATE( NKLIN_LBYM(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3)))
+ ALLOCATE(XCOEFLIN_LBXU(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3)))
+ ALLOCATE( NKLIN_LBXU(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3)))
+ ALLOCATE(XCOEFLIN_LBYU(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3)))
+ ALLOCATE( NKLIN_LBYU(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3)))
+ ALLOCATE(XCOEFLIN_LBXV(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3)))
+ ALLOCATE( NKLIN_LBXV(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3)))
+ ALLOCATE(XCOEFLIN_LBYV(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3)))
+ ALLOCATE( NKLIN_LBYV(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3)))
+ ALLOCATE(XCOEFLIN_LBXW(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3)))
+ ALLOCATE( NKLIN_LBXW(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3)))
+ ALLOCATE(XCOEFLIN_LBYW(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3)))
+ ALLOCATE( NKLIN_LBYW(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3)))
+ELSE
+ ALLOCATE(XCOEFLIN_LBXM(0,0,0))
+ ALLOCATE( NKLIN_LBXM(0,0,0))
+ ALLOCATE(XCOEFLIN_LBYM(0,0,0))
+ ALLOCATE( NKLIN_LBYM(0,0,0))
+ ALLOCATE(XCOEFLIN_LBXU(0,0,0))
+ ALLOCATE( NKLIN_LBXU(0,0,0))
+ ALLOCATE(XCOEFLIN_LBYU(0,0,0))
+ ALLOCATE( NKLIN_LBYU(0,0,0))
+ ALLOCATE(XCOEFLIN_LBXV(0,0,0))
+ ALLOCATE( NKLIN_LBXV(0,0,0))
+ ALLOCATE(XCOEFLIN_LBYV(0,0,0))
+ ALLOCATE( NKLIN_LBYV(0,0,0))
+ ALLOCATE(XCOEFLIN_LBXW(0,0,0))
+ ALLOCATE( NKLIN_LBXW(0,0,0))
+ ALLOCATE(XCOEFLIN_LBYW(0,0,0))
+ ALLOCATE( NKLIN_LBYW(0,0,0))
+END IF
+!
+! allocation of the LS fields for vertical relaxation and numerical diffusion
+IF( .NOT. LSTEADYLS ) THEN
+!
+ ALLOCATE(XLSUS(SIZE(XLSUM,1),SIZE(XLSUM,2),SIZE(XLSUM,3)))
+ ALLOCATE(XLSVS(SIZE(XLSVM,1),SIZE(XLSVM,2),SIZE(XLSVM,3)))
+ ALLOCATE(XLSWS(SIZE(XLSWM,1),SIZE(XLSWM,2),SIZE(XLSWM,3)))
+ ALLOCATE(XLSTHS(SIZE(XLSTHM,1),SIZE(XLSTHM,2),SIZE(XLSTHM,3)))
+ ALLOCATE(XLSRVS(SIZE(XLSRVM,1),SIZE(XLSRVM,2),SIZE(XLSRVM,3)))
+ ALLOCATE(XLSZWSS(SIZE(XLSZWSM,1),SIZE(XLSZWSM,2)))
+!
+ELSE
+!
+ ALLOCATE(XLSUS(0,0,0))
+ ALLOCATE(XLSVS(0,0,0))
+ ALLOCATE(XLSWS(0,0,0))
+ ALLOCATE(XLSTHS(0,0,0))
+ ALLOCATE(XLSRVS(0,0,0))
+ ALLOCATE(XLSZWSS(0,0))
+!
+END IF
+! allocation of the LB fields for horizontal relaxation and Lateral Boundaries
+IF( .NOT. ( LSTEADYLS .AND. KMI==1 ) ) THEN
+!
+ ALLOCATE(XLBXTKES(SIZE(XLBXTKEM,1),SIZE(XLBXTKEM,2),SIZE(XLBXTKEM,3)))
+ ALLOCATE(XLBYTKES(SIZE(XLBYTKEM,1),SIZE(XLBYTKEM,2),SIZE(XLBYTKEM,3)))
+ ALLOCATE(XLBXUS(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3)))
+ ALLOCATE(XLBYUS(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3)))
+ ALLOCATE(XLBXVS(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3)))
+ ALLOCATE(XLBYVS(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3)))
+ ALLOCATE(XLBXWS(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3)))
+ ALLOCATE(XLBYWS(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3)))
+ ALLOCATE(XLBXTHS(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3)))
+ ALLOCATE(XLBYTHS(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3)))
+ ALLOCATE(XLBXRS(SIZE(XLBXRM,1),SIZE(XLBXRM,2),SIZE(XLBXRM,3),SIZE(XLBXRM,4)))
+ ALLOCATE(XLBYRS(SIZE(XLBYRM,1),SIZE(XLBYRM,2),SIZE(XLBYRM,3),SIZE(XLBYRM,4)))
+ ALLOCATE(XLBXSVS(SIZE(XLBXSVM,1),SIZE(XLBXSVM,2),SIZE(XLBXSVM,3),SIZE(XLBXSVM,4)))
+ ALLOCATE(XLBYSVS(SIZE(XLBYSVM,1),SIZE(XLBYSVM,2),SIZE(XLBYSVM,3),SIZE(XLBYSVM,4)))
+!
+ELSE
+!
+ ALLOCATE(XLBXTKES(0,0,0))
+ ALLOCATE(XLBYTKES(0,0,0))
+ ALLOCATE(XLBXUS(0,0,0))
+ ALLOCATE(XLBYUS(0,0,0))
+ ALLOCATE(XLBXVS(0,0,0))
+ ALLOCATE(XLBYVS(0,0,0))
+ ALLOCATE(XLBXWS(0,0,0))
+ ALLOCATE(XLBYWS(0,0,0))
+ ALLOCATE(XLBXTHS(0,0,0))
+ ALLOCATE(XLBYTHS(0,0,0))
+ ALLOCATE(XLBXRS(0,0,0,0))
+ ALLOCATE(XLBYRS(0,0,0,0))
+ ALLOCATE(XLBXSVS(0,0,0,0))
+ ALLOCATE(XLBYSVS(0,0,0,0))
+!
+END IF
+!
+!
+!* 3.7 Module MODD_RADIATIONS_n (except XOZON and XAER)
+!
+! Initialization of SW bands
+NSWB_OLD = 6 ! Number of bands in ECMWF original scheme (from Fouquart et Bonnel (1980))
+ ! then modified through INI_RADIATIONS_ECMWF but remains equal to 6 practically
+
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+NLWB_OLD = 16 ! For XEMIS initialization (should be spectral in the future)
+#endif
+#endif
+
+NLWB_MNH = 16 ! For XEMIS initialization (should be spectral in the future)
+
+IF (CRAD == 'ECRA') THEN
+ NSWB_MNH = 14
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ NLWB_MNH = 16
+#endif
+#endif
+ELSE
+ NSWB_MNH = NSWB_OLD
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ NLWB_MNH = NLWB_OLD
+#endif
+#endif
+END IF
+
+ALLOCATE(XSW_BANDS (NSWB_MNH))
+ALLOCATE(XLW_BANDS (NLWB_MNH))
+ALLOCATE(XZENITH (IIU,IJU))
+ALLOCATE(XAZIM (IIU,IJU))
+ALLOCATE(XALBUV (IIU,IJU))
+XALBUV(:,:) = NALBUV_DEFAULT !Set to an arbitrary low value (XALBUV is needed in CH_INTERP_JVALUES even if no radiation)
+ALLOCATE(XDIRSRFSWD(IIU,IJU,NSWB_MNH))
+ALLOCATE(XSCAFLASWD(IIU,IJU,NSWB_MNH))
+ALLOCATE(XFLALWD (IIU,IJU))
+!
+IF (CRAD /= 'NONE') THEN
+ ALLOCATE(XSLOPANG(IIU,IJU))
+ ALLOCATE(XSLOPAZI(IIU,IJU))
+ ALLOCATE(XDTHRAD(IIU,IJU,IKU))
+ ALLOCATE(XDIRFLASWD(IIU,IJU,NSWB_MNH))
+ ALLOCATE(XDIR_ALB(IIU,IJU,NSWB_MNH))
+ ALLOCATE(XSCA_ALB(IIU,IJU,NSWB_MNH))
+ ALLOCATE(XEMIS (IIU,IJU,NLWB_MNH))
+ ALLOCATE(XTSRAD (IIU,IJU)) ; XTSRAD = XUNDEF_SFX
+ ALLOCATE(XSEA (IIU,IJU))
+ ALLOCATE(XZS_XY (IIU,IJU))
+ ALLOCATE(NCLEARCOL_TM1(IIU,IJU))
+ ALLOCATE(XSWU(IIU,IJU,IKU))
+ ALLOCATE(XSWD(IIU,IJU,IKU))
+ ALLOCATE(XLWU(IIU,IJU,IKU))
+ ALLOCATE(XLWD(IIU,IJU,IKU))
+ ALLOCATE(XDTHRADSW(IIU,IJU,IKU))
+ ALLOCATE(XDTHRADLW(IIU,IJU,IKU))
+ ALLOCATE(XRADEFF(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XSLOPANG(0,0))
+ ALLOCATE(XSLOPAZI(0,0))
+ ALLOCATE(XDTHRAD(0,0,0))
+ ALLOCATE(XDIRFLASWD(0,0,0))
+ ALLOCATE(XDIR_ALB(0,0,0))
+ ALLOCATE(XSCA_ALB(0,0,0))
+ ALLOCATE(XEMIS (0,0,0))
+ ALLOCATE(XTSRAD (0,0))
+ ALLOCATE(XSEA (0,0))
+ ALLOCATE(XZS_XY (0,0))
+ ALLOCATE(NCLEARCOL_TM1(0,0))
+ ALLOCATE(XSWU(0,0,0))
+ ALLOCATE(XSWD(0,0,0))
+ ALLOCATE(XLWU(0,0,0))
+ ALLOCATE(XLWD(0,0,0))
+ ALLOCATE(XDTHRADSW(0,0,0))
+ ALLOCATE(XDTHRADLW(0,0,0))
+ ALLOCATE(XRADEFF(0,0,0))
+END IF
+
+IF (CRAD == 'ECMW' .OR. CRAD == 'ECRA') THEN
+ ALLOCATE(XSTROATM(31,6))
+ ALLOCATE(XSMLSATM(31,6))
+ ALLOCATE(XSMLWATM(31,6))
+ ALLOCATE(XSPOSATM(31,6))
+ ALLOCATE(XSPOWATM(31,6))
+ ALLOCATE(XSTATM(31,6))
+ELSE
+ ALLOCATE(XSTROATM(0,0))
+ ALLOCATE(XSMLSATM(0,0))
+ ALLOCATE(XSMLWATM(0,0))
+ ALLOCATE(XSPOSATM(0,0))
+ ALLOCATE(XSPOWATM(0,0))
+ ALLOCATE(XSTATM(0,0))
+END IF
+!
+!* 3.8 Module MODD_DEEP_CONVECTION_n
+!
+IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
+ ALLOCATE(NCOUNTCONV(IIU,IJU))
+ ALLOCATE(XDTHCONV(IIU,IJU,IKU))
+ ALLOCATE(XDRVCONV(IIU,IJU,IKU))
+ ALLOCATE(XDRCCONV(IIU,IJU,IKU))
+ ALLOCATE(XDRICONV(IIU,IJU,IKU))
+ ALLOCATE(XPRCONV(IIU,IJU))
+ ALLOCATE(XPACCONV(IIU,IJU))
+ ALLOCATE(XPRSCONV(IIU,IJU))
+ ! diagnostics
+ IF (LCH_CONV_LINOX) THEN
+ ALLOCATE(XIC_RATE(IIU,IJU))
+ ALLOCATE(XCG_RATE(IIU,IJU))
+ ALLOCATE(XIC_TOTAL_NUMBER(IIU,IJU))
+ ALLOCATE(XCG_TOTAL_NUMBER(IIU,IJU))
+ ELSE
+ ALLOCATE(XIC_RATE(0,0))
+ ALLOCATE(XCG_RATE(0,0))
+ ALLOCATE(XIC_TOTAL_NUMBER(0,0))
+ ALLOCATE(XCG_TOTAL_NUMBER(0,0))
+ END IF
+ IF ( LDIAGCONV ) THEN
+ ALLOCATE(XUMFCONV(IIU,IJU,IKU))
+ ALLOCATE(XDMFCONV(IIU,IJU,IKU))
+ ALLOCATE(XPRLFLXCONV(IIU,IJU,IKU))
+ ALLOCATE(XPRSFLXCONV(IIU,IJU,IKU))
+ ALLOCATE(XCAPE(IIU,IJU))
+ ALLOCATE(NCLTOPCONV(IIU,IJU))
+ ALLOCATE(NCLBASCONV(IIU,IJU))
+ ELSE
+ ALLOCATE(XUMFCONV(0,0,0))
+ ALLOCATE(XDMFCONV(0,0,0))
+ ALLOCATE(XPRLFLXCONV(0,0,0))
+ ALLOCATE(XPRSFLXCONV(0,0,0))
+ ALLOCATE(XCAPE(0,0))
+ ALLOCATE(NCLTOPCONV(0,0))
+ ALLOCATE(NCLBASCONV(0,0))
+ END IF
+ELSE
+ ALLOCATE(NCOUNTCONV(0,0))
+ ALLOCATE(XDTHCONV(0,0,0))
+ ALLOCATE(XDRVCONV(0,0,0))
+ ALLOCATE(XDRCCONV(0,0,0))
+ ALLOCATE(XDRICONV(0,0,0))
+ ALLOCATE(XPRCONV(0,0))
+ ALLOCATE(XPACCONV(0,0))
+ ALLOCATE(XPRSCONV(0,0))
+ ALLOCATE(XIC_RATE(0,0))
+ ALLOCATE(XCG_RATE(0,0))
+ ALLOCATE(XIC_TOTAL_NUMBER(0,0))
+ ALLOCATE(XCG_TOTAL_NUMBER(0,0))
+ ALLOCATE(XUMFCONV(0,0,0))
+ ALLOCATE(XDMFCONV(0,0,0))
+ ALLOCATE(XPRLFLXCONV(0,0,0))
+ ALLOCATE(XPRSFLXCONV(0,0,0))
+ ALLOCATE(XCAPE(0,0))
+ ALLOCATE(NCLTOPCONV(0,0))
+ ALLOCATE(NCLBASCONV(0,0))
+END IF
+!
+IF ((CDCONV == 'KAFR' .OR. CSCONV == 'KAFR') &
+ .AND. LSUBG_COND .AND. LSIG_CONV) THEN
+ ALLOCATE(XMFCONV(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XMFCONV(0,0,0))
+ENDIF
+!
+IF ((CDCONV == 'KAFR' .OR. CSCONV == 'KAFR') &
+ .AND. LCHTRANS .AND. NSV > 0 ) THEN
+ ALLOCATE(XDSVCONV(IIU,IJU,IKU,NSV))
+ELSE
+ ALLOCATE(XDSVCONV(0,0,0,0))
+END IF
+!
+ALLOCATE(XCF_MF(IIU,IJU,IKU)) ; XCF_MF=0.0
+ALLOCATE(XRC_MF(IIU,IJU,IKU)) ; XRC_MF=0.0
+ALLOCATE(XRI_MF(IIU,IJU,IKU)) ; XRI_MF=0.0
+!
+!* 3.9 Local variables
+!
+ALLOCATE(ZJ(IIU,IJU,IKU))
+!
+!* 3.10 Forcing variables (Module MODD_FRC and MODD_FRCn)
+!
+IF ( LFORCING ) THEN
+ ALLOCATE(XWTFRC(IIU,IJU,IKU)) ; XWTFRC = XUNDEF
+ ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF
+ ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF
+ELSE
+ ALLOCATE(XWTFRC(0,0,0))
+ ALLOCATE(XUFRC_PAST(0,0,0))
+ ALLOCATE(XVFRC_PAST(0,0,0))
+END IF
+!
+IF (KMI == 1) THEN
+ IF ( LFORCING ) THEN
+ ALLOCATE(TDTFRC(NFRC))
+ ALLOCATE(XUFRC(IKU,NFRC))
+ ALLOCATE(XVFRC(IKU,NFRC))
+ ALLOCATE(XWFRC(IKU,NFRC))
+ ALLOCATE(XTHFRC(IKU,NFRC))
+ ALLOCATE(XRVFRC(IKU,NFRC))
+ ALLOCATE(XTENDTHFRC(IKU,NFRC))
+ ALLOCATE(XTENDRVFRC(IKU,NFRC))
+ ALLOCATE(XGXTHFRC(IKU,NFRC))
+ ALLOCATE(XGYTHFRC(IKU,NFRC))
+ ALLOCATE(XPGROUNDFRC(NFRC))
+ ALLOCATE(XTENDUFRC(IKU,NFRC))
+ ALLOCATE(XTENDVFRC(IKU,NFRC))
+ ELSE
+ ALLOCATE(TDTFRC(0))
+ ALLOCATE(XUFRC(0,0))
+ ALLOCATE(XVFRC(0,0))
+ ALLOCATE(XWFRC(0,0))
+ ALLOCATE(XTHFRC(0,0))
+ ALLOCATE(XRVFRC(0,0))
+ ALLOCATE(XTENDTHFRC(0,0))
+ ALLOCATE(XTENDRVFRC(0,0))
+ ALLOCATE(XGXTHFRC(0,0))
+ ALLOCATE(XGYTHFRC(0,0))
+ ALLOCATE(XPGROUNDFRC(0))
+ ALLOCATE(XTENDUFRC(0,0))
+ ALLOCATE(XTENDVFRC(0,0))
+ END IF
+ELSE
+ !Do not allocate because they are the same on all grids (not 'n' variables)
+END IF
+! ----------------------------------------------------------------------
+!
+IF (L2D_ADV_FRC) THEN
+ WRITE(ILUOUT,*) 'L2D_ADV_FRC IS SET TO', L2D_ADV_FRC
+ WRITE(ILUOUT,*) 'ADV FRC WILL BE SET'
+ ALLOCATE(TDTADVFRC(NADVFRC))
+ ALLOCATE(XDTHFRC(IIU,IJU,IKU,NADVFRC)) ; XDTHFRC=0.
+ ALLOCATE(XDRVFRC(IIU,IJU,IKU,NADVFRC)) ; XDRVFRC=0.
+ELSE
+ ALLOCATE(TDTADVFRC(0))
+ ALLOCATE(XDTHFRC(0,0,0,0))
+ ALLOCATE(XDRVFRC(0,0,0,0))
+ENDIF
+
+IF (L2D_REL_FRC) THEN
+ WRITE(ILUOUT,*) 'L2D_REL_FRC IS SET TO', L2D_REL_FRC
+ WRITE(ILUOUT,*) 'REL FRC WILL BE SET'
+ ALLOCATE(TDTRELFRC(NRELFRC))
+ ALLOCATE(XTHREL(IIU,IJU,IKU,NRELFRC)) ; XTHREL=0.
+ ALLOCATE(XRVREL(IIU,IJU,IKU,NRELFRC)) ; XRVREL=0.
+ELSE
+ ALLOCATE(TDTRELFRC(0))
+ ALLOCATE(XTHREL(0,0,0,0))
+ ALLOCATE(XRVREL(0,0,0,0))
+ENDIF
+!
+!* 4.11 BIS: Eddy fluxes allocation
+!
+IF ( LTH_FLX ) THEN
+ ALLOCATE(XVTH_FLUX_M(IIU,IJU,IKU)) ; XVTH_FLUX_M = 0.
+ ALLOCATE(XWTH_FLUX_M(IIU,IJU,IKU)) ; XWTH_FLUX_M = 0.
+ IF (KMI /= 1) THEN
+ ALLOCATE(XRTHS_EDDY_FLUX(IIU,IJU,IKU))
+ XRTHS_EDDY_FLUX = 0.
+ ELSE
+ ALLOCATE(XRTHS_EDDY_FLUX(0,0,0))
+ ENDIF
+ELSE
+ ALLOCATE(XVTH_FLUX_M(0,0,0))
+ ALLOCATE(XWTH_FLUX_M(0,0,0))
+ ALLOCATE(XRTHS_EDDY_FLUX(0,0,0))
+END IF
+!
+IF ( LUV_FLX) THEN
+ ALLOCATE(XVU_FLUX_M(IIU,IJU,IKU)) ; XVU_FLUX_M = 0.
+ IF (KMI /= 1) THEN
+ ALLOCATE(XRVS_EDDY_FLUX(IIU,IJU,IKU))
+ XRVS_EDDY_FLUX = 0.
+ ELSE
+ ALLOCATE(XRVS_EDDY_FLUX(0,0,0))
+ ENDIF
+ELSE
+ ALLOCATE(XVU_FLUX_M(0,0,0))
+ ALLOCATE(XRVS_EDDY_FLUX(0,0,0))
+END IF
+!
+!* 3.11 Module MODD_ICE_CONC_n
+!
+IF ( (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') .AND. &
+ (CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
+ ALLOCATE(XCIT(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XCIT(0,0,0))
+END IF
+!
+IF ( CCLOUD == 'KHKO' .OR. CCLOUD == 'C2R2') THEN
+ ALLOCATE(XSUPSAT(IIU,IJU,IKU))
+ ALLOCATE(XNACT(IIU,IJU,IKU))
+ ALLOCATE(XNPRO(IIU,IJU,IKU))
+ ALLOCATE(XSSPRO(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XSUPSAT(0,0,0))
+ ALLOCATE(XNACT(0,0,0))
+ ALLOCATE(XNPRO(0,0,0))
+ ALLOCATE(XSSPRO(0,0,0))
+END IF
+!
+!* 3.12 Module MODD_TURB_CLOUD
+!
+IF (LCLOUDMODIFLM) THEN
+ ALLOCATE(XCEI(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XCEI(0,0,0))
+ENDIF
+!
+!* 3.13 Module MODD_CH_PH_n
+!
+IF (LUSECHAQ.AND.(CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
+ IF (LCH_PH) THEN
+ ALLOCATE(XPHC(IIU,IJU,IKU))
+ IF (NRRL==2) THEN
+ ALLOCATE(XPHR(IIU,IJU,IKU))
+ ALLOCATE(XACPHR(IIU,IJU))
+ XACPHR(:,:) = 0.
+ ENDIF
+ ENDIF
+ IF (NRRL==2) THEN
+ ALLOCATE(XACPRAQ(IIU,IJU,NSV_CHAC/2))
+ XACPRAQ(:,:,:) = 0.
+ ENDIF
+ENDIF
+IF (.NOT.(ASSOCIATED(XPHC))) ALLOCATE(XPHC(0,0,0))
+IF (.NOT.(ASSOCIATED(XPHR))) ALLOCATE(XPHR(0,0,0))
+IF (.NOT.(ASSOCIATED(XACPHR))) ALLOCATE(XACPHR(0,0))
+IF (.NOT.(ASSOCIATED(XACPRAQ))) ALLOCATE(XACPRAQ(0,0,0))
+IF ((LUSECHEM).AND.(CPROGRAM == 'DIAG ')) THEN
+ ALLOCATE(XCHFLX(IIU,IJU,NSV_CHEM))
+ XCHFLX(:,:,:) = 0.
+ELSE
+ ALLOCATE(XCHFLX(0,0,0))
+END IF
+!
+!* 3.14 Module MODD_DRAG
+!
+IF (LDRAG) THEN
+ ALLOCATE(XDRAG(IIU,IJU))
+ELSE
+ ALLOCATE(XDRAG(0,0))
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. INITIALIZE BUDGET VARIABLES
+! ---------------------------
+!
+gles = lles_mean .or. lles_resolved .or. lles_subgrid .or. lles_updraft &
+ .or. lles_downdraft .or. lles_spectra
+!Called if budgets are enabled via NAM_BUDGET
+!or if LES budgets are enabled via NAM_LES (condition on kmi==1 to call it max once)
+if ( ( cbutype /= "NONE" .and. nbumod == kmi ) .or. ( ( gles .or. lcheck ) .and. kmi == 1 ) ) THEN
+ call Budget_preallocate()
+end if
+CALL TBUCONF_ASSOCIATE()
+IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN
+ CALL Ini_budget(ILUOUT,XTSTEP,NSV,NRR, &
+ LNUMDIFU,LNUMDIFTH,LNUMDIFSV, &
+ LHORELAX_UVWTH,LHORELAX_RV, LHORELAX_RC,LHORELAX_RR, &
+ LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, LHORELAX_RH,LHORELAX_TKE, &
+ LHORELAX_SV, LVE_RELAX, LVE_RELAX_GRD, &
+ LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LDRAGBLDG,LMAIN_EOL, &
+ CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. INITIALIZE INTERPOLATION COEFFICIENTS
+!
+CALL INI_BIKHARDT_n (NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI),KMI)
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. BUILT THE GENERIC OUTPUT NAME
+! ----------------------------
+!
+IF (KMI == 1) THEN
+ DO IMI = 1 , NMODEL
+ WRITE(IO_SURF_MNH_MODEL(IMI)%COUTFILE,'(A,".",I1,".",A)') CEXP,IMI,TRIM(ADJUSTL(CSEG))
+ WRITE(YNAME, '(A,".",I1,".",A)') CEXP,IMI,TRIM(ADJUSTL(CSEG))//'.000'
+ CALL IO_File_add2list(LUNIT_MODEL(IMI)%TDIAFILE,YNAME,'MNHDIACHRONIC','WRITE', &
+ HDIRNAME=CIO_DIR, &
+ KLFINPRAR=INT(50,KIND=LFIINT),KLFITYPE=1,KLFIVERB=NVERB, &
+ TPDADFILE=LUNIT_MODEL(NDAD(IMI))%TDIAFILE )
+ END DO
+ !
+ TDIAFILE => LUNIT_MODEL(KMI)%TDIAFILE !Necessary because no call to GOTO_MODEL before needing it
+ !
+ IF (CPROGRAM=='MESONH') THEN
+ IF ( NDAD(KMI) == 1) CDAD_NAME(KMI) = CEXP//'.1.'//CSEG
+ IF ( NDAD(KMI) == 2) CDAD_NAME(KMI) = CEXP//'.2.'//CSEG
+ IF ( NDAD(KMI) == 3) CDAD_NAME(KMI) = CEXP//'.3.'//CSEG
+ IF ( NDAD(KMI) == 4) CDAD_NAME(KMI) = CEXP//'.4.'//CSEG
+ IF ( NDAD(KMI) == 5) CDAD_NAME(KMI) = CEXP//'.5.'//CSEG
+ IF ( NDAD(KMI) == 6) CDAD_NAME(KMI) = CEXP//'.6.'//CSEG
+ IF ( NDAD(KMI) == 7) CDAD_NAME(KMI) = CEXP//'.7.'//CSEG
+ IF ( NDAD(KMI) == 8) CDAD_NAME(KMI) = CEXP//'.8.'//CSEG
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. INITIALIZE GRIDS AND METRIC COEFFICIENTS
+! ----------------------------------------
+!
+CALL SET_GRID( KMI, TPINIFILE, IKU, NIMAX_ll, NJMAX_ll, &
+ XTSTEP, XSEGLEN, &
+ XLONORI, XLATORI, XLON, XLAT, &
+ XXHAT, XYHAT, XDXHAT, XDYHAT, XXHATM, XYHATM, &
+ XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll, &
+ XHAT_BOUND, XHATM_BOUND, &
+ XMAP, XZS, XZZ, XZHAT, XZHATM, XZTOP, LSLEVE, &
+ XLEN1, XLEN2, XZSMT, ZJ, &
+ TDTMOD, TDTCUR, NSTOP, NBAK_NUMB, NOUT_NUMB, TBACKUPN, TOUTPUTN )
+!
+CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+!* update halos of metric coefficients
+!
+!
+CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+!
+CALL SET_DIRCOS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,TZINITHALO2D_ll, &
+ XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE )
+!
+! grid nesting initializations
+IF ( KMI == 1 ) THEN
+ XTSTEP_MODEL1=XTSTEP
+END IF
+!
+NDT_2_WAY(KMI)=4
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. INITIALIZE DATA FOR JVALUES AND AEROSOLS
+!
+IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
+ IF ((KMI==1).AND.(CPROGRAM == "MESONH".OR.CPROGRAM == "DIAG ")) &
+ CALL CH_INIT_JVALUES(TDTCUR%nday, TDTCUR%nmonth, &
+ TDTCUR%nyear, ILUOUT, XCH_TUV_DOBNEW)
+!
+ IF (LORILAM) THEN
+ CALL CH_AER_MOD_INIT
+ ENDIF
+END IF
+IF (.NOT.(ASSOCIATED(XMI))) ALLOCATE(XMI(0,0,0,0))
+IF (.NOT.(ASSOCIATED(XSOLORG))) ALLOCATE(XSOLORG(0,0,0,0))
+!
+IF (CCLOUD=='LIMA') CALL INIT_AEROSOL_PROPERTIES
+!
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. FIRE initializations
+! --------------------
+!
+IF(LBLAZE) THEN
+ !
+ ! 9.1 Array allocation
+ ! ----------------
+ !
+ ! Level Set function
+ ALLOCATE(XLSPHI(IIU,IJU,NREFINX*NREFINY)); XLSPHI(:,:,:) = 0.
+
+ ! BMap array
+ ! BMap default value
+ ! -1 = The fire is not here yet
+ ALLOCATE(XBMAP(IIU,IJU,NREFINX*NREFINY)); XBMAP(:,:,:) = -1.
+
+ ! A array
+ ALLOCATE(XFMRFA(IIU,IJU,NREFINX*NREFINY)); XFMRFA(:,:,:) = 0.
+
+ ! Wf0 array
+ ALLOCATE(XFMWF0(IIU,IJU,NREFINX*NREFINY)); XFMWF0(:,:,:) = 0.
+
+ ! R0 array
+ ALLOCATE(XFMR0(IIU,IJU,NREFINX*NREFINY)); XFMR0(:,:,:) = 0.
+
+ ! r00 array
+ ALLOCATE(XFMR00(IIU,IJU,NREFINX*NREFINY)); XFMR00(:,:,:) = 0.
+
+ ! Ignition
+ ! Default value as 1E6 : Ignition long after simulation end time
+ ! 1E6 should be enough as it is more than 11 days
+ ALLOCATE(XFMIGNITION(IIU,IJU,NREFINX*NREFINY)); XFMIGNITION(:,:,:) = 1.E6
+
+ ! Fuel type
+ ALLOCATE(XFMFUELTYPE(IIU,IJU,NREFINX*NREFINY)); XFMFUELTYPE(:,:,:) = 0.
+
+ ! Residence time function
+ ALLOCATE(XFIRETAU(IIU,IJU,NREFINX*NREFINY)); XFIRETAU(:,:,:) = 0.
+
+ ! Rate of spread with wind
+ ALLOCATE(XFIRERW(IIU,IJU,NREFINX*NREFINY)); XFIRERW(:,:,:) = 0.
+
+ ! Sensible heat flux parameters
+ ! get number of parameters
+ SELECT CASE(CHEAT_FLUX_MODEL)
+ CASE('CST')
+ ! 1 parameter for model : nominal injection value
+ INBPARAMSENSIBLE = 1
+
+ CASE('EXP')
+ ! 2 parameters for model : Max value and characteristic time
+ INBPARAMSENSIBLE = 2
+
+ CASE('EXS')
+ ! 3 parameters for model : Max value and characteristic time, smoldering injection value
+ INBPARAMSENSIBLE = 3
+ END SELECT
+
+ ALLOCATE(XFLUXPARAMH(IIU,IJU,NREFINX*NREFINY,INBPARAMSENSIBLE));
+ XFLUXPARAMH(:,:,:,:) = 0.
+
+ ! Latent heat flux parameters
+ ! get number of parameters
+ SELECT CASE(CLATENT_FLUX_MODEL)
+ CASE('CST')
+ ! 1 parameter for model : nominal injection value
+ INBPARAMLATENT = 1
+
+ CASE('EXP')
+ ! 2 parameters for model : Max value and characteristic time
+ INBPARAMLATENT = 2
+ END SELECT
+
+ ALLOCATE(XFLUXPARAMW(IIU,IJU,NREFINX*NREFINY,INBPARAMLATENT));
+ XFLUXPARAMW(:,:,:,:) = 0.
+
+ ! Available Sensible energy
+ ALLOCATE(XFMASE(IIU,IJU,NREFINX*NREFINY)); XFMASE(:,:,:) = 0.
+
+ ! Available Latent energy
+ ALLOCATE(XFMAWC(IIU,IJU,NREFINX*NREFINY)); XFMAWC(:,:,:) = 0.
+
+ ! Walking Ignition map (Arrival time matrix for ignition)
+ ALLOCATE(XFMWALKIG(IIU,IJU,NREFINX*NREFINY)); XFMWALKIG(:,:,:) = -1.
+
+ ! Sensible heat flux (W/m2)
+ ALLOCATE(XFMFLUXHDH(IIU,IJU,NREFINX*NREFINY)); XFMFLUXHDH(:,:,:) = 0.
+
+ ! Latent heat flux (kg/s/m2)
+ ALLOCATE(XFMFLUXHDW(IIU,IJU,NREFINX*NREFINY)); XFMFLUXHDW(:,:,:) = 0.
+
+ ! filtered wind on front normal (m/s)
+ ALLOCATE(XFMHWS(IIU,IJU,NREFINX*NREFINY)); XFMHWS(:,:,:) = 0.
+
+ ! filtered wind U (m/s)
+ ALLOCATE(XFMWINDU(IIU,IJU,NREFINX*NREFINY)); XFMWINDU(:,:,:) = 0.
+
+ ! filtered wind V (m/s)
+ ALLOCATE(XFMWINDV(IIU,IJU,NREFINX*NREFINY)); XFMWINDV(:,:,:) = 0.
+
+ ! filtered wind W (m/s)
+ ALLOCATE(XFMWINDW(IIU,IJU,NREFINX*NREFINY)); XFMWINDW(:,:,:) = 0.
+
+ ! Gradient of Level Set on x
+ ALLOCATE(XGRADLSPHIX(IIU,IJU,NREFINX*NREFINY)); XGRADLSPHIX(:,:,:) = 0.
+
+ ! Gradient of Level Set on y
+ ALLOCATE(XGRADLSPHIY(IIU,IJU,NREFINX*NREFINY)); XGRADLSPHIY(:,:,:) = 0.
+
+ ! Wind for fire
+ ALLOCATE(XFIREWIND(IIU,IJU,NREFINX*NREFINY)); XFIREWIND(:,:,:) = 0.
+
+ ! Orographic gradient on fire mesh
+ ALLOCATE(XFMGRADOROX(IIU,IJU,NREFINX*NREFINY)); XFMGRADOROX(:,:,:) = 0.
+ ALLOCATE(XFMGRADOROY(IIU,IJU,NREFINX*NREFINY)); XFMGRADOROY(:,:,:) = 0.
+ !
+ ! 9.2 Array 2d fire mesh allocation
+ ! -----------------------------
+ !
+ ! Level Set 2d
+ ALLOCATE(XLSPHI2D(IIU*NREFINX,IJU*NREFINY)); XLSPHI2D(:,:) = 0.
+ ! Gradient of Level Set on x 2d
+ ALLOCATE(XGRADLSPHIX2D(IIU*NREFINX,IJU*NREFINY)); XGRADLSPHIX2D(:,:) = 0.
+
+ ! Gradient of Level Set on y 2d
+ ALLOCATE(XGRADLSPHIY2D(IIU*NREFINX,IJU*NREFINY)); XGRADLSPHIY2D(:,:) = 0.
+
+ ! Level Set mask on x 2d
+ ALLOCATE(XGRADMASKX(IIU*NREFINX,IJU*NREFINY)); XGRADMASKX(:,:) = 0.
+
+ ! Level Set mask on y 2d
+ ALLOCATE(XGRADMASKY(IIU*NREFINX,IJU*NREFINY)); XGRADMASKY(:,:) = 0.
+
+ ! burnt surface ratio 2d
+ ALLOCATE(XSURFRATIO2D(IIU*NREFINX,IJU*NREFINY)); XSURFRATIO2D(:,:) = 0.
+
+ ! Level Set diffusuon x 2d
+ ALLOCATE(XLSDIFFUX2D(IIU*NREFINX,IJU*NREFINY)); XLSDIFFUX2D(:,:) = 0.
+
+ ! Level Set diffusion y 2d
+ ALLOCATE(XLSDIFFUY2D(IIU*NREFINX,IJU*NREFINY)); XLSDIFFUY2D(:,:) = 0.
+
+ ! ROS diffusion 2d
+ ALLOCATE(XFIRERW2D(IIU*NREFINX,IJU*NREFINY)); XFIRERW2D(:,:) = 0.
+ !
+ ! 9.3 Compute fire mesh size
+ ! ----------------------
+ !
+ XFIREMESHSIZE(1) = (XXHAT(2) - XXHAT(1)) / REAL(NREFINX)
+ XFIREMESHSIZE(2) = (XYHAT(2) - XYHAT(1)) / REAL(NREFINY)
+ !
+ELSE
+ !
+ ! 9.4 Default allocation
+ ! ------------------
+ !
+ ! 3d array
+ ALLOCATE(XLSPHI(0,0,0))
+ ALLOCATE(XBMAP(0,0,0))
+ ALLOCATE(XFMRFA(0,0,0))
+ ALLOCATE(XFMR0(0,0,0))
+ ALLOCATE(XFMWF0(0,0,0))
+ ALLOCATE(XFMR00(0,0,0))
+ ALLOCATE(XFMIGNITION(0,0,0))
+ ALLOCATE(XFMFUELTYPE(0,0,0))
+ ALLOCATE(XFIRETAU(0,0,0))
+ ALLOCATE(XFIRERW(0,0,0))
+ ALLOCATE(XFLUXPARAMH(0,0,0,0))
+ ALLOCATE(XFLUXPARAMW(0,0,0,0))
+ ALLOCATE(XFMASE(0,0,0))
+ ALLOCATE(XFMAWC(0,0,0))
+ ALLOCATE(XFMWALKIG(0,0,0))
+ ALLOCATE(XFMFLUXHDH(0,0,0))
+ ALLOCATE(XFMFLUXHDW(0,0,0))
+ ALLOCATE(XFMHWS(0,0,0))
+ ALLOCATE(XFMWINDU(0,0,0))
+ ALLOCATE(XFMWINDV(0,0,0))
+ ALLOCATE(XFMWINDW(0,0,0))
+ ALLOCATE(XGRADLSPHIX(0,0,0))
+ ALLOCATE(XGRADLSPHIY(0,0,0))
+ ALLOCATE(XFIREWIND(0,0,0))
+ ALLOCATE(XFMGRADOROX(0,0,0))
+ ALLOCATE(XFMGRADOROY(0,0,0))
+ ! 2d array
+ ALLOCATE(XLSPHI2D(0,0))
+ ALLOCATE(XGRADLSPHIX2D(0,0))
+ ALLOCATE(XGRADLSPHIY2D(0,0))
+ ALLOCATE(XGRADMASKX(0,0))
+ ALLOCATE(XGRADMASKY(0,0))
+ ALLOCATE(XSURFRATIO2D(0,0))
+ ALLOCATE(XLSDIFFUX2D(0,0))
+ ALLOCATE(XLSDIFFUY2D(0,0))
+ ALLOCATE(XFIRERW2D(0,0))
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. INITIALIZE THE PROGNOSTIC FIELDS
+! --------------------------------
+!
+CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before read_field::XUT",PRECISION)
+CALL READ_FIELD(KMI,TPINIFILE,IIU,IJU,IKU, &
+ CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT,CGETZWS, &
+ CGETRST,CGETRGT,CGETRHT,CGETSVT,CGETSRCT,CGETSIGS,CGETCLDFR, &
+ CGETICEFR, CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR, &
+ CUVW_ADV_SCHEME, CTEMP_SCHEME, &
+ NSIZELBX_ll, NSIZELBXU_ll, NSIZELBY_ll, NSIZELBYV_ll, &
+ NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
+ NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
+ XUM,XVM,XWM,XDUM,XDVM,XDWM, &
+ XUT,XVT,XWT,XTHT,XPABST,XTKET,XRTKEMS, &
+ XRT,XSVT,XZWS,XCIT,XDRYMASST,XDRYMASSS, &
+ XSIGS,XSRCT,XCLDFR,XICEFR, XBL_DEPTH,XSBL_DEPTH,XWTHVMF, &
+ XPHC,XPHR, XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM, &
+ XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM, &
+ XLBYRM,XLBYSVM, &
+ NFRC,TDTFRC,XUFRC,XVFRC,XWFRC,XTHFRC,XRVFRC, &
+ XTENDTHFRC,XTENDRVFRC,XGXTHFRC,XGYTHFRC, &
+ XPGROUNDFRC, XATC, &
+ XTENDUFRC, XTENDVFRC, &
+ NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
+ NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
+ XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
+ XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD, &
+ ZIBM_LS,XIBM_XMUT,XUMEANW,XVMEANW,XWMEANW,XUMEANN,XVMEANN, &
+ XWMEANN,XUMEANE,XVMEANE,XWMEANE,XUMEANS,XVMEANS,XWMEANS, &
+ XLSPHI, XBMAP, XFMASE, XFMAWC, XFMWINDU, XFMWINDV, XFMWINDW, XFMHWS )
+
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 10. INITIALIZE REFERENCE STATE
+! ---------------------------
+!
+!
+CALL SET_REF( KMI, TPINIFILE, &
+ XZZ, XZHATM, ZJ, XDXX, XDYY, CLBCX, CLBCY, &
+ XREFMASS, XMASS_O_PHI0, XLINMASS, &
+ XRHODREF, XTHVREF, XRVREF, XEXNREF, XRHODJ )
+!
+!-------------------------------------------------------------------------------
+!
+!* 10.1 INITIALIZE THE TURBULENCE VARIABLES
+! -----------------------------------
+!
+IF(LSTATNW) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','LSTATNW option not tested in Meso-NH')
+ENDIF
+CALL INI_TURB(CPROGRAM)
+IF ((CTURB == 'TKEL').AND.(CCONF=='START')) THEN
+ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before ini_tke_eps::XUT",PRECISION)
+ CALL INI_TKE_EPS(CGETTKET,XTHVREF,XZZ, &
+ XUT,XVT,XTHT, &
+ XTKET,TZINITHALO3D_ll )
+ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_tke_eps::XUT",PRECISION)
+END IF
+!
+!
+!* 10.2 INITIALIZE THE LES VARIABLES
+! ----------------------------
+!
+CALL INI_LES_n
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. INITIALIZE THE SOURCE OF TOTAL DRY MASS Md
+! ------------------------------------------
+!
+IF((KMI==1).AND.LSTEADYLS .AND. (CCONF=='START') ) THEN
+ XDRYMASSS = 0.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. INITIALIZE THE MICROPHYSICS
+! ----------------------------
+!
+IF (CELEC == 'NONE') THEN
+ CALL INI_MICRO_n(TPINIFILE,ILUOUT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. INITIALIZE THE ATMOSPHERIC ELECTRICITY
+! --------------------------------------
+!
+ELSE
+ CALL INI_ELEC_n(ILUOUT, CELEC, CCLOUD, TPINIFILE, &
+ XTSTEP, XZZ, &
+ XDXX, XDYY, XDZZ, XDZX, XDZY )
+!
+ WRITE (UNIT=ILUOUT,&
+ FMT='(/,"ELECTRIC VARIABLES ARE BETWEEN INDEX",I2," AND ",I2)')&
+ NSV_ELECBEG, NSV_ELECEND
+!
+ IF( CGETSVT(NSV_ELECBEG)=='INIT' ) THEN
+ XSVT(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg
+ XSVT(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:)
+!
+ XSVT(:,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ ELSE ! Convert elec_variables per m3 into elec_variables per kg of air
+ DO JSV = NSV_ELECBEG, NSV_ELECEND
+ XSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) / XRHODREF(:,:,:)
+ ENDDO
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 14. INITIALIZE THE LARGE SCALE SOURCES
+! ----------------------------------
+!
+IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
+ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before ini_cpl::XUT",PRECISION)
+ CALL INI_CPL(NSTOP,XTSTEP,LSTEADYLS,CCONF, &
+ CGETTKET, &
+ CGETRVT,CGETRCT,CGETRRT,CGETRIT, &
+ CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, &
+ NSV,NIMAX_ll,NJMAX_ll, &
+ NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
+ NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
+ NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
+ CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_cpl::XUT",PRECISION)
+!
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_LNOXBEG,NSV_LNOXEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#ifdef MNH_FOREFIRE
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#endif
+! Blaze smoke
+DO JSV=NSV_FIREBEG,NSV_FIREEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ENDDO
+!
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+!
+END IF
+!
+IF ( KMI > 1) THEN
+ ! Use dummy pointers to correct an ifort BUG
+ DPTR_XBMX1=>XBMX1
+ DPTR_XBMX2=>XBMX2
+ DPTR_XBMX3=>XBMX3
+ DPTR_XBMX4=>XBMX4
+ DPTR_XBMY1=>XBMY1
+ DPTR_XBMY2=>XBMY2
+ DPTR_XBMY3=>XBMY3
+ DPTR_XBMY4=>XBMY4
+ DPTR_XBFX1=>XBFX1
+ DPTR_XBFX2=>XBFX2
+ DPTR_XBFX3=>XBFX3
+ DPTR_XBFX4=>XBFX4
+ DPTR_XBFY1=>XBFY1
+ DPTR_XBFY2=>XBFY2
+ DPTR_XBFY3=>XBFY3
+ DPTR_XBFY4=>XBFY4
+ DPTR_CLBCX=>CLBCX
+ DPTR_CLBCY=>CLBCY
+ !
+ DPTR_XZZ=>XZZ
+ DPTR_XZHAT=>XZHAT
+ DPTR_XLSUM=>XLSUM
+ DPTR_XLSVM=>XLSVM
+ DPTR_XLSWM=>XLSWM
+ DPTR_XLSTHM=>XLSTHM
+ DPTR_XLSRVM=>XLSRVM
+ DPTR_XLSZWSM=>XLSZWSM
+ DPTR_XLSUS=>XLSUS
+ DPTR_XLSVS=>XLSVS
+ DPTR_XLSWS=>XLSWS
+ DPTR_XLSTHS=>XLSTHS
+ DPTR_XLSRVS=>XLSRVS
+ DPTR_XLSZWSS=>XLSZWSS
+ !
+ DPTR_NKLIN_LBXU=>NKLIN_LBXU
+ DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
+ DPTR_NKLIN_LBYU=>NKLIN_LBYU
+ DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU
+ DPTR_NKLIN_LBXV=>NKLIN_LBXV
+ DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV
+ DPTR_NKLIN_LBYV=>NKLIN_LBYV
+ DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV
+ DPTR_NKLIN_LBXW=>NKLIN_LBXW
+ DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW
+ DPTR_NKLIN_LBYW=>NKLIN_LBYW
+ DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW
+ DPTR_NKLIN_LBXM=>NKLIN_LBXM
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_NKLIN_LBYM=>NKLIN_LBYM
+ DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM
+ !
+ CALL INI_SPAWN_LS_n(NDAD(KMI),XTSTEP,KMI, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), &
+ DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT, &
+ LSLEVE,XLEN1,XLEN2, &
+ DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSZWSM, &
+ DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSZWSS, &
+ DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
+ DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
+ DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
+ DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM )
+ !
+ DPTR_XLBXUM=>XLBXUM
+ DPTR_XLBYUM=>XLBYUM
+ DPTR_XLBXVM=>XLBXVM
+ DPTR_XLBYVM=>XLBYVM
+ DPTR_XLBXWM=>XLBXWM
+ DPTR_XLBYWM=>XLBYWM
+ DPTR_XLBXTHM=>XLBXTHM
+ DPTR_XLBYTHM=>XLBYTHM
+ DPTR_XLBXTKEM=>XLBXTKEM
+ DPTR_XLBYTKEM=>XLBYTKEM
+ DPTR_XLBXRM=>XLBXRM
+ DPTR_XLBYRM=>XLBYRM
+ DPTR_XLBXSVM=>XLBXSVM
+ DPTR_XLBYSVM=>XLBYSVM
+ IF (CCONF=='START') THEN
+ CALL INI_ONE_WAY_n(NDAD(KMI),KMI, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), &
+ DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, &
+ DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
+ DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
+ DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
+ DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, &
+ CCLOUD, LUSECHAQ, LUSECHIC, &
+ DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, &
+ DPTR_XLBXTHM,DPTR_XLBYTHM, &
+ DPTR_XLBXTKEM,DPTR_XLBYTKEM, &
+ DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM )
+ ENDIF
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 15. INITIALIZE THE SCALAR VARIABLES
+! -------------------------------
+!
+IF (LLG .AND. LINIT_LG .AND. CPROGRAM=='MESONH') &
+ CALL INI_LG( XXHATM, XYHATM, XZZ, XSVT, XLBXSVM, XLBYSVM )
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 16. INITIALIZE THE PARAMETERS FOR THE DYNAMICS
+! ------------------------------------------
+!
+CALL INI_DYNAMICS(XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
+ XZHAT,XZHATM,CLBCX,CLBCY,XTSTEP, &
+ LVE_RELAX,LVE_RELAX_GRD,LHORELAX_UVWTH,LHORELAX_RV, &
+ LHORELAX_RC,LHORELAX_RR,LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, &
+ LHORELAX_RH,LHORELAX_TKE,LHORELAX_SV, &
+ LHORELAX_SVC2R2,LHORELAX_SVC1R3,LHORELAX_SVELEC,LHORELAX_SVLG, &
+ LHORELAX_SVCHEM,LHORELAX_SVAER,LHORELAX_SVDST,LHORELAX_SVSLT, &
+ LHORELAX_SVPP,LHORELAX_SVCS,LHORELAX_SVCHIC,LHORELAX_SVSNW, &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF, &
+#endif
+ XRIMKMAX,NRIMX,NRIMY, &
+ XALKTOP,XALKGRD,XALZBOT,XALZBAS, &
+ XT4DIFU,XT4DIFTH,XT4DIFSV, &
+ XCORIOX,XCORIOY,XCORIOZ,XCURVX,XCURVY, &
+ XDXHATM,XDYHATM,XRHOM,XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY,&
+ XALK,XALKW,NALBOT,XALKBAS,XALKWBAS,NALBAS, &
+ LMASK_RELAX,XKURELAX,XKVRELAX,XKWRELAX, &
+ XDK2U,XDK4U,XDK2TH,XDK4TH,XDK2SV,XDK4SV, &
+ LZDIFFU,XZDIFFU_HALO2, &
+ XBFB,XBF_SXP2_YP1_Z )
+!
+!
+!* 16.1 Initialize the XDRAG array
+! -------------
+IF (LDRAG) THEN
+ CALL INI_DRAG(LMOUNT,XZS,XHSTART,NSTART,XDRAG)
+ENDIF
+!* 16.2 Initialize the LevelSet function
+! -------------
+IF (LIBM) THEN
+ ALLOCATE(XIBM_LS(IIU,IJU,IKU,4)) ; XIBM_LS = -XIBM_IEPS
+ XIBM_LS(:,:,:,1)=ZIBM_LS(:,:,:)
+ DEALLOCATE(ZIBM_LS)
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 17. SURFACE FIELDS
+! --------------
+!
+!* 17.1 Radiative setup
+! ---------------
+!
+IF (CRAD /= 'NONE') THEN
+ IF (CGETRAD =='INIT') THEN
+ GINIRAD =.TRUE.
+ ELSE
+ GINIRAD =.FALSE.
+ END IF
+ CALL INI_RADIATIONS(TPINIFILE,GINIRAD,TDTCUR,TDTEXP,XZZ, &
+ XDXX, XDYY, &
+ XSINDEL,XCOSDEL,XTSIDER,XCORSOL, &
+ XSLOPANG,XSLOPAZI, &
+ XDTHRAD,XDIRFLASWD,XSCAFLASWD, &
+ XFLALWD,XDIRSRFSWD,NCLEARCOL_TM1, &
+ XZENITH,XAZIM, &
+ TDTRAD_FULL,TDTRAD_CLONLY, &
+ TZINITHALO2D_ll, &
+ XRADEFF,XSWU,XSWD,XLWU, &
+ XLWD,XDTHRADSW,XDTHRADLW )
+ !
+ IF (GINIRAD) CALL SUNPOS_n(XZENITH,PAZIMSOL=XAZIM)
+ CALL SURF_SOLAR_GEOM (XZS, XZS_XY)
+ !
+ ALLOCATE(XZS_ll (IIU_ll,IJU_ll))
+ ALLOCATE(XZS_XY_ll (IIU_ll,IJU_ll))
+ !
+ CALL GATHERALL_FIELD_ll('XY',XZS,XZS_ll,IRESP)
+ CALL GATHERALL_FIELD_ll('XY',XZS_XY,XZS_XY_ll,IRESP)
+ XZS_MAX_ll=MAXVAL(XZS_ll)
+ELSE
+ XAZIM = XPI
+ XZENITH = XPI/2.
+ XDIRSRFSWD = 0.
+ XSCAFLASWD = 0.
+ XFLALWD = 300. ! W/m2
+ XTSIDER = 0.
+END IF
+!
+!
+CALL INI_SW_SETUP (CRAD,NSWB_MNH,XSW_BANDS)
+CALL INI_LW_SETUP (CRAD,NLWB_MNH,XLW_BANDS)
+!
+!
+! 17.1.1 Special initialisation for CO2 content
+! CO2 (molar mass=44) horizontally and vertically homogeneous at 360 ppm
+!
+XCCO2 = 360.0E-06 * 44.0E-03 / XMD
+#ifdef MNH_ECRAD
+RCCO2 = 360.0E-06 * 44.0E-03 / XMD
+#endif
+!
+!
+!* 17.2 Externalized surface fields
+! ---------------------------
+!
+ALLOCATE(ZCO2(IIU,IJU))
+ZCO2(:,:) = XCCO2
+!
+
+ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH))
+ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
+ALLOCATE(ZEMIS (IIU,IJU,NLWB_MNH))
+ALLOCATE(ZTSRAD (IIU,IJU))
+!
+IF (LCOUPLES.AND.(KMI>1))THEN
+ CSURF ="NONE"
+ELSE
+ IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
+ CALL IO_Field_read(TPINIFILE,'SURF',CSURF)
+ ELSE
+ CSURF = "EXTE"
+ END IF
+END IF
+!
+!
+IF (CSURF=='EXTE' .AND. (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ')) THEN
+ ! ouverture du fichier PGD
+ IF ( LEN_TRIM(CINIFILEPGD) > 0 ) THEN
+ CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TINIFILEPGD,KRESP=IRESP)
+ LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD
+ IF (IRESP/=0) THEN
+ WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD
+ WRITE(ILUOUT,FMT=*) "CHECK YOUR NAMELIST NAM_LUNITn"
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
+ ENDIF
+ ELSE
+ ! case after a spawning
+ CINIFILEPGD = TPINIFILE%CNAME
+ END IF
+ !
+ CALL GOTO_SURFEX(KMI)
+#ifdef CPLOASIS
+ CALL SFX_OASIS_READ_NAM(CPROGRAM,XTSTEP)
+ WRITE(*,*) 'SFX-OASIS: READ NAM_SFX_SEA_CPL OK'
+#endif
+ !* initialization of surface
+ CALL INIT_GROUND_PARAM_n ('ALL',SIZE(CSV),CSV,ZCO2, &
+ XZENITH,XAZIM,XSW_BANDS,XLW_BANDS,ZDIR_ALB,ZSCA_ALB, &
+ ZEMIS,ZTSRAD )
+ !
+ IF (SIZE(XEMIS)>0) THEN
+ XDIR_ALB = ZDIR_ALB
+ XSCA_ALB = ZSCA_ALB
+ XEMIS = ZEMIS
+ XTSRAD = ZTSRAD
+ CALL MNHGET_SURF_PARAM_n (PSEA=XSEA)
+ END IF
+ELSE
+ !* fields not physically necessary, but must be initialized
+ IF (SIZE(XEMIS)>0) THEN
+ XDIR_ALB = 0.
+ XSCA_ALB = 0.
+ XEMIS = 1.
+ XTSRAD = XTT
+ XSEA = 1.
+ END IF
+END IF
+IF (CSURF=='EXTE' .AND. (CPROGRAM=='SPAWN ')) THEN
+ ! ouverture du fichier PGD
+ CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TINIFILEPGD,KRESP=IRESP)
+ LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD
+ IF (IRESP/=0) THEN
+ WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD
+ WRITE(ILUOUT,FMT=*) "CHECK YOUR NAMELIST NAM_LUNIT2_SPA"
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
+ ENDIF
+ENDIF
+!
+IF (.NOT.ASSOCIATED(TINIFILEPGD)) TINIFILEPGD => TFILE_DUMMY
+!
+ !* special case after spawning in prep_real_case
+IF (CSURF=='EXRM' .AND. CPROGRAM=='REAL ') CSURF = 'EXTE'
+!
+DEALLOCATE(ZDIR_ALB)
+DEALLOCATE(ZSCA_ALB)
+DEALLOCATE(ZEMIS )
+DEALLOCATE(ZTSRAD )
+!
+DEALLOCATE(ZCO2)
+!
+!
+!* in a RESTART case, reads surface radiative quantities in the MESONH file
+!
+IF ((CRAD == 'ECMW' .OR. CRAD == 'ECRA') .AND. CGETRAD=='READ') THEN
+ CALL INI_SURF_RAD(TPINIFILE, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD)
+END IF
+!
+!
+!* 17.3 Mesonh fields
+! -------------
+!
+IF (CPROGRAM/='REAL ') CALL MNHREAD_ZS_DUMMY_n(TINIFILEPGD)
+!
+!-------------------------------------------------------------------------------
+!
+!* 18. INITIALIZE THE PARAMETERS FOR THE PHYSICS
+! -----------------------------------------
+!
+IF (CRAD == 'ECMW') THEN
+!
+!* get cover mask for aerosols
+!
+ IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
+!
+ IF ( CAOP=='EXPL' .AND. LDUST .AND. KMI==1) THEN
+ ALLOCATE( XEXT_COEFF_WVL_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
+ ALLOCATE( XEXT_COEFF_550_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST ) )
+ ALLOCATE( XPIZA_LKT_DUST ( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
+ ALLOCATE( XCGA_LKT_DUST ( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
+ END IF
+!
+ IF ( CAOP=='EXPL' .AND. LSALT .AND. KMI==1) THEN
+ ALLOCATE( XEXT_COEFF_WVL_LKT_SALT( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) )
+ ALLOCATE( XEXT_COEFF_550_LKT_SALT( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT ) )
+ ALLOCATE( XPIZA_LKT_SALT ( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) )
+ ALLOCATE( XCGA_LKT_SALT ( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) )
+ END IF
+!
+ CALL INI_RADIATIONS_ECMWF (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
+ CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
+ XSTATM, XOZON, XAER,XDST_WL, LSUBG_COND )
+!
+ ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
+ XAER_CLIM(:,:,:,:) =XAER(:,:,:,:)
+!
+ END IF
+
+ELSE IF (CRAD == 'ECRA') THEN
+#ifdef MNH_ECRAD
+!* get cover mask for aerosols
+!
+ IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
+!
+ CALL INI_RADIATIONS_ECRAD (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
+ CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
+ XSTATM, XOZON, XAER,XDST_WL, LSUBG_COND )
+
+ ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
+ XAER_CLIM(:,:,:,:) = XAER(:,:,:,:)
+!
+ END IF
+#endif
+ELSE
+ ALLOCATE (XOZON(0,0,0))
+ ALLOCATE (XAER(0,0,0,0))
+ ALLOCATE (XDST_WL(0,0,0,0))
+ ALLOCATE (XAER_CLIM(0,0,0,0))
+END IF
+!
+!
+!
+IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
+ IF (CGETCONV=='INIT') THEN
+ GINIDCONV=.TRUE.
+ ELSE
+ GINIDCONV=.FALSE.
+ END IF
+!
+! commensurability between convection calling time and time step
+!
+ XDTCONV=XTSTEP*REAL( INT( (MIN(XDTCONV,1800.)+1.E-10)/XTSTEP ) )
+ XDTCONV=MAX( XDTCONV, XTSTEP )
+ IF (NVERB>=10) THEN
+ WRITE(ILUOUT,*) 'XDTCONV has been set to : ',XDTCONV
+ END IF
+ CALL INI_DEEP_CONVECTION (TPINIFILE,GINIDCONV,TDTCUR, &
+ NCOUNTCONV,XDTHCONV,XDRVCONV,XDRCCONV, &
+ XDRICONV,XPRCONV,XPRSCONV,XPACCONV, &
+ XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV,&
+ XCAPE,NCLTOPCONV,NCLBASCONV, &
+ TDTDCONV, CGETSVCONV, XDSVCONV, &
+ LCH_CONV_LINOX, XIC_RATE, XCG_RATE, &
+ XIC_TOTAL_NUMBER, XCG_TOTAL_NUMBER )
+
+END IF
+!
+!
+!
+IF (CSCONV == 'EDKF') THEN
+ CALL INI_MFSHALL()
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 19. ALLOCATION OF THE TEMPORAL SERIES
+! ---------------------------------
+!
+IF (LSERIES .AND. CPROGRAM/='DIAG ') CALL INI_SERIES_n
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 20. (re)initialize scalar variables
+! -------------------------------
+!
+!
+IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
+ IF (CPROGRAM=='MESONH'.AND.CCONF=='RESTA') LCH_INIT_FIELD =.FALSE.
+ IF (CPROGRAM=='MESONH'.OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='IDEAL ') &
+ CALL CH_INIT_FIELD_n(KMI, ILUOUT, NVERB)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. UPDATE HALO
+! -----------
+!
+!
+CALL UPDATE_HALO_ll(TZINITHALO3D_ll,IINFO_ll)
+CALL UPDATE_HALO_ll(TZINITHALO2D_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZINITHALO3D_ll)
+CALL CLEANLIST_ll(TZINITHALO2D_ll)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. DEALLOCATION
+! -------------
+!
+DEALLOCATE(ZJ)
+!
+DEALLOCATE(XSTROATM)
+DEALLOCATE(XSMLSATM)
+DEALLOCATE(XSMLWATM)
+DEALLOCATE(XSPOSATM)
+DEALLOCATE(XSPOWATM)
+!
+!-------------------------------------------------------------------------------
+!
+!* 23. BALLOON and AIRCRAFT initializations
+! ------------------------------------
+!
+CALL INI_AIRCRAFT_BALLOON( TPINIFILE, XLATORI, XLONORI )
+!
+!-------------------------------------------------------------------------------
+!
+!* 24. STATION initializations
+! -----------------------
+!
+CALL INI_SURFSTATION_n( )
+!
+!-------------------------------------------------------------------------------
+!
+!* 25. PROFILER initializations
+! ------------------------
+!
+CALL INI_POSPROFILER_n( )
+!
+!-------------------------------------------------------------------------------
+!
+!* 26. Prognostic aerosols
+! ------------------------
+!
+IF ( ( CRAD=='ECMW' .OR. CRAD=='ECRA' ) .AND. CAOP=='EXPL' .AND. LORILAM ) THEN
+ IF(.NOT.ALLOCATED(POLYTAU)) ALLOCATE(POLYTAU(6,10,8,6,13))
+ IF(.NOT.ALLOCATED(POLYSSA)) ALLOCATE(POLYSSA(6,10,8,6,13))
+ IF(.NOT.ALLOCATED(POLYG)) ALLOCATE(POLYG (6,10,8,6,13))
+ CALL INI_AEROSET1
+ CALL INI_AEROSET2
+ CALL INI_AEROSET3
+ CALL INI_AEROSET4
+ CALL INI_AEROSET5
+ CALL INI_AEROSET6
+END IF
+#ifdef MNH_FOREFIRE
+!
+!-------------------------------------------------------------------------------
+!
+!* 27. FOREFIRE initializations
+! ------------------------
+!
+
+! Coupling with ForeFire if resolution is low enough
+!---------------------------------------------------
+IF ( LFOREFIRE .AND. 0.5*(XXHAT(2)-XXHAT(1)+XYHAT(2)-XYHAT(1)) < COUPLINGRES ) THEN
+ FFCOUPLING = .TRUE.
+ELSE
+ FFCOUPLING = .FALSE.
+ENDIF
+
+! Initializing the ForeFire variables
+!------------------------------------
+IF ( LFOREFIRE ) THEN
+ CALL INIT_FOREFIRE_n(KMI, ILUOUT, IP &
+ , TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, XTSTEP)
+END IF
+#endif
+
+!-------------------------------------------------------------------------------
+!
+!* 30. Total production/Loss for chemical species
+!
+IF (LCHEMDIAG) THEN
+ CALL CH_INIT_PRODLOSSTOT_n(ILUOUT)
+ IF (NEQ_PLT>0) THEN
+ ALLOCATE(XPROD(IIU,IJU,IKU,NEQ_PLT))
+ ALLOCATE(XLOSS(IIU,IJU,IKU,NEQ_PLT))
+ XPROD=0.0
+ XLOSS=0.0
+ ELSE
+ ALLOCATE(XPROD(0,0,0,0))
+ ALLOCATE(XLOSS(0,0,0,0))
+ END IF
+ELSE
+ ALLOCATE(XPROD(0,0,0,0))
+ ALLOCATE(XLOSS(0,0,0,0))
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 31. Extended production/loss terms for chemical species
+!
+IF (LCHEMDIAG) THEN
+ CALL CH_INIT_BUDGET_n(ILUOUT)
+ IF (NEQ_BUDGET>0) THEN
+ ALLOCATE(IINDEX(2,NNONZEROTERMS))
+ ALLOCATE(IIND(NEQ_BUDGET))
+ CALL CH_NONZEROTERMS(KMI,IINDEX,NNONZEROTERMS)
+ ALLOCATE(XTCHEM(NEQ_BUDGET))
+ DO JM=1,NEQ_BUDGET
+ IIND(JM)=COUNT((IINDEX(1,:))==NSPEC_BUDGET(JM))
+ ALLOCATE(XTCHEM(JM)%NB_REAC(IIND(JM)))
+ ALLOCATE(XTCHEM(JM)%XB_REAC(IIU,IJU,IKU,IIND(JM)))
+ END DO
+ DEALLOCATE(IIND)
+ DEALLOCATE(IINDEX)
+ ELSE
+ ALLOCATE(XTCHEM(0))
+ END IF
+ELSE
+ ALLOCATE(XTCHEM(0))
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 32. Wind turbine
+!
+IF (LMAIN_EOL .AND. KMI == NMODEL_EOL) THEN
+ ALLOCATE(XFX_RG(IIU,IJU,IKU))
+ ALLOCATE(XFY_RG(IIU,IJU,IKU))
+ ALLOCATE(XFZ_RG(IIU,IJU,IKU))
+ ALLOCATE(XFX_SMR_RG(IIU,IJU,IKU))
+ ALLOCATE(XFY_SMR_RG(IIU,IJU,IKU))
+ ALLOCATE(XFZ_SMR_RG(IIU,IJU,IKU))
+ SELECT CASE(CMETH_EOL)
+ CASE('ADNR')
+ CALL INI_EOL_ADNR
+ CASE('ALM')
+ CALL INI_EOL_ALM(XDXX,XDYY)
+ END SELECT
+END IF
+!
+!* 33. Auto-coupling Atmos-Ocean LES NH
+!
+IF (LCOUPLES) THEN
+ ALLOCATE(XSSUFL_C(IIU,IJU,1)); XSSUFL_C=0.0
+ ALLOCATE(XSSVFL_C(IIU,IJU,1)); XSSVFL_C=0.0
+ ALLOCATE(XSSTFL_C(IIU,IJU,1)); XSSTFL_C=0.0
+ ALLOCATE(XSSRFL_C(IIU,IJU,1)); XSSRFL_C=0.
+ELSE
+ ALLOCATE(XSSUFL_C(0,0,0))
+ ALLOCATE(XSSVFL_C(0,0,0))
+ ALLOCATE(XSSTFL_C(0,0,0))
+ ALLOCATE(XSSRFL_C(0,0,0))
+END IF
+!
+END SUBROUTINE INI_MODEL_n
diff --git a/src/PHYEX/ext/ini_nsv.f90 b/src/PHYEX/ext/ini_nsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0d7358737ad6b6fbc37b3254fb5867691b27b86d
--- /dev/null
+++ b/src/PHYEX/ext/ini_nsv.f90
@@ -0,0 +1,1237 @@
+!MNH_LIC Copyright 2001-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_INI_NSV
+! ###################
+INTERFACE
+!
+ SUBROUTINE INI_NSV(KMI)
+ INTEGER, INTENT(IN) :: KMI ! model index
+ END SUBROUTINE INI_NSV
+!
+END INTERFACE
+!
+END MODULE MODI_INI_NSV
+!
+!
+! ###########################
+ SUBROUTINE INI_NSV(KMI)
+! ###########################
+!
+!!**** *INI_NSV* - compute NSV_* values and indices for model KMI
+!!
+!! PURPOSE
+!! -------
+!
+!
+!
+!!** METHOD
+!! ------
+!!
+!! This routine is called from any routine which stores values in
+!! the first model module (for example READ_EXSEG).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_NSV : contains NSV_A array variable
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/01
+!! Modification 29/11/02 (Pinty) add SV for C3R5 and ELEC
+!! Modification 01/2004 (Masson) add scalar names
+!! Modification 03/2006 (O.Geoffroy) add KHKO scheme
+!! Modification 04/2007 (Leriche) add SV for aqueous chemistry
+!! M. Chong 26/01/10 Add Small ions
+!! Modification 07/2010 (Leriche) add SV for ice chemistry
+!! X.Pialat & J.Escobar 11/2012 remove deprecated line NSV_A(KMI) = ISV
+!! Modification 15/02/12 (Pialat/Tulet) Add SV for ForeFire scalars
+!! 03/2013 (C.Lac) add supersaturation as
+!! the 4th C2R2 scalar variable
+!! J.escobar 04/08/2015 suit Pb with writ_lfin JSA increment , modif in ini_nsv to have good order initialization
+!! Modification 01/2016 (JP Pinty) Add LIMA and LUSECHEM condition
+!! Modification 07/2017 (V. Vionnet) Add blowing snow condition
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
+! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! P. Wautelet 26/11/2021: initialize TSVLIST_A
+! A. Costes 12/2021: smoke tracer for fire model
+! P. Wautelet 14/01/2022: add CSV_CHEM_LIST(_A) to store the list of all chemical variables
+! + NSV_CHEM_LIST(_A) the size of the list
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BLOWSNOW, ONLY: CSNOWNAMES, LBLOWSNOW, NBLOWSNOW3D, YPSNOW_INI
+USE MODD_CH_AEROSOL
+! USE MODD_CH_AEROSOL, ONLY: CAERONAMES, CDEAERNAMES, JPMODE, LAERINIT, LDEPOS_AER, LORILAM, &
+! LVARSIGI, LVARSIGJ, NCARB, NM6_AER, NSOA, NSP
+USE MODD_CH_M9_n, ONLY: CICNAMES, CNAMES, NEQ, NEQAQ
+USE MODD_CH_MNHC_n, ONLY: LCH_PH, LUSECHEM, LUSECHAQ, LUSECHIC, CCH_SCHEME, LCH_CONV_LINOX
+USE MODD_CONDSAMP, ONLY: LCONDSAMP, NCONDSAMP
+USE MODD_CONF, ONLY: LLG, CPROGRAM, NVERB
+USE MODD_CST, ONLY: XMNH_TINY
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, LCHAQDIAG
+USE MODD_DUST, ONLY: CDEDSTNAMES, CDUSTNAMES, JPDUSTORDER, LDEPOS_DST, LDSTINIT, LDSTPRES, LDUST, &
+ LRGFIX_DST, LVARSIG, NMODE_DST, YPDEDST_INI, YPDUST_INI
+USE MODD_DYN_n, ONLY: LHORELAX_SV,LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
+ LHORELAX_SVFIRE, LHORELAX_SVLIMA, &
+ LHORELAX_SVELEC,LHORELAX_SVCHEM,LHORELAX_SVLG, &
+ LHORELAX_SVDST,LHORELAX_SVAER, LHORELAX_SVSLT, &
+ LHORELAX_SVPP,LHORELAX_SVCS, LHORELAX_SVCHIC, &
+ LHORELAX_SVSNW
+#ifdef MNH_FOREFIRE
+USE MODD_DYN_n, ONLY: LHORELAX_SVFF
+#endif
+USE MODD_ELEC_DESCR, ONLY: LLNOX_EXPLICIT
+USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
+USE MODD_FIRE_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
+USE MODD_LG, ONLY: CLGNAMES, XLG1MIN, XLG2MIN, XLG3MIN
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAM_C2R2, ONLY: LSUPSAT
+USE MODD_PARAMETERS, ONLY: NCOMMENTLGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX
+USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM, NIMM, NMOD_CCN, NMOD_IFN, NMOD_IMM, PARAM_LIMA_ALLOCATE, PARAM_LIMA_DEALLOCATE
+USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
+USE MODD_PARAM_LIMA_WARM, ONLY: CAERO_MASS, CLIMA_WARM_NAMES
+USE MODD_PARAM_n, ONLY: CCLOUD, CELEC
+USE MODD_PASPOL, ONLY: LPASPOL, NRELEASE
+USE MODD_PREP_REAL, ONLY: XT_LS
+USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
+USE MODD_SALT, ONLY: CSALTNAMES, CDESLTNAMES, JPSALTORDER, &
+ LRGFIX_SLT, LSALT, LSLTINIT, LSLTPRES, LDEPOS_SLT, LVARSIG_SLT, NMODE_SLT, YPDESLT_INI, YPSALT_INI
+
+USE MODE_MSG
+USE MODE_LIMA_UPDATE_NSV, ONLY: LIMA_UPDATE_NSV
+
+USE MODI_CH_AER_INIT_SOA, ONLY: CH_AER_INIT_SOA
+USE MODI_CH_INIT_SCHEME_n, ONLY: CH_INIT_SCHEME_n
+USE MODI_UPDATE_NSV, ONLY: UPDATE_NSV
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.1 Declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI ! model index
+!
+!* 0.2 Declarations of local variables
+!
+CHARACTER(LEN=2) :: YNUM2
+CHARACTER(LEN=3) :: YNUM3
+CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT
+CHARACTER(LEN=NUNITLGTMAX) :: YUNITS
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YAEROLONGNAMES
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YDUSTLONGNAMES
+CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YSALTLONGNAMES
+INTEGER :: ILUOUT
+INTEGER :: ICHIDX ! Index for position in CSV_CHEM_LIST_A array
+INTEGER :: ISV ! total number of scalar variables
+INTEGER :: IMODEIDX
+INTEGER :: JAER
+INTEGER :: JI, JJ, JSV
+INTEGER :: JMODE, JMOM, JSV_NAME
+INTEGER :: INMOMENTS_DST, INMOMENTS_SLT !Number of moments for dust or salt
+!
+!-------------------------------------------------------------------------------
+!
+
+!Associate the pointers
+CALL NSV_ASSOCIATE
+!
+LINI_NSV(KMI) = .TRUE.
+
+ILUOUT = TLUOUT%NLU
+
+ICHIDX = 0
+NSV_CHEM_LIST_A(KMI) = 0
+!
+! Users scalar variables are first considered
+!
+NSV_USER_A(KMI) = NSV_USER
+ISV = NSV_USER
+!
+! scalar variables used in microphysical schemes C2R2,KHKO and C3R5
+!
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) THEN
+ IF ((CCLOUD == 'C2R2' .AND. LSUPSAT) .OR. (CCLOUD == 'KHKO'.AND. LSUPSAT)) THEN
+ ! 4th scalar field = supersaturation
+ NSV_C2R2_A(KMI) = 4
+ ELSE
+ NSV_C2R2_A(KMI) = 3
+ END IF
+ NSV_C2R2BEG_A(KMI) = ISV+1
+ NSV_C2R2END_A(KMI) = ISV+NSV_C2R2_A(KMI)
+ ISV = NSV_C2R2END_A(KMI)
+ IF (CCLOUD == 'C3R5') THEN ! the SVs for C2R2 and C1R3 must be contiguous
+ NSV_C1R3_A(KMI) = 2
+ NSV_C1R3BEG_A(KMI) = ISV+1
+ NSV_C1R3END_A(KMI) = ISV+NSV_C1R3_A(KMI)
+ ISV = NSV_C1R3END_A(KMI)
+ ELSE
+ NSV_C1R3_A(KMI) = 0
+ ! force First index to be superior to last index
+ ! in order to create a null section
+ NSV_C1R3BEG_A(KMI) = 1
+ NSV_C1R3END_A(KMI) = 0
+ END IF
+ELSE
+ NSV_C2R2_A(KMI) = 0
+ NSV_C1R3_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_C2R2BEG_A(KMI) = 1
+ NSV_C2R2END_A(KMI) = 0
+ NSV_C1R3BEG_A(KMI) = 1
+ NSV_C1R3END_A(KMI) = 0
+END IF
+!
+! scalar variables used in the LIMA microphysical scheme
+!
+CALL LIMA_UPDATE_NSV(LDINIT=.TRUE., KMI=KMI, KSV=ISV, CDCLOUD=CCLOUD, LDUPDATE=.FALSE.)
+IF (CCLOUD == 'LIMA' ) THEN
+
+ IF ( NMOD_IFN > 0 ) THEN
+ IF ( .NOT. ASSOCIATED( NIMM ) ) CALL PARAM_LIMA_ALLOCATE('NIMM', NMOD_CCN)
+ NIMM(:) = 0
+ IF ( ASSOCIATED( NINDICE_CCN_IMM ) ) CALL PARAM_LIMA_DEALLOCATE('NINDICE_CCN_IMM')
+ CALL PARAM_LIMA_ALLOCATE('NINDICE_CCN_IMM', MAX( 1, NMOD_IMM ))
+ IF (NMOD_IMM > 0 ) THEN
+ DO JI = 0, NMOD_IMM - 1
+ NIMM(NMOD_CCN - JI) = 1
+ NINDICE_CCN_IMM(NMOD_IMM - JI) = NMOD_CCN - JI
+ END DO
+! ELSE IF (NMOD_IMM == 0) THEN ! PNIS exists but is 0 for the call to resolved_cloud
+! NMOD_IMM = 1
+! NINDICE_CCN_IMM(1) = 0
+ END IF
+ END IF
+END IF ! CCLOUD = LIMA
+!
+!
+! Add one scalar for negative ion
+! First variable: positive ion (NSV_ELECBEG_A index number)
+! Last --------: negative ion (NSV_ELECEND_A index number)
+! Correspondence for ICE3:
+! Relative index 1 2 3 4 5 6 7
+! Charge for ion+ cloud rain ice snow graupel ion-
+!
+! Correspondence for ICE4:
+! Relative index 1 2 3 4 5 6 7 8
+! Charge for ion+ cloud rain ice snow graupel hail ion-
+!
+IF (CELEC /= 'NONE') THEN
+ IF (CCLOUD == 'ICE3') THEN
+ NSV_ELEC_A(KMI) = 7
+ NSV_ELECBEG_A(KMI)= ISV+1
+ NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
+ ISV = NSV_ELECEND_A(KMI)
+ CELECNAMES(7) = CELECNAMES(8)
+ ELSE IF (CCLOUD == 'ICE4') THEN
+ NSV_ELEC_A(KMI) = 8
+ NSV_ELECBEG_A(KMI)= ISV+1
+ NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
+ ISV = NSV_ELECEND_A(KMI)
+ END IF
+ELSE
+ NSV_ELEC_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_ELECBEG_A(KMI) = 1
+ NSV_ELECEND_A(KMI) = 0
+END IF
+!
+! scalar variables used as lagragian variables
+!
+IF (LLG) THEN
+ NSV_LG_A(KMI) = 3
+ NSV_LGBEG_A(KMI) = ISV+1
+ NSV_LGEND_A(KMI) = ISV+NSV_LG_A(KMI)
+ ISV = NSV_LGEND_A(KMI)
+ELSE
+ NSV_LG_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_LGBEG_A(KMI) = 1
+ NSV_LGEND_A(KMI) = 0
+END IF
+!
+! scalar variables used as LiNOX passive tracer
+!
+! In case without chemistry
+IF (LPASPOL) THEN
+ NSV_PP_A(KMI) = NRELEASE
+ NSV_PPBEG_A(KMI)= ISV+1
+ NSV_PPEND_A(KMI)= ISV+NSV_PP_A(KMI)
+ ISV = NSV_PPEND_A(KMI)
+ELSE
+ NSV_PP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_PPBEG_A(KMI)= 1
+ NSV_PPEND_A(KMI)= 0
+END IF
+!
+#ifdef MNH_FOREFIRE
+! ForeFire tracers
+IF (LFOREFIRE .AND. NFFSCALARS .GT. 0) THEN
+ NSV_FF_A(KMI) = NFFSCALARS
+ NSV_FFBEG_A(KMI) = ISV+1
+ NSV_FFEND_A(KMI) = ISV+NSV_FF_A(KMI)
+ ISV = NSV_FFEND_A(KMI)
+ELSE
+ NSV_FF_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_FFBEG_A(KMI)= 1
+ NSV_FFEND_A(KMI)= 0
+END IF
+#endif
+! Blaze tracers
+IF (LBLAZE .AND. NNBSMOKETRACER .GT. 0) THEN
+ NSV_FIRE_A(KMI) = NNBSMOKETRACER
+ NSV_FIREBEG_A(KMI) = ISV+1
+ NSV_FIREEND_A(KMI) = ISV+NSV_FIRE_A(KMI)
+ ISV = NSV_FIREEND_A(KMI)
+ELSE
+ NSV_FIRE_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_FIREBEG_A(KMI)= 1
+ NSV_FIREEND_A(KMI)= 0
+END IF
+!
+! Conditional sampling variables
+IF (LCONDSAMP) THEN
+ NSV_CS_A(KMI) = NCONDSAMP
+ NSV_CSBEG_A(KMI)= ISV+1
+ NSV_CSEND_A(KMI)= ISV+NSV_CS_A(KMI)
+ ISV = NSV_CSEND_A(KMI)
+ELSE
+ NSV_CS_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_CSBEG_A(KMI)= 1
+ NSV_CSEND_A(KMI)= 0
+END IF
+!
+! scalar variables used in chemical core system
+!
+IF (LUSECHEM) THEN
+ CALL CH_INIT_SCHEME_n(KMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
+ IF (LORILAM) CALL CH_AER_INIT_SOA(ILUOUT, NVERB)
+END IF
+
+IF (LUSECHEM .AND.(NEQ .GT. 0)) THEN
+ NSV_CHEM_A(KMI) = NEQ
+ NSV_CHEMBEG_A(KMI)= ISV+1
+ NSV_CHEMEND_A(KMI)= ISV+NSV_CHEM_A(KMI)
+ ISV = NSV_CHEMEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_CHEM_A(KMI)
+ELSE
+ NSV_CHEM_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_CHEMBEG_A(KMI)= 1
+ NSV_CHEMEND_A(KMI)= 0
+END IF
+!
+! aqueous chemistry (part of the "chem" variables)
+!
+IF ((LUSECHAQ .OR. LCHAQDIAG).AND.(NEQ .GT. 0)) THEN
+ NSV_CHGS_A(KMI) = NEQ-NEQAQ
+ NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI)
+ NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1
+ NSV_CHAC_A(KMI) = NEQAQ
+ NSV_CHACBEG_A(KMI)= NSV_CHGSEND_A(KMI)+1
+ NSV_CHACEND_A(KMI)= NSV_CHEMEND_A(KMI)
+! ice phase chemistry
+ IF (LUSECHIC) THEN
+ NSV_CHIC_A(KMI) = NEQAQ/2. -1.
+ NSV_CHICBEG_A(KMI)= ISV+1
+ NSV_CHICEND_A(KMI)= ISV+NSV_CHIC_A(KMI)
+ ISV = NSV_CHICEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_CHIC_A(KMI)
+ ELSE
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ENDIF
+ELSE
+ IF (NEQ .GT. 0) THEN
+ NSV_CHGS_A(KMI) = NEQ-NEQAQ
+ NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI)
+ NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1
+ NSV_CHAC_A(KMI) = 0
+ NSV_CHACBEG_A(KMI)= 1
+ NSV_CHACEND_A(KMI)= 0
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ELSE
+ NSV_CHGS_A(KMI) = 0
+ NSV_CHGSBEG_A(KMI)= 1
+ NSV_CHGSEND_A(KMI)= 0
+ NSV_CHAC_A(KMI) = 0
+ NSV_CHACBEG_A(KMI)= 1
+ NSV_CHACEND_A(KMI)= 0
+ NSV_CHIC_A(KMI) = 0
+ NSV_CHICBEG_A(KMI)= 1
+ NSV_CHICEND_A(KMI)= 0
+ ENDIF
+END IF
+! aerosol variables
+IF (LORILAM.AND.(NEQ .GT. 0)) THEN
+ NM6_AER = 0
+ IF (LVARSIGI) NM6_AER = 1
+ IF (LVARSIGJ) NM6_AER = NM6_AER + 1
+ NSV_AER_A(KMI) = (NSP+NCARB+NSOA+1)*JPMODE + NM6_AER
+ NSV_AERBEG_A(KMI)= ISV+1
+ NSV_AEREND_A(KMI)= ISV+NSV_AER_A(KMI)
+ ISV = NSV_AEREND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_AER_A(KMI)
+
+ ALLOCATE( YAEROLONGNAMES(NSV_AER_A(KMI)) )
+ELSE
+ NSV_AER_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_AERBEG_A(KMI)= 1
+ NSV_AEREND_A(KMI)= 0
+END IF
+IF (LORILAM .AND. LDEPOS_AER(KMI)) THEN
+ NSV_AERDEP_A(KMI) = JPMODE*2
+ NSV_AERDEPBEG_A(KMI)= ISV+1
+ NSV_AERDEPEND_A(KMI)= ISV+NSV_AERDEP_A(KMI)
+ ISV = NSV_AERDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_AERDEP_A(KMI)
+ELSE
+ NSV_AERDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_AERDEPBEG_A(KMI)= 1
+ NSV_AERDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+END IF
+!
+! scalar variables used in dust model
+!
+IF (LDUST) THEN
+ IF (ALLOCATED(XT_LS).AND. .NOT.(LDSTPRES)) LDSTINIT=.TRUE.
+ IF (CPROGRAM == 'IDEAL ') LVARSIG = .TRUE.
+ IF ((CPROGRAM == 'REAL ').AND.LDSTINIT) LVARSIG = .TRUE.
+ !Determine number of moments
+ IF ( LRGFIX_DST ) THEN
+ INMOMENTS_DST = 1
+ IF ( LVARSIG ) CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'LVARSIG forced to FALSE because LRGFIX_DST is TRUE' )
+ LVARSIG = .FALSE.
+ ELSE IF ( LVARSIG ) THEN
+ INMOMENTS_DST = 3
+ ELSE
+ INMOMENTS_DST = 2
+ END IF
+ !Number of entries = number of moments multiplied by number of modes
+ NSV_DST_A(KMI) = NMODE_DST * INMOMENTS_DST
+ NSV_DSTBEG_A(KMI)= ISV+1
+ NSV_DSTEND_A(KMI)= ISV+NSV_DST_A(KMI)
+ ISV = NSV_DSTEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_DST_A(KMI)
+ELSE
+ NSV_DST_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_DSTBEG_A(KMI)= 1
+ NSV_DSTEND_A(KMI)= 0
+END IF
+IF ( LDUST .AND. LDEPOS_DST(KMI) ) THEN
+ NSV_DSTDEP_A(KMI) = NMODE_DST*2
+ NSV_DSTDEPBEG_A(KMI)= ISV+1
+ NSV_DSTDEPEND_A(KMI)= ISV+NSV_DSTDEP_A(KMI)
+ ISV = NSV_DSTDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_DSTDEP_A(KMI)
+ELSE
+ NSV_DSTDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_DSTDEPBEG_A(KMI)= 1
+ NSV_DSTDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+
+ END IF
+! scalar variables used in sea salt model
+!
+IF (LSALT) THEN
+ IF (ALLOCATED(XT_LS).AND. .NOT.(LSLTPRES)) LSLTINIT=.TRUE.
+ IF (CPROGRAM == 'IDEAL ') LVARSIG_SLT = .TRUE.
+ IF ((CPROGRAM == 'REAL ').AND. LSLTINIT ) LVARSIG_SLT = .TRUE.
+ !Determine number of moments
+ IF ( LRGFIX_SLT ) THEN
+ INMOMENTS_SLT = 1
+ IF ( LVARSIG_SLT ) CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'LVARSIG_SLT forced to FALSE because LRGFIX_SLT is TRUE' )
+ LVARSIG_SLT = .FALSE.
+ ELSE IF ( LVARSIG_SLT ) THEN
+ INMOMENTS_SLT = 3
+ ELSE
+ INMOMENTS_SLT = 2
+ END IF
+ !Number of entries = number of moments multiplied by number of modes
+ NSV_SLT_A(KMI) = NMODE_SLT * INMOMENTS_SLT
+ NSV_SLTBEG_A(KMI)= ISV+1
+ NSV_SLTEND_A(KMI)= ISV+NSV_SLT_A(KMI)
+ ISV = NSV_SLTEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_SLT_A(KMI)
+ELSE
+ NSV_SLT_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SLTBEG_A(KMI)= 1
+ NSV_SLTEND_A(KMI)= 0
+END IF
+IF ( LSALT .AND. LDEPOS_SLT(KMI) ) THEN
+ NSV_SLTDEP_A(KMI) = NMODE_SLT*2
+ NSV_SLTDEPBEG_A(KMI)= ISV+1
+ NSV_SLTDEPEND_A(KMI)= ISV+NSV_SLTDEP_A(KMI)
+ ISV = NSV_SLTDEPEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_SLTDEP_A(KMI)
+ELSE
+ NSV_SLTDEP_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SLTDEPBEG_A(KMI)= 1
+ NSV_SLTDEPEND_A(KMI)= 0
+! force First index to be superior to last index
+! in order to create a null section
+END IF
+!
+! scalar variables used in blowing snow model
+!
+IF (LBLOWSNOW) THEN
+ NSV_SNW_A(KMI) = NBLOWSNOW3D
+ NSV_SNWBEG_A(KMI)= ISV+1
+ NSV_SNWEND_A(KMI)= ISV+NSV_SNW_A(KMI)
+ ISV = NSV_SNWEND_A(KMI)
+ELSE
+ NSV_SNW_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_SNWBEG_A(KMI)= 1
+ NSV_SNWEND_A(KMI)= 0
+END IF
+!
+! scalar variables used as LiNOX passive tracer
+!
+! In case without chemistry
+IF (.NOT.(LUSECHEM.OR.LCHEMDIAG) .AND. (LCH_CONV_LINOX.OR.LLNOX_EXPLICIT)) THEN
+ NSV_LNOX_A(KMI) = 1
+ NSV_LNOXBEG_A(KMI)= ISV+1
+ NSV_LNOXEND_A(KMI)= ISV+NSV_LNOX_A(KMI)
+ ISV = NSV_LNOXEND_A(KMI)
+ NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_LNOX_A(KMI)
+ELSE
+ NSV_LNOX_A(KMI) = 0
+! force First index to be superior to last index
+! in order to create a null section
+ NSV_LNOXBEG_A(KMI)= 1
+ NSV_LNOXEND_A(KMI)= 0
+END IF
+!
+! Final number of NSV variables
+!
+NSV_A(KMI) = ISV
+!
+!
+!* Update LHORELAX_SV,CGETSVM,CGETSVT for NON USER SV
+!
+! C2R2 or KHKO SV case
+!*BUG*JPC*MAR2006
+! IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) &
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) &
+!*BUG*JPC*MAR2006
+LHORELAX_SV(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=LHORELAX_SVC2R2
+! C3R5 SV case
+IF (CCLOUD == 'C3R5') &
+LHORELAX_SV(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=LHORELAX_SVC1R3
+! LIMA SV case
+IF (CCLOUD == 'LIMA') &
+LHORELAX_SV(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=LHORELAX_SVLIMA
+! Electrical SV case
+IF (CELEC /= 'NONE') &
+LHORELAX_SV(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=LHORELAX_SVELEC
+! Chemical SV case
+IF (LUSECHEM .OR. LCHEMDIAG) &
+LHORELAX_SV(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=LHORELAX_SVCHEM
+! Ice phase Chemical SV case
+IF (LUSECHIC) &
+LHORELAX_SV(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=LHORELAX_SVCHIC
+! LINOX SV case
+IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) &
+LHORELAX_SV(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=LHORELAX_SVCHEM
+! Dust SV case
+IF (LDUST) &
+LHORELAX_SV(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=LHORELAX_SVDST
+! Sea Salt SV case
+IF (LSALT) &
+LHORELAX_SV(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=LHORELAX_SVSLT
+! Aerosols SV case
+IF (LORILAM) &
+LHORELAX_SV(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=LHORELAX_SVAER
+! Lagrangian variables
+IF (LLG) &
+LHORELAX_SV(NSV_LGBEG_A(KMI):NSV_LGEND_A(KMI))=LHORELAX_SVLG
+! Passive pollutants
+IF (LPASPOL) &
+LHORELAX_SV(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=LHORELAX_SVPP
+#ifdef MNH_FOREFIRE
+! Fire pollutants
+IF (LFOREFIRE) &
+LHORELAX_SV(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=LHORELAX_SVFF
+#endif
+! Blaze Fire pollutants
+IF (LBLAZE) &
+LHORELAX_SV(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=LHORELAX_SVFIRE
+! Conditional sampling
+IF (LCONDSAMP) &
+LHORELAX_SV(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=LHORELAX_SVCS
+! Blowing snow case
+IF (LBLOWSNOW) &
+LHORELAX_SV(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=LHORELAX_SVSNW
+! Update NSV* variables for model KMI
+CALL UPDATE_NSV(KMI)
+!
+! SET MINIMUN VALUE FOR DIFFERENT SV GROUPS
+!
+XSVMIN(1:NSV_USER_A(KMI))=0.
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) &
+XSVMIN(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=0.
+IF (CCLOUD == 'C3R5') &
+XSVMIN(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=0.
+IF (CCLOUD == 'LIMA') &
+XSVMIN(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=0.
+IF (CELEC /= 'NONE') &
+XSVMIN(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=0.
+IF (LUSECHEM .OR. LCHEMDIAG) &
+XSVMIN(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=0.
+IF (LUSECHIC) &
+XSVMIN(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=0.
+IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) &
+XSVMIN(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=0.
+IF (LORILAM .OR. LCHEMDIAG) &
+XSVMIN(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=0.
+IF (LDUST) XSVMIN(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=XMNH_TINY
+IF ((LDUST).AND.(LDEPOS_DST(KMI))) &
+XSVMIN(NSV_DSTDEPBEG_A(KMI):NSV_DSTDEPEND_A(KMI))=XMNH_TINY
+IF (LSALT) XSVMIN(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=XMNH_TINY
+IF (LLG) THEN
+ XSVMIN(NSV_LGBEG_A(KMI)) =XLG1MIN
+ XSVMIN(NSV_LGBEG_A(KMI)+1)=XLG2MIN
+ XSVMIN(NSV_LGEND_A(KMI)) =XLG3MIN
+ENDIF
+IF ((LSALT).AND.(LDEPOS_SLT(KMI))) &
+XSVMIN(NSV_SLTDEPBEG_A(KMI):NSV_SLTDEPEND_A(KMI))=XMNH_TINY
+IF ((LORILAM).AND.(LDEPOS_AER(KMI))) &
+XSVMIN(NSV_AERDEPBEG_A(KMI):NSV_AERDEPEND_A(KMI))=XMNH_TINY
+IF (LPASPOL) XSVMIN(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=0.
+#ifdef MNH_FOREFIRE
+IF (LFOREFIRE) XSVMIN(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=0.
+#endif
+! Blaze smoke
+IF (LBLAZE) XSVMIN(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=0.
+!
+IF (LCONDSAMP) XSVMIN(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=0.
+IF (LBLOWSNOW) XSVMIN(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=XMNH_TINY
+!
+! NAME OF THE SCALAR VARIABLES IN THE DIFFERENT SV GROUPS
+!
+CSV_A(:, KMI) = ' '
+IF (LLG) THEN
+ CSV_A(NSV_LGBEG_A(KMI), KMI) = 'X0 '
+ CSV_A(NSV_LGBEG_A(KMI)+1, KMI) = 'Y0 '
+ CSV_A(NSV_LGEND_A(KMI), KMI) = 'Z0 '
+ENDIF
+
+! Initialize scalar variable names for dust
+IF ( LDUST ) THEN
+ IF ( NMODE_DST < 1 .OR. NMODE_DST > 3 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_DST must in the 1 to 3 interval' )
+
+ ! Initialization of dust names
+ ! Was allocated for previous KMI
+ ! We assume that if LDUST=T on a model, NSV_DST_A(KMI) is the same for all
+ IF( .NOT. ALLOCATED( CDUSTNAMES ) ) THEN
+ ALLOCATE( CDUSTNAMES(NSV_DST_A(KMI)) )
+ ELSE IF ( SIZE( CDUSTNAMES ) /= NSV_DST_A(KMI) ) THEN
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_DST not the same for different model (if LDUST=T)' )
+ DEALLOCATE( CDUSTNAMES )
+ ALLOCATE( CDUSTNAMES(NSV_DST_A(KMI)) )
+ END IF
+ ALLOCATE( YDUSTLONGNAMES(NSV_DST_A(KMI)) )
+ !Loop on all dust modes
+ IF ( INMOMENTS_DST == 1 ) THEN
+ DO JMODE = 1, NMODE_DST
+ IMODEIDX = JPDUSTORDER(JMODE)
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
+ CDUSTNAMES(JMODE) = YPDUST_INI(JSV_NAME)
+ !Add meaning of the ppv unit (here for moment 3)
+ YDUSTLONGNAMES(JMODE) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ END DO
+ ELSE
+ DO JMODE = 1,NMODE_DST
+ !Find which mode we are dealing with
+ IMODEIDX = JPDUSTORDER(JMODE)
+ DO JMOM = 1, INMOMENTS_DST
+ !Find which number this is of the list of scalars
+ JSV = ( JMODE - 1 ) * INMOMENTS_DST + JMOM
+ !Find what name this corresponds to, always 3 moments assumed in YPDUST_INI
+ JSV_NAME = ( IMODEIDX - 1) * 3 + JMOM
+ !Get the right CDUSTNAMES which should follow the list of scalars transported in XSVM/XSVT
+ CDUSTNAMES(JSV) = YPDUST_INI(JSV_NAME)
+ !Add meaning of the ppv unit
+ IF ( JMOM == 1 ) THEN !Corresponds to moment 0
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( JMOM == 2 ) THEN !Corresponds to moment 3
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( JMOM == 3 ) THEN !Corresponds to moment 6
+ YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for DUST' )
+ YDUSTLONGNAMES(JMODE) = TRIM( YPDUST_INI(JSV_NAME) )
+ END IF
+ ENDDO ! Loop on moments
+ ENDDO ! Loop on dust modes
+ END IF
+
+ ! Initialization of deposition scheme names
+ IF ( LDEPOS_DST(KMI) ) THEN
+ IF( .NOT. ALLOCATED( CDEDSTNAMES ) ) THEN
+ ALLOCATE( CDEDSTNAMES(NMODE_DST * 2) )
+ DO JMODE = 1, NMODE_DST
+ IMODEIDX = JPDUSTORDER(JMODE)
+ CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX)
+ CDEDSTNAMES(NMODE_DST + JMODE) = YPDEDST_INI(NMODE_DST + IMODEIDX)
+ ENDDO
+ END IF
+ END IF
+END IF
+
+! Initialize scalar variable names for salt
+IF ( LSALT ) THEN
+ IF ( NMODE_SLT < 1 .OR. NMODE_SLT > 8 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_SLT must in the 1 to 8 interval' )
+
+ ! Was allocated for previous KMI
+ ! We assume that if LSALT=T on a model, NSV_SLT_A(KMI) is the same for all
+ IF( .NOT. ALLOCATED( CSALTNAMES ) ) THEN
+ ALLOCATE( CSALTNAMES(NSV_SLT_A(KMI)) )
+ ELSE IF ( SIZE( CSALTNAMES ) /= NSV_SLT_A(KMI) ) THEN
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_SLT not the same for different model (if LSALT=T)' )
+ DEALLOCATE( CSALTNAMES )
+ ALLOCATE( CSALTNAMES(NSV_SLT_A(KMI)) )
+ END IF
+ ALLOCATE( YSALTLONGNAMES(NSV_SLT_A(KMI)) )
+ !Loop on all dust modes
+ IF ( INMOMENTS_SLT == 1 ) THEN
+ DO JMODE = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JMODE)
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
+ CSALTNAMES(JMODE) = YPSALT_INI(JSV_NAME)
+ !Add meaning of the ppv unit (here for moment 3)
+ YSALTLONGNAMES(JMODE) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ END DO
+ ELSE
+ DO JMODE = 1, NMODE_SLT
+ !Find which mode we are dealing with
+ IMODEIDX = JPSALTORDER(JMODE)
+ DO JMOM = 1, INMOMENTS_SLT
+ !Find which number this is of the list of scalars
+ JSV = ( JMODE - 1 ) * INMOMENTS_SLT + JMOM
+ !Find what name this corresponds to, always 3 moments assumed in YPSALT_INI
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + JMOM
+ !Get the right CSALTNAMES which should follow the list of scalars transported in XSVM/XSVT
+ CSALTNAMES(JSV) = YPSALT_INI(JSV_NAME)
+ !Add meaning of the ppv unit
+ IF ( JMOM == 1 ) THEN !Corresponds to moment 0
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( JMOM == 2 ) THEN !Corresponds to moment 3
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( JMOM == 3 ) THEN !Corresponds to moment 6
+ YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for SALT' )
+ YSALTLONGNAMES(JMODE) = TRIM( YPSALT_INI(JSV_NAME) )
+ END IF
+ ENDDO ! Loop on moments
+ ENDDO ! Loop on dust modes
+ END IF
+
+ ! Initialization of deposition scheme
+ IF ( LDEPOS_SLT(KMI) ) THEN
+ IF( .NOT. ALLOCATED( CDESLTNAMES ) ) THEN
+ ALLOCATE( CDESLTNAMES(NMODE_SLT * 2) )
+ DO JMODE = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JMODE)
+ CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
+ CDESLTNAMES(NMODE_SLT + JMODE) = YPDESLT_INI(NMODE_SLT + IMODEIDX)
+ ENDDO
+ ENDIF
+ ENDIF
+END IF
+
+! Initialize scalar variable names for snow
+IF ( LBLOWSNOW ) THEN
+ IF( .NOT. ALLOCATED( CSNOWNAMES ) ) THEN
+ ALLOCATE( CSNOWNAMES(NSV_SNW_A(KMI)) )
+ DO JMOM = 1, NSV_SNW_A(KMI)
+ CSNOWNAMES(JMOM) = YPSNOW_INI(JMOM)
+ END DO
+ END IF
+END IF
+
+!Fill metadata for model KMI
+DO JSV = 1, NSV_USER_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVUSER' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVUSER' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVUSER' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_C2R2BEG_A(KMI), NSV_C2R2END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CUNITS = 'm-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_C1R3BEG_A(KMI), NSV_C1R3END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( C1R3NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( C1R3NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
+ CUNITS = 'm-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_LIMA_BEG_A(KMI), NSV_LIMA_END_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SV LIMA ' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = '', &
+ CUNITS = 'kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ IF ( JSV == NSV_LIMA_NC_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(1) )
+ ELSE IF ( JSV == NSV_LIMA_NR_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(2) )
+ ELSE IF ( JSV >= NSV_LIMA_CCN_FREE_A(KMI) .AND. JSV < NSV_LIMA_CCN_ACTI_A(KMI) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_FREE_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(3) ) // YNUM2
+ ELSE IF (JSV >= NSV_LIMA_CCN_ACTI_A(KMI) .AND. JSV < ( NSV_LIMA_CCN_ACTI_A(KMI) + NMOD_CCN ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_ACTI_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(4) ) // YNUM2
+ ELSE IF ( JSV == NSV_LIMA_SCAVMASS_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CAERO_MASS(1) )
+ TSVLIST_A(JSV, KMI)%CUNITS = 'kg kg-1'
+ ELSE IF ( JSV == NSV_LIMA_NI_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(1) )
+ ELSE IF ( JSV == NSV_LIMA_NS_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(2) )
+ ELSE IF ( JSV == NSV_LIMA_NG_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(3) )
+ ELSE IF ( JSV == NSV_LIMA_NH_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(4) )
+ ELSE IF ( JSV >= NSV_LIMA_IFN_FREE_A(KMI) .AND. JSV < NSV_LIMA_IFN_NUCL_A(KMI) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_FREE_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(5) ) // YNUM2
+ ELSE IF ( JSV >= NSV_LIMA_IFN_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IFN_NUCL_A(KMI) + NMOD_IFN ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_NUCL_A(KMI) + 1
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(6) ) // YNUM2
+ ELSE IF ( JSV >= NSV_LIMA_IMM_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IMM_NUCL_A(KMI) + NMOD_IMM ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) NINDICE_CCN_IMM(JSV-NSV_LIMA_IMM_NUCL_A(KMI)+1)
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(7) ) // YNUM2
+ ELSE IF ( JSV == NSV_LIMA_HOM_HAZE_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(8) )
+ ELSE IF ( JSV == NSV_LIMA_SPRO_A(KMI) ) THEN
+ TSVLIST_A(JSV, KMI)%CUNITS = '1'
+ TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(5) )
+ ELSE
+ CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'invalid index for LIMA' )
+ END IF
+
+ TSVLIST_A(JSV, KMI)%CLONGNAME = TRIM( TSVLIST_A(JSV, KMI)%CMNHNAME )
+END DO
+
+DO JSV = NSV_ELECBEG_A(KMI), NSV_ELECEND_A(KMI)
+ IF ( JSV > NSV_ELECBEG .AND. JSV < NSV_ELECEND ) THEN
+ YUNITS = 'C kg-1'
+ WRITE( YCOMMENT, '( A6, A3, I3.3 )' ) 'X_Y_Z_', 'SVT', JSV
+ ELSE
+ YUNITS = 'kg-1'
+ WRITE( YCOMMENT, '( A6, A3, I3.3, A8 )' ) 'X_Y_Z_', 'SVT', JSV, ' (nb ions/kg)'
+ END IF
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ), &
+ CUNITS = TRIM( YUNITS ), &
+ CDIR = 'XY', &
+ CCOMMENT = TRIM( YCOMMENT ), &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_LGBEG_A(KMI), NSV_LGEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ), &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_PPBEG_A(KMI), NSV_PPEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_PPBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVPP' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVPP' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+#ifdef MNH_FOREFIRE
+DO JSV = NSV_FFBEG_A(KMI), NSV_FFEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FFBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVFF' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVFF' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+#endif
+
+DO JSV = NSV_FIREBEG_A(KMI), NSV_FIREEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FIREBEG_A(KMI)+1
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVFIRE' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVFIRE' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CSBEG_A(KMI), NSV_CSEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_CSBEG_A(KMI)
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'SVCS' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'SVCS' // YNUM3, &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CHEMBEG_A(KMI), NSV_CHEMEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_CHICBEG_A(KMI), NSV_CHICEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_AERBEG_A(KMI), NSV_AEREND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ !Determine moment to add meaning of the ppv unit
+ JAER = JSV - NSV_AERBEG_A(KMI) + 1
+ IF ( ANY( JAER == [JP_CH_M0i, JP_CH_M0j] ) ) THEN
+ !Moment 0
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [nb_aerosols/molec_{air}]'
+ ELSE IF ( ANY( JAER == [ JP_CH_SO4i, JP_CH_SO4j, JP_CH_NO3i, JP_CH_NO3j, JP_CH_H2Oi, JP_CH_H2Oj, JP_CH_NH3i, JP_CH_NH3j, &
+ JP_CH_OCi, JP_CH_OCj, JP_CH_BCi, JP_CH_BCj, JP_CH_DSTi, JP_CH_DSTj ] ) &
+ .OR. ( NSOA == 10 .AND. &
+ ANY( JAER == [ JP_CH_SOA1i, JP_CH_SOA1j, JP_CH_SOA2i, JP_CH_SOA2j, JP_CH_SOA3i, JP_CH_SOA3j, JP_CH_SOA4i, &
+ JP_CH_SOA4j, JP_CH_SOA5i, JP_CH_SOA5j, JP_CH_SOA6i, JP_CH_SOA6j, JP_CH_SOA7i, JP_CH_SOA7j, &
+ JP_CH_SOA8i, JP_CH_SOA8j, JP_CH_SOA9i, JP_CH_SOA9j, JP_CH_SOA10i, JP_CH_SOA10j ] ) ) ) THEN
+ !Moment 3
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [molec_{aer}/molec_{air}]'
+ ELSE IF ( ( LVARSIGI .AND. JAER == JP_CH_M6i ) .OR. ( LVARSIGJ .AND. JAER == JP_CH_M6j ) ) THEN
+ !Moment 6
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [um6/molec_{air}*(cm3/m3)]'
+ ELSE
+ CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for AER' )
+ YAEROLONGNAMES = TRIM( CAERONAMES(JAER) )
+ END IF
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YAEROLONGNAMES(JSV-NSV_AERBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_AERDEPBEG_A(KMI), NSV_AERDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_DSTBEG_A(KMI), NSV_DSTEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YDUSTLONGNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_DSTDEPBEG_A(KMI), NSV_DSTDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SLTBEG_A(KMI), NSV_SLTEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( YSALTLONGNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SLTDEPBEG_A(KMI), NSV_SLTDEPEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) )
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ), &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+DO JSV = NSV_SNWBEG_A(KMI), NSV_SNWEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ), &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ), &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+!Check if there is at most 1 LINOX scalar variable
+!if not, the name must be modified and different for all of them
+IF ( NSV_LNOX_A(KMI) > 1 ) &
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_LNOX_A>1: problem with the names of the corresponding scalar variables' )
+
+DO JSV = NSV_LNOXBEG_A(KMI), NSV_LNOXEND_A(KMI)
+ ICHIDX = ICHIDX + 1
+ CSV_CHEM_LIST_A(ICHIDX, KMI) = 'LINOX'
+
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
+ CMNHNAME = 'LINOX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LINOX', &
+ CUNITS = 'ppv', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+END DO
+
+IF ( ICHIDX /= NSV_CHEM_LIST_A(KMI) ) &
+ CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'ICHIDX /= NSV_CHEM_LIST_A(KMI)' )
+
+END SUBROUTINE INI_NSV
diff --git a/src/PHYEX/ext/ini_radar.f90 b/src/PHYEX/ext/ini_radar.f90
new file mode 100644
index 0000000000000000000000000000000000000000..efe222510b6882e595a88afd90253a4ce5a7ec2c
--- /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_n
+!
+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, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: 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..9299f713c570da1307054de55657bf040c94a415
--- /dev/null
+++ b/src/PHYEX/ext/ini_segn.f90
@@ -0,0 +1,483 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_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: 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_n
+USE MODD_PARAMETERS
+USE MODD_REF, ONLY: LBOUSS
+!
+use mode_field, only: 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
+!
+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 LES_ASSOCIATE()
+CALL DEFAULT_DESFM_n(KMI)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. READ INITIAL FILE NAME AND OPEN INITIAL FILE
+! --------------------------------------------
+!
+CALL POSNAM( TZFILE_DES, '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( TZFILE_DES, 'NAM_CONFZ', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
+ CALL POSNAM( TZFILE_DES, 'NAM_CONFIO', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFIO)
+ CALL IO_Config_set()
+ 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 ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' &
+ .OR. ( 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,CINIFILEPGD_n )
+!
+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/ini_tke_eps.f90 b/src/PHYEX/ext/ini_tke_eps.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a07160722558475a37baff36ada0a00739bff061
--- /dev/null
+++ b/src/PHYEX/ext/ini_tke_eps.f90
@@ -0,0 +1,179 @@
+!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_INI_TKE_EPS
+! #######################
+INTERFACE
+!
+ SUBROUTINE INI_TKE_EPS(HGETTKET,PTHVREF,PZZ, &
+ PUT,PVT,PTHT, &
+ PTKET,TPINITHALO3D_ll )
+!
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+CHARACTER (LEN=*), INTENT(IN) :: HGETTKET
+ ! character string indicating whether TKE must be
+ ! initialized or not
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! virtual potential
+ ! temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height for
+ ! w-point
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PUT ! x-component of wind
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PVT ! y-component of wind
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTHT ! potential temperature
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTKET ! TKE fields
+TYPE(LIST_ll), POINTER, INTENT(INOUT):: TPINITHALO3D_ll ! pointer for the list of fields
+ ! which must be communicated in INIT
+!
+END SUBROUTINE INI_TKE_EPS
+!
+END INTERFACE
+!
+END MODULE MODI_INI_TKE_EPS
+!
+! ###################################################################
+ SUBROUTINE INI_TKE_EPS(HGETTKET,PTHVREF,PZZ, &
+ PUT,PVT,PTHT, &
+ PTKET,TPINITHALO3D_ll )
+! ###################################################################
+!
+!
+!! **** *INI_TKE* initializes by a 1D stationarized TKE equation the
+!! values of TKE. A positivity control is made. The
+!! dissipation of TKE is set to its minimum value.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize the values of the
+! turbulence kinetic energy. The dissipation is intialized to its minimum
+! value.
+!
+!!** METHOD
+!! ------
+!! A diagnostic 1D equation for the TKE is used. The transport terms
+!! are neglected.
+!!
+!! EXTERNAL
+!! --------
+!! DZF ,MXF, MYF, MZM : Shuman operators
+!! ADD3DFIELD_ll : add a field to 3D-list
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CST : XG, XRV, XRD
+!! MODD_CTURB : XLINI, XTKEMIN, XCED, XCMFS
+!! MODD_PARAMETERS: JPVEXT
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of Documentation (routine INI_TKE)
+!! Book 1 of Documentation (Chapter Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Jan 19, 1995
+!! Feb 13, 1995 (J. Cuxart) add EPS initialization
+!! March 25, 1995 (J. Stein)add PZZ in the arguments
+!! to compute a real gradient and allow RESTA conf.
+!! Aug 10, 1998 (N. Asencio) add parallel code
+!! May 2006 Remove KEPS
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! March 2021 (JL Redelsperger) Add Ocean LES case)
+!! -------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_CST, ONLY: XG, XALPHAOC
+USE MODD_CTURB, ONLY: XCMFS
+USE MODD_TURB_n, ONLY: XLINI, XCED, XTKEMIN, XCSHF
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_PARAMETERS, ONLY: JPVEXT
+!
+USE MODE_ll
+!
+USE MODI_SHUMAN, ONLY: DZF, MXF, MYF, MZM
+!
+IMPLICIT NONE
+!
+!* 0.1. declarations of arguments
+!
+CHARACTER (LEN=*), INTENT(IN) :: HGETTKET
+ ! character string indicating whether TKE must be
+ ! initialized or not
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! virtual potential
+ ! temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height for
+ ! w-point
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PUT ! x-component of wind
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PVT ! y-component of wind
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTHT ! potential temperature
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTKET ! TKE field
+TYPE(LIST_ll), POINTER, INTENT(INOUT):: TPINITHALO3D_ll ! pointer for the list of fields
+ ! which must be communicated in INIT
+!
+!* 0.2 Declaration of local variables
+!
+INTEGER :: IKB,IKE ! index value for the first and last inner
+ ! mass points
+INTEGER :: JKK ! vertical loop index
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZDELTZ ! vertical
+ ! increment
+!
+! ---------------------------------------------------------------------
+!
+!
+IKB=1+JPVEXT
+IKE=SIZE(PTHT,3)-JPVEXT
+!
+!* 1. TKE DETERMINATION
+! -----------------
+!
+DO JKK=IKB-1,IKE
+ ZDELTZ(:,:,JKK) = PZZ(:,:,JKK+1)-PZZ(:,:,JKK)
+END DO
+ZDELTZ(:,:,IKE+1) = ZDELTZ(:,:,IKE)
+!
+IF (HGETTKET == 'INIT' ) THEN
+! instant t
+ PTHT(:,:,IKB-1) = PTHT(:,:,IKB)
+ PUT(:,:,IKB-1) = PUT(:,:,IKB)
+ PVT(:,:,IKB-1) = PVT(:,:,IKB)
+ !
+ PTHT(:,:,IKE+1) = PTHT(:,:,IKE)
+ PUT(:,:,IKE+1) = PUT(:,:,IKE)
+ PVT(:,:,IKE+1) = PVT(:,:,IKE)
+ !
+ ! determines TKE
+ ! Equilibrium/Stationary/neutral 1D TKE equation
+ IF (LOCEAN) THEN
+ PTKET(:,:,:)=(XLINI**2/XCED)*( &
+ XCMFS*( DZF(MXF(MZM(PUT)))**2 &
+ +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
+ -(XG*XALPHAOC)*XCSHF*DZF(MZM(PTHT)) &
+ ) / ZDELTZ
+ ELSE
+ PTKET(:,:,:)=(XLINI**2/XCED)*( &
+ XCMFS*( DZF(MXF(MZM(PUT)))**2 &
+ +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
+ -(XG/PTHVREF)*XCSHF*DZF(MZM(PTHT)) &
+ ) / ZDELTZ
+ END IF
+ ! positivity control
+ WHERE (PTKET < XTKEMIN) PTKET=XTKEMIN
+ !
+ !
+ ! Add PTKET to TPINITHALO3D_ll list of fields updated at the
+ ! end of initialization
+ CALL ADD3DFIELD_ll ( TPINITHALO3D_ll, PTKET, 'INI_TKE_EPS::PTKET' )
+END IF
+!
+!
+END SUBROUTINE INI_TKE_EPS
diff --git a/src/PHYEX/ext/init_mnh.f90 b/src/PHYEX/ext/init_mnh.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4170ca68e7ebf89b388aa90fee1d25880fd73edd
--- /dev/null
+++ b/src/PHYEX/ext/init_mnh.f90
@@ -0,0 +1,252 @@
+!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.
+!-----------------------------------------------------------------
+! ###############
+ SUBROUTINE INIT_MNH
+! ###############
+!
+!!**** *INIT_MNH * - monitor to initialize the variables of the model
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize all the variables
+! used in the model temporal loop or in the post-processings
+!
+!!** METHOD
+!! ------
+!! This initialization is separated in three parts :
+!! 1. A part common to all models where :
+!! - The output-listing file common to all models is opened.
+!! - The physical constants are initialized.
+!! - The other constants for all models are initialized.
+!! 2. The treatment of descriptor files model by model :
+!! The DESFM and EXSEG files are read and the EXSEG file is updated
+!! 3. The sequential initialization of nested models :
+!! The initial data fields are read in different files for each
+!! model and variables which are not in these initial files are
+!! deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! INI_CST : to initialize physical constants
+!! INI_CTURB : to initialize for all models the constants used in the
+!! turbulence scheme
+!! INI_SEG_n : to read and update descriptor files
+!! INI_SIZE : to initialize the sizes of the different models
+!! INI_MODEL : to initialize each nested model
+!! INI_PARA_ll: to build the ll data structures
+!! GO_TOMODEL : displace the ll lists to the right nested model
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : JPMODELMAX
+!!
+!! Module MODD_CONF : NMODEL,NVERB
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine INIT_MNH)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/06/94
+!! J.Stein 05/01/95 add ini_cturb
+!! J.P. Lafore 18/08/95 Time STEP change
+!! J.P. Lafore 22/07/96 ZTSTEP_ALL introduction for nesting
+!! V. Ducrocq 7/08/98 //
+!! P. Jabouille 7/07/99 split ini_modeln in 2 parts+ cleaning
+!! V. Masson 15/03/99 call to ini_data_cover
+!! P.Jabouille 15/07/99 special initialisation for spawning
+!! J.P Chaboureau 2015 add ini_spectre_n
+!! J.Escobar 2/03/2016 bypass , reset NHALO=1 for SPAWNING
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CONF
+USE MODD_DYN_n, ONLY: CPRESOPT, NITR ! only for spawning purpose
+USE MODD_IO, ONLY: TFILE_OUTPUTLISTING, TPTR2FILE
+USE MODD_LBC_n, ONLY: CLBCX,CLBCY ! only for spawning purpose
+USE MODD_LUNIT
+USE MODD_LUNIT_n
+USE MODD_MNH_SURFEX_n
+USE MODD_PARAMETERS
+USE MODD_NSV, ONLY: NSV_ASSOCIATE
+!
+use mode_field, only: Alloc_field_scalars, Fieldlist_goto_model
+USE MODE_IO_FILE, ONLY: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+USE MODE_SPLITTINGZ_ll
+!
+USE MODE_INI_CST, ONLY: INI_CST
+USE MODI_INI_MODEL_n
+USE MODI_INI_SEG_n
+USE MODI_INI_SIZE_n
+USE MODI_INI_SIZE_SPAWN
+USE MODI_INI_SPECTRE_n
+USE MODI_READ_ALL_NAMELISTS
+USE MODI_RESET_EXSEG
+!
+IMPLICIT NONE
+!
+!* 0.1 Local variables
+!
+INTEGER :: JMI ! Loop index
+CHARACTER(LEN=28),DIMENSION(JPMODELMAX) :: YINIFILEPGD
+INTEGER :: ILUOUT0,IRESP ! Logical unit number for
+ ! output-listing common
+ ! to all models and return
+ ! code of file management
+REAL, DIMENSION(JPMODELMAX) :: ZTSTEP_ALL ! Time STEP of ALL models
+INTEGER :: IINFO_ll ! return code of // routines
+!
+! Dummy pointers needed to correct an ifort Bug
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
+
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATION COMMON TO ALL MODELS
+! ------------------------------------
+!
+!* 1.1 initialize // E/S and open output-listing file
+!
+!
+IF (CPROGRAM/='REAL ') THEN
+ CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
+ CALL IO_File_open(TLUOUT0)
+ !Set output file for PRINT_MSG
+ TFILE_OUTPUTLISTING => TLUOUT0
+ ILUOUT0=TLUOUT0%NLU
+ELSE
+ ILUOUT0=TLUOUT0%NLU
+END IF
+!
+WRITE(UNIT=ILUOUT0,FMT="(50('*'),/,'*',48X,'*',/, &
+ & 7('*'),10X, ' MESO-NH MODEL ',10X,8('*'),/, &
+ & '*',48X,'*',/, &
+ & 7('*'),12X,' CNRM - LA ',12X,8('*'),/, &
+ & '*',48X,'*',/, 50('*'))")
+!
+CALL NSV_ASSOCIATE()
+!
+!
+!* 1.2 initialize physical constants
+!
+CALL INI_CST
+!
+!
+!* 1.3 initialize constants for the turbulence scheme
+!
+!Now done in ini_modeln
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. READ AND UPDATE DESCRIPTOR FILES
+! --------------------------------
+!
+IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' .OR. CPROGRAM=='MESONH') THEN
+ CALL ALLOC_FIELD_SCALARS()
+END IF
+!
+CALL GOTO_MODEL(1)
+CALL INI_SEG_n(1,LUNIT_MODEL(1)%TINIFILE,YINIFILEPGD(1),ZTSTEP_ALL)
+!
+DO JMI=2,NMODEL
+ CALL GOTO_MODEL(JMI)
+ CALL INI_SEG_n(JMI,LUNIT_MODEL(JMI)%TINIFILE,YINIFILEPGD(JMI),ZTSTEP_ALL)
+END DO
+!
+IF (CPROGRAM=='SPAWN ') THEN
+ !bypass
+ NHALO = 1
+END IF
+!
+IF (CPROGRAM=='DIAG') CALL RESET_EXSEG()
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. INITIALIZE EACH MODEL SIZES AND DEPENDENCY
+! ------------------------------------------
+!
+DO JMI=1,NMODEL
+ CALL GOTO_MODEL(JMI)
+ CALL INI_SIZE_n(JMI,LUNIT_MODEL(JMI)%TINIFILE,YINIFILEPGD(JMI))
+END DO
+!
+IF (CPROGRAM=='SPAWN ') THEN
+ DPTR_CLBCX=>CLBCX
+ DPTR_CLBCY=>CLBCY
+ CALL INI_PARAZ_ll(IINFO_ll)
+ CALL INI_SIZE_SPAWN(DPTR_CLBCX,DPTR_CLBCY,CPRESOPT,NITR,LUNIT_MODEL(1)%TINIFILE)
+END IF
+!
+! INITIALIZE data structures of ComLib
+!
+!JUAN CALL INI_PARA_ll(IINFO_ll)
+CALL INI_PARAZ_ll(IINFO_ll)
+!
+!-------------------------------------------------------------------------------
+!
+!
+! Allocations of Surfex Types
+CALL SURFEX_ALLOC_LIST(NMODEL)
+!
+DO JMI=1,NMODEL
+ YSURF_CUR => YSURF_LIST(JMI)
+!
+ IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL ') THEN
+ CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
+ ELSE
+ CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','ALL',.TRUE.)
+ ENDIF
+ENDDO
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. INITIALIZE EACH MODEL
+! ---------------------
+!
+DO JMI=1,NMODEL
+ CALL GO_TOMODEL_ll(JMI,IINFO_ll)
+ CALL GOTO_MODEL(JMI)
+ IF (CPROGRAM/='SPEC ') THEN
+ CALL INI_MODEL_n(JMI,LUNIT_MODEL(JMI)%TINIFILE)
+ !Call necessary to update the TFIELDLIST pointers to the data
+ CALL FIELDLIST_GOTO_MODEL(JMI,JMI)
+ ELSE
+ CALL INI_SPECTRE_n(JMI,LUNIT_MODEL(JMI)%TINIFILE)
+ END IF
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. WRITE MESSAGE ON OUTPUT-LISTING
+! -------------------------------
+!
+IF (NVERB >= 5) THEN
+ WRITE(UNIT=ILUOUT0,FMT="(50('*'),/,'*',48X,'*',/, &
+ & '*',10X,' INITIALIZATION TERMINATED',10X,'*',/, &
+ & '*',48X,'*',/,50('*'))")
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE INIT_MNH
diff --git a/src/PHYEX/ext/ion_attach_elec.f90 b/src/PHYEX/ext/ion_attach_elec.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cd0fcf1c3eb268b93d7eeceef9161bc5157122aa
--- /dev/null
+++ b/src/PHYEX/ext/ion_attach_elec.f90
@@ -0,0 +1,631 @@
+!MNH_LIC Copyright 2010-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_ION_ATTACH_ELEC
+! ############################
+!
+INTERFACE
+ SUBROUTINE ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
+ PRHODJ,PSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
+ PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
+
+
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry air density* Jacobian
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable vol. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable vol. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU, PEFIELDV, PEFIELDW
+ ! Electric field components
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GATTACH !Recombination and
+ !Attachment if true
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+
+ END SUBROUTINE ION_ATTACH_ELEC
+END INTERFACE
+END MODULE MODI_ION_ATTACH_ELEC
+
+
+
+! ######################################################################
+ SUBROUTINE ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
+ PRHODJ,PSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
+ PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
+! ######################################################################
+
+
+!
+!!**** * -
+!!
+!! PURPOSE
+!! -------
+!! This routine computes the ion capture by (or attachment to) hydrometeors
+!! providing a source of charge for hydrometeors and a sink for positive
+!! negative ion mixing ratio. It is assumed as resulting from both ionic
+!! diffusion and conduction (electrical attraction).
+!!
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! M. Chong *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 2010
+!! Modifications:
+!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only : lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_CONF, ONLY: CCONF
+USE MODD_CST
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_n
+USE MODD_ELEC_PARAM
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELEC
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_PARAM_n
+USE MODD_REF, ONLY: XTHVREFZ
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools_ll, only: GET_INDICE_ll
+
+USE MODI_MOMG
+
+IMPLICIT NONE
+!
+! 0.1 Declaration of arguments
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry air density* Jacobian
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable vol. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable vol. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU, PEFIELDV, PEFIELDW
+ ! Electric field components
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GATTACH !Recombination and
+ !Attachment if true
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+
+!
+!
+! 0.2 Declaration of local variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZT ! Temperature (K)
+REAL, DIMENSION(:), ALLOCATABLE :: ZCONC, ZVIT, ZRADIUS ! Number concentration
+ !fallspeed, radius
+REAL :: ZCQD, ZCDIF ! computed coefficients
+INTEGER, DIMENSION(SIZE(PTHT)) :: IGI, IGJ, IGK ! Valid grid index
+INTEGER :: IVALID ! Nb of valid grid
+INTEGER :: IIB ! Beginning (B) and end (E) grid points
+INTEGER :: IIE ! along i axis,
+INTEGER :: IJB ! j axis,
+INTEGER :: IJE !
+INTEGER :: IKB ! and k axis
+INTEGER :: IKE !
+
+INTEGER :: II, IJ, IK, JRR, JSV ! Loop index for variable
+INTEGER :: ITYPE ! Hydrometeor category (2: cloud, 3: rain,
+ ! 4: ice crystal, 5: snow, 6: graupel, 7: hail)
+REAL :: ZCOMB ! Recombination
+!
+!
+!-------------------------------------------------------------------------------
+if ( lbudget_sv ) then
+ do jrr = 1, nsv_elec
+ call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
+ end do
+end if
+!
+!* 1. COMPUTE THE ION RECOMBINATION and TEMPERATURE
+! ---------------------------------------------
+!
+!
+ZCQD = 4 * XPI * XEPSILON * XBOLTZ / XECHARGE
+ZCDIF = XBOLTZ /XECHARGE
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PTHT,3) - JPVEXT
+!
+!* 1.1 Add Ion Recombination source (PSVS in 1/(m3.s))
+! and count and localize valid grid points for ion source terms
+!
+IVALID = 0
+DO IK = IKB, IKE
+ DO IJ = IJB, IJE
+ DO II = IIB, IIE
+ IF (GATTACH(II,IJ,IK)) THEN
+! Recombination
+ ZCOMB = XIONCOMB * (PSVS(II,IJ,IK,1)*PTSTEP) * &
+ (PSVS(II,IJ,IK,NSV_ELEC)*PTSTEP) * &
+ PRHODREF(II,IJ,IK) / PRHODJ(II,IJ,IK)
+ ZCOMB = MIN(ZCOMB, PSVS(II,IJ,IK,1), PSVS(II,IJ,IK,NSV_ELEC))
+ PSVS(II,IJ,IK,1) = PSVS(II,IJ,IK,1) - ZCOMB
+ PSVS(II,IJ,IK,NSV_ELEC) = PSVS(II,IJ,IK,NSV_ELEC) - ZCOMB
+! Counting
+ IVALID = IVALID + 1
+ IGI(IVALID) = II
+ IGJ(IVALID) = IJ
+ IGK(IVALID) = IK
+ END IF
+ ENDDO
+ ENDDO
+ENDDO
+!
+!* 1.2 Compute the temperature
+!
+IF( IVALID /= 0 ) THEN
+ ALLOCATE (ZT(IVALID))
+ DO II = 1, IVALID
+ ZT(II) = PTHT(IGI(II),IGJ(II),IGK(II)) * &
+ (PPABST(IGI(II),IGJ(II),IGK(II)) / XP00) ** (XRD / XCPD)
+ ENDDO
+END IF
+!
+!
+!* 2. TRANSFORM VOLUM. SOURCE TERMS INTO MIXING RATIO
+! FOR WATER SPECIES, AND VOLUMIC CONTENT FOR ELECTRIC VARIABLES
+! -------------------------------------------------------------
+!
+DO JRR = 1, KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) *PTSTEP / PRHODJ(:,:,:)
+ENDDO
+!
+DO JSV = 1, NSV_ELEC
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) *PTSTEP *PRHODREF(:,:,:) / PRHODJ(:,:,:)
+ENDDO
+!
+!
+!* 3. COMPUTE ATTACHMENT DUE TO ION DIFFUSION AND CONDUCTION
+! ------------------------------------------------------
+!
+! Attachment to cloud droplets, rain, cloud ice, snow, graupel,
+! and hail (optional)
+!
+!
+IF( IVALID /= 0 ) THEN
+!
+!* 3.1 Attachment to cloud droplets
+!
+ ALLOCATE (ZCONC(IVALID))
+ ALLOCATE (ZVIT (IVALID))
+ ALLOCATE (ZRADIUS(IVALID))
+
+ ITYPE = 2
+ IF (PRESENT(PSEA)) THEN
+ CALL HYDROPARAM (IGI, IGJ, IGK, ZCONC, ZVIT, ZRADIUS, ITYPE, PSEA, PTOWN)
+ ELSE
+ CALL HYDROPARAM (IGI, IGJ, IGK, ZCONC, ZVIT, ZRADIUS, ITYPE)
+ ENDIF
+!
+ CALL DIFF_COND (IGI, IGJ, IGK, PSVS(:,:,:,1), PSVS(:,:,:,NSV_ELEC), &
+ PSVS(:,:,:,ITYPE))
+!
+!* 3.2 Attachment to raindrops, ice crystals, snow, graupel,
+! and hail (if activated)
+!
+ DO ITYPE = 3, KRR
+ CALL HYDROPARAM (IGI, IGJ, IGK, ZCONC, ZVIT, ZRADIUS, ITYPE)
+!
+ CALL DIFF_COND (IGI, IGJ, IGK, PSVS(:,:,:,1), PSVS(:,:,:,NSV_ELEC), &
+ PSVS(:,:,:,ITYPE))
+ END DO
+!
+ DEALLOCATE (ZCONC, ZVIT, ZRADIUS)
+ DEALLOCATE (ZT)
+ENDIF
+!
+!
+!* 4. RETURN TO VOLUMETRIC SOURCE (Prognostic units)
+! ---------------------------
+!
+DO JRR = 1, KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:) / PTSTEP
+ENDDO
+!
+DO JSV = 1, NSV_ELEC
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:) / (PTSTEP * PRHODREF(:,:,:))
+ENDDO
+!
+!
+!* 5. BUDGET
+! ------
+!
+if ( lbudget_sv ) then
+ do jrr = 1, nsv_elec
+ call Budget_store_end( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
+ end do
+end if
+!
+!------------------------------------------------------------------------------
+!
+CONTAINS
+!
+!------------------------------------------------------------------------------
+!
+ SUBROUTINE HYDROPARAM (IGRIDX, IGRIDY, IGRIDZ, ZCONC, &
+ ZVIT, ZRADIUS, ITYPE, PSEA, PTOWN)
+!
+! Purpose : Compute in regions of valid grid points (IGRIDX, IGRIDY, IGRIDZ)
+! the hydrometeor parameters: concentration (ZCONC),
+! fallspeed (ZVIT),
+! and mean radius (ZRADIUS)
+! involved in the evaluation of ion attachment
+!
+!
+!* 0. DECLARATIONS
+! ------------
+IMPLICIT NONE
+!
+!* 0.1 declaration of dummy arguments
+!
+INTEGER, DIMENSION(:), INTENT(IN) :: IGRIDX, IGRIDY, IGRIDZ ! Index of
+ ! valid gridpoints
+INTEGER, INTENT(IN) :: ITYPE ! Hydrometeor category
+ ! ITYPE= 2: cloud, 3: rain, 4: ice, 5: snow, 6: graupel, 7: hail
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCONC, ZVIT, ZRADIUS
+! Number concentration, fallspeed, radius
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
+!
+!* 0.2 declaration of local variables
+!
+REAL :: ZCONC1, ZCONC2 ! for cloud
+REAL :: ZLBC
+REAL :: ZFSEDC
+REAL :: ZRAY
+REAL :: ZEXP1, ZEXP2, ZMOM1, ZMOM2
+REAL :: ZVCOEF, ZRHO00, ZLBI
+REAL :: ZLAMBDA
+INTEGER :: JI, JJ, JK, IV
+!
+!
+ZCONC(:) = 0.
+ZVIT (:) = 0.
+ZRADIUS(:) = 0.
+!
+SELECT CASE (ITYPE)
+!
+!* 1. PARAMETERS FOR CLOUD
+! --------------------
+ CASE (2)
+!
+ IF (PRESENT(PSEA)) THEN
+
+ ZMOM1 = 0.5*MOMG(XALPHAC,XNUC,1.)
+ ZMOM2 = 0.5*MOMG(XALPHAC2,XNUC2,1.)
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI, JJ, JK, 2)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(2) .AND. &
+ PSVS(JI, JJ, JK, 2) /=0. ) THEN
+ ZCONC1 = PSEA(JI,JJ) * XCONC_SEA + (1. - PSEA(JI,JJ)) * XCONC_LAND
+ ZLBC = PSEA(JI,JJ) * XLBC(2) + (1. - PSEA(JI,JJ)) * XLBC(1)
+ ZFSEDC = PSEA(JI,JJ) * XFSEDC(2) + (1. - PSEA(JI,JJ)) * XFSEDC(1)
+ ZFSEDC = MAX(MIN(XFSEDC(1),XFSEDC(2)), ZFSEDC)
+ ZCONC2 = (1. - PTOWN(JI,JJ)) * ZCONC1 + PTOWN(JI,JJ) * XCONC_URBAN
+ ZRAY = (1. - PSEA(JI,JJ)) * ZMOM1 + PSEA(JI,JJ) * ZMOM2
+ ZCONC (IV) = ZCONC2 ! Number concentration
+ ZLAMBDA = (ZLBC *ZCONC2 / (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,2)))**XLBEXC
+ ZRADIUS (IV) = ZRAY / ZLAMBDA
+ ZVIT (IV) = XCC * ZFSEDC * ZLAMBDA**(-XDC) * &
+ PRHODREF(JI,JJ,JK)**(-XCEXVT)
+ END IF
+ ENDDO
+ ELSE
+ ZRAY = 0.5*MOMG(XALPHAC,XNUC,1.)
+ ZLBC = XLBC(1) * XCONC_LAND
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI, JJ, JK, 2)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(2) .AND. &
+ PSVS(JI, JJ, JK, 2) /=0. ) THEN
+ ZCONC (IV) = XCONC_LAND ! Number concentration
+ ZLAMBDA = (ZLBC / (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,2)))**XLBEXC
+ ZRADIUS (IV) = ZRAY / ZLAMBDA
+ ZVIT (IV) = XCC * XFSEDC(1) * ZLAMBDA**(-XDC) * &
+ PRHODREF(JI,JJ,JK)**(-XCEXVT)
+ END IF
+ ENDDO
+ END IF
+!
+!
+!* 2. PARAMETERS FOR RAIN
+! -------------------
+ CASE (3)
+ ZEXP1 = XEXSEDR - 1.
+ ZEXP2 = ZEXP1 - XCEXVT
+!
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI, JJ, JK, 3)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(3) .AND. &
+ PSVS(JI, JJ, JK, 3) /=0. ) THEN
+ ZLAMBDA = XLBR * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,3))**XLBEXR
+ ZRADIUS (IV) = 0.5 / ZLAMBDA
+ ZCONC (IV) = XCCR / ZLAMBDA
+ ZVIT (IV) = XFSEDR * PRHODREF(JI,JJ,JK)**ZEXP2 &
+ * PRS(JI,JJ,JK,3)**ZEXP1
+ END IF
+ ENDDO
+!
+!
+!* 3. PARAMETERS FOR ICE
+! ------------------
+!
+ CASE (4)
+!
+ ZRAY = 0.5*MOMG(XALPHAI,XNUI,1.)
+ ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+! ZVCOEF= XC_I * (GAMMA(XNUI+(XBI+XDI)/XALPHAI) / GAMMA(XNUI+XBI/XALPHAI)) &
+! * ZRHO00**XCEXVT
+! Computations for Columns (see ini_rain_ice_elec.f90)
+ ZVCOEF = 2.1E5 * MOMG(XALPHAI,XNUI, 3.285) / MOMG(XALPHAI,XNUI, 1.7) &
+ * ZRHO00**XCEXVT
+ ZLBI = (2.14E-3 * MOMG(XALPHAI,XNUI,1.7)) **0.588235
+
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI, JJ, JK, 4)/PRHODREF(JI, JJ, JK) > XRTMIN_ELEC(4) .AND. &
+ PSVS(JI, JJ, JK, 4) /=0.) THEN
+ ZCONC (IV) = XFCI * PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,4) * &
+ MAX(0.05E6, -0.15319E6 - 0.021454E6 * &
+ ALOG(PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,4)))**3
+ ZLAMBDA = ZLBI * (ZCONC(IV) / (PRHODREF(JI,JJ,JK) * &
+ PRS(JI,JJ,JK,4)))**0.588235
+ ZRADIUS (IV) = ZRAY / ZLAMBDA
+ ZVIT (IV) = ZVCOEF * ZLAMBDA**(-1.585) * & !(-XDI) * &
+ PRHODREF(JI,JJ,JK)**(-XCEXVT)
+ END IF
+ ENDDO
+!
+!
+!* 4. PARAMETERS FOR SNOW
+! -------------------
+!
+ CASE (5)
+!
+ ZEXP1 = XEXSEDS - 1.
+ ZEXP2 = ZEXP1 - XCEXVT
+!
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI, JJ, JK, 5)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(5) .AND. &
+ PSVS(JI, JJ, JK, 5) /=0. ) THEN
+ ZLAMBDA = XLBS * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,5))**XLBEXS
+ ZRADIUS (IV) = 0.5 / ZLAMBDA
+ ZCONC (IV) = XCCS * ZLAMBDA**XCXS
+ ZVIT (IV) = XFSEDS * PRHODREF(JI,JJ,JK)**ZEXP2 &
+ * PRS(JI,JJ,JK,5)**ZEXP1
+ END IF
+ ENDDO
+!
+!
+!* 5. PARAMETERS FOR GRAUPEL
+! ----------------------
+!
+ CASE (6)
+!
+ ZEXP1 = XEXSEDG - 1.
+ ZEXP2 = ZEXP1 - XCEXVT
+!
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI, JJ, JK, 6)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(6) .AND. &
+ PSVS(JI, JJ, JK, 6) /=0. ) THEN
+ ZLAMBDA = XLBG * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,6))**XLBEXG
+ ZRADIUS (IV) = 0.5 / ZLAMBDA
+ ZCONC (IV) = XCCG * ZLAMBDA**XCXG
+ ZVIT (IV) = XFSEDG * PRHODREF(JI,JJ,JK)**ZEXP2 &
+ * PRS(JI,JJ,JK,6)**ZEXP1
+ END IF
+ ENDDO
+!
+!
+!* 6. PARAMETERS FOR HAIL
+! -------------------
+!
+ CASE (7)
+!
+ ZEXP1 = XEXSEDH - 1.
+ ZEXP2 = ZEXP1-XCEXVT
+ ZRAY = 0.5*MOMG(XALPHAH, XNUH, 1.)
+!
+ DO IV = 1, IVALID
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+ IF( PRS(JI, JJ, JK, 7)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(7) .AND. &
+ PSVS(JI, JJ, JK, 7) /=0. ) THEN
+ ZLAMBDA = XLBH * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,7))**XLBEXH
+ ZRADIUS (IV) = ZRAY / ZLAMBDA
+ ZCONC (IV) = XCCG * ZLAMBDA**XCXG
+ ZVIT (IV) = XFSEDH * PRHODREF(JI,JJ,JK)**ZEXP2 &
+ * PRS(JI,JJ,JK,7)**ZEXP1
+ END IF
+ ENDDO
+!
+END SELECT
+!
+END SUBROUTINE HYDROPARAM
+!
+!------------------------------------------------------------------------------
+!
+ SUBROUTINE DIFF_COND (IGRIDX, IGRIDY, IGRIDZ, PQPIS, PQNIS, PQVS)
+!
+! Purpose : Compute in regions of valid grid points (IGRIDX, IGRIDY, IGRIDZ)
+! the attachment of positive (sink for PQPIS) and negative
+! (sink for PQNIS) ions to the hydrometeor variable (charge
+! source for PQVS)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+IMPLICIT NONE
+!
+!* 0.1 declaration of dummy arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion concentration
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion concentration
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQVS !Hydrom volumetric charge
+INTEGER, DIMENSION(:), INTENT(IN) :: IGRIDX, IGRIDY, IGRIDZ ! Index of
+ ! valid gridpoints
+
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JI, JJ, JK, IV
+REAL :: ZNC, ZRADI, ZVT ! Nb conc., radius, fallspeed of the hydrometeor category
+REAL :: ZQ ! net particule charge
+REAL :: ZX, ZFXP, ZFXN ! Limiting diffusion function ZFX = +/- ZX /(exp(+/-ZX) -1)
+REAL :: ZDIFP, ZDPIDT_D ! Diffusion of positive ions
+REAL :: ZDIFM, ZDNIDT_D ! Diffusion of negative ions
+REAL :: ZDPIDT_C ! Conduction of positive ions
+REAL :: ZDNIDT_C ! Conduction of negative ions
+REAL :: ZDELPI, ZDELNI ! Total attachment of pos/neg ions
+REAL :: ZEFIELD ! Electric field magnitude
+REAL :: ZQBOUND ! Limit charge for conduction
+!
+!
+!* 1. COMPUTE ION ATTACHMENT
+! ----------------------
+!
+DO IV = 1, IVALID
+ IF (ZCONC(IV) .NE. 0.) THEN
+ JI = IGRIDX(IV)
+ JJ = IGRIDY(IV)
+ JK = IGRIDZ(IV)
+!
+ ZNC = ZCONC(IV)
+ ZRADI = ZRADIUS(IV)
+ ZVT = ZVIT(IV)
+!
+!* 1.0 Ion diffusion to a particle
+!
+ ZDPIDT_D = 0.
+ ZDNIDT_D = 0.
+!
+ ZQ = PQVS(JI,JJ,JK) / ZNC
+ ZX = ZQ / (ZCQD * ZRADI * ZT(IV))
+!
+ IF(ZX /= 0. .AND. ABS(ZX) <= 20.0) THEN
+ IF( ABS(ZX) < 1.0E-15) THEN
+ ZFXP = 1.
+ ZFXN = 1.
+ ELSE
+ ZFXP = ZX / (EXP(ZX) - 1.)
+ ZFXN = -ZX / (EXP(-ZX) -1.)
+ ENDIF
+!
+ ZDIFP = 4. * XPI * XMOBIL_POS(JI,JJ,JK) * ZCDIF * ZT(IV)
+ ZDPIDT_D = ZRADI * ZDIFP * PQPIS(JI,JJ,JK) * ZFXP * &
+ (1. + (2. * ZRADI * ZVT / ZDIFP)**0.5)
+!
+ ZDIFM = 4. * XPI * XMOBIL_NEG(JI,JJ,JK) * ZCDIF * ZT(IV)
+ ZDNIDT_D = ZRADI * ZDIFM * PQNIS(JI,JJ,JK) * ZFXN * &
+ (1. + (2. * ZRADI * ZVT / ZDIFM)**0.5)
+!
+ ZDELPI = MIN(ZDPIDT_D*PTSTEP*ZNC, PQPIS(JI,JJ,JK))
+ ZDELNI = MIN(ZDNIDT_D*PTSTEP*ZNC, PQNIS(JI,JJ,JK))
+!
+ PQPIS(JI,JJ,JK) = PQPIS(JI,JJ,JK) - ZDELPI
+ PQNIS(JI,JJ,JK) = PQNIS(JI,JJ,JK) - ZDELNI
+ PQVS(JI,JJ,JK) = PQVS(JI,JJ,JK) + XECHARGE * (ZDELPI - ZDELNI)
+ ENDIF
+!
+!
+!* 1.1 Ion conduction to a particle
+!
+ ZDPIDT_C = 0.
+ ZDNIDT_C = 0.
+ ZEFIELD = SQRT(PEFIELDU(JI,JJ,JK)**2+PEFIELDV(JI,JJ,JK)**2+ &
+ PEFIELDW(JI,JJ,JK)**2)
+ ZQBOUND = 12. * XPI * XEPSILON * ZEFIELD * ZRADI**2
+ ZQ = PQVS(JI,JJ,JK) / ZNC
+!
+ IF (ABS(ZQ) < ZQBOUND) THEN
+ IF (PEFIELDW(JI,JJ,JK) > 0.) THEN ! opposite to fall velocity direction
+ ZDPIDT_C = 3. * XPI * ZRADI**2 * ZEFIELD * PQPIS(JI,JJ,JK) * &
+ XMOBIL_POS(JI,JJ,JK) * (1. - ZQ / ZQBOUND)**2
+ IF (ZVT < XMOBIL_NEG(JI,JJ,JK)*ZEFIELD) THEN
+ ZDNIDT_C = 3. * XPI * ZRADI**2 * ZEFIELD * PQNIS(JI,JJ,JK) * &
+ XMOBIL_NEG(JI,JJ,JK) * (1. + ZQ / ZQBOUND)**2
+ ELSE IF (ZQ > 0.) THEN
+ ZDNIDT_C = PQNIS(JI,JJ,JK) * XMOBIL_NEG(JI,JJ,JK) * ZQ / XEPSILON
+ ENDIF
+ ELSE IF (PEFIELDW(JI,JJ,JK) < 0.) THEN ! in the direction of fall veloc.
+ IF( ZVT < XMOBIL_POS(JI,JJ,JK)*ZEFIELD) THEN
+ ZDPIDT_C = 3. * XPI * ZRADI**2 * ZEFIELD * PQPIS(JI,JJ,JK) * &
+ XMOBIL_POS(JI,JJ,JK) * (1. - ZQ / ZQBOUND)**2
+ ELSE IF (ZQ < 0.) THEN
+ ZDPIDT_C = -PQPIS(JI,JJ,JK) * XMOBIL_POS(JI,JJ,JK) * ZQ / XEPSILON
+ ENDIF
+ ZDNIDT_C = 3. * XPI * ZRADI**2 * ZEFIELD * PQNIS(JI,JJ,JK) * &
+ XMOBIL_NEG(JI,JJ,JK) * (1. + ZQ / ZQBOUND)**2
+ ENDIF
+ ELSE IF (ZQ >= ZQBOUND) THEN
+ ZDPIDT_C = 0.
+ ZDNIDT_C = PQNIS(JI,JJ,JK) * XMOBIL_NEG(JI,JJ,JK) * ZQ / XEPSILON
+ ELSE IF (ZQ <= -ZQBOUND) THEN
+ ZDPIDT_C = -PQPIS(JI,JJ,JK) * XMOBIL_POS(JI,JJ,JK) * ZQ / XEPSILON
+ ZDNIDT_C = 0.
+ ENDIF
+!
+ ZDELPI = MIN(ZDPIDT_C*PTSTEP*ZNC, PQPIS(JI,JJ,JK))
+ ZDELNI = MIN(ZDNIDT_C*PTSTEP*ZNC, PQNIS(JI,JJ,JK))
+!
+ PQPIS(JI,JJ,JK) = PQPIS(JI,JJ,JK) - ZDELPI
+ PQNIS(JI,JJ,JK) = PQNIS(JI,JJ,JK) - ZDELNI
+ PQVS(JI,JJ,JK) = PQVS(JI,JJ,JK) + XECHARGE *(ZDELPI - ZDELNI)
+ END IF
+ENDDO
+!
+END SUBROUTINE DIFF_COND
+!
+!-----------------------------------------------------------------------------
+!
+END SUBROUTINE ION_ATTACH_ELEC
diff --git a/src/PHYEX/ext/latlon_to_xy.f90 b/src/PHYEX/ext/latlon_to_xy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d5879356511d4b00f687923928cb4535ee4289ed
--- /dev/null
+++ b/src/PHYEX/ext/latlon_to_xy.f90
@@ -0,0 +1,225 @@
+!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ PROGRAM LATLON_TO_XY
+! ####################
+!
+!!**** *LATLON_TO_XY* program to compute x and y from latitude and longiude
+!! for a MESONH file
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! module MODE_GRIDPROJ : contains projection routines
+!! SM_LATLON and SM_XYHAT
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! module MODD_GRID : variables for projection:
+!! XLAT0,XLON0,XRPK,XBETA
+!!
+!! module MODD_PGDDIM : specify the dimentions of the data arrays:
+!! NPGDIMAX and NPGDJMAX
+!!
+!! module MODD_PGDGRID : grid variables:
+!! XPGDLONOR,XPGDLATOR: longitude and latitude of the
+!! origine point for the conformal projection.
+!! XPGDXHAT,XPGDYHAT: position x,y in the conformal plane
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 29/12/95
+!!
+!! remove the USE MODI_DEFAULT_DESFM Apr. 17, 1996 (J.Stein)
+!! no transfer of the file when closing Dec. 09, 1996 (V.Masson)
+!! + changes call to READ_HGRID
+! 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 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 10/04/2020: add missing initializations (LATLON_TO_XY was not working)
+! J. Escobar 21/07/2020: missing modi_version
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+use MODD_CONF, only: CPROGRAM
+USE MODD_DIM_n
+USE MODD_GRID
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PGDDIM
+USE MODD_PGDGRID
+USE MODD_PARAMETERS
+USE MODD_LUNIT
+!
+USE MODE_FIELD, ONLY: INI_FIELD_LIST
+USE MODE_GRIDPROJ
+USE MODE_IO, only: IO_Config_set, IO_Init
+use MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+use MODE_INIT_ll, only: SET_DIM_ll, SET_JP_ll
+USE MODE_MODELN_HANDLER, ONLY: GOTO_MODEL
+USE MODE_POS, ONLY: POSNAM
+use MODE_SPLITTINGZ_ll
+!
+USE MODE_INI_CST, ONLY: INI_CST
+USE MODI_READ_HGRID
+USE MODI_VERSION
+!
+USE MODN_CONFIO, ONLY: NAM_CONFIO
+!
+IMPLICIT NONE
+!
+!* 0.2 Declaration of variables
+! ------------------------
+!
+CHARACTER(LEN=28) :: YINIFILE ! name of input FM file
+CHARACTER(LEN=28) :: YNAME ! true name of input FM file
+CHARACTER(LEN=28) :: YDAD ! name of dad of input FM file
+CHARACTER(LEN=2) :: YSTORAGE_TYPE
+INTEGER :: INAM ! Logical unit for namelist file
+INTEGER :: ILUOUT0 ! Logical unit for output file.
+INTEGER :: IRESP ! Return-code if problem eraised.
+REAL :: ZLAT ! input latitude
+REAL :: ZLON ! input longitude
+REAL :: ZXHAT ! output conformal coodinate x
+REAL :: ZYHAT ! output conformal coodinate y
+INTEGER :: II,IJ ! indexes of the point
+REAL :: ZI,ZJ ! fractionnal indexes of the point
+TYPE(TFILEDATA),POINTER :: TZINIFILE => NULL()
+TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL()
+LOGICAL :: GFOUND
+!
+!* 0.3 Declaration of namelists
+! ------------------------
+!
+NAMELIST/NAM_INIFILE/ YINIFILE
+!----------------------------------------------------------------------------
+!
+ WRITE(*,*) '+---------------------------------+'
+ WRITE(*,*) '| program latlon_to_xy |'
+ WRITE(*,*) '+---------------------------------+'
+ WRITE(*,*) ''
+ WRITE(*,*) 'Warning: I and J are integer for flux points'
+!
+!* 1. Initializations
+! ---------------
+!
+CALL GOTO_MODEL(1)
+!
+CALL VERSION()
+!
+CPROGRAM='LAT2XY'
+!
+CALL IO_Init()
+!
+CALL INI_CST()
+!
+CALL INI_FIELD_LIST()
+!
+!* 2. Reading of namelist file
+! ------------------------
+!
+!
+CALL IO_File_add2list(TZNMLFILE,'LATLON2XY1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE)
+INAM=TZNMLFILE%NLU
+!
+CALL POSNAM( TZNMLFILE, 'NAM_INIFILE', GFOUND )
+IF (GFOUND) THEN
+ READ(UNIT=INAM,NML=NAM_INIFILE)
+END IF
+!
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
+IF (GFOUND) THEN
+ READ(UNIT=INAM,NML=NAM_CONFIO)
+END IF
+!
+CALL IO_Config_set()
+CALL IO_File_close(TZNMLFILE)
+!
+!* 1. Opening of MESONH file
+! ----------------------
+!
+CALL IO_File_add2list(TZINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=2)
+CALL IO_File_open(TZINIFILE)
+!
+CALL IO_Field_read(TZINIFILE,'IMAX', NIMAX)
+CALL IO_Field_read(TZINIFILE,'JMAX', NJMAX)
+NKMAX = 1
+CALL IO_Field_read(TZINIFILE,'JPHEXT',JPHEXT)
+!
+CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DIM_ll(NIMAX, NJMAX, NKMAX)
+CALL INI_PARAZ_ll(IRESP)
+!
+!* 2. Reading of MESONH file
+! ----------------------
+!
+CALL READ_HGRID(0,TZINIFILE,YNAME,YDAD,YSTORAGE_TYPE)
+!
+!* 3. Closing of MESONH file
+! ----------------------
+!
+CALL IO_File_close(TZINIFILE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Reading of latitude and longitude
+! ---------------------------------
+!
+DO
+ WRITE(*,*) '-------------------------------------------------------------------'
+ WRITE(*,*) 'please enter the latitude (in decimal degrees; quit or q to stop):'
+ READ(*,*,ERR=1) ZLAT
+ WRITE(*,*) 'please enter the longitude (in decimal degrees; quit or q to stop):'
+ READ(*,*,ERR=1) ZLON
+!
+ CALL SM_XYHAT(XPGDLATOR,XPGDLONOR, &
+ ZLAT,ZLON,ZXHAT,ZYHAT)
+!
+ WRITE(*,*) 'x=', ZXHAT
+ WRITE(*,*) 'y=', ZYHAT
+!
+ II=MAX(MIN(COUNT(XPGDXHAT(:)<ZXHAT),NPGDIMAX+2*JPHEXT-1),1)
+ IJ=MAX(MIN(COUNT(XPGDYHAT(:)<ZYHAT),NPGDJMAX+2*JPHEXT-1),1)
+ ZI=(ZXHAT-XPGDXHAT(II))/(XPGDXHAT(II+1)-XPGDXHAT(II))+REAL(II)
+ ZJ=(ZYHAT-XPGDYHAT(IJ))/(XPGDYHAT(IJ+1)-XPGDYHAT(IJ))+REAL(IJ)
+!
+ IF ( (ZI>=1.) .AND. (ZI<=NPGDIMAX+2*JPHEXT+1) &
+ .AND. (ZJ>=1.) .AND. (ZJ<=NPGDJMAX+2*JPHEXT+1) ) THEN
+ WRITE(*,*) 'I=',ZI
+ WRITE(*,*) 'J=',ZJ
+ ELSE
+ WRITE(*,*) 'point not in the domain'
+ WRITE(*,*) 'I=',ZI
+ WRITE(*,*) 'J=',ZJ
+ END IF
+END DO
+1 WRITE(*,*) 'good bye'
+!
+!-------------------------------------------------------------------------------
+!
+END PROGRAM LATLON_TO_XY
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..6411b6cc5518e610d79264dfc126b8f9f38c6a79
--- /dev/null
+++ b/src/PHYEX/ext/lesn.f90
@@ -0,0 +1,3582 @@
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ 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_n, 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))
+ !ZZ_LES = vertical position of the mass points where data is computed
+ CALL LES_VER_INT( MZF(XZZ) ,ZZ_LES )
+ !XLES_Z = mean vertical altitude for each level (taking into account the mask)
+ 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/lidar.f90 b/src/PHYEX/ext/lidar.f90
new file mode 100644
index 0000000000000000000000000000000000000000..93cfad846b1d3342188e5e085056f1edbfb6a001
--- /dev/null
+++ b/src/PHYEX/ext/lidar.f90
@@ -0,0 +1,695 @@
+!MNH_LIC Copyright 2007-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_LIDAR
+! #################
+!
+INTERFACE
+ SUBROUTINE LIDAR(HCLOUD,HVIEW,PALT,PWVL,PZZ,PRHO,PT,PCLDFR,PRT, &
+ PLIDAROUT,PLIPAROUT,PCT,PDSTC,PDSTD,PDSTS)
+!
+CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! Name of the cloud scheme
+CHARACTER(LEN=*), INTENT(IN) :: HVIEW ! Upward or Downward integration
+REAL, INTENT(IN) :: PALT ! Altitude of the lidar source
+REAL, INTENT(IN) :: PWVL ! Wavelength of the lidar source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! Air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Air temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIDAROUT ! Lidar output
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIPAROUT ! Lidar output (particle only)
+
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PCT ! Concentration
+ ! (C2R2 and C1R3)
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTC ! Dust Concentration
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTD ! Dust Diameter
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTS ! Dust Sigma
+!
+
+!
+END SUBROUTINE LIDAR
+!
+END INTERFACE
+!
+END MODULE MODI_LIDAR
+! #########################################################
+ SUBROUTINE LIDAR(HCLOUD,HVIEW,PALT,PWVL,PZZ,PRHO,PT,PCLDFR,PRT, &
+ PLIDAROUT,PLIPAROUT,PCT,PDSTC,PDSTD,PDSTS)
+! #########################################################
+!
+!!**** *LIDAR * - computes pertinent lidar parameters
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the normalized backscattered
+!! signal of an upward or downward looking lidar in an atmosperic column
+!! containing air molecules, aerosols, cloud particles and hydrometeors.
+!!
+!!** METHOD
+!! ------
+!! The reflectivities are computed using the n(D) * D**6 formula. The
+!! equivalent reflectiviy is the sum of the reflectivity produced by the
+!! the raindrops and the equivalent reflectivities of the ice crystals.
+!! The latter are computed using the melted diameter. The Doppler
+!! reflectivity is the 'fall speed'-moment of individual particle
+!! reflectivity. Ice crystal are assumed to have no preferred orientation.
+!! the Z_VV formula is taken from Brandes et al. (MWR, 1995).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XPI !
+!! XRHOLW ! Liquid water density
+!! Module MODD_RAIN_ICE_DESCR
+!! Module MODD_RAIN_ICE_PARAM
+!!
+!! REFERENCE
+!! ---------
+!! Chaboureau et al. 2011: Long-range transport of Saharan dust and its
+!! radiative impact on precipitation forecast over western Europe: a case
+!! study during COPS. Quart. J. Roy. Meteor. Soc., 137, 236-251
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/10/07
+!! JP Chaboureau 12/02/10 change dust refraction index
+!! add inputs (lidar charact. and cloud fraction)
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! B.VIE 2016 : LIMA
+! P. Wautelet 18/03/2020: remove ICE2 option
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_CST
+USE MODD_RAIN_C2R2_DESCR, ONLY : XLBEXC, XLBEXR, &
+ XRTMIN, XCTMIN
+USE MODD_PARAM_C2R2, ONLY : YALPHAC=>XALPHAC,YNUC=>XNUC, &
+ YALPHAR=>XALPHAR,YNUR=>XNUR
+USE MODD_PARAM_ICE_n, ONLY: WSNOW_T=>LSNOW_T
+USE MODD_RAIN_ICE_DESCR_n, ONLY : XCCR, WLBEXR=>XLBEXR, XLBR, &
+ XCCS, XCXS, XLBEXS, XLBS, WNS=>XNS, WBS=>XBS, &
+ XCCG, XCXG, XLBEXG, XLBG, &
+ XCCH, XCXH, XLBEXH, XLBH, &
+ WRTMIN=>XRTMIN, &
+ WLBDAS_MAX=>XLBDAS_MAX,WLBDAS_MIN=>XLBDAS_MIN,WTRANS_MP_GAMMAS=>XTRANS_MP_GAMMAS
+USE MODD_ICE_C1R3_DESCR, ONLY : XLBEXI, &
+ YRTMIN=>XRTMIN, YCTMIN=>XCTMIN
+!
+USE MODD_PARAM_LIMA, ONLY : URTMIN=>XRTMIN, UCTMIN=>XCTMIN, &
+ UALPHAC=>XALPHAC,UNUC=>XNUC, &
+ UALPHAR=>XALPHAR,UNUR=>XNUR, &
+ UALPHAI=>XALPHAI,UNUI=>XNUI, &
+ USNOW_T=>LSNOW_T
+USE MODD_PARAM_LIMA_COLD, ONLY : UCCS=>XCCS, UCXS=>XCXS, ULBEXS=>XLBEXS, &
+ ULBS=>XLBS, UNS=>XNS, UBS=>XBS, &
+ ULBDAS_MAX=>XLBDAS_MAX,ULBDAS_MIN=>XLBDAS_MIN,UTRANS_MP_GAMMAS=>XTRANS_MP_GAMMAS
+USE MODD_PARAM_LIMA_MIXED,ONLY : UCCG=>XCCG, UCXG=>XCXG, ULBEXG=>XLBEXG, &
+ ULBG=>XLBG
+
+use mode_tools_ll, only: GET_INDICE_ll
+
+USE MODI_BHMIE_WATER ! Gamma or mono dispersed size distributions
+USE MODI_BHMIE_AEROSOLS ! Lognormal or mono dispersed size distributions
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! Name of the cloud scheme
+CHARACTER(LEN=*), INTENT(IN) :: HVIEW ! Upward or Downward integration
+REAL, INTENT(IN) :: PALT ! Altitude of the lidar source
+REAL, INTENT(IN) :: PWVL ! Wavelength of the lidar source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! Air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Air temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIDAROUT ! Lidar output
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIPAROUT ! Lidar output (particle only)
+
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PCT ! Concentration
+ ! (C2R2 and C1R3)
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTC ! Dust Concentration
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTD ! Dust Diameter
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTS ! Dust Sigma
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JI, JJ, JK
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE
+INTEGER :: IALT
+INTEGER, DIMENSION(3) :: IKMIN
+!
+REAL, PARAMETER :: ZCLDFRMIN = 1.0E-03 ! Cloud fraction minimum
+!
+!
+COMPLEX, PARAMETER :: ZZREFIND_WAT = (1.337E+00,1.818E-09) ! Refraction Index
+ ! of pure water
+COMPLEX, PARAMETER :: ZZREFIND_ICE = (1.312E+00,2.614E-09) ! Refraction Index
+ ! of pure ice
+!COMPLEX, PARAMETER :: ZZREFIND_DUST= (1.530E+00,8.000E-03) ! Refraction Index
+! ! of mineral dust
+! West, R. A., L. R. Doose, A. M. Eibl, M. G. Tomasko, and M. I. Mishchenko
+! (1997), Laboratory measurements of mineral dust scattering phase function
+! and linear polarization, J. Geophys. Res., 102(D14), 16,871-16,882.
+COMPLEX :: ZZREFIND_DUST
+
+! Tulet, P., M. Mallet, V. Pont, J. Pelon, and A. Boone (2008), The 7-13
+! March 2006 dust storm over West Africa: Generation, transport, and vertical
+! stratification, J. Geophys. Res., 113, D00C08, doi:10.1029/2008JD009871.
+!! Ri = 1.448-0.00292i for wavelengths between 0.185 and 0.69um.
+!! Ri = 1.44023-0.00116i for wavelengths between 0.69 and 1.19um.
+!! Ri = 1.41163-0.00106i for wavelengths between 1.19 and 4.0um.
+COMPLEX, PARAMETER :: ZZREFIND_DSTL= (1.448,2.92E-03)
+COMPLEX, PARAMETER :: ZZREFIND_DSTM= (1.44023,1.16E-03)
+COMPLEX, PARAMETER :: ZZREFIND_DSTH= (1.41163,1.06E-03)
+
+!
+! COMPLEX, PARAMETER :: ZZREFIND_WAT = (1.321E+00,1.280E-06) ! Refraction Index
+! ! of pure water
+! COMPLEX, PARAMETER :: ZZREFIND_ICE = (1.300E+00,1.898E-06) ! Refraction Index
+! ! of pure ice
+!
+COMPLEX, PARAMETER :: ZZREFIND_COAT= (1.337E+00,1.818E-09) ! Refraction Index
+ ! of coating material
+COMPLEX, PARAMETER :: ZZREFIND_BC = (1.870E+00,0.569E+00) ! Refraction Index
+ ! of black carbone
+REAL :: ZCXR=-1.0 ! for rain N ~ 1/N_0
+ ! (in Kessler parameterization)
+!
+REAL :: ZCMOL
+REAL :: ZWAVE_LENGTH
+! BETA: backscattering coefficient
+! ALPHA: extinction coefficient
+REAL, DIMENSION(SIZE(PRHO,1),SIZE(PRHO,2),SIZE(PRHO,3)) :: ZBETA_MOL
+REAL, DIMENSION(SIZE(PRHO,1),SIZE(PRHO,2),SIZE(PRHO,3)) :: ZALPH_MOL
+REAL, DIMENSION(SIZE(PRHO,1),SIZE(PRHO,2),SIZE(PRHO,3)) :: ZBETA_PAR
+REAL, DIMENSION(SIZE(PRHO,1),SIZE(PRHO,2),SIZE(PRHO,3)) :: ZALPH_PAR
+REAL, ALLOCATABLE, DIMENSION(:,:) :: ZOPTD_TOT ! Optical depths
+REAL, ALLOCATABLE, DIMENSION(:,:) :: ZOPTD_MOL
+REAL, ALLOCATABLE, DIMENSION(:,:) :: ZOPTD_PAR
+!
+CHARACTER (LEN=5) :: YDSD
+INTEGER :: IRADIUS, IANGLE
+REAL :: ZRADIUS, ZCONC, ZLWC, ZIWC
+REAL :: ZREFF_FACT
+REAL :: ZEXT_COEF, ZBAK_COEF
+REAL :: ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZTCEL
+REAL :: ZFRACVOL_CORE, ZDMODAL, ZSIG
+REAL :: ZFRACVOL_BC
+!
+REAL :: ZETACLD, ZETAAER ! Multiple diffusion paramter for cloud and dust
+!
+REAL, DIMENSION(5) :: ZPOLC, ZPOLR, ZPOLI ! BackScat. Coefficients
+!
+REAL, DIMENSION(10) :: ZRTMIN, ZCTMIN
+REAL :: ZLBEXR
+!
+INTEGER :: JL
+REAL :: ZALPHAC, ZNUC, ZALPHAR, ZNUR, ZALPHAI, ZNUI
+REAL :: ZCCS, ZCXS, ZLBEXS, ZLBS, ZNS
+REAL :: ZCCG, ZCXG, ZLBEXG, ZLBG
+!
+! -----------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PRHO,3) - JPVEXT
+!
+ZWAVE_LENGTH = PWVL
+ZCMOL=5.45E-32*((ZWAVE_LENGTH)/0.55E-6)**(-4.09)
+IF (ZWAVE_LENGTH<0.69E-6) THEN
+ PRINT *,'Tulet et al. refractive index - low wavelength'
+ ZZREFIND_DUST = ZZREFIND_DSTL
+ELSEIF (ZWAVE_LENGTH<1.00E-6) THEN
+ PRINT *,'Tulet et al. refractive index - medium wavelength'
+ ZZREFIND_DUST = ZZREFIND_DSTM
+ELSE
+ PRINT *,'Tulet et al. refractive index - high wavelength'
+ ZZREFIND_DUST = ZZREFIND_DSTH
+END IF
+ZPOLC = (/ 2.6980E-8,-3.7701E-6, 1.6594E-4,-0.0024, 0.0626 /)
+ZPOLR(:) = ZPOLC(:)
+ZPOLI = (/-1.0176E-8, 1.7615E-6,-1.0480E-4, 0.0019, 0.0460 /)
+!
+! Multiple diffusion parameter
+ZETAAER=1.0
+ZETACLD=1.0
+! a multiple scattering correction for lidar in space; Platt 73
+IF (HVIEW=='NADIR'.AND.PALT==0.) ZETACLD=0.5
+PRINT *,'Multiple diffusion parameter for aerosol ',ZETAAER
+PRINT *,'Multiple diffusion parameter for cloud ',ZETACLD
+!
+!
+!* 1. MORE INITIALIZATION
+! -------------------
+!
+SELECT CASE ( HCLOUD )
+ CASE('KESS')
+ ZRTMIN(1) = 1.0E-20
+ ZRTMIN(2) = 1.0E-20
+ ZRTMIN(3) = 1.0E-20
+ ZLBEXR = 1.0/(-1.0-3.0)
+ CASE('ICE3','ICE4')
+ ZRTMIN(1:SIZE(WRTMIN)) = WRTMIN(1:SIZE(WRTMIN))
+ ZLBEXR = WLBEXR
+ ZCCS = XCCS
+ ZCXS = XCXS
+ ZLBEXS = XLBEXS
+ ZLBS = XLBS
+ ZNS = WNS
+ ZCCG = XCCG
+ ZCXG = XCXG
+ ZLBEXG = XLBEXG
+ ZLBG = XLBG
+ CASE('C2R2')
+ ZRTMIN(1:SIZE(XRTMIN)) = XRTMIN(1:SIZE(XRTMIN))
+ ZCTMIN(1:SIZE(XCTMIN)) = XCTMIN(1:SIZE(XCTMIN))
+ ZLBEXR = XLBEXR
+ ZALPHAC = YALPHAC
+ ZNUR = YNUR
+ ZALPHAR = YALPHAR
+ ZNUC = YNUC
+ CASE('C3R5')
+ ZRTMIN(1:SIZE(YRTMIN)) = YRTMIN(1:SIZE(YRTMIN))
+ ZCTMIN(1:SIZE(YCTMIN)) = YCTMIN(1:SIZE(YCTMIN))
+ ZALPHAC = YALPHAC
+ ZNUR = YNUR
+ ZALPHAR = YALPHAR
+ ZNUC = YNUC
+ ZALPHAI = ZALPHAC
+ ZNUI = ZNUC
+ ZCCS = XCCS
+ ZCXS = XCXS
+ ZLBEXS = XLBEXS
+ ZLBS = XLBS
+ ZCCG = XCCG
+ ZCXG = XCXG
+ ZLBEXG = XLBEXG
+ ZLBG = XLBG
+ CASE('LIMA')
+ ZRTMIN(1:SIZE(URTMIN)) = URTMIN(1:SIZE(URTMIN))
+ ZCTMIN(1:SIZE(UCTMIN)) = UCTMIN(1:SIZE(UCTMIN))
+ ZALPHAC = UALPHAC
+ ZNUR = UNUR
+ ZALPHAR = UALPHAR
+ ZNUC = UNUC
+ ZALPHAI = UALPHAI
+ ZNUI = UNUI
+ ZCCS = UCCS
+ ZCXS = UCXS
+ ZLBEXS = ULBEXS
+ ZLBS = ULBS
+ ZNS = UNS
+ ZCCG = UCCG
+ ZCXG = UCXG
+ ZLBEXG = ULBEXG
+ ZLBG = ULBG
+END SELECT
+!
+! -----------------------------------------------------------------------------
+!
+!* 2. INITIALIZES THE MEAN-LAYER VARIABLES
+! ------------------------------------
+!
+!
+! MOLECULAR CONTRIBUTION
+!
+ZBETA_MOL(:,:,:) = ( PRHO(:,:,:)*XAVOGADRO/XMD )*ZCMOL
+ZALPH_MOL(:,:,:) = ZBETA_MOL(:,:,:)*(8.0*XPI/3.0)
+!
+! PARTICULAR CONTRIBUTION
+!
+ZBETA_PAR(:,:,:) = 0.
+ZALPH_PAR(:,:,:) = 0.
+!
+! AEROSOL CONTRIBUTION ! call bhmie_aerosols
+!
+IF (PRESENT(PDSTC)) THEN
+ DO JL = 1, SIZE(PDSTD,4)
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF ( PDSTD(JI,JJ,JK,JL)>0.1 ) THEN
+ !
+ ! Desert dust particles
+ !
+ YDSD = 'MONOD'
+ ZCONC = PDSTC(JI,JJ,JK,JL)
+ ZFRACVOL_CORE = 1.0
+ ZRADIUS = PDSTD(JI,JJ,JK,JL)*1.0E-6
+ IF( ZRADIUS .GE. 1.0E-3 ) ZRADIUS = ZRADIUS * 1.0E-6
+ CALL BHMIE_AEROSOLS( ZWAVE_LENGTH, ZZREFIND_DUST, ZZREFIND_DUST, &
+ YDSD, ZCONC, ZFRACVOL_CORE, ZEXT_COEF, &
+ ZBAK_COEF, PRADIUS=ZRADIUS )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETAAER * ZEXT_COEF
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
+ END IF
+ END DO
+ END DO
+ END DO
+ END DO
+END IF
+!
+!
+! HYDROMETEOR CONTRIBUTION ! call bhmie_water
+!
+! LIQUID WATER
+!
+! Some Prefactors: Assume Martin et al. (1994, JAS) for Reff
+!
+ZREFF_FACT = 1.0E-3*(3.E3/(4.0*XPI*0.67E-3))**0.33 ! Continental N=500
+ZREFF_FACT = 1.0E-3*(3.E3/(4.0*XPI*0.80E-3))**0.33 ! Maritime N=150
+!
+SELECT CASE ( HCLOUD )
+ CASE('KESS','ICE3','ICE4')
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF ( PRT(JI,JJ,JK,2)>ZRTMIN(2) .AND. PCLDFR(JI,JJ,JK)>ZCLDFRMIN) THEN
+!
+! Cloud droplets
+!
+ YDSD = 'MONOD'
+ ZCONC = 200.E6 ! Continental case
+ ZLWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,2) / PCLDFR(JI,JJ,JK)
+ ZRADIUS = MIN( 16.0E-6,MAX( 4.0E-6,ZREFF_FACT*(ZLWC/ZCONC)**0.33 ) )
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_WAT, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF &
+ * PCLDFR(JI,JJ,JK)
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF &
+ * PCLDFR(JI,JJ,JK)
+ END IF
+ END DO
+ END DO
+ END DO
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF ( PRT(JI,JJ,JK,3)>ZRTMIN(3) ) THEN
+!
+! Rain drops
+!
+ YDSD = 'MONOD'
+ ZLWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,3)
+ ZLBDAR = XLBR*(ZLWC)**ZLBEXR
+ ZCONC = XCCR*(ZLBDAR)**ZCXR
+ ZRADIUS = 0.5*(3.0/ZLBDAR) ! Assume Marshall-Palmer law for Reff
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_WAT, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
+ END IF
+ END DO
+ END DO
+ END DO
+ CASE ('C2R2','C3R5','LIMA')
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF (PRT(JI,JJ,JK,2)>ZRTMIN(2) .AND. PCT(JI,JJ,JK,2)>ZCTMIN(2)) THEN
+!
+! Cloud droplets
+!
+ YDSD = 'GAMMA'
+ ZCONC = PCT(JI,JJ,JK,2)
+ IRADIUS = 20
+ ZLWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,2)
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_WAT, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, KRADIUS=IRADIUS, &
+ PALPHA=ZALPHAC, PNU=ZNUC, PLWC=ZLWC )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
+ END IF
+ END DO
+ END DO
+ END DO
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF (PRT(JI,JJ,JK,3)>ZRTMIN(3) .AND. PCT(JI,JJ,JK,3)>ZCTMIN(3)) THEN
+!
+! Rain drops
+!
+ YDSD = 'GAMMA'
+ ZCONC = PCT(JI,JJ,JK,3)
+ IRADIUS = 20
+ ZLWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,3)
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_WAT, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, KRADIUS=IRADIUS, &
+ PALPHA=ZALPHAR, PNU=ZNUR, PLWC=ZLWC )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
+ END IF
+ END DO
+ END DO
+ END DO
+END SELECT
+!
+! SOLID ICE
+!
+SELECT CASE ( HCLOUD )
+ CASE('ICE3','ICE4')
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF ( PRT(JI,JJ,JK,4)>ZRTMIN(4) .AND. PCLDFR(JI,JJ,JK)>ZCLDFRMIN) THEN
+!
+! Pristine crystals
+!
+ YDSD = 'MONOD'
+ ZCONC = 10.E3 ! Continental case
+ ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,4) / PCLDFR(JI,JJ,JK)
+ ZTCEL = 10.0-0.0065*PZZ(JI,JJ,JK) ! A rough estimate
+ ZRADIUS = MIN( 350.0E-6,MAX( 45.0E-6,0.5E-6*(1.2351+0.0105*ZTCEL)* &
+ (5.8966*(ZIWC*1.0E3)**0.2214 + &
+ (0.7957*(ZIWC*1.0E3)**0.2535)*(ZTCEL+190.0)) ) )
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF &
+ *PCLDFR(JI,JJ,JK)
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF &
+ *PCLDFR(JI,JJ,JK)
+ END IF
+ END DO
+ END DO
+ END DO
+ CASE ('C3R5','LIMA')
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF (PRT(JI,JJ,JK,4)>ZRTMIN(4) .AND. PCT(JI,JJ,JK,4)>ZCTMIN(4)) THEN
+!
+! Pristine crystals
+!
+ YDSD = 'GAMMA'
+ ZCONC = PCT(JI,JJ,JK,4)
+ IRADIUS = 20
+ ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,4)
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, KRADIUS=IRADIUS, &
+ PALPHA=ZALPHAI, PNU=ZNUI, PLWC=ZIWC )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
+ END IF
+ END DO
+ END DO
+ END DO
+END SELECT
+SELECT CASE ( HCLOUD )
+ CASE('ICE3','ICE4','C3R5','LIMA')
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF ( PRT(JI,JJ,JK,5)>ZRTMIN(5) ) THEN
+!
+! Snow flakes
+!
+ YDSD = 'MONOD'
+ ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,5)
+ IF (HCLOUD=='LIMA' .AND. USNOW_T) THEN
+ IF (PT(JI,JJ,JK)>263.15) THEN
+ ZLBDAS = MAX(MIN(ULBDAS_MAX, 10**(14.554-0.0423*PT(JI,JJ,JK))),ULBDAS_MIN)*UTRANS_MP_GAMMAS
+ ELSE
+ ZLBDAS = MAX(MIN(ULBDAS_MAX, 10**(6.226-0.0106*PT(JI,JJ,JK))),ULBDAS_MIN)*UTRANS_MP_GAMMAS
+ END IF
+ ZCONC=ZNS*ZIWC*ZLBDAS**UBS
+ ELSE IF (HCLOUD=='ICE3' .AND. WSNOW_T) THEN
+ IF (PT(JI,JJ,JK)>263.15) THEN
+ ZLBDAS = MAX(MIN(WLBDAS_MAX, 10**(14.554-0.0423*PT(JI,JJ,JK))),WLBDAS_MIN)*WTRANS_MP_GAMMAS
+ ELSE
+ ZLBDAS = MAX(MIN(WLBDAS_MAX, 10**(6.226-0.0106*PT(JI,JJ,JK))),WLBDAS_MIN)*WTRANS_MP_GAMMAS
+ END IF
+ ZCONC=ZNS*ZIWC*ZLBDAS**WBS
+ ELSE
+ ZLBDAS = ZLBS*(ZIWC)**ZLBEXS
+ ZCONC = ZCCS*(ZLBDAS)**ZCXS
+ END IF
+ IF (ZLBDAS .GT. 0) THEN
+ ZRADIUS = 0.5*(3.0/ZLBDAS) ! Assume Marshall-Palmer law for Reff
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
+ END IF
+ END IF
+ END DO
+ END DO
+ END DO
+END SELECT
+SELECT CASE ( HCLOUD )
+ CASE('ICE3','ICE4','C3R5','LIMA')
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF ( PRT(JI,JJ,JK,6)>ZRTMIN(6) ) THEN
+!
+! Graupel particles
+!
+ YDSD = 'MONOD'
+ ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,6)
+ ZLBDAG = ZLBG*(ZIWC)**ZLBEXG
+ ZCONC = ZCCG*(ZLBDAG)**ZCXG
+ ZRADIUS = 0.5*(3.0/ZLBDAG) ! Assume Marshall-Palmer law for Reff
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
+ END IF
+ END DO
+ END DO
+ END DO
+END SELECT
+SELECT CASE ( HCLOUD )
+ CASE('ICE4')
+ DO JK = IKB, IKE
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ IF ( PRT(JI,JJ,JK,7)>ZRTMIN(7) ) THEN
+!
+! Hailstones
+!
+ YDSD = 'MONOD'
+ ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,7)
+ ZLBDAH = XLBH*(ZIWC)**XLBEXH
+ ZCONC = XCCH*(ZLBDAH)**XCXH
+ ZRADIUS = 0.5*(3.0/ZLBDAH) ! Assume Marshall-Palmer law for Reff
+ IANGLE = 11
+ CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
+ IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
+ ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
+ ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
+ END IF
+ END DO
+ END DO
+ END DO
+END SELECT
+!
+! -----------------------------------------------------------------------------
+!
+!* 3. PERFORMS THE BOTTOM-UP OR TOP-DOWN VERTICAL INTEGRATION
+! -------------------------------------------------------
+!
+!
+ALLOCATE(ZOPTD_TOT(SIZE(PRHO,1),SIZE(PRHO,2)))
+ALLOCATE(ZOPTD_MOL(SIZE(PRHO,1),SIZE(PRHO,2)))
+ALLOCATE(ZOPTD_PAR(SIZE(PRHO,1),SIZE(PRHO,2)))
+ZOPTD_TOT(:,:) = 0.
+ZOPTD_MOL(:,:) = 0.
+ZOPTD_PAR(:,:) = 0.
+!
+IF( HVIEW=='ZENIT' ) THEN
+ IALT=IKB
+ IF (PALT/=0.) THEN
+ IKMIN=MINLOC(ABS(PZZ(:,:,:)-PALT))
+ IALT=MIN(MAX(IKB,IKMIN(3)),IKE)
+ ENDIF
+ DO JK=IALT,IKE
+!
+! molecular optical depth
+!
+ ZOPTD_MOL(:,:) = ZOPTD_MOL(:,:) &
+ + ZALPH_MOL(:,:,JK)*(PZZ(:,:,JK)-PZZ(:,:,JK-1))
+!
+! Particular optical depth
+!
+ ZOPTD_PAR(:,:) = ZOPTD_PAR(:,:) &
+ + ZALPH_PAR(:,:,JK)*(PZZ(:,:,JK)-PZZ(:,:,JK-1))
+!
+! Total optical depth
+!
+ ZOPTD_TOT(:,:) = ZOPTD_MOL(:,:) + ZOPTD_PAR(:,:)
+!
+! Normalized Lidar profile
+!
+ PLIDAROUT(:,:,JK) = ( ZBETA_MOL(:,:,JK)+ZBETA_PAR(:,:,JK) ) &
+ * EXP( -2.0*ZOPTD_TOT(:,:) )
+!
+! Normalized Lidar particle profile
+!
+ PLIPAROUT(:,:,JK) = ZBETA_PAR(:,:,JK) * EXP( -2.0*ZOPTD_PAR(:,:) )
+ END DO
+ELSE IF( HVIEW=='NADIR' ) THEN
+ IALT=IKE
+ IF (PALT/=0.) THEN
+ IKMIN=MINLOC(ABS(PZZ(:,:,:)-PALT))
+ IALT=MIN(MAX(IKB,IKMIN(3)),IKE)
+ ENDIF
+ DO JK=IALT,IKB,-1
+!
+! molecular optical depth
+!
+ ZOPTD_MOL(:,:) = ZOPTD_MOL(:,:) &
+ + ZALPH_MOL(:,:,JK)*(PZZ(:,:,JK)-PZZ(:,:,JK-1))
+!
+! Particular optical depth
+!
+ ZOPTD_PAR(:,:) = ZOPTD_PAR(:,:) &
+ + ZALPH_PAR(:,:,JK)*(PZZ(:,:,JK)-PZZ(:,:,JK-1))
+!
+! Total optical depth
+!
+ ZOPTD_TOT(:,:) = ZOPTD_MOL(:,:) + ZOPTD_PAR(:,:)
+!
+! Normalized Lidar profile
+!
+ PLIDAROUT(:,:,JK) = ( ZBETA_MOL(:,:,JK)+ZBETA_PAR(:,:,JK) ) &
+ * EXP( -2.0*ZOPTD_TOT(:,:) )
+!
+! Normalized Lidar particle profile
+!
+ PLIPAROUT(:,:,JK) = ZBETA_PAR(:,:,JK) * EXP( -2.0*ZOPTD_PAR(:,:) )
+ END DO
+ENDIF
+!
+DEALLOCATE(ZOPTD_TOT,ZOPTD_MOL,ZOPTD_PAR)
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIDAR
diff --git a/src/PHYEX/ext/mnh2lpdm.f90 b/src/PHYEX/ext/mnh2lpdm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e5472663fb4f3727590afe015482fcab299981f6
--- /dev/null
+++ b/src/PHYEX/ext/mnh2lpdm.f90
@@ -0,0 +1,181 @@
+!MNH_LIC Copyright 2002-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------------
+! ######spl
+ PROGRAM MNH2LPDM
+! ##############
+!-----------------------------------------------------------------------------
+!**** MNH2DIF COUPLAGE MESO-NH / SPRAY.
+!
+! Auteur : Michel Bouzom, DP/SERV/ENV
+! Creation : 16.07.2002
+! Modification : 07.01.2006 (T.LAUVAUX, adaptation LPDM)
+! Modification : 04.01.2009 (F. BONNARDOT, DP/SER/ENV )
+! 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 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
+!
+!-----------------------------------------------------------------------------
+!
+!
+!
+!* 0. DECLARATIONS.
+! -------------
+!
+!* 0.1 Modules.
+!
+USE MODD_CONF, ONLY : CPROGRAM
+USE MODD_IO, ONLY : TFILEDATA, TFILE_OUTPUTLISTING, TPTR2FILE
+use modd_lunit, only: TLUOUT0
+use modd_lunit_n, only: TLUOUT
+USE MODD_MNH2LPDM
+!
+USE MODE_FIELD, ONLY: INI_FIELD_LIST, INI_FIELD_SCALARS
+USE MODE_IO, ONLY: IO_Init, IO_Config_set
+USE MODE_IO_FILE, ONLY: IO_File_open, IO_File_close
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
+USE MODE_MODELN_HANDLER
+use mode_msg
+USE MODE_POS
+!
+USE MODE_INI_CST, ONLY: INI_CST
+USE MODI_MNH2LPDM_ECH
+USE MODI_MNH2LPDM_INI
+USE MODI_VERSION
+!
+USE MODN_CONFIO
+!
+!
+!* 0.2 Variables locales.
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*),PARAMETER :: YFLOG = 'METEO.log' ! Log filename
+CHARACTER(LEN=*),PARAMETER :: YFNML = 'MNH2LPDM1.nam' ! Namelist filename
+INTEGER, PARAMETER :: IVERB = 5
+!
+INTEGER :: IFNML ! Unit of namelist
+INTEGER :: JFIC
+LOGICAL :: GFOUND ! Return code when searching namelist
+TYPE(TPTR2FILE),DIMENSION(JPMNHMAX) :: TZFMNH ! MesoNH files
+TYPE(TFILEDATA),POINTER :: TZDATEFILE => NULL() ! Date file
+TYPE(TFILEDATA),POINTER :: TZGRIDFILE => NULL() ! Grid file
+TYPE(TFILEDATA),POINTER :: TZMETEOFILE => NULL() ! Meteo file
+TYPE(TFILEDATA),POINTER :: TZLOGFILE => NULL() ! Log file
+TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL() ! Namelist file
+!
+!
+!
+!
+!* 1. INITIALISATION.
+! ---------------
+!
+CPROGRAM='M2LPDM'
+CALL GOTO_MODEL(1)
+CALL VERSION()
+CALL IO_Init()
+CALL INI_CST()
+CALL INI_FIELD_LIST()
+CALL INI_FIELD_SCALARS()
+!
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING1','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
+!Set output files for PRINT_MSG
+TLUOUT => TLUOUT0
+TFILE_OUTPUTLISTING => TLUOUT0
+!
+!* 1.1 Variables generales.
+!
+ CFMNH(:) = ''
+!
+!
+!* 1.2 Initialisation routines LL.
+!
+CALL IO_Init()
+!
+!
+!* 1.3 Ouverture du fichier log.
+!
+CALL IO_File_add2list(TZLOGFILE,YFLOG,'TXT','WRITE')
+CALL IO_File_open(TZLOGFILE)
+!
+!
+!* 1.4 Lecture des namelists.
+!
+CALL IO_File_add2list(TZNMLFILE,YFNML,'NML','READ')
+CALL IO_File_open(TZNMLFILE)
+IFNML = TZNMLFILE%NLU
+
+READ(UNIT=IFNML,NML=NAM_TURB)
+READ(UNIT=IFNML,NML=NAM_FIC)
+print *,'Lecture de NAM_FIC OK.'
+
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
+IF (GFOUND) THEN
+ READ(UNIT=IFNML,NML=NAM_CONFIO)
+END IF
+LCDF4 = .FALSE.
+LLFIOUT = .FALSE.
+LLFIREAD = .FALSE.
+CALL IO_Config_set()
+CALL IO_File_close(TZNMLFILE)
+!
+!
+!* 1.5 Comptage des FM a traiter.
+!
+IF (LEN_TRIM(CFMNH(1))>0) THEN
+ NBMNH=1
+ CALL IO_File_add2list(TZFMNH(1)%TZFILE,TRIM(CFMNH(1)),'MNH','READ',KLFITYPE=2,KLFIVERB=IVERB)
+ DO WHILE (CFMNH(NBMNH+1).NE.'VIDE')
+ NBMNH=NBMNH+1
+ CALL IO_File_add2list(TZFMNH(NBMNH)%TZFILE,TRIM(CFMNH(NBMNH)),'MNH','READ',KLFITYPE=2,KLFIVERB=IVERB)
+ END DO
+ print *,NBMNH,' fichiers a traiter.'
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH2LPDM', 'no CFMNH file given' )
+END IF
+!
+!
+!
+!
+!* 2. TRAITEMENTS.
+! ------------
+!
+!* 2.1 Ouverture des fichiers METEO et GRILLE et DATE.
+!
+CALL IO_File_add2list(TZGRIDFILE,CFGRI,'TXT','WRITE')
+CALL IO_File_open(TZGRIDFILE)
+CALL IO_File_add2list(TZDATEFILE,CFDAT,'TXT','WRITE')
+CALL IO_File_open(TZDATEFILE)
+!
+!
+!* 2.2 Preparation du couplage.
+!
+CALL MNH2LPDM_INI(TZFMNH(1)%TZFILE,TZFMNH(NBMNH)%TZFILE,TZLOGFILE,TZGRIDFILE,TZDATEFILE)
+!
+!
+!* 2.3 Traitement des echeances.
+!
+DO JFIC=1,NBMNH
+ print*,"CFMTO(JFIC)=",CFMTO(JFIC)
+ CALL IO_File_add2list(TZMETEOFILE,CFMTO(JFIC),'METEO','WRITE')
+ CALL IO_File_open(TZMETEOFILE)
+ CALL MNH2LPDM_ECH(TZFMNH(JFIC)%TZFILE,TZMETEOFILE)
+ print*,"CLOSE_LL(CFMTO(JFIC)"
+ CALL IO_File_close(TZMETEOFILE)
+ TZMETEOFILE => NULL()
+END DO
+!
+!
+!* 2.4 Fermeture des fichiers, METEO, GRILLE et LOG.
+!
+CALL IO_File_close(TZGRIDFILE)
+CALL IO_File_close(TZDATEFILE)
+CALL IO_File_close(TZLOGFILE)
+!
+!
+!
+END PROGRAM MNH2LPDM
diff --git a/src/PHYEX/ext/mnh2lpdm_ech.f90 b/src/PHYEX/ext/mnh2lpdm_ech.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a916c8922e4c593d22658fce09a769978a0d2163
--- /dev/null
+++ b/src/PHYEX/ext/mnh2lpdm_ech.f90
@@ -0,0 +1,497 @@
+!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------------
+! ######spl
+ SUBROUTINE MNH2LPDM_ECH(TPFILE,TPMETEOFILE)
+! ##################################################
+!-----------------------------------------------------------------------
+!**** MNH2S2_ECH TRAITEMENT D'UNE ECHEANCE.
+!
+! Auteur : Francois Bonnardot, DP/SERV/ENV
+! Creation : 07.01.2009
+! Modifications:
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/05/2018: corrected truncated integer division (1/3 -> 1./3.)
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
+!-----------------------------------------------------------------------
+!
+!* 0. DECLARATIONS.
+! -------------
+!
+!* 0.1 Modules.
+!
+!
+!
+USE MODD_DIM_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_TIME_n
+USE MODD_GRID_n
+!
+USE MODD_CST
+USE MODD_PARAMETERS
+USE MODD_TIME
+!
+USE MODD_MNH2LPDM
+!
+use modd_field, only: tfieldmetadata, TYPEREAL
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+!
+IMPLICIT NONE
+!
+!
+!* 0.2 Arguments.
+!
+TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPFILE
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPMETEOFILE
+!
+!
+!* 0.3 Variables locales.
+!
+CHARACTER(LEN=100) :: YFTURB ! Stockage champs de turbulence.
+INTEGER :: IFTURB
+INTEGER :: IFMTO,IREP
+INTEGER :: ICURAA,ICURMM,ICURJJ ! Date courante.
+INTEGER :: ICURHH,ICURMN,ICURSS ! Heure courante.
+INTEGER :: JI,JJ,JK
+TYPE(DATE_TIME) :: TZDTCUR
+type(tfieldmetadata) :: tzfield
+TYPE(TFILEDATA),POINTER :: TZFILE
+!
+!
+!
+!
+!* 1. INITIALISATION.
+! ---------------
+!
+!* 1.1 Blabla.
+!
+TZFILE => NULL()
+IFMTO = TPMETEOFILE%NLU
+!
+!* 2. LECTURE DES DONNEES MESO-NH DE BASE.
+! ------------------------------------
+!
+!* 2.1 Ouverture du fichier Meso-NH.
+!
+CALL IO_File_open(TPFILE)
+!
+!* 2.2 Date et heure courante.
+!
+CALL IO_Field_read(TPFILE,'DTCUR',TZDTCUR)
+!
+ICURAA=MOD(TZDTCUR%nyear,100) ! Annee sur 2 caracteres.
+ICURMM=TZDTCUR%nmonth
+ICURJJ=TZDTCUR%nday
+ICURSS=NINT(TZDTCUR%xtime)
+!
+ICURMN = NINT( (REAL(ICURSS)/60.0)/5.0 )*5 ! Heure arrondie a 5 minutes pres.
+ICURSS = 0
+ICURHH =ICURMN/60
+ICURMN =ICURMN-ICURHH*60
+!
+print*, '%%% MNH2LPDM2_ECH Date et heure des donnees :'
+print 20300, ICURJJ,ICURMM,ICURAA,ICURHH,ICURMN,ICURSS
+20300 FORMAT(I2.2,'/',I2.2,'/',I4.4,' ',I2.1,'h',I2.1,'mn',I2.1,'sec')
+!
+!
+!
+!* 2.3 Lecture des champs Meso-NH de base.
+!
+CALL IO_Field_read(TPFILE,'UT', XUT)
+CALL IO_Field_read(TPFILE,'VT', XVT)
+CALL IO_Field_read(TPFILE,'WT', XWT)
+CALL IO_Field_read(TPFILE,'THT', XTHT)
+CALL IO_Field_read(TPFILE,'TKET', XTKET)
+
+tzfield = tfieldmetadata( &
+ cmnhname = 'LM', &
+ clongname = '', &
+ cunits = 'm', &
+ cdir = 'XY', &
+ ccomment = 'Mixing length', &
+ ngrid = 1, &
+ ntype = TYPEREAL, &
+ ndims = 3 )
+CALL IO_Field_read(TPFILE, tzfield, XLM)
+
+tzfield = tfieldmetadata(&
+ cmnhname = 'THW_FLX', &
+ clongname = '', &
+ cunits = 'K s-1', & !correct?
+ cdir = 'XY', &
+ ccomment = 'Conservative potential temperature vertical flux', &
+ ngrid = 4, &
+ ntype = TYPEREAL, &
+ ndims = 3 )
+CALL IO_Field_read(TPFILE, tzfield, XWPTHP)
+
+tzfield = tfieldmetadata( &
+ cmnhname = 'DISS', &
+ clongname = '', &
+ cunits = '', & !TODO: set units
+ cdir = 'XY', &
+ ccomment = 'X_Y_Z_DISS', &
+ ngrid = 1, &
+ ntype = TYPEREAL, &
+ ndims = 3 )
+CALL IO_Field_read(TPFILE, tzfield, XDISSIP)
+
+tzfield = tfieldmetadata( &
+ cmnhname = 'FMU', &
+ clongname = '', &
+ cunits = 'kg m-1 s-2', &
+ cdir = 'XY', &
+ ccomment = 'X_Y_FMU', &
+ ngrid = 4, &
+ ntype = TYPEREAL, &
+ ndims = 2 )
+CALL IO_Field_read(TPFILE, tzfield, XSFU)
+
+tzfield = tfieldmetadata( &
+ cmnhname = 'FMV', &
+ clongname = '', &
+ cunits = 'kg m-1 s-2', &
+ cdir = 'XY', &
+ ccomment = 'X_Y_FMV', &
+ ngrid = 4, &
+ ntype = TYPEREAL, &
+ ndims = 2 )
+CALL IO_Field_read(TPFILE, tzfield, XSFV)
+
+CALL IO_Field_read(TPFILE,'INPRT', XINRT)
+CALL IO_Field_read(TPFILE,'RVT', XRMVT)
+CALL IO_Field_read(TPFILE,'RCT', XRMCT)
+CALL IO_Field_read(TPFILE,'RRT', XRMRT)
+!
+! Lecture des donnees Meso-NH terminee.'
+!
+!* 2.4 Fermeture du fichier Meso-NH.
+!
+CALL IO_File_close(TPFILE)
+!
+!
+!* 3. PREPARATION DES DONNEES.
+! ------------------------
+!
+!
+!* 3.2 Niveaux altitude "hors-sol" (1:NKMAX).
+!
+XSU(:,:,1:NKMAX) = XUT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSV(:,:,1:NKMAX) = XVT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSW(:,:,1:NKMAX) = XWT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSTH(:,:,1:NKMAX) = XTHT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSTKE(:,:,1:NKMAX) = XTKET(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSLM(:,:,1:NKMAX) = XLM(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSDISSIP(:,:,1:NKMAX) = XDISSIP(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSINRT(:,:) = XINRT(NSIB:NSIE,NSJB:NSJE)
+XSWPTHP(:,:,1:NKMAX) = XWPTHP(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSRMV(:,:,1:NKMAX) = XRMVT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSRMC(:,:,1:NKMAX) = XRMCT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSRMR(:,:,1:NKMAX) = XRMRT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
+XSSFU(:,:) = XSFU(NSIB:NSIE,NSJB:NSJE)
+XSSFV(:,:) = XSFV(NSIB:NSIE,NSJB:NSJE)
+!
+!
+!* 4. CALCULS DES TEMPS LAGRANGIENS ET VARIANCES DU VENT POUR LPDM.
+! ------------------------------------------------------------
+!
+ XRVSRD = XRV/XRD
+!
+ XSUSTAR (:,:) = XUNDEF
+ XSLMO (:,:) = XUNDEF
+ XSHMIX (:,:) = XUNDEF
+ XSWSTAR (:,:) = XUNDEF
+ XSSIGU (:,:,:) = XUNDEF
+ XSSIGW (:,:,:) = XUNDEF
+ XSTIMEU (:,:,:) = XUNDEF
+ XSTIMEW (:,:,:) = XUNDEF
+!
+ DO JI=1,NSIMAX ; DO JJ=1,NSJMAX
+ !
+ !* Temperature potentielle virtuelle.
+ !
+ XSTHETAV(:)=1.0+XSRMV(JI,JJ,:)+XSRMC(JI,JJ,:)+XSRMR(JI,JJ,:)
+ XSTHETAV(:) = XSTH(JI,JJ,:)*(1.0+XSRMV(JI,JJ,:)*XRVSRD)/XSTHETAV(:)
+ !
+ !* ZHMIX Hauteur de melange.
+ !
+ XTHSOL = XSTHETAV(1)+0.5
+ XSHMIX(JI,JJ) = 0.0
+ DO JK=2,NKMAX
+ IF ( XSTHETAV(JK).GT.XTHSOL ) THEN
+ XSHMIX(JI,JJ) = XSHAUT (JK-1) &
+ +( XSHAUT (JK) - XSHAUT (JK-1) ) &
+ /( XSTHETAV(JK) - XSTHETAV(JK-1) ) &
+ *( XTHSOL - XSTHETAV(JK-1) )
+ EXIT
+ ENDIF
+ END DO
+ XSHMIX(JI,JJ)=MAX(XSHMIX(JI,JJ),50.0)
+
+ !
+ !* XSUSTAR Vitesse de frottement.
+ !
+ XSUSTAR(JI,JJ) = XSSFU(JI,JJ)*XSSFU(JI,JJ) &
+ +XSSFV(JI,JJ)*XSSFV(JI,JJ)
+ XSUSTAR(JI,JJ) = SQRT(SQRT(XSUSTAR(JI,JJ)))
+ !
+ !
+ !
+ !* XSLMO Longueur de Monin-Obukhov.
+ !
+ IF (XSWPTHP(JI,JJ,1).NE.0.) THEN
+ XSLMO(JI,JJ)= -XSTHETAV(1)*(XSUSTAR(JI,JJ)**3) &
+ / (XKARMAN*XG*XSWPTHP(JI,JJ,1))
+ ENDIF
+ !
+ !
+ !* XSWSTAR Vitesse Verticale Convective.
+ !
+ XSWSTAR(JI,JJ)=XG/XSTHETAV(1)*XSWPTHP(JI,JJ,1)*XSHMIX(JI,JJ)
+ XSWSTAR(JI,JJ)=SIGN(1.,XSWSTAR(JI,JJ)) &
+ * ( ABS(XSWSTAR(JI,JJ))**(1./3.))
+ !
+ !
+ IF (CTURBPARAM=="HANNA".OR.CTURBPARAM=="HANNABIS") THEN
+ !
+ IF ((XSLMO(JI,JJ).GT.0).AND.(XSLMO(JI,JJ).LE.300)) THEN
+ !
+ !* Conditions stables.
+ !
+ !* XSSIGU,XSSIGW <u'2>**0.5, <w'2>**0.5
+ DO JK=1,NKMAX
+ IF (XSHAUT(JK).LT.XSHMIX(JI,JJ)) THEN
+ XSSIGU(JI,JJ,JK) = SQRT( 0.5 * &
+ ((2.0*(1-XSHAUT(JK)/XSHMIX(JI,JJ))*XSUSTAR(JI,JJ))**2) &
+ + ((1.3*(1-XSHAUT(JK)/XSHMIX(JI,JJ))*XSUSTAR(JI,JJ))**2) )
+ XSSIGW(JI,JJ,JK) = 1.3*(1-XSHAUT(JK)/XSHMIX(JI,JJ)) &
+ *XSUSTAR(JI,JJ)
+ ELSE
+ XSSIGU(JI,JJ,JK) = 0.001
+ XSSIGW(JI,JJ,JK) = 0.001
+ ENDIF
+ ENDDO
+ !
+ XSSIGU(JI,JJ,:)=MAX(0.001,XSSIGU(JI,JJ,:))
+ XSSIGW(JI,JJ,:)=MAX(0.001,XSSIGW(JI,JJ,:))
+ !
+ !* Lagrangian time scale
+ XSTIMEU(JI,JJ,:) = 0.11*XSHMIX(JI,JJ)/XSSIGU(JI,JJ,:) &
+ *SQRT( XSHAUT(:)/XSHMIX(JI,JJ) )
+ XSTIMEW(JI,JJ,:) = 0.10*XSHMIX(JI,JJ)/XSSIGW(JI,JJ,:) &
+ *( XSHAUT(:)/XSHMIX(JI,JJ) )**0.8
+ !
+ !
+ ENDIF
+ !
+ !
+ IF (ABS(XSLMO(JI,JJ)).GT.300) THEN
+ !
+ !* Conditions neutres.
+ !
+ !* XSSIGU,XSSIGW <u'2>**0.5, <w'2>**0.5
+ XSSIGU(JI,JJ,:)=SQRT( 0.5 * &
+ ((2.0*XSUSTAR(JI,JJ)*EXP(-3*XSCORIOZ(JI,JJ)*XSHAUT(:)/XSUSTAR(JI,JJ)))**2) &
+ + ((1.3*XSUSTAR(JI,JJ)*EXP(-2*XSCORIOZ(JI,JJ)*XSHAUT(:)/XSUSTAR(JI,JJ)))**2) )
+ XSSIGW(JI,JJ,:)=1.3*XSUSTAR(JI,JJ)*EXP(-2*XSCORIOZ(JI,JJ)*XSHAUT(:)/XSUSTAR(JI,JJ))
+ XSSIGU(JI,JJ,:)=MAX(0.001,XSSIGU(JI,JJ,:))
+ XSSIGW(JI,JJ,:)=MAX(0.001,XSSIGW(JI,JJ,:))
+ !
+ !* lagrangian time scale
+ XSTIMEU(JI,JJ,:) = 0.5*XSHAUT(:)/ &
+ (XSSIGW(JI,JJ,:)*(1.+15.0*XSCORIOZ(JI,JJ)*XSHAUT(:)/XSUSTAR(JI,JJ)))
+ XSTIMEW(JI,JJ,:) = XSTIMEU(JI,JJ,:)
+ !
+ ENDIF
+ !
+ !
+ IF ((XSLMO(JI,JJ).LT.0).AND.(XSLMO(JI,JJ).GE.-300)) THEN
+ !
+ !* Conditions instables.
+ !
+ !* XSSIGU,XSSIGW <u'2>**0.5, <w'2>**0.5
+ !
+ IF (CTURBPARAM=="HANNA") THEN
+ !
+ DO JK=1,NKMAX
+ IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
+ XSSIGU(JI,JJ,JK)=XSUSTAR(JI,JJ) &
+ * (12+0.5*XSHMIX(JI,JJ)/ABS(XSLMO(JI,JJ)))**(1./3.)
+ ELSE
+ XSSIGU(JI,JJ,JK)=0.001
+ ENDIF
+ ENDDO
+ !
+ DO JK=1,NKMAX
+ !IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
+ ! XSSIGW(JI,JJ,JK)=SQRT( 1.2*XSWSTAR(JI,JJ)**2 &
+ ! *(1-0.9*XSHAUT(JK)/XSHMIX(JI,JJ)) &
+ ! *(XSHAUT(JK)/XSHMIX(JI,JJ))**(2/3) &
+ ! + (1.8-1.4*XSHAUT(JK)/XSHMIX(JI,JJ)) &
+ ! *XSUSTAR(JI,JJ)**2 )
+ !ELSE
+ IF (XSHAUT(JK).LE.0.4*XSHMIX(JI,JJ)) THEN
+ XSSIGW(JI,JJ,JK)=0.763*(XSHAUT(JK)/XSHMIX(JI,JJ))**0.175
+ ELSE IF (XSHAUT(JK).LE.0.96*XSHMIX(JI,JJ)) THEN
+ XSSIGW(JI,JJ,JK)=0.722*XSWSTAR(JI,JJ)* &
+ (1-XSHAUT(JK)/XSHMIX(JI,JJ))**0.207
+ ELSE IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
+ XSSIGW(JI,JJ,JK)=0.37*XSWSTAR(JI,JJ)
+ ELSE
+ XSSIGW(JI,JJ,JK)=0.001
+ ENDIF
+ ENDDO
+ !
+ XSSIGU(JI,JJ,:)=MAX(0.001,XSSIGU(JI,JJ,:))
+ XSSIGW(JI,JJ,:)=MAX(0.001,XSSIGW(JI,JJ,:))
+ !
+ !* Lagrangian time scale
+ XSTIMEU(JI,JJ,:) = 0.15*XSHMIX(JI,JJ)/XSSIGU(JI,JJ,:)
+ DO JK=1,NKMAX
+ IF (XSHAUT(JK).LE.(0.1*XSHMIX(JI,JJ))) THEN
+ IF ( XSHAUT(JK).LT.(XSZ0(JI,JJ)-XSLMO(JI,JJ)) ) THEN
+ XSTIMEW(JI,JJ,JK) = 0.1*XSHAUT(JK)/XSSIGW(JI,JJ,JK) &
+ / ( 0.55 - 0.38*(XSHAUT(JK)-XSZ0(JI,JJ))/ABS(XSLMO(JI,JJ)))
+ ELSE
+ XSTIMEW(JI,JJ,JK) = 0.59*XSHAUT(JK)/XSSIGW(JI,JJ,JK)
+ ENDIF
+ ELSE
+ XSTIMEW(JI,JJ,JK) = 0.15*XSHMIX(JI,JJ)/XSSIGW(JI,JJ,JK) &
+ *( 1.-EXP(-5*XSHAUT(JK)/XSHMIX(JI,JJ)) )
+ ENDIF
+ END DO
+ !
+ ELSE IF (CTURBPARAM=="HANNABIS") THEN
+ !* sigmas
+ XSSIGW(JI,JJ,:) = SQRT(2./3.*XSTKE(JI,JJ,:))
+ XSSIGU(JI,JJ,:) = XSSIGW(JI,JJ,:)
+ !* Temps Lagrangien
+ DO JK=1,NKMAX
+ IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
+ XSTIMEU(JI,JJ,JK)=0.17*XSHMIX(JI,JJ)/XSSIGU(JI,JJ,JK)
+ XSTIMEW(JI,JJ,JK)=0.2*XSHMIX(JI,JJ)/XSSIGW(JI,JJ,JK)* &
+ (1-EXP(-4*XSHAUT(JK)/XSHMIX(JI,JJ)) &
+ -0.0003*EXP(8*XSHAUT(JK)/XSHMIX(JI,JJ)))
+ ELSE IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)*1.2) THEN
+ XSTIMEU(JI,JJ,JK)= &
+ (1-(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1)))* &
+ XSTIMEU(JI,JJ,JK-1) &
+ +(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1))*10000.0
+ XSTIMEW(JI,JJ,JK)= &
+ (1-(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1)))* &
+ XSTIMEW(JI,JJ,JK-1) &
+ +(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1))*10000.0
+ ELSE
+ XSTIMEU(JI,JJ,JK)=10000.0
+ XSTIMEW(JI,JJ,JK)=10000.0
+ ENDIF
+ ENDDO
+ !
+ ENDIF ! CTURBPARAM=HANNA ou HANNABIS
+ !
+ ENDIF ! instable
+ !
+ ELSE ! CTURBPARAM=="ISOTROPE"
+ !
+ !* XSSIGU,XSSIGW <u'2>**0.5, <w'2>**0.5
+ !
+ XSSIGW(JI,JJ,:) = SQRT(2./3.*XSTKE(JI,JJ,:))
+ XSSIGU(JI,JJ,:) = XSSIGW(JI,JJ,:)
+ !
+ !* Lagrangian time scale
+ DO JK=1,NKMAX
+ IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
+ XSTIMEU(JI,JJ,JK)=ABS(2*(XSSIGU(JI,JJ,JK)**2)/(3*XSDISSIP(JI,JJ,JK)))
+ XSTIMEW(JI,JJ,JK)=ABS(2*(XSSIGW(JI,JJ,JK)**2)/(3*XSDISSIP(JI,JJ,JK)))
+ ELSE IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)*1.2) THEN
+ XSTIMEU(JI,JJ,JK)= &
+ (1-(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1)))*XSTIMEU(JI,JJ,JK-1) &
+ +(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1))*1000.0
+ XSTIMEW(JI,JJ,JK)=XSTIMEU(JI,JJ,JK)
+ ELSE
+ XSTIMEU(JI,JJ,JK)=1000.0
+ XSTIMEW(JI,JJ,JK)=1000.0
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ !
+ !
+ END DO
+ END DO
+ !
+ IF (IGRILLE.EQ.2) THEN
+ WRITE(YFTURB,'("TURB_LPDM",5I2.2)') ICURAA,ICURMM,ICURJJ,ICURHH,ICURMN
+ CALL IO_File_add2list(TZFILE,YFTURB,'TXT','WRITE')
+ CALL IO_File_open(TZFILE)
+ IFTURB = TZFILE%NLU
+ WRITE(UNIT=IFTURB,FMT='(5A12)') "WSTAR ","USTAR ", &
+ "HMIX ","LMO ", &
+ "WPTHP"
+ WRITE(UNIT=IFTURB,FMT='(5F12.5)') XSWSTAR(15,15),XSUSTAR(15,15), &
+ XSHMIX(15,15),XSLMO(15,15), &
+ XSWPTHP(15,15,1)
+
+
+ WRITE(UNIT=IFTURB,FMT='(8A12)') "HAUT ","TKE ", &
+ "DISS ","THETA ", &
+ "SIGU ","SIGW ", &
+ "TIMEU ","TIMEW "
+ DO JK=1,NKMAX
+ WRITE(UNIT=IFTURB,FMT='(6F12.5,2F12.1)') XSHAUT(JK),XSTKE(15,15,JK), &
+ XSDISSIP(15,15,JK),XSTH(15,15,JK), &
+ XSSIGU(15,15,JK),XSSIGW(15,15,JK), &
+ XSTIMEU(15,15,JK),XSTIMEW(15,15,JK)
+
+ ENDDO
+ CALL IO_File_close(TZFILE)
+ ENDIF
+!
+
+
+!
+!* 5. ECRITURES FIC MTO.
+! ------------------
+!
+!
+DO JK = 1,NKMAX
+WRITE(IFMTO) XSU(:,:,JK) ! Composante zonale du vent.
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) XSV(:,:,JK) ! Composante meridienne du vent.
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) XSW(:,:,JK) ! Vitesse verticale.
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) XSTH(:,:,JK) ! Temperature potentielle.
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) XSTKE(:,:,JK) ! Energie cinetique Turbulence
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) (XSSIGU(:,:,JK))**2 ! SigmaU
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) (XSSIGU(:,:,JK))**2 ! SigmaV
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) (XSSIGW(:,:,JK))**2 ! SigmaW
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) XSTIMEU(:,:,JK) ! Temps lagrangien U
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) XSTIMEU(:,:,JK) ! Temps lagrangien V
+ENDDO
+DO JK = 1,NKMAX
+WRITE(IFMTO) XSTIMEW(:,:,JK) ! Dissipation de TKE
+ENDDO
+WRITE(IFMTO) XSINRT
+!
+END SUBROUTINE MNH2LPDM_ECH
diff --git a/src/PHYEX/ext/mnh2lpdm_ini.f90 b/src/PHYEX/ext/mnh2lpdm_ini.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a18acfcbec58726cee80ab7c9f92620c6b5c96bd
--- /dev/null
+++ b/src/PHYEX/ext/mnh2lpdm_ini.f90
@@ -0,0 +1,459 @@
+!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------------
+! ######spl
+ SUBROUTINE MNH2LPDM_INI(TPFILE1,TPFILE2,TPLOGFILE,TPGRIDFILE,TPDATEFILE)
+!--------------------------------------------------------------------------
+!* MNH2S2_INI : INITIALISATION DU COUPLAGE MESO-NH / LPDM.
+!
+! Auteur : Francois BONNARDOT, DP/SERV/ENV
+! Creation : 04.01.2009 (mnh2s2_ini.f90)
+!
+!
+! Arguments explicites.
+! ---------------------
+! TPFILE1,TPFILE2 First and last files to treat
+! TPLOGFILE Log file
+! TPGRIDFILE Grid file
+! TPDATEFILE Date file
+!
+! Modifications:
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
+!--------------------------------------------------------------------------
+!
+!
+!
+!* 0. INITIALISATION.
+! ---------------
+!
+!* 0.1 Modules.
+!
+USE MODD_CST
+USE MODD_DIM_n
+use modd_field, only: tfieldmetadata, TYPEREAL
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT
+USE MODD_MNH2LPDM
+USE MODD_PARAMETERS
+USE MODD_TIME
+USE MODD_TIME_n
+!
+USE MODE_DATETIME
+USE MODE_GRIDPROJ
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_MODELN_HANDLER
+!
+USE MODE_INI_CST, ONLY: INI_CST
+USE MODI_READ_HGRID
+USE MODI_XYTOLATLON
+!
+!* 0.2 Arguments.
+!
+IMPLICIT NONE
+!
+TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPFILE1,TPFILE2
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPLOGFILE
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPGRIDFILE
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPDATEFILE
+!
+!
+!* 0.3 Variables locales.
+!
+CHARACTER(LEN=28) :: YNAME,YDAD ! Noms du FM et de son papa.
+CHARACTER(LEN=2) :: YSTORAGE ! Type de variable.
+!
+REAL :: ZECHEANCE1,ZECHEANCE2 ! dist temp date modele - date courante
+INTEGER :: IHHMDL,IMNMDL,ISSMDL ! h - mn - s du model
+INTEGER :: IHHCUR1,IMNCUR1,ISSCUR1
+INTEGER :: IHHCUR2,IMNCUR2,ISSCUR2
+CHARACTER(LEN=14) :: YDATMDL,YDATCUR1,YDATCUR2
+!
+REAL :: XLATOR,XLONOR,XPTLAT,XPTLON
+REAL :: XXPTSOMNH,XYPTSOMNH
+INTEGER :: JI,JJ,JK,a
+INTEGER :: b,c,I
+INTEGER, DIMENSION(:), ALLOCATABLE :: TAB1D
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB2D
+TYPE(DATE_TIME) :: TZDTCUR1,TZDTCUR2,TZDTEXP1
+INTEGER :: IFDAT,IFGRI,IFLOG
+type(tfieldmetadata) :: tzfield
+!
+!
+!
+!* 1. INITIALISATION.
+! ---------------
+!
+IFDAT = TPDATEFILE%NLU
+IFGRI = TPGRIDFILE%NLU
+IFLOG = TPLOGFILE%NLU
+!
+CALL INI_CST
+!
+CALL GOTO_MODEL(1)
+!
+!
+!* 2. DONNEES MESO-NH.
+! ----------------
+!
+!* 2.1 Ouverture du fichier Meso-NH.
+!
+CALL IO_File_open(TPFILE1)
+CALL IO_File_open(TPFILE2)
+!
+!
+!* 2.2 Date et heure du modele.
+!
+CALL IO_Field_read(TPFILE1,'DTEXP',TZDTEXP1)
+CALL IO_Field_read(TPFILE1,'DTCUR',TZDTCUR1)
+CALL IO_Field_read(TPFILE2,'DTCUR',TZDTCUR2)
+!
+CALL DATETIME_DISTANCE(TZDTEXP1,TZDTCUR1,ZECHEANCE1)
+CALL DATETIME_DISTANCE(TZDTEXP1,TZDTCUR2,ZECHEANCE2)
+!
+IHHMDL=INT(TZDTEXP1%xtime/3600)
+IMNMDL=INT((TZDTEXP1%xtime-IHHMDL*3600)/60)
+ISSMDL=INT(TZDTEXP1%xtime-IHHMDL*3600-IMNMDL*60)
+IHHCUR1=INT(TZDTCUR1%xtime/3600)
+IMNCUR1=INT((TZDTCUR1%xtime-IHHCUR1*3600)/60)
+ISSCUR1=INT(TZDTCUR1%xtime-IHHCUR1*3600-IMNCUR1*60)
+IHHCUR2=INT(TZDTCUR2%xtime/3600)
+IMNCUR2=INT((TZDTCUR2%xtime-IHHCUR2*3600)/60)
+ISSCUR2=INT(TZDTCUR2%xtime-IHHCUR2*3600-IMNCUR2*60)
+!
+WRITE(YDATMDL, '(I4.4,5I2.2)') TZDTEXP1%nyear, TZDTEXP1%nmonth, TZDTEXP1%nday, &
+ IHHMDL, IMNMDL, ISSMDL
+WRITE(YDATCUR1,'(I4.4,5I2.2)') TZDTCUR1%nyear, TZDTCUR1%nmonth, TZDTCUR1%nday, &
+ IHHCUR1, IMNCUR1, ISSCUR1
+WRITE(YDATCUR2,'(I4.4,5I2.2)') TZDTCUR2%nyear, TZDTCUR2%nmonth, TZDTCUR2%nday, &
+ IHHCUR2, IMNCUR2, ISSCUR2
+!
+NMDLAA=MOD( TZDTEXP1%nyear, 100 ) ! Annee arrondi a 2 chiffres.
+NMDLMM=TZDTEXP1%nmonth
+NMDLJJ=TZDTEXP1%nday
+NMDLSS=NINT(TZDTEXP1%xtime)
+!
+!* Heure du modele arrondie a 5 minutes pres.
+!
+NMDLMN = NINT( (REAL(NMDLSS)/60.0)/5.0 )*5
+NMDLSS = 0
+NMDLHH =NMDLMN/60
+NMDLMN =NMDLMN-NMDLHH*60
+!
+!* 2.3 Grille horizontale.
+!
+CALL READ_HGRID(1,TPFILE1,YNAME,YDAD,YSTORAGE)
+IF (YNAME == YDAD) THEN
+IGRILLE=1
+ELSE
+IGRILLE=2
+ENDIF
+print*,IGRILLE
+!
+! Lecture grille horizontale
+!
+NIU=NIMAX+2*JPHEXT
+NJU=NJMAX+2*JPHEXT
+NIB=1+JPHEXT
+NJB=1+JPHEXT
+NIE=NIU-JPHEXT
+NJE=NJU-JPHEXT
+!
+!
+!* 2.4 Nombre de niveaux-verticaux.
+!
+CALL IO_Field_read(TPFILE1,'KMAX',NKMAX)
+!WRITE(IFLOG,*) '%%% MNH2S2_INI Lecture du nombre de niveau OK.'
+!
+NKU = NKMAX+2*JPVEXT
+NKB = 1+JPVEXT
+NKE = NKU-JPVEXT
+!
+!
+!* 2.5 Allocations Meso-NH.
+!
+ALLOCATE( XZHAT(NKU) )
+ALLOCATE( XZS(NIU,NJU) )
+ALLOCATE( XZ0(NIU,NJU) )
+ALLOCATE( XUT(NIU,NJU,NKU))
+ALLOCATE( XVT(NIU,NJU,NKU))
+ALLOCATE( XWT(NIU,NJU,NKU))
+ALLOCATE( XTHT(NIU,NJU,NKU))
+ALLOCATE( XTKET(NIU,NJU,NKU))
+ALLOCATE( XLM(NIU,NJU,NKU))
+ALLOCATE( XDISSIP(NIU,NJU,NKU))
+ALLOCATE( XWPTHP(NIU,NJU,NKU))
+ALLOCATE( XRMVT(NIU,NJU,NKU))
+ALLOCATE( XRMCT(NIU,NJU,NKU))
+ALLOCATE( XRMRT(NIU,NJU,NKU))
+ALLOCATE( XINRT(NIU,NJU))
+ALLOCATE( XSFU(NIU,NJU))
+ALLOCATE( XSFV(NIU,NJU))
+!
+!* 2.6 Decoupage vertical.
+!
+CALL IO_Field_read(TPFILE1,'ZHAT',XZHAT)
+CALL IO_Field_read(TPFILE1,'ZTOP',XZTOP)
+!
+!* 2.7 Orographie.
+!
+CALL IO_Field_read(TPFILE1,'ZS',XZS)
+!
+!* 2.8 Rugosite Z0.
+!
+tzfield = tfieldmetadata( &
+ cmnhname = 'Z0', &
+ clongname = '', &
+ cunits = 'm', &
+ cdir = 'XY', &
+ ccomment = 'X_Y_Z0', &
+ ngrid = 4, &
+ ntype = TYPEREAL, &
+ ndims = 2 )
+CALL IO_Field_read(TPFILE1,tzfield,XZ0)
+!
+XXPTSOMNH=XXHAT(1)+(XXHAT(2)-XXHAT(1))/2
+XYPTSOMNH=XYHAT(1)+(XYHAT(2)-XYHAT(1))/2
+CALL SM_LATLON(XLATORI,XLONORI,XXPTSOMNH,XYPTSOMNH,XLATOR,XLONOR)
+!
+!* 2.9 DOMAINE D'EXTRACTION.
+! ---------------------
+!
+NSIB = NIB
+NSIE = NIE
+NSJB = NJB
+NSJE = NJE
+!
+NSIMAX = NSIE-NSIB+1
+NSJMAX = NSJE-NSJB+1
+!
+!
+!* 3. Impression de controle Meso-NH.
+! -------------------------------
+!
+! Domaine horizontal Meso-NH.
+!modif 12.2014 : passage a 1 seul domaine MesoNH
+! ---------------------------
+WRITE(IFLOG,'(I1,a12)') IGRILLE,' ngrid '
+!WRITE(IFLOG,'(a13)') '2 ngrids'
+WRITE(IFLOG,'(a13)') '1 ngrids'
+WRITE(IFLOG,'(i4,3x,a6)') NSIMAX,'nx '
+WRITE(IFLOG,'(i4,3x,a6)') NSJMAX,'ny '
+WRITE(IFLOG,'(i4,3x,a6)') NKU-2,'nz '
+WRITE(IFLOG,'(i4,3x,a6)') NKU-3,'nzg '
+WRITE(IFLOG,'(a13)') '12 npatch'
+WRITE(IFLOG,'(a13)') '0 icloud'
+WRITE(IFLOG,'(a11)') '0.0 wlon '
+WRITE(IFLOG,'(a11)') '45.0 rnlat '
+WRITE(IFLOG,'(f10.1,3x,a6)') XZHAT(NKE),'s '
+WRITE(IFLOG,'(f8.0,a8)') ZECHEANCE1,' time1 '
+WRITE(IFLOG,'(f8.0,a8)') ZECHEANCE2,' time2 '
+WRITE(IFLOG,'(a13)') '3600 dtmet '
+WRITE(IFLOG,'(a13)') 'm tunits'
+WRITE(IFLOG,'(a13)') '12 nvout '
+WRITE(IFLOG,'(6x,a8,i4)') 'u ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'v ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'w ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'tp ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'tke ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'uu ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'vv ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'ww ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'tlx ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'tly ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'tlz ',1
+WRITE(IFLOG,'(6x,a8,i4)') 'intopr ',1
+WRITE(IFLOG,*) ' grid structure'
+!
+!* 4. FICHIER METEO.
+! --------------
+!
+!* 4.1 Allocations.
+!
+ALLOCATE( XSHAUT(NKMAX))
+ALLOCATE( XSREL(NSIMAX,NSJMAX) )
+ALLOCATE( XSZ0(NSIMAX,NSJMAX) )
+ALLOCATE( XSCORIOZ (NSIMAX,NSJMAX) )
+ALLOCATE( XSPHI(NSIMAX,NSJMAX,NKMAX) )
+ALLOCATE( XSU(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSV(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSW(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSTH(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSTKE(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSLM(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSDISSIP(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSWPTHP(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSRMV(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSRMC(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSRMR(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSINRT(NSIMAX,NSJMAX))
+ALLOCATE( XSSFU(NSIMAX,NSJMAX))
+ALLOCATE( XSSFV(NSIMAX,NSJMAX))
+ALLOCATE( XSTIMEW(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSTIMEU(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSSIGW(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSSIGU(NSIMAX,NSJMAX,NKMAX))
+ALLOCATE( XSUSTAR(NSIMAX,NSJMAX))
+ALLOCATE( XSWSTAR(NSIMAX,NSJMAX))
+ALLOCATE( XSHMIX(NSIMAX,NSJMAX))
+ALLOCATE( XSLMO(NSIMAX,NSJMAX))
+ALLOCATE( XSTHETAV(NKMAX))
+
+!
+! 4.2. Nombre de niveaux en Z
+!
+XSHAUT(1:NKMAX) = (XZHAT(NKB:NKE)+XZHAT(NKB+1:NKE+1))/2.
+print*,"niveaux hauteur"
+DO JK=1,NKMAX
+print*,XSHAUT(JK)
+ENDDO
+!
+! 4.3. Calcul du tableau contenant les coef. de coriolis de la grille
+!
+DO JI=NSIB,NSIE ; DO JJ=NSJB,NSJE
+ CALL SM_LATLON(XLATORI,XLONORI,XXHAT(JI),XYHAT(JJ),XPTLAT,XPTLON)
+ XSCORIOZ(JI-1,JJ-1)=2.*XOMEGA*SIN(XPTLAT*XPI/180.)
+ENDDO ; ENDDO
+!
+!
+!* 4.4 Geometrie de la grille et positionnement.
+!
+!
+! On a besoin du point sud-ouest, c'est-a-dire de l'angle inferieur gauche
+! du domaine physique de la maille "en bas a gauche". Ca tombe bien, on
+! va travailler avec les XXHAT et les XYHAT directement.
+!
+XPASXM = XXHAT(2)-XXHAT(1) ! Pas selon X en metres.
+XPASYM = XYHAT(2)-XYHAT(1) ! Pas selon Y en metres.
+ZMAILLE = MAX(XPASXM,XPASYM)
+!
+!* 4.5 Constantes et champs constants.
+!
+!* Relief.
+!
+XSREL(:,:) = XZS(NSIB:NSIE,NSJB:NSJE)
+!
+!* Geopotentiel PHI
+!
+print*,"Geopotentiel"
+DO JK=1,NKMAX
+XSPHI(:,:,JK) = (XSREL(:,:)+XSHAUT(JK))*XG
+print*,MINVAL(XSPHI(:,:,JK)),MAXVAL(XSPHI(:,:,JK))
+ENDDO
+!
+!* Rugosite.
+!
+XSZ0(:,:) = XZ0(NSIB:NSIE,NSJB:NSJE)
+print*,"Rugosite"
+print*,MINVAL(XSZ0),MAXVAL(XSZ0)
+!
+!* 5 FICHIER DATES.
+! -------------
+!
+WRITE(IFDAT,'(A14)') YDATMDL
+WRITE(IFDAT,'(A14)') YDATCUR1
+WRITE(IFDAT,'(A14)') YDATCUR2
+!
+!* 5. FICHIER GRILLE.
+! --------------
+!
+!
+!* 5.1 Infos franchement utiles.
+!
+WRITE(IFGRI,'(F15.8,1X,A)') &
+ XLON0, 'XLON0 Longitude reference (deg.deci.)'
+WRITE(IFGRI,'(F15.8,1X,A)') &
+ XLAT0, 'XLAT0 Latitude reference (deg.deci.)'
+WRITE(IFGRI,'(F15.8,1X,A)') &
+ XBETA, 'XBETA Rotation grille (deg.deci.)'
+WRITE(IFGRI,'(F15.8,1X,A)') XRPK, 'XRPK Facteur de conicite'
+WRITE(IFGRI,'(F15.8,1X,A)') &
+ XLONOR, 'XLONOR Longitude origine (deg.deci.)'
+WRITE(IFGRI,'(F15.8,1X,A)') &
+ XLATOR, 'XLATOR Latitude origine (deg.deci.)'
+WRITE(IFGRI,'(F15.1,1X,A)') XXHAT(1),'XHAT(1) Coord. Cartesienne (m)'
+WRITE(IFGRI,'(F15.1,1X,A)') XXHAT(2),'XHAT(2) Coord. Cartesienne (m)'
+WRITE(IFGRI,'(F15.1,1X,A)') XYHAT(1),'YHAT(1) Coord. Cartesienne (m)'
+WRITE(IFGRI,'(F15.1,1X,A)') XYHAT(2),'YHAT(2) Coord. Cartesienne (m)'
+!
+print*,"GRILLE"
+print*,"LON0 : ",XLON0
+print*,"LAT0 : ",XLAT0
+print*,"BETA : ",XBETA
+print*,"RPK : ",XRPK
+print*,"LONOR: ",XLONOR
+print*,"LATOR: ",XLATOR
+!
+!* 5.2 Points de grille x y z zg
+!
+WRITE(IFLOG,*)NSIMAX,' gridpoints in x direction'
+WRITE(IFLOG,'(8f10.0)')XXHAT(NSIB:NSIE)
+WRITE(IFLOG,*)NSJMAX,' gridpoints y direction'
+WRITE(IFLOG,'(8f10.0)')XYHAT(NSJB:NSJE)
+WRITE(IFLOG,*)NKMAX,' main gridpoints in z direction'
+WRITE(IFLOG,'(8f10.2)')XSHAUT(1:NKMAX)
+WRITE(IFLOG,'(i4,3x,a38)')NKU-2,'intermediate gridpoints in z direction'
+WRITE(IFLOG,'(8f10.2)')XZHAT(2:NKU-1)
+WRITE(IFLOG,*)' =================================================='
+!
+! Topographie
+!
+WRITE(IFLOG,*) 'TERRAIN TOPOGRAPHY'
+c=1
+a=0
+!modif 12/2014 : passage a une grille haute resolution MesoNH, on depasse 99
+!300 format(i2,'|',18i4)
+300 format(i3,'|',18i5)
+!400 format(i2,'|',18(f4.2))
+!400 format(i3,'|',18(f5.2))
+!301 format(3x,18('__',i2))
+301 format(3x,18('__',i3))
+ALLOCATE(TAB2D(NSIMAX,NSJMAX))
+ALLOCATE(TAB1D(NSIMAX))
+DO I=1,NSIMAX
+ TAB1D(I)=I
+ENDDO
+TAB2D(:,:) = NINT(XSREL(:,:))
+DO WHILE (c.lt.(NSIMAX+1))
+ DO b=NSJB,NSJE
+ IF ((c+17).LT.(NSIMAX+1)) then
+ a=NSJMAX-b+NSJB
+ WRITE(IFLOG,300) a,TAB2D(c:c+17,a)
+ ELSE
+ a=NSJMAX-b+NSJB
+ WRITE(IFLOG,300) a,TAB2D(c:NSIMAX,a)
+ ENDIF
+ ENDDO
+IF ((c+17).LT.(NSIMAX+1)) then
+ WRITE(IFLOG,301) TAB1D(c:c+17)
+ELSE
+ WRITE(IFLOG,301) TAB1D(c:NSIMAX)
+ENDIF
+
+c=c+18
+ENDDO
+!
+DEALLOCATE(TAB2D)
+DEALLOCATE(TAB1D)
+DEALLOCATE(XZS)
+DEALLOCATE(XZ0)
+DEALLOCATE(XZHAT)
+!
+! Fermeture du fichier Meso-NH.
+!
+CALL IO_File_close(TPFILE1)
+CALL IO_File_close(TPFILE2)
+!
+!
+!-------------------------------------------'
+print*,' FIN MNH2LPDM_INI'
+!-------------------------------------------'
+!
+!
+END SUBROUTINE MNH2LPDM_INI
diff --git a/src/PHYEX/ext/modeln.f90 b/src/PHYEX/ext/modeln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8079f0d349befbd4bfe24c02d47f30d77d1f9ce2
--- /dev/null
+++ b/src/PHYEX/ext/modeln.f90
@@ -0,0 +1,2415 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_MODEL_n
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
+TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
+LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
+!
+END SUBROUTINE MODEL_n
+!
+END INTERFACE
+!
+END MODULE MODI_MODEL_n
+
+! ###################################
+ SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
+! ###################################
+!
+!!**** *MODEL_n * -monitor of the model version _n
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to build up a typical model version
+! by sequentially calling the specialized routines.
+!
+!!** METHOD
+!! ------
+!! Some preliminary initializations are performed in the first section.
+!! Then, specialized routines are called to update the guess of the future
+!! instant XRxxS of the variable xx by adding the effects of all the
+!! different sources of evolution.
+!!
+!! (guess of xx at t+dt) * Rhod_ref * Jacobian
+!! XRxxS = -------------------------------------------
+!! 2 dt
+!!
+!! At this level, the informations are transferred with a USE association
+!! from the INIT step, where the modules have been previously filled. The
+!! transfer to the subroutines computing each source term is performed by
+!! argument in order to avoid repeated compilations of these subroutines.
+!! This monitor model_n, must therefore be duplicated for each model,
+!! model1 corresponds in this case to the outermost model, model2 is used
+!! for the first level of gridnesting,....
+!! The effect of all parameterizations is computed in PHYS_PARAM_n, which
+!! is itself a monitor. This is due to a possible large number of
+!! parameterizations, which can be activated and therefore, will require a
+!! very large list of arguments. To circumvent this problem, we transfer by
+!! a USE association, the necessary informations in this monitor, which will
+!! dispatch the pertinent information to every parametrization.
+!! Some elaborated diagnostics, LES tools, budget storages are also called
+!! at this level because they require informations about the fields at every
+!! timestep.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine IO_File_open: to open a file
+!! Subroutine WRITE_DESFM: to write the descriptive part of a FMfile
+!! Subroutine WRITE_LFIFM: to write the binary part of a FMfile
+!! Subroutine SET_MASK : to compute all the masks selected for budget
+!! computations
+!! Subroutine BOUNDARIES : set the fields at the marginal points in every
+!! directions according the selected boundary conditions
+!! Subroutine INITIAL_GUESS: initializes the guess of the future instant
+!! Subroutine LES_FLX_SPECTRA: computes the resolved fluxes and the
+!! spectra of some quantities when running in LES mode.
+!! Subroutine ADVECTION: computes the advection terms.
+!! Subroutine DYN_SOURCES: computes the curvature, Coriolis, gravity terms.
+!! Subroutine NUM_DIFF: applies the fourth order numerical diffusion.
+!! Subroutine RELAXATION: performs the relaxation to Larger Scale fields
+!! in the upper levels and outermost vertical planes
+!! Subroutine PHYS_PARAM_n : computes the parameterized physical terms
+!! Subroutine RAD_BOUND: prepares the velocity normal components for the bc.
+!! Subroutine RESOLVED_CLOUD : computes the sources terms for water in any
+!! form
+!! Subroutine PRESSURE : computes the pressure gradient term and the
+!! absolute pressure
+!! Subroutine EXCHANGE : updates the halo of each subdomains
+!! Subroutine ENDSTEP : advances in time the fields.
+!! Subroutines UVW_LS_COUPLING and SCALAR_LS_COUPLING:
+!! compute the large scale fields, used to
+!! couple Model_n with outer informations.
+!! Subroutine ENDSTEP_BUDGET: writes the budget informations.
+!! Subroutine IO_File_close: closes a file
+!! Subroutine DATETIME_CORRECTDATE: transform the current time in GMT
+!! Subroutine FORCING : computes forcing terms
+!! Subroutine ADD3DFIELD_ll : add a field to 3D-list
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_DYN
+!! MODD_CONF
+!! MODD_NESTING
+!! MODD_BUDGET
+!! MODD_PARAMETERS
+!! MODD_CONF_n
+!! MODD_CURVCOR_n
+!! MODD_DYN_n
+!! MODD_DIM_n
+!! MODD_ADV_n
+!! MODD_FIELD_n
+!! MODD_LSFIELD_n
+!! MODD_GRID_n
+!! MODD_METRICS_n
+!! MODD_LBC_n
+!! MODD_PARAM_n
+!! MODD_REF_n
+!! MODD_LUNIT_n
+!! MODD_OUT_n
+!! MODD_TIME_n
+!! MODD_TURB_n
+!! MODD_CLOUDPAR_n
+!! MODD_TIME
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/09/94
+!! Modification 20/10/94 (J.Stein) for the outputs and abs_layers routines
+!! Modification 10/11/94 (J.Stein) change ABS_LAYER_FIELDS call
+!! Modification 16/11/94 (J.Stein) add call to the renormalization
+!! Modification 17/11/94 (J.-P. Lafore and J.-P. Pinty) call NUM_DIFF
+!! Modification 08/12/94 (J.Stein) cleaning + remove (RENORM + ABS_LAYER..
+!! ..) + add RELAXATION + LS fiels in the arguments
+!! Modification 19/12/94 (J.Stein) switch for the num diff
+!! Modification 22/12/94 (J.Stein) update tdtcur + change dyn_source call
+!! Modification 05/01/95 (J.Stein) add the parameterization monitor
+!! Modification 09/01/95 (J.Stein) add the 1D switch
+!! Modification 10/01/95 (J.Stein) displace the TDTCUR computation
+!! Modification 03/01/95 (J.-P. Lafore) Absolute pressure diagnosis
+!! Modification Jan 19, 1995 (J. Cuxart) Shunt the DYN_SOURCES in 1D cases.
+!! Modification Jan 24, 1995 (J. Stein) Interchange Boundaries and
+!! Initial_guess to correct a bug in 2D configuration
+!! Modification Feb 02, 1995 (I.Mallet) update BOUNDARIES and RAD_BOUND
+!! calls
+!! Modification Mar 10, 1995 (I.Mallet) add call to SET_COUPLING
+!! March,21, 1995 (J. Stein) remove R from the historical var.
+!! March,26, 1995 (J. Stein) add the EPS variable
+!! April 18, 1995 (J. Cuxart) add the LES call
+!! Sept 20,1995 (Lafore) coupling for the dry mass Md
+!! Nov 2,1995 (Stein) displace the temporal counter increase
+!! Jan 2,1996 (Stein) rm the test on the temporal counter
+!! Modification Feb 5,1996 (J. Vila) implementation new advection
+!! schemes for scalars
+!! Modification Feb 20,1996 (J.Stein) doctor norm
+!! Dec95 - Jul96 (Georgelin, Pinty, Mari, Suhre) FORCING
+!! June 17,1996 (Vincent, Lafore, Jabouille)
+!! statistics of computing time
+!! Aug 8, 1996 (K. Suhre) add chemistry
+!! October 12, 1996 (J. Stein) save the PSRC value
+!! Sept 05,1996 (V.Masson) print of loop index for debugging
+!! purposes
+!! July 22,1996 (Lafore) improve write of computing time statistics
+!! July 29,1996 (Lafore) nesting introduction
+!! Aug. 1,1996 (Lafore) synchronization between models
+!! Sept. 4,1996 (Lafore) modification of call to routine SET_COUPLING
+!! now split in 2 routines
+!! (UVW_LS_COUPLING and SCALAR_LS_COUPLING)
+!! Sept 5,1996 (V.Masson) print of loop index for debugging
+!! purposes
+!! Sept 25,1996 (V.Masson) test for coupling performed here
+!! Oct. 29,1996 (Lafore) one-way nesting implementation
+!! Oct. 12,1996 (J. Stein) save the PSRC value
+!! Dec. 12,1996 (Lafore) change call to RAD_BOUND
+!! Dec. 21,1996 (Lafore) two-way nesting implementation
+!! Mar. 12,1997 (Lafore) introduction of "surfacic" LS fields
+!! Nov 18, 1996 (J.-P. Pinty) FORCING revisited (translation)
+!! Dec 04, 1996 (J.-P. Pinty) include mixed-phase clouds
+!! Dec 20, 1996 (J.-P. Pinty) update the budgets
+!! Dec 23, 1996 (J.-P. Pinty) add the diachronic file control
+!! Jan 11, 1997 (J.-P. Pinty) add the deep convection control
+!! Dec 20,1996 (V.Masson) call boundaries before the writing
+!! Fev 25, 1997 (P.Jabouille) modify the LES tools
+!! April 3,1997 (Lafore) merging of the nesting
+!! developments on MASTER3
+!! Jul. 8,1997 (Lafore) print control for nesting (NVERB>=7)
+!! Jul. 28,1997 (Masson) supress LSTEADY_DMASS
+!! Aug. 19,1997 (Lafore) full Clark's formulation introduction
+!! Sept 26,1997 (Lafore) LS source calculation at restart
+!! (temporarily test to have LS at instant t)
+!! Jan. 28,1998 (Bechtold) add SST forcing
+!! fev. 10,1998 (Lafore) RHODJ computation and storage for budget
+!! Jul. 10,1998 (Stein ) sequentiel loop for nesting
+!! Apr. 07,1999 (Stein ) cleaning of the nesting subroutines
+!! oct. 20,1998 (Jabouille) //
+!! oct. 20,2000 (J.-P. Pinty) add the C2R2 scheme
+!! fev. 01,2001 (D.Gazen) add module MODD_NSV for NSV variables
+!! mar, 4,2002 (V.Ducrocq) call to temporal series
+!! mar, 8, 2001 (V. Masson) advection of perturbation of theta in neutral cases.
+!! Nov, 6, 2002 (V. Masson) time counters for budgets & LES
+!! mars 20,2001 (Pinty) add ICE4 and C3R5 options
+!! jan. 2004 (Masson) surface externalization
+!! sept 2004 (M. Tomasini) Cloud mixing length modification
+!! june 2005 (P. Tulet) add aerosols / dusts
+!! Jul. 2005 (N. Asencio) two_way and phys_param calls:
+!! Add the surface parameters : precipitating
+!! hydrometeors, Short and Long Wave , MASKkids array
+!! Fev. 2006 (M. Leriche) add aqueous phase chemistry
+!! april 2006 (T.Maric) Add halo related to 4th order advection scheme
+!! May 2006 Remove KEPS
+!! Oct 2008 (C.Lac) FIT for variables advected with PPM
+!! July 2009 : Displacement of surface diagnostics call to be
+!! coherent with surface diagnostics obtained with DIAG
+!! 10/11/2009 (P. Aumond) Add mean moments
+!! Nov, 12, 2009 (C. Barthe) add cloud electrification and lightning flashes
+!! July 2010 (M. Leriche) add ice phase chemical species
+!! April 2011 (C.Lac) : Remove instant M
+!! April 2011 (C.Lac, V.Masson) : Time splitting for advection
+!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
+!! Dec 2014 (C.Lac) : For reproducibility START/RESTA
+!! J.Escobar 20/04/2015: missing UPDATE_HALO before UPDATE_HALO2
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! C.Lac 11/09/2015: correction of the budget due to FIT temporal scheme
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Sep 2015 (S. Bielli) : Remove YDADFILE from argument call
+! of write_phys_param
+!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
+!! M.Mazoyer : 04/2016 DTHRAD used for radiative cooling when LACTIT
+!!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! M.Leriche : 03/2016 Move computation of accumulated chem. in rain to ch_monitor
+!! 09/2016 Add filter on negative values on AERDEP SV before relaxation
+!! 10/2016 (C.Lac) _ Correction on the flag for Strang splitting
+!! to insure reproducibility between START and RESTA
+!! _ Add OSPLIT_WENO
+!! _ Add droplet deposition
+!! 10/2016 (M.Mazoyer) New KHKO output fields
+!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 10/2017 (C.Lac) Necessity to have chemistry processes as
+!! the las process modifying XRSVS
+!! 01/2018 (G.Delautier) SURFEX 8.1
+!! 03/2018 (P.Wautelet) replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 07/2017 (V. Vionnet) : Add blowing snow scheme
+!! S. Riette : 11/2016 Add ZPABST to keep pressure constant during timestep
+!! 01/2018 (C.Lac) Add VISCOSITY
+!! Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll
+! to allow to disable writes (for bench purposes)
+! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
+!! 02/2019 C.Lac add rain fraction as an output field
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
+! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
+! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls
+! F. Auguste 01/02/2021: add IBM
+! T. Nagel 01/02/2021: add turbulence recycling
+! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
+! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
+! R. Schoetter 12/2021 multi-level coupling between MesoNH and SURFEX
+! A. Costes 12/2021: add Blaze fire model
+! C. Barthe 07/04/2022: deallocation of ZSEA
+! P. Wautelet 08/12/2022: bugfix if no TDADFILE
+! P. Wautelet 13/01/2023: manage close of backup files outside of MODEL_n
+! (useful to close them in reverse model order (child before parent, needed by WRITE_BALLOON_n)
+! J. Wurtz 01/2023 : correction for mean in SURFEX outputs
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_2D_FRC
+USE MODD_ADV_n
+USE MODD_AIRCRAFT_BALLOON
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_BAKOUT
+USE MODD_BIKHARDT_n
+USE MODD_BLANK_n
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: cbutype, lbu_ru, lbu_rv, lbu_rw, lbudget_u, lbudget_v, lbudget_w, lbudget_sv, lbu_enable, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_SV1, nbumod, nbutime, &
+ tbudgets, tbuconf, tburhodj, &
+ xtime_bu, xtime_bu_process
+USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
+ LCH_INIT_FIELD
+USE MODD_CLOUD_MF_n
+USE MODD_CLOUDPAR_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST, ONLY: CST
+USE MODD_CURVCOR_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_DIM_n
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_DRAG_n
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN
+USE MODD_DYN_n
+USE MODD_DYNZD
+USE MODD_DYNZD_n
+USE MODD_ELEC_DESCR
+USE MODD_EOL_MAIN
+USE MODD_FIELD_n
+USE MODD_FIRE_n
+USE MODD_FRC
+USE MODD_FRC_n
+USE MODD_GET_n
+USE MODD_GRID, ONLY: XLONORI,XLATORI
+USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: CIBM_ADV, LIBM, LIBM_TROUBLE, XIBM_LS
+USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
+USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
+USE MODD_LBC_n
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_LIMA_PRECIP_SCAVENGING_n
+USE MODD_LSFIELD_n
+USE MODD_LUNIT, ONLY: TOUTDATAFILE
+USE MODD_LUNIT_n, ONLY: TDIAFILE,TINIFILE,TINIFILEPGD,TLUOUT
+USE MODD_MEAN_FIELD
+USE MODD_MEAN_FIELD_n
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING
+USE MODD_NSV
+USE MODD_NUDGING_n
+USE MODD_OUT_n
+USE MODD_PARAM_C1R3, ONLY: NSEDI => LSEDI, NHHONI => LHHONI
+USE MODD_PARAM_C2R2, ONLY: NSEDC => LSEDC, NRAIN => LRAIN, NACTIT => LACTIT,LACTTKE,LDEPOC
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE_n, ONLY: LWARM,LSEDIC,LCONVHG,LDEPOSC, CSUBG_AUCV_RC
+USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, NMOM_C, NMOM_R, &
+ MACTIT => LACTIT, LSCAV, NMOM_I, &
+ MSEDI => LSEDI, MHHONI => LHHONI, NMOM_H, &
+ XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
+USE MODD_PARAM_MFSHALL_n
+USE MODD_PARAM_n
+USE MODD_PAST_FIELD_n
+USE MODD_PRECIP_n
+use modd_precision, only: MNHTIME
+USE MODD_PROFILER_n
+USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XRTMIN
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_REF_n
+USE MODD_SALT, ONLY: LSALT
+USE MODD_SERIES, ONLY: LSERIES
+USE MODD_SERIES_n, ONLY: NFREQSERIES
+USE MODD_STATION_n
+USE MODD_SUB_MODEL_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_TIMEZ
+USE MODD_TURB_n
+USE MODD_NEB_n, ONLY: VSIGQSAT, LSIGMAS, LSUBG_COND
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+USE MODD_VISCOSITY
+!
+USE MODE_AIRCRAFT_BALLOON
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_DATETIME
+USE MODE_ELEC_ll
+USE MODE_GRIDCART
+USE MODE_GRIDPROJ
+USE MODE_IO_FIELD_WRITE, only: IO_Field_user_write, IO_Fieldlist_write, IO_Header_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_ll
+#ifdef MNH_IOLFI
+use mode_menu_diachro, only: MENU_DIACHRO
+#endif
+USE MODE_MNH_TIMING
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_MSG
+USE MODE_ONE_WAY_n
+USE MODE_WRITE_AIRCRAFT_BALLOON
+use mode_write_les_n, only: Write_les_n
+use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
+USE MODE_WRITE_STATPROF_n, ONLY: WRITE_STATPROF_n
+!
+USE MODI_ADDFLUCTUATIONS
+USE MODI_ADVECTION_METSV
+USE MODI_ADVECTION_UVW
+USE MODI_ADVECTION_UVW_CEN
+USE MODI_ADV_FORCING_n
+USE MODI_AER_MONITOR_n
+USE MODI_BLOWSNOW
+USE MODI_BOUNDARIES
+USE MODI_BUDGET_FLAGS
+USE MODI_CART_COMPRESS
+USE MODI_CH_MONITOR_n
+USE MODI_DIAG_SURF_ATM_N
+USE MODI_DYN_SOURCES
+USE MODI_END_DIAG_IN_RUN
+USE MODI_ENDSTEP
+USE MODI_ENDSTEP_BUDGET
+USE MODI_EXCHANGE
+USE MODI_FORCING
+USE MODI_FORC_SQUALL_LINE
+USE MODI_FORC_WIND
+USE MODI_GET_HALO
+USE MODI_GRAVITY_IMPL
+USE MODI_IBM_INIT
+USE MODI_IBM_FORCING
+USE MODI_IBM_FORCING_TR
+USE MODI_IBM_FORCING_ADV
+USE MODI_INI_DIAG_IN_RUN
+USE MODI_INI_LG
+USE MODI_INI_MEAN_FIELD
+USE MODI_INITIAL_GUESS
+USE MODI_LES_INI_TIMESTEP_n
+USE MODI_LES_N
+USE MODI_LIMA_PRECIP_SCAVENGING
+USE MODI_LS_COUPLING
+USE MODI_MASK_COMPRESS
+USE MODI_MEAN_FIELD
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_MNHWRITE_ZS_DUMMY_n
+USE MODI_NUDGING
+USE MODI_NUM_DIFF
+USE MODI_PHYS_PARAM_n
+USE MODI_PRESSUREZ
+USE MODI_PROFILER_n
+USE MODI_RAD_BOUND
+USE MODI_RECYCLING
+USE MODI_RELAX2FW_ION
+USE MODI_RELAXATION
+USE MODI_REL_FORCING_n
+USE MODI_RESOLVED_CLOUD
+USE MODI_RESOLVED_ELEC_n
+USE MODI_SERIES_N
+USE MODI_SETLB_LG
+USE MODI_SET_MASK
+USE MODI_SHUMAN
+USE MODI_SPAWN_LS_n
+USE MODI_STATION_n
+USE MODI_TURB_CLOUD_INDEX
+USE MODI_TWO_WAY
+USE MODI_UPDATE_NSV
+USE MODI_VISCOSITY
+USE MODI_WRITE_DESFM_n
+USE MODI_WRITE_DIAG_SURF_ATM_N
+USE MODI_WRITE_LFIFM_n
+USE MODI_WRITE_SERIES_n
+USE MODI_WRITE_SURF_ATM_N
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
+TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
+LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILUOUT ! Logical unit number for the output listing
+INTEGER :: IIU,IJU,IKU ! array size in first, second and third dimensions
+INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
+INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
+INTEGER :: INBVAR ! number of HALO2_lls to allocate
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: IVERB ! LFI verbosity level
+LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation
+!
+ ! for computing time analysis
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT, ZBLAZETOT
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
+CHARACTER :: YMI
+INTEGER :: IPOINTS
+CHARACTER(len=16) :: YTCOUNT,YPOINTS
+CHARACTER(LEN=:), ALLOCATABLE :: YDADNAME
+!
+INTEGER :: ISYNCHRO ! model synchronic index relative to its father
+ ! = 1 for the first time step in phase with DAD
+ ! = 0 for the last time step (out of phase)
+INTEGER :: IMI ! Current model index
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZTOWN
+! Dummy pointers needed to correct an ifort Bug
+REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
+REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWS,DPTR_XLBYWS,DPTR_XLBXTHS,DPTR_XLBYTHS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKES,DPTR_XLBYTKES
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS
+!
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRHODJ,DPTR_XUM,DPTR_XVM,DPTR_XWM,DPTR_XTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XTKEM,DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRTKES,DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XRM,DPTR_XSVM,DPTR_XRRS,DPTR_XRSVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG
+REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV
+LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids
+!
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDC
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDR
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDG
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDH
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRC3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRS3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRG3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRH3D
+!
+LOGICAL :: KWARM
+LOGICAL :: KRAIN
+LOGICAL :: KSEDC
+LOGICAL :: KACTIT
+LOGICAL :: KSEDI
+LOGICAL :: KHHONI
+!
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPABST !To give pressure at t
+ ! (and not t+1) to resolved_cloud
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZJ
+!
+TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll ! list of fields to exchange
+LOGICAL :: GCLD ! conditionnal call for dust wet deposition
+LOGICAL :: GCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) :: ZWETDEPAER
+!
+TYPE(TFILEDATA),POINTER :: TZOUTFILE
+! TYPE(TFILEDATA),SAVE :: TZDIACFILE
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
+!-------------------------------------------------------------------------------
+!
+TPBAKFILE=> NULL()
+TZOUTFILE=> NULL()
+!
+TPDTMODELN = TDTCUR
+!
+!* 0. MICROPHYSICAL SCHEME
+! -------------------
+SELECT CASE(CCLOUD)
+CASE('C2R2','KHKO','C3R5')
+ KWARM = .TRUE.
+ KRAIN = NRAIN
+ KSEDC = NSEDC
+ KACTIT = NACTIT
+!
+ KSEDI = NSEDI
+ KHHONI = NHHONI
+CASE('LIMA')
+ KRAIN = NMOM_R.GE.1
+ KWARM = NMOM_C.GE.1
+ KSEDC = MSEDC
+ KACTIT = MACTIT
+!
+ KSEDI = MSEDI
+ KHHONI = MHHONI
+CASE('ICE3','ICE4') !default values
+ KWARM = LWARM
+ KRAIN = .TRUE.
+ KSEDC = .TRUE.
+ KACTIT = .FALSE.
+!
+ KSEDI = .TRUE.
+ KHHONI = .FALSE.
+END SELECT
+!
+!
+!* 1 PRELIMINARY
+! ------------
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1.0 update NSV_* variables for current model
+! ----------------------------------------
+!
+CALL UPDATE_NSV(IMI)
+!
+!* 1.1 RECOVER THE LOGICAL UNIT NUMBER FOR THE OUTPUT PRINTS
+!
+ILUOUT = TLUOUT%NLU
+!
+!* 1.2 SET ARRAY SIZE
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU=NKMAX+2*JPVEXT
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+IF (IMI==1) THEN
+ GSTEADY_DMASS=LSTEADYLS
+ELSE
+ GSTEADY_DMASS=.FALSE.
+END IF
+!
+!* 1.3 OPEN THE DIACHRONIC FILE
+!
+IF (KTCOUNT == 1) THEN
+!
+ NULLIFY(TFIELDS_ll,TLSFIELD_ll,TFIELDT_ll)
+ NULLIFY(TLSFIELD2D_ll)
+ NULLIFY(THALO2T_ll)
+ NULLIFY(TLSHALO2_ll)
+ NULLIFY(TFIELDSC_ll)
+!
+ ALLOCATE(XWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
+ ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2)))
+!
+ IF ( .NOT. LIO_NO_WRITE ) THEN
+ CALL IO_File_open(TDIAFILE)
+!
+ CALL IO_Header_write(TDIAFILE)
+ CALL WRITE_DESFM_n(IMI,TDIAFILE)
+ CALL WRITE_LFIFMN_FORDIACHRO_n(TDIAFILE)
+ END IF
+!
+!* 1.4 Initialization of the list of fields for the halo updates
+!
+! a) Sources terms
+!
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS, 'MODEL_n::XRUS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS, 'MODEL_n::XRVS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS, 'MODEL_n::XRWS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS, 'MODEL_n::XRTHS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS_PRES, 'MODEL_n::XRUS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS_PRES, 'MODEL_n::XRVS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS_PRES, 'MODEL_n::XRWS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS_CLD, 'MODEL_n::XRTHS_CLD' )
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XRTKES, 'MODEL_n::XRTKES' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS (:,:,:,1:NRR), 'MODEL_n::XRRS' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS_CLD (:,:,:,1:NRR), 'MODEL_n::XRRS_CLD' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS (:,:,:,1:NSV), 'MODEL_n::XRSVS')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS_CLD(:,:,:,1:NSV), 'MODEL_n::XRSVS_CLD')
+ IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XSRCT, 'MODEL_n::XSRCT' )
+ ! Fire model parallel setup
+ IF (LBLAZE) THEN
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XLSPHI, 'MODEL_n::XLSPHI')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XBMAP, 'MODEL_n::XBMAP')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMRFA, 'MODEL_n::XFMRFA')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWF0, 'MODEL_n::XFMWF0')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR0, 'MODEL_n::XFMR0')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR00, 'MODEL_n::XFMR00')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMIGNITION, 'MODEL_n::XFMIGNITION')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFUELTYPE, 'MODEL_n::XFMFUELTYPE')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRETAU, 'MODEL_n::XFIRETAU')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMH(:,:,:,1:SIZE(XFLUXPARAMH,4)), 'MODEL_n::XFLUXPARAMH')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMW(:,:,:,1:SIZE(XFLUXPARAMW,4)), 'MODEL_n::XFLUXPARAMW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRERW, 'MODEL_n::XFIRERW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMASE, 'MODEL_n::XFMASE')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMAWC, 'MODEL_n::XFMAWC')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWALKIG, 'MODEL_n::XFMWALKIG')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDH, 'MODEL_n::XFMFLUXHDH')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDW, 'MODEL_n::XFMFLUXHDW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMHWS, 'MODEL_n::XFMHWS')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDU, 'MODEL_n::XFMWINDU')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDV, 'MODEL_n::XFMWINDV')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDW, 'MODEL_n::XFMWINDW')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROX, 'MODEL_n::XFMGRADOROX')
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROY, 'MODEL_n::XFMGRADOROY')
+ END IF
+ !
+ IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
+ !
+ ! b) LS fields
+ !
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSUM, 'MODEL_n::XLSUM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSVM, 'MODEL_n::XLSVM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSWM, 'MODEL_n::XLSWM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSTHM, 'MODEL_n::XLSTHM' )
+ CALL ADD2DFIELD_ll( TLSFIELD2D_ll, XLSZWSM, 'MODEL_n::XLSZWSM' )
+ IF (NRR >= 1) THEN
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSRVM, 'MODEL_n::XLSRVM' )
+ ENDIF
+ !
+ ! c) Fields at t
+ !
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XUT, 'MODEL_n::XUT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XVT, 'MODEL_n::XVT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XWT, 'MODEL_n::XWT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XTHT, 'MODEL_n::XTHT' )
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDT_ll, XTKET, 'MODEL_n::XTKET' )
+ CALL ADD4DFIELD_ll(TFIELDT_ll, XRT (:,:,:,1:NRR), 'MODEL_n::XSV' )
+ CALL ADD4DFIELD_ll(TFIELDT_ll, XSVT(:,:,:,1:NSV), 'MODEL_n::XSVT' )
+ !
+ !* 1.5 Initialize the list of fields for the halo updates (2nd layer)
+ !
+ INBVAR = 4+NRR+NSV
+ IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1
+ CALL INIT_HALO2_ll(THALO2T_ll,INBVAR,IIU,IJU,IKU)
+ CALL INIT_HALO2_ll(TLSHALO2_ll,4+MIN(1,NRR),IIU,IJU,IKU)
+ !
+ !* 1.6 Initialise the 2nd layer of the halo of the LS fields
+ !
+ IF ( LSTEADYLS ) THEN
+ CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
+ END IF
+ END IF
+ !
+!
+ !
+ XT_START = 0.0_MNHTIME
+ !
+ XT_STORE = 0.0_MNHTIME
+ XT_BOUND = 0.0_MNHTIME
+ XT_GUESS = 0.0_MNHTIME
+ XT_FORCING = 0.0_MNHTIME
+ XT_NUDGING = 0.0_MNHTIME
+ XT_ADV = 0.0_MNHTIME
+ XT_ADVUVW = 0.0_MNHTIME
+ XT_GRAV = 0.0_MNHTIME
+ XT_SOURCES = 0.0_MNHTIME
+ !
+ XT_DIFF = 0.0_MNHTIME
+ XT_RELAX = 0.0_MNHTIME
+ XT_PARAM = 0.0_MNHTIME
+ XT_SPECTRA = 0.0_MNHTIME
+ XT_HALO = 0.0_MNHTIME
+ XT_VISC = 0.0_MNHTIME
+ XT_RAD_BOUND = 0.0_MNHTIME
+ XT_PRESS = 0.0_MNHTIME
+ !
+ XT_CLOUD = 0.0_MNHTIME
+ XT_STEP_SWA = 0.0_MNHTIME
+ XT_STEP_MISC = 0.0_MNHTIME
+ XT_COUPL = 0.0_MNHTIME
+ XT_1WAY = 0.0_MNHTIME
+ XT_STEP_BUD = 0.0_MNHTIME
+ !
+ XT_RAD = 0.0_MNHTIME
+ XT_DCONV = 0.0_MNHTIME
+ XT_GROUND = 0.0_MNHTIME
+ XT_TURB = 0.0_MNHTIME
+ XT_MAFL = 0.0_MNHTIME
+ XT_DRAG = 0.0_MNHTIME
+ XT_EOL = 0.0_MNHTIME
+ XT_TRACER = 0.0_MNHTIME
+ XT_SHADOWS = 0.0_MNHTIME
+ XT_ELEC = 0.0_MNHTIME
+ XT_CHEM = 0.0_MNHTIME
+ XT_2WAY = 0.0_MNHTIME
+ !
+ XT_IBM_FORC = 0.0_MNHTIME
+ ! Blaze fire model
+ XFIREPERF = 0.0_MNHTIME
+ !
+END IF
+!
+!* 1.7 Allocation of arrays for observation diagnostics
+!
+CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER)
+!
+!
+CALL SECOND_MNH2(ZEND)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ONE-WAY NESTING AND LARGE SCALE FIELD REFRESH
+! ---------------------------------------------
+!
+!
+CALL SECOND_MNH2(ZTIME1)
+!
+ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) ) ! test of synchronisation
+!
+!
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL NHOA_COUPL_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,IKU)
+END IF
+! No Gridnest in coupled OA LES for now
+IF (.NOT. LCOUPLES .AND. IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
+!
+! Use dummy pointers to correct an ifort BUG
+ DPTR_XBMX1=>XBMX1
+ DPTR_XBMX2=>XBMX2
+ DPTR_XBMX3=>XBMX3
+ DPTR_XBMX4=>XBMX4
+ DPTR_XBMY1=>XBMY1
+ DPTR_XBMY2=>XBMY2
+ DPTR_XBMY3=>XBMY3
+ DPTR_XBMY4=>XBMY4
+ DPTR_XBFX1=>XBFX1
+ DPTR_XBFX2=>XBFX2
+ DPTR_XBFX3=>XBFX3
+ DPTR_XBFX4=>XBFX4
+ DPTR_XBFY1=>XBFY1
+ DPTR_XBFY2=>XBFY2
+ DPTR_XBFY3=>XBFY3
+ DPTR_XBFY4=>XBFY4
+ DPTR_CLBCX=>CLBCX
+ DPTR_CLBCY=>CLBCY
+ !
+ DPTR_XZZ=>XZZ
+ DPTR_XZHAT=>XZHAT
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_XLSTHM=>XLSTHM
+ DPTR_XLSRVM=>XLSRVM
+ DPTR_XLSUM=>XLSUM
+ DPTR_XLSVM=>XLSVM
+ DPTR_XLSWM=>XLSWM
+ DPTR_XLSZWSM=>XLSZWSM
+ DPTR_XLSTHS=>XLSTHS
+ DPTR_XLSRVS=>XLSRVS
+ DPTR_XLSUS=>XLSUS
+ DPTR_XLSVS=>XLSVS
+ DPTR_XLSWS=>XLSWS
+ DPTR_XLSZWSS=>XLSZWSS
+ !
+ IF ( LSTEADYLS ) THEN
+ NCPL_CUR=0
+ ELSE
+ IF (NCPL_CUR/=1) THEN
+ IF ( KTCOUNT+1 == NCPL_TIMES(NCPL_CUR-1,IMI) ) THEN
+ !
+ ! LS sources are interpolated from the LS field
+ ! values of model DAD(IMI)
+ CALL SPAWN_LS_n(NDAD(IMI),XTSTEP,IMI, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI), &
+ DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT,LSLEVE,XLEN1,XLEN2,DPTR_XCOEFLIN_LBXM, &
+ DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSZWSM, &
+ DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS, DPTR_XLSZWSS )
+ END IF
+ END IF
+ !
+ END IF
+ !
+ DPTR_NKLIN_LBXU=>NKLIN_LBXU
+ DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
+ DPTR_NKLIN_LBYU=>NKLIN_LBYU
+ DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU
+ DPTR_NKLIN_LBXV=>NKLIN_LBXV
+ DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV
+ DPTR_NKLIN_LBYV=>NKLIN_LBYV
+ DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV
+ DPTR_NKLIN_LBXW=>NKLIN_LBXW
+ DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW
+ DPTR_NKLIN_LBYW=>NKLIN_LBYW
+ DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW
+ !
+ DPTR_NKLIN_LBXM=>NKLIN_LBXM
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_NKLIN_LBYM=>NKLIN_LBYM
+ DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM
+ !
+ DPTR_XLBXUM=>XLBXUM
+ DPTR_XLBYUM=>XLBYUM
+ DPTR_XLBXVM=>XLBXVM
+ DPTR_XLBYVM=>XLBYVM
+ DPTR_XLBXWM=>XLBXWM
+ DPTR_XLBYWM=>XLBYWM
+ DPTR_XLBXTHM=>XLBXTHM
+ DPTR_XLBYTHM=>XLBYTHM
+ DPTR_XLBXTKEM=>XLBXTKEM
+ DPTR_XLBYTKEM=>XLBYTKEM
+ DPTR_XLBXRM=>XLBXRM
+ DPTR_XLBYRM=>XLBYRM
+ DPTR_XLBXSVM=>XLBXSVM
+ DPTR_XLBYSVM=>XLBYSVM
+ !
+ DPTR_XLBXUS=>XLBXUS
+ DPTR_XLBYUS=>XLBYUS
+ DPTR_XLBXVS=>XLBXVS
+ DPTR_XLBYVS=>XLBYVS
+ DPTR_XLBXWS=>XLBXWS
+ DPTR_XLBYWS=>XLBYWS
+ DPTR_XLBXTHS=>XLBXTHS
+ DPTR_XLBYTHS=>XLBYTHS
+ DPTR_XLBXTKES=>XLBXTKES
+ DPTR_XLBYTKES=>XLBYTKES
+ DPTR_XLBXRS=>XLBXRS
+ DPTR_XLBYRS=>XLBYRS
+ DPTR_XLBXSVS=>XLBXSVS
+ DPTR_XLBYSVS=>XLBYSVS
+ !
+ CALL ONE_WAY_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),NDTRATIO(IMI), &
+ DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, &
+ DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
+ DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
+ DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
+ DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, &
+ GSTEADY_DMASS,CCLOUD,LUSECHAQ,LUSECHIC, &
+ DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, &
+ DPTR_XLBXTHM,DPTR_XLBYTHM, &
+ DPTR_XLBXTKEM,DPTR_XLBYTKEM, &
+ DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM, &
+ XDRYMASST,XDRYMASSS, &
+ DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS,DPTR_XLBXWS,DPTR_XLBYWS, &
+ DPTR_XLBXTHS,DPTR_XLBYTHS, &
+ DPTR_XLBXTKES,DPTR_XLBYTKES, &
+ DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS )
+ !
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+!
+!* 2.1 RECYCLING TURBULENCE
+! ----
+IF (CTURB /= 'NONE' .AND. LRECYCL) THEN
+ CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, &
+ XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, &
+ KTCOUNT)
+ENDIF
+!
+!* 2.2 IBM
+! ----
+!
+IF (LIBM .AND. KTCOUNT==1) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_INIT(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. LATERAL BOUNDARY CONDITIONS EXCEPT FOR NORMAL VELOCITY
+! ------------------------------------------------------
+!
+ZTIME1=ZTIME2
+!
+!* 3.1 Set the lagragian variables values at the LB
+!
+IF( LLG .AND. IMI==1 ) CALL SETLB_LG
+!
+IF (CCONF == "START" .OR. (CCONF == "RESTA" .AND. KTCOUNT /= 1 )) THEN
+CALL MPPDB_CHECK3DM("before BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET)
+CALL BOUNDARIES ( &
+ XTSTEP,CLBCX,CLBCY,NRR,NSV,KTCOUNT, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
+ XRHODJ,XRHODREF, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
+CALL MPPDB_CHECK3DM("after BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET)
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_BOUND = XT_BOUND + ZTIME2 - ZTIME1
+!
+!
+! For START/RESTART MPPDB_CHECK use
+!IF ( (IMI==1) .AND. (CCONF == "START") .AND. (KTCOUNT == 2) ) THEN
+! CALL MPPDB_START_DEBUG()
+!ENDIF
+!IF ( (IMI==1) .AND. (CCONF == "RESTA") .AND. (KTCOUNT == 1) ) THEN
+! CALL MPPDB_START_DEBUG()
+!ENDIF
+!-------------------------------------------------------------------------------
+!* initializes surface number
+IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI)
+!-------------------------------------------------------------------------------
+!
+!* 4. STORAGE IN A SYNCHRONOUS FILE
+! -----------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF ( nfile_backup_current < NBAK_NUMB ) THEN
+ IF ( KTCOUNT == TBACKUPN(nfile_backup_current + 1)%NSTEP ) THEN
+ nfile_backup_current = nfile_backup_current + 1
+ !
+ TPBAKFILE => TBACKUPN(nfile_backup_current)%TFILE
+ IVERB = TPBAKFILE%NLFIVERB
+ !
+ CALL IO_File_open(TPBAKFILE)
+ !
+ CALL WRITE_DESFM_n(IMI,TPBAKFILE)
+ CALL IO_Header_write( TBACKUPN(nfile_backup_current)%TFILE )
+ IF ( ASSOCIATED( TBACKUPN(nfile_backup_current)%TFILE%TDADFILE ) ) THEN
+ YDADNAME = TBACKUPN(nfile_backup_current)%TFILE%TDADFILE%CNAME
+ ELSE
+ ! Set a dummy name for the dad file. Its non-zero size will allow the writing of some data in the backup file
+ YDADNAME = 'DUMMY'
+ END IF
+ CALL WRITE_LFIFM_n( TBACKUPN(nfile_backup_current)%TFILE, TRIM( YDADNAME ) )
+ TOUTDATAFILE => TPBAKFILE
+ CALL MNHWRITE_ZS_DUMMY_n(TPBAKFILE)
+ IF (CSURF=='EXTE') THEN
+ TFILE_SURFEX => TPBAKFILE
+ CALL GOTO_SURFEX(IMI)
+ CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
+ IF ( KTCOUNT > 1) THEN
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
+ CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL', KTCOUNT/nfile_backup_current)
+ END IF
+ NULLIFY(TFILE_SURFEX)
+ END IF
+ !
+ ! Reinitialize Lagragian variables at every model backup
+ IF (LLG .AND. LINIT_LG .AND. CINIT_LG=='FMOUT') THEN
+ CALL INI_LG( XXHATM, XYHATM, XZZ, XSVT, XLBXSVM, XLBYSVM )
+ IF (IVERB>=5) THEN
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(TPBAKFILE%CNAME),' backup'
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ END IF
+ END IF
+ ! Reinitialise mean variables
+ IF (LMEAN_FIELD) THEN
+ CALL INI_MEAN_FIELD
+ END IF
+!
+ ELSE
+ !Necessary to have a 'valid' CNAME when calling some subroutines
+ TPBAKFILE => TFILE_DUMMY
+ END IF
+ELSE
+ !Necessary to have a 'valid' CNAME when calling some subroutines
+ TPBAKFILE => TFILE_DUMMY
+END IF
+!
+IF ( nfile_output_current < NOUT_NUMB ) THEN
+ IF ( KTCOUNT == TOUTPUTN(nfile_output_current + 1)%NSTEP ) THEN
+ nfile_output_current = nfile_output_current + 1
+ !
+ TZOUTFILE => TOUTPUTN(nfile_output_current)%TFILE
+ !
+ CALL IO_File_open(TZOUTFILE)
+ !
+ CALL IO_Header_write(TZOUTFILE)
+ CALL IO_Fieldlist_write( TOUTPUTN(nfile_output_current) )
+ CALL IO_Field_user_write( TOUTPUTN(nfile_output_current) )
+ !
+ CALL IO_File_close(TZOUTFILE)
+ !
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STORE = XT_STORE + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.BIS IBM and Fluctuations application
+! -----------------------------
+!
+!* 4.B1 Add fluctuations at the domain boundaries
+!
+IF (LRECYCL) THEN
+ CALL ADDFLUCTUATIONS ( &
+ CLBCX,CLBCY, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT, &
+ XFLUCTUTN,XFLUCTVTW,XFLUCTUTS,XFLUCTVTE, &
+ XFLUCTWTW,XFLUCTWTN,XFLUCTWTS,XFLUCTWTE )
+ENDIF
+!
+!* 4.B2 Immersed boundaries
+!
+IF (LIBM) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_FORCING(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ !
+ IF (LIBM_TROUBLE) THEN
+ CALL IBM_FORCING_TR(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ ENDIF
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 5. INITIALIZATION OF THE BUDGET VARIABLES
+! --------------------------------------
+!
+IF (NBUMOD==IMI) THEN
+ LBU_ENABLE = CBUTYPE /='NONE'.AND. CBUTYPE /='SKIP'
+ELSE
+ LBU_ENABLE = .FALSE.
+END IF
+!
+IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN
+ CALL SET_MASK()
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, nbutime, :) = tburhodj%xdata(:, nbutime, :) + Mask_compress( xrhodj(:, :, :) )
+END IF
+!
+IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) + Cart_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) + Cart_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) &
+ + Cart_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = tburhodj%xdata(:, :, :) + Cart_compress( xrhodj(:, :, :) )
+END IF
+!
+CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH )
+!
+XTIME_BU = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. INITIALIZATION OF THE FIELD TENDENCIES
+! --------------------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+!
+CALL INITIAL_GUESS ( NRR, NSV, KTCOUNT, XRHODJ,IMI, XTSTEP, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRTKES, XRSVS, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GUESS = XT_GUESS + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. INITIALIZATION OF THE LES FOR CURRENT TIME-STEP
+! -----------------------------------------------
+!
+XTIME_LES_BU = 0.0
+XTIME_LES = 0.0
+IF (LLES) CALL LES_INI_TIMESTEP_n(KTCOUNT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. TWO-WAY INTERACTIVE GRID-NESTING
+! --------------------------------
+!
+!
+CALL SECOND_MNH2(ZTIME1)
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+GMASKkids(:,:)=.FALSE.
+!
+IF (NMODEL>1) THEN
+ ! correct an ifort bug
+ DPTR_XRHODJ=>XRHODJ
+ DPTR_XUM=>XUT
+ DPTR_XVM=>XVT
+ DPTR_XWM=>XWT
+ DPTR_XTHM=>XTHT
+ DPTR_XRM=>XRT
+ DPTR_XTKEM=>XTKET
+ DPTR_XSVM=>XSVT
+ DPTR_XRUS=>XRUS
+ DPTR_XRVS=>XRVS
+ DPTR_XRWS=>XRWS
+ DPTR_XRTHS=>XRTHS
+ DPTR_XRRS=>XRRS
+ DPTR_XRTKES=>XRTKES
+ DPTR_XRSVS=>XRSVS
+ DPTR_XINPRC=>XINPRC
+ DPTR_XINPRR=>XINPRR
+ DPTR_XINPRS=>XINPRS
+ DPTR_XINPRG=>XINPRG
+ DPTR_XINPRH=>XINPRH
+ DPTR_XPRCONV=>XPRCONV
+ DPTR_XPRSCONV=>XPRSCONV
+ DPTR_XDIRFLASWD=>XDIRFLASWD
+ DPTR_XSCAFLASWD=>XSCAFLASWD
+ DPTR_XDIRSRFSWD=>XDIRSRFSWD
+ DPTR_GMASKkids=>GMASKkids
+ !
+ CALL TWO_WAY( NRR,NSV,KTCOUNT,DPTR_XRHODJ,IMI,XTSTEP, &
+ DPTR_XUM ,DPTR_XVM ,DPTR_XWM , DPTR_XTHM, DPTR_XRM,DPTR_XSVM, &
+ DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS,DPTR_XRRS,DPTR_XRSVS, &
+ DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG,DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV, &
+ DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD,DPTR_GMASKkids )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_2WAY = XT_2WAY + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+!* 10. FORCING
+! -------
+!
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ( XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, XZS, &
+ LSLEVE, XLEN1, XLEN2, XZSMT, XLATORI, XLONORI, &
+ XMAP, XLAT, XLON, XDXHAT, XDYHAT, XZZ, ZJ )
+END IF
+!
+IF ( LFORCING ) THEN
+ CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
+ XUFRC_PAST, XVFRC_PAST,XWTFRC, &
+ XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
+ XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
+END IF
+!
+IF ( L2D_ADV_FRC ) THEN
+ CALL ADV_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
+END IF
+IF ( L2D_REL_FRC ) THEN
+ CALL REL_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_FORCING = XT_FORCING + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. NUDGING
+! -------
+!
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF ( LNUDGING ) THEN
+ CALL NUDGING(LUSERV,XRHODJ,XTNUDGING, &
+ XUT,XVT,XWT,XTHT,XRT, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
+ XRUS,XRVS,XRWS,XRTHS,XRRS)
+
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_NUDGING = XT_NUDGING + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. DYNAMICAL SOURCES
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) + XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) + XVTRANS
+END IF
+!
+CALL DYN_SOURCES( NRR,NRRL, NRRI, &
+ XUT, XVT, XWT, XTHT, XRT, &
+ XCORIOX, XCORIOY, XCORIOZ, XCURVX, XCURVY, &
+ XRHODJ, XZZ, XTHVREF, XEXNREF, &
+ XRUS, XRVS, XRWS, XRTHS )
+!
+IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) - XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) - XVTRANS
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_SOURCES = XT_SOURCES + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. NUMERICAL DIFFUSION
+! -------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF ( LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV ) THEN
+!
+ CALL UPDATE_HALO_ll(TFIELDT_ll, IINFO_ll)
+ CALL UPDATE_HALO2_ll(TFIELDT_ll, THALO2T_ll, IINFO_ll)
+ IF ( .NOT. LSTEADYLS ) THEN
+ CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
+ END IF
+ CALL NUM_DIFF ( CLBCX, CLBCY, NRR, NSV, &
+ XDK2U, XDK4U, XDK2TH, XDK4TH, XDK2SV, XDK4SV, IMI, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XRHODJ, &
+ XRUS, XRVS, XRWS, XRTHS, XRTKES, XRRS, XRSVS, &
+ LZDIFFU,LNUMDIFU, LNUMDIFTH, LNUMDIFSV, &
+ THALO2T_ll, TLSHALO2_ll,XZDIFFU_HALO2 )
+END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+
+DO JSV = NSV_CHEMBEG,NSV_CHEMEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_CHICBEG,NSV_CHICEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_AERBEG,NSV_AEREND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_LNOXBEG,NSV_LNOXEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_DSTBEG,NSV_DSTEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SLTBEG,NSV_SLTEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_PPBEG,NSV_PPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+#ifdef MNH_FOREFIRE
+DO JSV = NSV_FFBEG,NSV_FFEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+#endif
+! Blaze smoke
+DO JSV = NSV_FIREBEG,NSV_FIREEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_CSBEG,NSV_CSEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SNWBEG,NSV_SNWEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+IF (CELEC .NE. 'NONE') THEN
+ XRSVS(:,:,:,NSV_ELECBEG) = MAX(XRSVS(:,:,:,NSV_ELECBEG),0.)
+ XRSVS(:,:,:,NSV_ELECEND) = MAX(XRSVS(:,:,:,NSV_ELECEND),0.)
+END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_DIFF = XT_DIFF + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 14. UPPER AND LATERAL RELAXATION
+! ----------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.&
+ LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI .OR. LHORELAX_RS .OR. &
+ LHORELAX_RG .OR. LHORELAX_RH .OR. LHORELAX_TKE .OR. &
+ ANY(LHORELAX_SV)) THEN
+ CALL RELAXATION (LVE_RELAX,LVE_RELAX_GRD,LHORELAX_UVWTH,LHORELAX_RV,LHORELAX_RC, &
+ LHORELAX_RR,LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, &
+ LHORELAX_RH,LHORELAX_TKE,LHORELAX_SV, &
+ LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
+ LHORELAX_SVELEC,LHORELAX_SVLG, &
+ LHORELAX_SVCHEM,LHORELAX_SVCHIC,LHORELAX_SVAER, &
+ LHORELAX_SVDST,LHORELAX_SVSLT,LHORELAX_SVPP, &
+ LHORELAX_SVCS,LHORELAX_SVSNW,LHORELAX_SVFIRE, &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF, &
+#endif
+ KTCOUNT,NRR,NSV,XTSTEP,XRHODJ, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XLSUM, XLSVM, XLSWM, XLSTHM, &
+ XLBXUM, XLBXVM, XLBXWM, XLBXTHM, &
+ XLBXRM, XLBXSVM, XLBXTKEM, &
+ XLBYUM, XLBYVM, XLBYWM, XLBYTHM, &
+ XLBYRM, XLBYSVM, XLBYTKEM, &
+ NALBOT, XALK, XALKW, &
+ NALBAS, XALKBAS, XALKWBAS, &
+ LMASK_RELAX,XKURELAX, XKVRELAX, XKWRELAX, &
+ NRIMX,NRIMY, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES )
+END IF
+
+IF (CELEC.NE.'NONE' .AND. LRELAX2FW_ION) THEN
+ CALL RELAX2FW_ION (KTCOUNT, IMI, XTSTEP, XRHODJ, XSVT, NALBOT, &
+ XALK, LMASK_RELAX, XKWRELAX, XRSVS )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_RELAX = XT_RELAX + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 15. PARAMETRIZATIONS' MONITOR
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL PHYS_PARAM_n( KTCOUNT, TPBAKFILE, &
+ XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, &
+ XT_MAFL, XT_DRAG, XT_EOL, XT_TURB, XT_TRACER, &
+ ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
+!
+IF (CDCONV/='NONE') THEN
+ XPACCONV = XPACCONV + XPRCONV * XTSTEP
+ IF (LCH_CONV_LINOX) THEN
+ XIC_TOTAL_NUMBER = XIC_TOTAL_NUMBER + XIC_RATE * XTSTEP
+ XCG_TOTAL_NUMBER = XCG_TOTAL_NUMBER + XCG_RATE * XTSTEP
+ END IF
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_PARAM = XT_PARAM + ZTIME2 - ZTIME1 - XTIME_LES - ZTIME
+!
+!-------------------------------------------------------------------------------
+!
+!* 16. TEMPORAL SERIES
+! ---------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LSERIES) THEN
+ IF ( MOD (KTCOUNT-1,NFREQSERIES) == 0 ) CALL SERIES_n
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. LARGE SCALE FIELD REFRESH
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (.NOT. LSTEADYLS) THEN
+ IF ( IMI==1 .AND. &
+ NCPL_CUR < NCPL_NBR ) THEN
+ IF (KTCOUNT+1 == NCPL_TIMES(NCPL_CUR,1) ) THEN
+ ! The next current time reachs a
+ NCPL_CUR=NCPL_CUR+1 ! coupling one, LS sources are refreshed
+ !
+ CALL LS_COUPLING(XTSTEP,GSTEADY_DMASS,CCONF, &
+ CGETTKET, &
+ CGETRVT,CGETRCT,CGETRRT,CGETRIT, &
+ CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, NSV, &
+ NIMAX_ll,NJMAX_ll, &
+ NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
+ NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
+ NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
+ !
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_LNOXBEG,NSV_LNOXEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#ifdef MNH_FOREFIRE
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#endif
+ DO JSV=NSV_FIREBEG,NSV_FIREEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SNWBEG,NSV_SNWEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ END IF
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_COUPL = XT_COUPL + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 8 Bis . Blowing snow scheme
+! ---------
+!
+IF ( LBLOWSNOW ) THEN
+ CALL BLOWSNOW( XTSTEP, NRR, XPABST, XTHT, XRT, XZZ, XRHODREF, &
+ XRHODJ, XEXNREF, XRRS, XRTHS, XSVT, XRSVS, XSNWSUBL3D )
+ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!* 8 Ter VISCOSITY (no-slip condition inside)
+! ---------
+!
+!
+IF ( LVISC ) THEN
+!
+ZTIME1 = ZTIME2
+!
+ CALL VISCOSITY(CLBCX, CLBCY, NRR, NSV, XMU_V,XPRANDTL, &
+ LVISC_UVW,LVISC_TH,LVISC_SV,LVISC_R, &
+ LDRAG, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS,XDRAG )
+!
+ENDIF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_VISC = XT_VISC + ZTIME2 - ZTIME1
+!!
+!-------------------------------------------------------------------------------
+!
+!* 9. ADVECTION
+! ---------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+!
+!
+CALL MPPDB_CHECK3DM("before ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
+ CALL ADVECTION_METSV ( TPBAKFILE, CUVW_ADV_SCHEME, &
+ CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, NSPLIT, &
+ LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
+ CLBCX, CLBCY, NRR, NSV, TDTCUR, XTSTEP, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT, XPABST, &
+ XTHVREF, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRTHS, XRRS, XRTKES, XRSVS, &
+ XRTHS_CLD, XRRS_CLD, XRSVS_CLD, XRTKEMS )
+CALL MPPDB_CHECK3DM("after ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ ",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADV = XT_ADV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZRWS = XRWS
+!
+CALL GRAVITY_IMPL ( CLBCX, CLBCY, NRR, NRRL, NRRI,XTSTEP, &
+ XTHT, XRT, XTHVREF, XRHODJ, XRWS, XRTHS, XRRS, &
+ XRTHS_CLD, XRRS_CLD )
+!
+! At the initial instant the difference with the ref state creates a
+! vertical velocity production that must not be advected as it is
+! compensated by the pressure gradient
+!
+IF (KTCOUNT == 1 .AND. CCONF=='START') XRWS_PRES = - (XRWS - ZRWS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+IF ( LIBM .AND. CIBM_ADV=='FORCIN' ) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ CALL IBM_FORCING_ADV (XRUS,XRVS,XRWS)
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+!MPPDB_CHECK_LB=.TRUE.
+CALL MPPDB_CHECK3DM("before ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
+IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR')) THEN
+ IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
+ NULLIFY(TZFIELDC_ll)
+ NULLIFY(TZHALO2C_ll)
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XUT, 'MODEL_n::XUT' )
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XVT, 'MODEL_n::XVT' )
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XWT, 'MODEL_n::XWT' )
+ CALL INIT_HALO2_ll(TZHALO2C_ll,3,IIU,IJU,IKU)
+ CALL UPDATE_HALO_ll(TZFIELDC_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDC_ll, TZHALO2C_ll, IINFO_ll)
+ END IF
+ CALL ADVECTION_UVW_CEN(CUVW_ADV_SCHEME, &
+ CLBCX, CLBCY, &
+ XTSTEP, KTCOUNT, &
+ XUM, XVM, XWM, XDUM, XDVM, XDWM, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS,XRVS, XRWS, &
+ TZHALO2C_ll )
+ IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL CLEANLIST_ll(TZFIELDC_ll)
+ NULLIFY(TZFIELDC_ll)
+ CALL DEL_HALO2_ll(TZHALO2C_ll)
+ NULLIFY(TZHALO2C_ll)
+ END IF
+ELSE
+
+ CALL ADVECTION_UVW(CUVW_ADV_SCHEME, CTEMP_SCHEME, &
+ NWENO_ORDER, LSPLIT_WENO, &
+ CLBCX, CLBCY, XTSTEP, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, &
+ XRUS_PRES, XRVS_PRES, XRWS_PRES )
+END IF
+!
+CALL MPPDB_CHECK3DM("after ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
+!MPPDB_CHECK_LB=.FALSE.
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADVUVW = XT_ADVUVW + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+IF (LCLOUDMODIFLM) THEN
+ CALL TURB_CLOUD_INDEX( XTSTEP, TPBAKFILE, &
+ LTURB_DIAG, NRRI, &
+ XRRS, XRT, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XCEI )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 18. LATERAL BOUNDARY CONDITION FOR THE NORMAL VELOCITY
+! --------------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL MPPDB_CHECK3DM("before RAD_BOUND :XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+ZRUS=XRUS
+ZRVS=XRVS
+ZRWS=XRWS
+!
+if ( .not. l1d ) then
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', xrvs(:, :, :) )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', xrws(:, :, :) )
+end if
+!
+CALL MPPDB_CHECK3DM("before RAD_BOUND : other var",PRECISION,XUT,XVT,XRHODJ,XTKET)
+CALL MPPDB_CHECKLB(XLBXUM,"modeln XLBXUM",PRECISION,'LBXU',NRIMX)
+CALL MPPDB_CHECKLB(XLBYVM,"modeln XLBYVM",PRECISION,'LBYV',NRIMY)
+CALL MPPDB_CHECKLB(XLBXUS,"modeln XLBXUS",PRECISION,'LBXU',NRIMX)
+CALL MPPDB_CHECKLB(XLBYVS,"modeln XLBYVS",PRECISION,'LBYV',NRIMY)
+!
+ CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
+ XTSTEP, &
+ XDXHAT, XDYHAT, XZHAT, &
+ XUT, XVT, &
+ XLBXUM, XLBYVM, XLBXUS, XLBYVS, &
+ XFLUCTUNW,XFLUCTVNN,XFLUCTUNE,XFLUCTVNS, &
+ XCPHASE, XCPHASE_PBL, XRHODJ, &
+ XTKET,XRUS, XRVS, XRWS )
+ZRUS=XRUS-ZRUS
+ZRVS=XRVS-ZRVS
+ZRWS=XRWS-ZRWS
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_RAD_BOUND = XT_RAD_BOUND + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 19. PRESSURE COMPUTATION
+! --------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZPABST = XPABST
+!
+IF(.NOT. L1D) THEN
+!
+CALL MPPDB_CHECK3DM("before pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+ XRUS_PRES = XRUS
+ XRVS_PRES = XRVS
+ XRWS_PRES = XRWS
+!
+ CALL PRESSUREZ( CLBCX,CLBCY,CPRESOPT,NITR,LITRADJ,KTCOUNT, XRELAX,IMI, &
+ XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY,XDXHATM,XDYHATM,XRHOM, &
+ XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, &
+ NRR,NRRL,NRRI,XDRYMASST,XREFMASS,XMASS_O_PHI0, &
+ XTHT,XRT,XRHODREF,XTHVREF,XRVREF,XEXNREF, XLINMASS, &
+ XRUS, XRVS, XRWS, XPABST, &
+ XBFB,&
+ XBF_SXP2_YP1_Z) !JUAN Z_SPLITING
+!
+ XRUS_PRES = XRUS - XRUS_PRES + ZRUS
+ XRVS_PRES = XRVS - XRVS_PRES + ZRVS
+ XRWS_PRES = XRWS - XRWS_PRES + ZRWS
+ CALL MPPDB_CHECK3DM("after pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+!
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_PRESS = XT_PRESS + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 20. CHEMISTRY/AEROSOLS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LUSECHEM) THEN
+ CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,XTSTEP, ILUOUT, NVERB)
+END IF
+!
+! For inert aerosol (dust and sea salt) => aer_monitor_n
+IF ((LDUST).OR.(LSALT)) THEN
+!
+! tests to see if any cloud exists
+!
+ GCLD=.TRUE.
+ IF (GCLD .AND. NRR.LE.3 ) THEN
+ IF( MAX(MAXVAL(XCLDFR(:,:,:)),MAXVAL(XICEFR(:,:,:))).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no clouds
+ END IF
+ END IF
+!
+ IF (GCLD .AND. NRR.GE.4 ) THEN
+ IF( CCLOUD(1:3)=='ICE' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='C3R5' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='LIMA' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ END IF
+
+!
+ CALL AER_MONITOR_n(KTCOUNT,XTSTEP, ILUOUT, NVERB, GCLD)
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CHEM = XT_CHEM + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+ZTIME = ZTIME + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+
+!-------------------------------------------------------------------------------
+!
+!* 20. WATER MICROPHYSICS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
+!
+ IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' .OR. CCLOUD == 'C3R5' &
+ .OR. CCLOUD == "LIMA" ) THEN
+ IF ( LFORCING ) THEN
+ XWT_ACT_NUC(:,:,:) = XWT(:,:,:) + XWTFRC(:,:,:)
+ ELSE
+ XWT_ACT_NUC(:,:,:) = XWT(:,:,:)
+ END IF
+ IF (CTURB /= 'NONE' ) THEN
+ IF ( ((CCLOUD=='C2R2'.OR.CCLOUD=='KHKO').AND.LACTTKE) .OR. (CCLOUD=='LIMA'.AND.MACTTKE) ) THEN
+ XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:) + (2./3. * XTKET(:,:,:))**0.5
+ ELSE
+ XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:)
+ ENDIF
+ ENDIF
+ ELSE
+ XWT_ACT_NUC(:,:,:) = 0.
+ END IF
+!
+ XRTHS_CLD = XRTHS
+ XRRS_CLD = XRRS
+ XRSVS_CLD = XRSVS
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ZSEA(:,:) = 0.
+ ZTOWN(:,:)= 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
+ CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
+ NSPLITG, IMI, KTCOUNT, &
+ CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV_RC,XTSTEP, &
+ XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XICEFR, XCIT, &
+ LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
+ LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
+ XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
+ XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
+ ZSEA, ZTOWN )
+ DEALLOCATE(ZTOWN)
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
+ NSPLITG, IMI, KTCOUNT, &
+ CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV_RC, &
+ XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR, XICEFR, XCIT, &
+ LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
+ LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
+ XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
+ XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF )
+ END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
+!
+ IF (CCLOUD /= 'REVE' ) THEN
+ XACPRR = XACPRR + XINPRR * XTSTEP
+ IF ( (CCLOUD(1:3) == 'ICE' .AND. LSEDIC ) .OR. &
+ ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' &
+ .OR. CCLOUD == 'LIMA' ) .AND. KSEDC ) ) THEN
+ XACPRC = XACPRC + XINPRC * XTSTEP
+ IF (LDEPOSC .OR. LDEPOC) XACDEP = XACDEP + XINDEP * XTSTEP
+ END IF
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
+ (CCLOUD == 'LIMA' .AND. NMOM_I.GE.1 ) ) THEN
+ XACPRS = XACPRS + XINPRS * XTSTEP
+ XACPRG = XACPRG + XINPRG * XTSTEP
+ IF (CCLOUD == 'ICE4' .OR. (CCLOUD == 'LIMA' .AND. NMOM_H.GE.1)) XACPRH = XACPRH + XINPRH * XTSTEP
+ END IF
+!
+! Lessivage des CCN et IFN nucléables par Slinn
+!
+ IF (LSCAV .AND. (CCLOUD == 'LIMA')) THEN
+ CALL LIMA_PRECIP_SCAVENGING( YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ CCLOUD, CCONF, ILUOUT, KTCOUNT,XTSTEP,XRT(:,:,:,3), &
+ XRHODREF, XRHODJ, XZZ, XPABST, XTHT, &
+ XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ XRSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), XINPAP )
+!
+ XACPAP(:,:) = XACPAP(:,:) + XINPAP(:,:) * XTSTEP
+ END IF
+ END IF
+!
+! It is necessary that SV_C2R2 and SV_C1R3 are contiguous in the preceeding CALL
+!
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CLOUD = XT_CLOUD + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. CLOUD ELECTRIFICATION AND LIGHTNING FLASHES
+! -------------------------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
+ XWT_ACT_NUC(:,:,:) = 0.
+!
+ XRTHS_CLD = XRTHS
+ XRRS_CLD = XRRS
+ XRSVS_CLD = XRSVS
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ZSEA(:,:) = 0.
+ ZTOWN(:,:)= 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
+ CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
+ NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
+ CLBCX, CLBCY, CRAD, CTURBDIM, &
+ LSUBG_COND, LSIGMAS,VSIGQSAT,CSUBG_AUCV_RC, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XRTHS, XWT, XRT, XRRS, &
+ XSVT, XRSVS, XCIT, &
+ XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
+ XRI_MF, LSEDIC, LWARM, &
+ XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS, XINPRG, XINPRH, &
+ ZSEA, ZTOWN )
+ DEALLOCATE(ZTOWN)
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
+ NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
+ CLBCX, CLBCY, CRAD, CTURBDIM, &
+ LSUBG_COND, LSIGMAS,VSIGQSAT, CSUBG_AUCV_RC, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XRTHS, XWT, &
+ XRT, XRRS, XSVT, XRSVS, XCIT, &
+ XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
+ XRI_MF, LSEDIC, LWARM, &
+ XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS, XINPRG, XINPRH )
+ END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
+!
+ XACPRR = XACPRR + XINPRR * XTSTEP
+ IF ((CCLOUD(1:3) == 'ICE' .AND. LSEDIC)) &
+ XACPRC = XACPRC + XINPRC * XTSTEP
+ IF (CCLOUD(1:3) == 'ICE') THEN
+ XACPRS = XACPRS + XINPRS * XTSTEP
+ XACPRG = XACPRG + XINPRG * XTSTEP
+ IF (CCLOUD == 'ICE4') XACPRH = XACPRH + XINPRH * XTSTEP
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ELEC = XT_ELEC + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. L.E.S. COMPUTATIONS
+! -------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL LES_n
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. bis MEAN_UM
+! --------------------
+!
+IF (LMEAN_FIELD) THEN
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XRT(:,:,:,1), XSVT(:,:,:,1))
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. UPDATE HALO OF EACH SUBDOMAINS FOR TIME T+DT
+! --------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL EXCHANGE (XTSTEP,NRR,NSV,XRHODJ,TFIELDS_ll, &
+ XRUS, XRVS,XRWS,XRTHS,XRRS,XRTKES,XRSVS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_HALO = XT_HALO + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 23. TEMPORAL SWAPPING
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+!
+CALL ENDSTEP ( XTSTEP,NRR,NSV,KTCOUNT,IMI, &
+ CUVW_ADV_SCHEME,CTEMP_SCHEME,XRHODJ, &
+ XRUS,XRVS,XRWS,XDRYMASSS, &
+ XRTHS,XRRS,XRTKES,XRSVS, &
+ XLSUS,XLSVS,XLSWS, &
+ XLSTHS,XLSRVS,XLSZWSS, &
+ XLBXUS,XLBXVS,XLBXWS, &
+ XLBXTHS,XLBXRS,XLBXTKES,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS, &
+ XLBYTHS,XLBYRS,XLBYTKES,XLBYSVS, &
+ XUM,XVM,XWM,XZWS, &
+ XUT,XVT,XWT,XPABST,XDRYMASST, &
+ XTHT, XRT, XTHM, XRCM, XPABSM,XTKET, XSVT,&
+ XLSUM,XLSVM,XLSWM, &
+ XLSTHM,XLSRVM,XLSZWSM, &
+ XLBXUM,XLBXVM,XLBXWM, &
+ XLBXTHM,XLBXRM,XLBXTKEM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM, &
+ XLBYTHM,XLBYRM,XLBYTKEM,XLBYSVM )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_SWA = XT_STEP_SWA + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 24.1 BALLOON and AIRCRAFT
+! --------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LFLYER) THEN
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE(ZSEA(IIU,IJU))
+ ZSEA(:,:) = 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
+ CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI, &
+ XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
+ XRHODREF, XCIT, PSEA = ZSEA(:,:) )
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI, &
+ XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
+ XRHODREF, XCIT )
+ END IF
+END IF
+
+!-------------------------------------------------------------------------------
+!
+!* 24.2 STATION (observation diagnostic)
+! --------------------------------
+!
+IF ( LSTATION ) &
+ CALL STATION_n( XZZ, XRHODREF, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
+!
+!---------------------------------------------------------
+!
+!* 24.3 PROFILER (observation diagnostic)
+! ---------------------------------
+!
+IF (LPROFILER) THEN
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE(ZSEA(IIU,IJU))
+ ZSEA(:,:) = 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
+ CALL PROFILER_n( XZZ, XRHODREF, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XTSRAD, XPABST, XAER, XCIT, PSEA=ZSEA(:,:) )
+ DEALLOCATE(ZSEA)
+ ELSE
+ CALL PROFILER_n( XZZ, XRHODREF, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XTSRAD, XPABST, XAER, XCIT )
+ END IF
+END IF
+!
+IF (ALLOCATED(ZSEA)) DEALLOCATE (ZSEA)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 24.4 deallocation of observation diagnostics
+! ---------------------------------------
+!
+CALL END_DIAG_IN_RUN
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 25. STORAGE OF BUDGET FIELDS
+! ------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF ( .NOT. LIO_NO_WRITE ) THEN
+ IF (NBUMOD==IMI .AND. CBUTYPE/='NONE') THEN
+ CALL ENDSTEP_BUDGET(TDIAFILE,KTCOUNT,TDTCUR,XTSTEP,NSV)
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU
+!
+!-------------------------------------------------------------------------------
+!
+!* 27. CURRENT TIME REFRESH
+! --------------------
+!
+TDTCUR%xtime=TDTCUR%xtime + XTSTEP
+CALL DATETIME_CORRECTDATE(TDTCUR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 28. CPU ANALYSIS
+! ------------
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_START=XT_START+ZTIME2-ZEND
+!
+!
+IF ( KTCOUNT == NSTOP .AND. IMI==1) THEN
+ OEXIT=.TRUE.
+END IF
+!
+IF (OEXIT) THEN
+!
+ IF ( .NOT. LIO_NO_WRITE ) THEN
+ IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE)
+ CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
+ CALL WRITE_STATPROF_n( TDIAFILE, TSTATIONS )
+ CALL WRITE_STATPROF_n( TDIAFILE, TPROFILERS )
+ call Write_les_n( tdiafile )
+#ifdef MNH_IOLFI
+ CALL MENU_DIACHRO(TDIAFILE,'END')
+#endif
+ CALL IO_File_close(TDIAFILE)
+ ! Free memory of flyer that is not present on the master process of the file (was allocated in WRITE_AIRCRAFT_BALLOON)
+ CALL AIRCRAFT_BALLOON_FREE_NONLOCAL( TDIAFILE )
+ END IF
+ !
+ CALL IO_File_close(TINIFILE)
+ IF (CSURF=="EXTE") CALL IO_File_close(TINIFILEPGD)
+!
+!* 28.1 print statistics!
+!
+ ! Set File Timing OUTPUT
+ !
+ CALL SET_ILUOUT_TIMING(TLUOUT)
+ !
+ ! Compute global time
+ !
+ CALL TIME_STAT_ll(XT_START,ZTOT)
+ !
+ CALL TIME_HEADER_ll(IMI)
+ !
+ CALL TIME_STAT_ll(XT_1WAY,ZTOT, ' ONE WAY','=')
+ CALL TIME_STAT_ll(XT_BOUND,ZTOT, ' BOUNDARIES','=')
+ CALL TIME_STAT_ll(XT_STORE,ZTOT, ' STORE-FIELDS','=')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_SEND,ZTOT, ' W3D_SEND ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_RECV,ZTOT, ' W3D_RECV ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WRIT,ZTOT, ' W3D_WRIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WAIT,ZTOT, ' W3D_WAIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_ALL ,ZTOT, ' W3D_ALL ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_GATH,ZTOT, ' W2D_GATH ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_WRIT,ZTOT, ' W2D_WRIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_ALL ,ZTOT, ' W2D_ALL ','-')
+ CALL TIME_STAT_ll(XT_GUESS,ZTOT, ' INITIAL_GUESS','=')
+ CALL TIME_STAT_ll(XT_2WAY,ZTOT, ' TWO WAY','=')
+ CALL TIME_STAT_ll(XT_ADV,ZTOT, ' ADVECTION MET','=')
+ CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=')
+ CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=')
+ CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=')
+ CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT, ' IBM','=')
+ CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=')
+ CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=')
+ CALL TIME_STAT_ll(XT_DIFF,ZTOT, ' NUM_DIFF','=')
+ CALL TIME_STAT_ll(XT_RELAX,ZTOT, ' RELAXATION','=')
+ !
+ CALL TIMING_LEGEND()
+ !
+ CALL TIME_STAT_ll(XT_PARAM,ZTOT, ' PHYS_PARAM','=')
+ CALL TIME_STAT_ll(XT_RAD,ZTOT, ' RAD = '//CRAD ,'-')
+ CALL TIME_STAT_ll(XT_SHADOWS,ZTOT, ' SHADOWS' ,'-')
+ CALL TIME_STAT_ll(XT_DCONV,ZTOT, ' DEEP CONV = '//CDCONV,'-')
+ CALL TIME_STAT_ll(XT_GROUND,ZTOT, ' GROUND' ,'-')
+ ! Blaze perf
+ IF (LBLAZE) THEN
+ CALL TIME_STAT_ll(XFIREPERF,ZBLAZETOT)
+ CALL TIME_STAT_ll(XFIREPERF,ZTOT, ' BLAZE' ,'~')
+ CALL TIME_STAT_ll(XGRADPERF,ZBLAZETOT, ' GRAD(PHI)' ,' ')
+ CALL TIME_STAT_ll(XROSWINDPERF,ZBLAZETOT, ' ROS & WIND' ,' ')
+ CALL TIME_STAT_ll(XPROPAGPERF,ZBLAZETOT, ' PROPAGATION' ,' ')
+ CALL TIME_STAT_ll(XFLUXPERF,ZBLAZETOT, ' HEAT FLUXES' ,' ')
+ END IF
+ CALL TIME_STAT_ll(XT_TURB,ZTOT, ' TURB = '//CTURB ,'-')
+ CALL TIME_STAT_ll(XT_MAFL,ZTOT, ' MAFL = '//CSCONV,'-')
+ CALL TIME_STAT_ll(XT_CHEM,ZTOT, ' CHIMIE' ,'-')
+ CALL TIME_STAT_ll(XT_EOL,ZTOT, ' WIND TURBINE' ,'-')
+ CALL TIMING_LEGEND()
+ CALL TIME_STAT_ll(XT_COUPL,ZTOT, ' SET_COUPLING','=')
+ CALL TIME_STAT_ll(XT_RAD_BOUND,ZTOT, ' RAD_BOUND','=')
+ !
+ CALL TIMING_LEGEND()
+ !
+ CALL TIME_STAT_ll(XT_PRESS,ZTOT, ' PRESSURE ','=','F')
+ !JUAN Z_SPLITTING
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SX_YP2_ZP1,ZTOT, ' REMAP B=>FFTXZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1,ZTOT, ' REMAP FFTXZ=>FFTYZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_B,ZTOT, ' REMAP FTTYZ=>B' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z,ZTOT, ' REMAP FFTYZ=>SUBZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SXP2_Y_ZP1,ZTOT, ' REMAP B=>FFTYZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1,ZTOT, ' REMAP SUBZ=>FFTYZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1,ZTOT, ' REMAP FFTYZ-1=>FFTXZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_B,ZTOT, ' REMAP FFTXZ-1=>B ' ,'-','F')
+ ! JUAN P1/P2
+ CALL TIME_STAT_ll(XT_CLOUD,ZTOT, ' RESOLVED_CLOUD','=')
+ CALL TIME_STAT_ll(XT_ELEC,ZTOT, ' RESOLVED_ELEC','=')
+ CALL TIME_STAT_ll(XT_HALO,ZTOT, ' EXCHANGE_HALO','=')
+ CALL TIME_STAT_ll(XT_STEP_SWA,ZTOT, ' ENDSTEP','=')
+ CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT, ' BUDGETS','=')
+ CALL TIME_STAT_ll(XT_SPECTRA,ZTOT, ' LES','=')
+ CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT, ' MISCELLANEOUS','=')
+ IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=')
+ !
+ ! sum of call subroutine
+ !
+ ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + &
+ XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + &
+ XT_ADVUVW + XT_GRAV + XT_IBM_FORC + &
+ XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + &
+ XT_CLOUD+ XT_ELEC + XT_HALO + XT_SPECTRA + XT_STEP_SWA + &
+ XT_STEP_MISC+ XT_STEP_BUD
+ CALL TIME_STAT_ll(ZALL,ZTOT, ' SUM(CALL)','=')
+ CALL TIMING_SEPARATOR('=')
+ !
+ ! Gobale Stat
+ !
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*)
+ CALL TIMING_LEGEND()
+ !
+ ! MODELN all included
+ !
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ WRITE(YMI,FMT="(I0)") IMI
+ CALL TIME_STAT_ll(XT_START,ZTOT, ' MODEL'//YMI,'+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ !
+ ! Timing/ Steps
+ !
+ ZTIME_STEP = XT_START / REAL(KTCOUNT)
+ WRITE(YTCOUNT,FMT="(I0)") KTCOUNT
+ CALL TIME_STAT_ll(ZTIME_STEP,ZTOT, ' SECOND/STEP='//YTCOUNT,'=')
+ !
+ ! Timing/Step/Points
+ !
+ IPOINTS = NIMAX_ll*NJMAX_ll*NKMAX
+ WRITE(YPOINTS,FMT="(I0)") IPOINTS
+ ZTIME_STEP_PTS = ZTIME_STEP / REAL(IPOINTS) * 1e6
+ CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT)
+ CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT, ' MICROSEC/STP/PT='//YPOINTS,'-')
+ !
+ CALL TIMING_SEPARATOR('=')
+ !
+END IF
+!
+END SUBROUTINE MODEL_n
diff --git a/src/PHYEX/ext/phys_paramn.f90 b/src/PHYEX/ext/phys_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ef93f2ccca1bcd8df3a68c8ada3b37176d740461
--- /dev/null
+++ b/src/PHYEX/ext/phys_paramn.f90
@@ -0,0 +1,1764 @@
+!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_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
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
+! P. Wautelet 30/11/2022: compute XTHW_FLUX, XRCW_FLUX and XSVW_FLUX only when needed
+! A. Costes 12/2021: add Blaze fire model
+! Q. Rodier 2022 : integration with PHYEX
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ADV_n, ONLY : XRTKEMS
+USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
+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_n, ONLY: NLES_TIMES
+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_n, ONLY : LSEDIC
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
+USE MODD_PARAM_MFSHALL_n, ONLY: CMF_CLOUD
+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_n, 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_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
+USE MODD_TURB_n
+USE MODD_NEB_n, ONLY: NEBN
+
+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 :: ZSFTH_WALL
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFTH_ROOF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCD_ROOF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV_WALL
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV_ROOF
+!
+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.,NLES_TIMES)
+!
+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))
+!
+ALLOCATE(ZSFTH_WALL (IIU,IJU))
+ALLOCATE(ZSFTH_ROOF (IIU,IJU))
+ALLOCATE(ZCD_ROOF (IIU,IJU))
+ALLOCATE(ZSFRV_WALL (IIU,IJU))
+ALLOCATE(ZSFRV_ROOF (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, XDXHAT, XDYHAT, 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 ( 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
+ !
+ 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 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
+ !
+ 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 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, ZSFTH_WALL, ZSFTH_ROOF, ZCD_ROOF, ZSFRV, ZSFRV_WALL, ZSFRV_ROOF, &
+ 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.
+ ZSFTH_WALL = 0.
+ ZSFTH_ROOF = 0.
+ ZCD_ROOF = 0.
+ ZSFRV_WALL = 0.
+ ZSFRV_ROOF = 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.
+!
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFTH_WALL, 'PHYS_PARAM_n::ZSFTH_WALL')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFTH_ROOF, 'PHYS_PARAM_n::ZSFTH_ROOF')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZCD_ROOF, 'PHYS_PARAM_n::ZCD_ROOF')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFRV_WALL, 'PHYS_PARAM_n::ZSFRV_WALL')
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSFRV_ROOF, 'PHYS_PARAM_n::ZSFRV_ROOF')
+!
+IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ ZSFTH_WALL(IIB-1,:)=ZSFTH_WALL(IIB,:)
+ ZSFTH_ROOF(IIB-1,:)=ZSFTH_ROOF(IIB,:)
+ ZCD_ROOF (IIB-1,:)=ZCD_ROOF(IIB,:)
+ ZSFRV_WALL(IIB-1,:)=ZSFRV_WALL(IIB,:)
+ ZSFRV_ROOF(IIB-1,:)=ZSFRV_ROOF(IIB,:)
+ENDIF
+!
+IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ ZSFTH_WALL(IIE+1,:)=ZSFTH_WALL(IIE,:)
+ ZSFTH_ROOF(IIE+1,:)=ZSFTH_ROOF(IIE,:)
+ ZCD_ROOF(IIE+1,:) =ZCD_ROOF(IIE,:)
+ ZSFRV_WALL(IIE+1,:)=ZSFRV_WALL(IIE,:)
+ ZSFRV_ROOF(IIE+1,:)=ZSFRV_ROOF(IIE,:)
+ENDIF
+!
+IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ ZSFTH_WALL(:,IJB-1)=ZSFTH_WALL(:,IJB)
+ ZSFTH_ROOF(:,IJB-1)=ZSFTH_ROOF(:,IJB)
+ ZCD_ROOF(:,IJB-1) =ZCD_ROOF(:,IJB)
+ ZSFRV_WALL(:,IJB-1)=ZSFRV_WALL(:,IJB)
+ ZSFRV_ROOF(:,IJB-1)=ZSFRV_ROOF(:,IJB)
+ENDIF
+!
+IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ ZSFTH_WALL(:,IJE+1)=ZSFTH_WALL(:,IJE)
+ ZSFTH_ROOF(:,IJE+1)=ZSFTH_ROOF(:,IJE)
+ ZCD_ROOF(:,IJE+1)=ZCD_ROOF(:,IJE)
+ ZSFRV_WALL(:,IJE+1)=ZSFRV_WALL(:,IJE)
+ ZSFRV_ROOF(:,IJE+1)=ZSFRV_ROOF(:,IJE)
+ENDIF
+!
+!
+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, XPABST, XTHT, XRT, XSVT, &
+ XRHODJ, XZZ, XRUS, XRVS, XRTKES, XRTHS, XRRS, &
+ ZSFTH_WALL, ZSFTH_ROOF, ZCD_ROOF, ZSFRV_WALL, &
+ ZSFRV_ROOF )
+!
+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 ) ) DEALLOCATE( XTHW_FLUX )
+IF ( LFLYER ) THEN
+ ALLOCATE( XTHW_FLUX(SIZE( XTHT, 1 ), SIZE( XTHT, 2 ), SIZE( XTHT, 3 )) )
+ELSE
+ ALLOCATE( XTHW_FLUX(0, 0, 0) )
+END IF
+
+IF ( ALLOCATED( XRCW_FLUX ) ) DEALLOCATE( XRCW_FLUX )
+IF ( LFLYER ) THEN
+ ALLOCATE( XRCW_FLUX(SIZE( XTHT, 1 ), SIZE( XTHT, 2 ), SIZE( XTHT, 3 )) )
+ELSE
+ ALLOCATE( XRCW_FLUX(0, 0, 0) )
+END IF
+
+IF ( ALLOCATED( XSVW_FLUX ) ) DEALLOCATE( XSVW_FLUX )
+IF ( LFLYER ) THEN
+ ALLOCATE( XSVW_FLUX(SIZE( XSVT, 1 ), SIZE( XSVT, 2 ), SIZE( XSVT, 3 ), SIZE( XSVT, 4 )) )
+ELSE
+ ALLOCATE( XSVW_FLUX(0, 0, 0, 0) )
+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
+!
+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, NEBN, YLDIMPHYEX,TLES, &
+ NRR, NRRL, NRRI, CLBCX, CLBCY, IGRADIENTS, NHALO, NTURBSPLIT, &
+ LCLOUDMODIFLM, NSV, NSV_LGBEG, NSV_LGEND, &
+ NSV_LIMA_NR, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
+ L2D, LNOMIXLG,LFLAT, &
+ LCOUPLES, LBLOWSNOW, LIBM,LFLYER, &
+ 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, &
+ TPFILE,ZTIME_LES_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)
+!
+DEALLOCATE(ZSFTH_WALL )
+DEALLOCATE(ZSFTH_ROOF )
+DEALLOCATE(ZCD_ROOF )
+DEALLOCATE(ZSFRV_WALL )
+DEALLOCATE(ZSFRV_ROOF )
+!-------------------------------------------------------------------------------
+!
+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..25eac5bc19829db1276abb1fb4def279fa28d9b8
--- /dev/null
+++ b/src/PHYEX/ext/prep_ideal_case.f90
@@ -0,0 +1,1953 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ 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_BUDGET, ONLY: TBUCONF_ASSOCIATE
+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_LES, ONLY : LES_ASSOCIATE
+USE MODD_PGDDIM
+USE MODD_PGDGRID
+USE MODD_TIME
+USE MODD_TIME_n
+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, NSV_ASSOCIATE
+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 MODE_SET_GRID, only: INTERP_HORGRID_TO_MASSPOINTS, STORE_GLOB_HORGRID
+!
+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 MODE_INI_CST, ONLY: INI_CST
+USE MODD_NEB_n, ONLY: NEBN
+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 ::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
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. SET DEFAULT VALUES :
+! --------------------
+!
+!
+!* 2.1 For variables in DESFM file
+!
+CALL ALLOC_FIELD_SCALARS()
+CALL TBUCONF_ASSOCIATE()
+CALL LES_ASSOCIATE()
+CALL DEFAULT_DESFM_n(1)
+CALL NSV_ASSOCIATE()
+!
+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( TZEXPREFILE, 'NAM_REAL_PGD', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_REAL_PGD)
+!
+!
+CALL POSNAM( TZEXPREFILE, 'NAM_CONF_PRE', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONF_PRE)
+!JUANZ
+CALL POSNAM( TZEXPREFILE, 'NAM_CONFZ', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFZ)
+!JUANZ
+CALL POSNAM( TZEXPREFILE, 'NAM_CONFIO', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFIO)
+CALL IO_Config_set()
+CALL POSNAM( TZEXPREFILE, 'NAM_GRID_PRE', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE)
+CALL POSNAM( TZEXPREFILE, 'NAM_GRIDH_PRE', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
+CALL POSNAM( TZEXPREFILE, 'NAM_VPROF_PRE', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
+CALL POSNAM( TZEXPREFILE, 'NAM_BLANKN', GFOUND )
+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( TZEXPREFILE )
+CALL POSNAM( TZEXPREFILE, 'NAM_AERO_PRE', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
+CALL POSNAM( TZEXPREFILE, 'NAM_IBM_LSF', GFOUND )
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
+!
+CALL INI_FIELD_LIST()
+!
+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) )
+ ALLOCATE( XXHATM(NIU), XYHATM(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.
+!
+ CALL SM_LATLON(XLATCEN,XLONCEN, &
+ -XDELTAX*(NIMAX_ll/2-0.5+JPHEXT), &
+ -XDELTAY*(NJMAX_ll/2-0.5+JPHEXT), &
+ XLATORI,XLONORI)
+!
+ 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
+
+ ! Interpolations of positions to mass points
+ CALL INTERP_HORGRID_TO_MASSPOINTS( XXHAT, XYHAT, XXHATM, XYHATM )
+
+ ! Collect global domain boundaries
+ CALL STORE_GLOB_HORGRID( XXHAT, XYHAT, XXHATM, XYHATM, XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll, XHAT_BOUND, XHATM_BOUND )
+
+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, XXHATM, XYHATM, 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
+!
+IF (CTYPELOC /= 'IJGRID') THEN
+ NILOC = MINLOC(ABS(XXHATLOC-XXHAT_ll(:)))
+ NJLOC = MINLOC(ABS(XYHATLOC-XYHAT_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(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(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, XZHATM, 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, NEBN, 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_nest_pgd.f90 b/src/PHYEX/ext/prep_nest_pgd.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4a2352d7736938047c49746ff2bfb416e4357fb1
--- /dev/null
+++ b/src/PHYEX/ext/prep_nest_pgd.f90
@@ -0,0 +1,408 @@
+!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_NEST_PGD
+! #####################
+!
+!!**** *PREP_NEST_PGD* - to make coherent pgd files for nesting
+!!
+!! PURPOSE
+!! -------
+!!
+!! The purpose of this program is to prepare pgd files with which
+!! nesting can be performed. A pgd file must be coherent with its
+!! father:
+!! The average of orography of fine model on each of its father grid
+!! mesh must be the same as its father orography.
+!!
+!! All the pgd files are read at the begining of the program,
+!! then they are checked, and recursively, the orography of a father
+!! is replaced by the averaged orography from ist son.
+!!
+!! The control data are given in the namelist file PRE_NEST.nam
+!!
+!! &NAM_NEST_PGD1 CPGD='coarser model' /
+!! &NAM_NEST_PGD2 CPGD='medium model' , IDAD=1 /
+!! &NAM_NEST_PGD3 CPGD='medium model' , IDAD=1 /
+!! &NAM_NEST_PGD4 CPGD='fine model' , IDAD=2 /
+!! &NAM_NEST_PGD5 CPGD='fine model' , IDAD=2 /
+!! &NAM_NEST_PGD6 CPGD='fine model' , IDAD=3 /
+!! &NAM_NEST_PGD7 CPGD='very fine model' , IDAD=6 /
+!! &NAM_NEST_PGD8 CPGD='very very fine model' , IDAD=7 /
+!!
+!! In each namelist is given the name of the pgd file, and the number
+!! of its father. This one MUST be smaller.
+!! There is one output file for each input file, with the suffix
+!! '.nest' added at the end of the file name (even if the file has not
+!! been changed).
+!!
+!! In the case of the namelist above, one obtain something like:
+!!
+!! +----------------------------------------------------------+
+!! | 1 |
+!! | +-----------------------+ |
+!! | | 2 | |
+!! | | | |
+!! | | +-+ | |
+!! | | +-------+ |5| | +-----------------------+ |
+!! | | | 4 | +-+ | | +----------+ 3 | |
+!! | | +-------+ | | |+------+ 6| | |
+!! | +-----------------------+ | || +-+ 7| | | |
+!! | | || |8| | | | |
+!! | | || +-+ | | | |
+!! | | |+------+ | | |
+!! | | +----------+ | |
+!! | +-----------------------+ |
+!! +----------------------------------------------------------+
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/09/95
+!! 30/07/97 (Masson) split of mode_lfifm_pgd
+!! 2014 (M.Faivre)
+!! 06/2015 (M.Moge) parallelization
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
+!! 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 06/07/2021: use FINALIZE_MNH
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_DIM_n
+USE MODD_IO, ONLY: TFILE_SURFEX, TPTR2FILE
+USE MODD_GRID_n, ONLY: XZSMT
+USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING
+USE MODD_PARAMETERS
+USE MODD_VAR_ll, ONLY: NPROC, IP, NMNH_COMM_WORLD
+!
+use mode_field, only: Ini_field_list
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_IO, only: 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_MNH_WORLD, ONLY: INIT_NMNH_COMM_WORLD
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_SPLITTINGZ_ll, ONLY: INI_PARAZ_ll
+!
+USE MODI_DEFINE_MASK_n
+USE MODI_INIT_HORGRID_ll_n
+USE MODI_INIT_PGD_SURF_ATM
+USE MODI_NEST_FIELD_n
+USE MODI_NEST_ZSMT_n
+USE MODI_OPEN_NESTPGD_FILES
+USE MODI_READ_ALL_NAMELISTS
+USE MODI_READ_HGRID
+USE MODI_RETRIEVE1_NEST_INFO_n
+USE MODI_VERSION
+USE MODI_WRITE_PGD_SURF_ATM_N
+USE MODE_INI_CST, ONLY: INI_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of local variables
+! ------------------------------
+!
+INTEGER, DIMENSION(JPMODELMAX) :: NXSIZE ! number of grid points for each model
+INTEGER, DIMENSION(JPMODELMAX) :: NYSIZE ! in x and y-directions
+ ! relatively to its father grid
+!
+INTEGER :: ILUOUT0
+INTEGER :: IINFO_ll ! return code of // routines
+INTEGER :: JPGD ! loop control
+CHARACTER(LEN=28) :: YMY_NAME,YDAD_NAME
+CHARACTER(LEN=2) :: YSTORAGE_TYPE
+LOGICAL, DIMENSION(JPMODELMAX) :: L1D_ALL ! Flag for 1D conf. for each PGD
+LOGICAL, DIMENSION(JPMODELMAX) :: L2D_ALL ! Flag for 2D conf. for each PGD
+LOGICAL, DIMENSION(JPMODELMAX) :: LPACK_ALL! Flag for packing conf. for each PGD
+!
+INTEGER :: JTIME,ITIME
+INTEGER :: IIMAX,IJMAX,IKMAX
+INTEGER :: IDXRATIO,IDYRATIO
+INTEGER :: IDAD
+INTEGER :: II
+LOGICAL :: GISINIT
+!
+TYPE(TPTR2FILE),DIMENSION(:),ALLOCATABLE :: TZFILEPGD ! Input PGD files
+TYPE(TPTR2FILE),DIMENSION(:),ALLOCATABLE,TARGET :: TZFILENESTPGD ! Output PGD files
+!
+!-------------------------------------------------------------------------------
+!
+CALL MPPDB_INIT()
+!
+CALL VERSION
+CPROGRAM='NESPGD'
+!
+CALL IO_Init()
+!!$CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
+!
+!* 1. INITIALIZATION OF PHYSICAL CONSTANTS
+! ------------------------------------
+!
+CALL INI_CST
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. OPENING OF THE FILES
+! ---------------------
+!
+NVERB=1
+!
+CALL OPEN_NESTPGD_FILES(TZFILEPGD,TZFILENESTPGD)
+CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
+!
+ILUOUT0 = TLUOUT0%NLU
+!
+CALL SURFEX_ALLOC_LIST(NMODEL)
+YSURF_CUR => YSURF_LIST(1)
+CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. READING OF THE GRIDS
+! --------------------
+!
+CALL INI_FIELD_LIST()
+!
+CALL SET_DAD0_ll()
+DO JPGD=1,NMODEL
+ ! read and set dimensions and ratios of model JPGD
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'IMAX', IIMAX)
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'JMAX', IJMAX)
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'DXRATIO',NDXRATIO_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'DYRATIO',NDYRATIO_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'XSIZE', NXSIZE(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'YSIZE', NYSIZE(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'XOR', NXOR_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'YOR', NYOR_ALL(JPGD))
+ CALL SET_DIM_ll(IIMAX, IJMAX, 1)
+ ! compute origin and end of local subdomain of model JPGD
+ ! initialize variables from MODD_NESTING, origin and end of global model JPGD in coordinates of its father
+ IF ( NDAD(JPGD) > 0 ) THEN
+ NXEND_ALL(JPGD) = NXOR_ALL(JPGD) + NXSIZE(JPGD) - 1 + 2*JPHEXT
+ NYEND_ALL(JPGD) = NYOR_ALL(JPGD) + NYSIZE(JPGD) - 1 + 2*JPHEXT
+ ELSE ! this is not a son model
+ NXOR_ALL(JPGD) = 1
+ NXEND_ALL(JPGD) = IIMAX+2*JPHEXT
+ NYOR_ALL(JPGD) = 1
+ NYEND_ALL(JPGD) = IJMAX+2*JPHEXT
+ NDXRATIO_ALL(JPGD) = 1
+ NDYRATIO_ALL(JPGD) = 1
+ ENDIF
+ ! initialize variables from MODD_DIM_ll, origin and end of global model JPGD in coordinates of its father
+ CALL SET_XOR_ll(NXOR_ALL(JPGD), JPGD)
+ CALL SET_XEND_ll(NXEND_ALL(JPGD), JPGD)
+ CALL SET_YOR_ll(NYOR_ALL(JPGD), JPGD)
+ CALL SET_YEND_ll(NYEND_ALL(JPGD), JPGD)
+ ! set the father model of model JPGD
+! set MODD_NESTING::NDAD using MODD_DIM_ll::NDAD
+! MODD_DIM_ll::NDAD was filled in OPEN_NESTPGD_FILES
+ CALL SET_DAD_ll(NDAD(JPGD), JPGD)
+ ! set the ratio of model JPGD in MODD_DIM_ll
+ CALL SET_XRATIO_ll(NDXRATIO_ALL(JPGD), JPGD)
+ CALL SET_YRATIO_ll(NDYRATIO_ALL(JPGD), JPGD)
+END DO
+!
+! reading of the grids
+!
+ CALL SET_DIM_ll(NXEND_ALL(1)-NXOR_ALL(1)+1-2*JPHEXT, NYEND_ALL(1)-NYOR_ALL(1)+1-2*JPHEXT, 1)
+ CALL INI_PARAZ_ll(IINFO_ll)
+DO JPGD=1,NMODEL
+ CALL GOTO_MODEL(JPGD)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+ CALL GOTO_SURFEX(JPGD)
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'L1D', L1D_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'L2D', L2D_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'PACK',LPACK_ALL(JPGD))
+ CALL IO_Pack_set(L1D_ALL(JPGD),L2D_ALL(JPGD),LPACK_ALL(JPGD))
+ CALL READ_HGRID(JPGD,TZFILEPGD(JPGD)%TZFILE,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
+ CSTORAGE_TYPE='PG'
+END DO
+ CALL INI_PARAZ_ll(IINFO_ll)
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. MASKS DEFINITIONS
+! -----------------
+!
+
+DO JPGD=1,NMODEL
+ CALL GOTO_SURFEX(JPGD)
+ CALL GOTO_MODEL(JPGD)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+!!$ CALL INIT_HORGRID_ll_n()
+ CALL DEFINE_MASK_n()
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. MODIFICATION OF OROGRAPHY
+! -------------------------
+!
+WRITE(ILUOUT0,FMT=*)
+WRITE(ILUOUT0,FMT=*) 'field ZS of all models'
+DO JPGD=NMODEL,1,-1
+ CALL GOTO_MODEL(JPGD)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+ CALL GOTO_SURFEX(JPGD)
+ CALL NEST_FIELD_n('ZS ')
+END DO
+!
+! *** Adaptation of smooth topography for SLEVE coordinate
+!
+WRITE(ILUOUT0,FMT=*)
+WRITE(ILUOUT0,FMT=*) 'field ZSMT of all models'
+DO JPGD=1,NMODEL
+ CALL GOTO_MODEL(JPGD)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+ CALL GOTO_SURFEX(JPGD)
+ CALL NEST_ZSMT_n('ZSMT ')
+END DO
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. SURFACE FIELDS READING
+! ----------------------
+!
+DO JPGD=1,NMODEL
+ IF (LEN_TRIM(TZFILEPGD(JPGD)%TZFILE%CNAME)>0) THEN
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+ TPGDFILE => TZFILEPGD(JPGD)%TZFILE
+ CALL GOTO_MODEL(JPGD)
+ CALL GOTO_SURFEX(JPGD)
+ CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PGD', &
+ ' ',' ',&
+ NUNDEF,NUNDEF,NUNDEF,XUNDEF )
+ END IF
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. MODIFICATION OF OROGRAPHY
+! -------------------------
+!
+DO JPGD=1,NMODEL
+ CALL GOTO_MODEL(JPGD)
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+ CALL GOTO_SURFEX(JPGD)
+ CALL MNHPUT_ZS_n
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SURFACE FIELDS WRITING
+! ----------------------
+!
+DO JPGD=1,NMODEL
+ CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
+ TPGDFILE => TZFILEPGD(JPGD)%TZFILE
+ TOUTDATAFILE => TZFILENESTPGD(JPGD)%TZFILE
+ CALL GOTO_MODEL(JPGD)
+ !Open done here because grid dimensions have to be known
+ CALL IO_File_open(TZFILENESTPGD(JPGD)%TZFILE)
+ CALL GOTO_SURFEX(JPGD)
+ TFILE_SURFEX => TZFILENESTPGD(JPGD)%TZFILE
+ CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
+ NULLIFY(TFILE_SURFEX)
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'ZSMT',XZSMT)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. Write configuration variables in the output file
+! ------------------------------------------------
+!
+!
+DO JPGD=1,NMODEL
+ CALL IO_Header_write(TZFILENESTPGD(JPGD)%TZFILE)
+ IF ( ASSOCIATED(TZFILENESTPGD(JPGD)%TZFILE%TDADFILE) ) THEN
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'DXRATIO',NDXRATIO_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'DYRATIO',NDYRATIO_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'XOR', NXOR_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'YOR', NYOR_ALL(JPGD))
+ END IF
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'SURF', 'EXTE')
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'L1D', L1D_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'L2D', L2D_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'PACK', LPACK_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'JPHEXT',JPHEXT)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. CLOSING OF THE FILES
+! --------------------
+!
+DO JPGD=1,NMODEL
+ CALL IO_File_close(TZFILEPGD(JPGD)%TZFILE)
+ CALL IO_File_close(TZFILENESTPGD(JPGD)%TZFILE)
+END DO
+!
+!* loop to spare enough time to transfer commands before end of program
+ITIME=0
+DO JTIME=1,1000000
+ ITIME=ITIME+1
+END DO
+!-------------------------------------------------------------------------------
+!
+!* 12. EPILOGUE
+! --------
+!
+WRITE(ILUOUT0,FMT=*)
+WRITE(ILUOUT0,FMT=*) '************************************************'
+WRITE(ILUOUT0,FMT=*) '* PREP_NEST_PGD: PREP_NEST_PGD ends correctly. *'
+WRITE(ILUOUT0,FMT=*) '************************************************'
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. FINALIZE THE PARALLEL SESSION
+! -----------------------------
+!
+CALL FINALIZE_MNH()
+
+! CALL END_PARA_ll(IINFO_ll)
+!
+! CALL SURFEX_DEALLO_LIST
+!
+!-------------------------------------------------------------------------------
+
+END PROGRAM PREP_NEST_PGD
diff --git a/src/PHYEX/ext/prep_pgd.f90 b/src/PHYEX/ext/prep_pgd.f90
new file mode 100644
index 0000000000000000000000000000000000000000..617389344cce3df0e04725dc6174037299dab045
--- /dev/null
+++ b/src/PHYEX/ext/prep_pgd.f90
@@ -0,0 +1,340 @@
+!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################
+ PROGRAM PREP_PGD
+! ################
+!!
+!! PURPOSE
+!! -------
+!! This program prepares the physiographic data fields.
+!!
+!! METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! F. Mereyde Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 21/07/95
+!! Modification 26/07/95 Treatment of orography and subgrid-scale
+!! orography roughness length (V. Masson)
+!! Modification 22/05/96 Variable CSTORAGE_TYPE (V. Masson)
+!! Modification 25/05/96 Modification of splines, correction on z0rel
+!! and set limits for some surface varaibles
+!! Modification 12/06/96 Treatment of a rare case for ZPGDZ0EFF (Masson)
+!! Modification 22/11/96 removes the filtering. It will have to be
+!! performed in ADVANCED_PREP_PGD (Masson)
+!! Modification 15/03/99 **** MAJOR MODIFICATION **** (Masson)
+!! PGD fields are now defined from the cover
+!! type fractions in the grid meshes
+!! User can still include its own data, and
+!! even additional (dummy) fields
+!! Modificatio 06/00 patch approach, for vegetation related variable (Solmon/Masson)
+! averaging is performed on subclass(=patch) of nature
+!! 08/03/01 add chemical emission treatment (D.Gazen)
+!! Modification 15/10/01 allow namelists in different orders (I.Mallet)
+!!
+!! ################################
+!! MODIFICATION 13/10/03 EXTERNALIZED VERSION (V. Masson)
+!! ################################
+!! J.Escobar 4/04/2008 Improve checking --> add STATUS=OLD in open_ll(PRE_PGD1.nam,...
+!!
+!! Modification 30/03/2012 Add NAM_NCOUT for netcdf output (S.Bielli)
+!! S.Bielli 23/04/2014 supress writing of LAt and LON in NETCDF case
+!! S.Bielli 20/11/2014 add writing of LAt and LON in NETCDF case
+!! M.Moge 01/03/2015 use MPPDB + SPLIT_GRID is now called in PGD_GRID. Here we extend
+!! the new grid on the halo with EXTEND_GRID_ON_HALO (M.Moge)
+!! M.Moge 06/2015 write NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR in .lfi output file
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 05/10/2015 : missing JPHEXT for LAT/LON/ZS/ZSMT writing
+!! M.Moge 11/2015 disable the creation of files on multiple
+!! Z-levels when using parallel IO for PREP_PGD
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
+!! 10/2016 (S.Faroux S.Bielli) correction for NHALO=0
+!! 01/2018 (G.Delautier) SURFEX 8.1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Q. Rodier 01/2019 : add a new filtering for very high slopes in NAM_ZSFILTER
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK, LCARTESIAN
+USE MODD_CONF_n,ONLY : CSTORAGE_TYPE
+USE MODD_LUNIT, ONLY : TLUOUT0
+USE MODD_LUNIT_n,ONLY : LUNIT_MODEL
+USE MODD_PARAMETERS, ONLY : XUNDEF
+USE MODD_IO, only: TFILEDATA, TFILE_OUTPUTLISTING, TFILE_SURFEX
+use modd_precision, only: LFIINT
+USE MODD_IO_SURF_MNH, ONLY : NHALO
+USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
+!
+use mode_field, only: Ini_field_list
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_IO, only: IO_Config_set, IO_Init
+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_MSG
+USE MODE_POS
+!
+USE MODI_ZSMT_PGD
+!
+!JUAN
+USE MODN_CONFZ
+USE MODD_PARAMETERS, ONLY : JPHEXT
+USE MODD_CONF, ONLY : NHALO_CONF_MNH => NHALO
+!JUAN
+!
+USE MODI_READ_ALL_NAMELISTS
+USE MODI_VERSION
+USE MODI_PGD_GRID_SURF_ATM
+USE MODI_SPLIT_GRID
+USE MODI_PGD_SURF_ATM
+USE MODI_WRITE_PGD_SURF_ATM_N
+USE MODD_MNH_SURFEX_n
+!
+USE MODE_MPPDB
+USE MODI_EXTEND_GRID_ON_HALO
+!
+USE MODN_CONFIO, ONLY : NAM_CONFIO
+USE MODE_INI_CST, ONLY: INI_CST
+!
+IMPLICIT NONE
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: IRESP ! return code for I/O
+INTEGER :: ILUOUT0
+INTEGER :: ILUNAM
+LOGICAL :: GFOUND
+CHARACTER(LEN=28) :: YDAD =' ' ! name of dad of input FM file
+CHARACTER(LEN=28) :: CPGDFILE ='PGDFILE' ! name of the output file
+CHARACTER(LEN=100) :: YMSG
+INTEGER :: NZSFILTER=1 ! number of iteration for filter for fine orography
+INTEGER :: NLOCZSFILTER=3 ! number of iteration for filter of local fine orography
+LOGICAL :: LHSLOP=.FALSE. ! filtering of local slopes higher than XHSLOP
+REAL :: XHSLOP=1.0 ! slopes where the local fine filtering is applied
+INTEGER :: NSLEVE =12 ! number of iteration for filter for smooth orography
+REAL :: XSMOOTH_ZS = XUNDEF ! optional uniform smooth orography for SLEVE coordinate
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! work array for lat and lon reshape
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK_LAT ! work array for lat and lon reshape
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK_LON ! work array for lat and lon reshape
+INTEGER :: IIMAX, IJMAX
+INTEGER :: NHALO_MNH
+TYPE(TFILEDATA),POINTER :: TZFILE => NULL()
+TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL() ! Namelist file
+!
+NAMELIST/NAM_PGDFILE/CPGDFILE, NHALO
+NAMELIST/NAM_ZSFILTER/NZSFILTER,NLOCZSFILTER,LHSLOP,XHSLOP
+NAMELIST/NAM_SLEVE/NSLEVE, XSMOOTH_ZS
+NAMELIST/NAM_CONF_PGD/JPHEXT, NHALO_MNH
+!------------------------------------------------------------------------------
+!
+CALL MPPDB_INIT()
+!
+CPROGRAM='PGD '
+!
+!* 1. Set default names and parallelized I/O
+! --------------------------------------
+!
+CALL IO_Init()
+!
+NHALO=15
+!
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
+!
+!Set output file for PRINT_MSG
+TFILE_OUTPUTLISTING => TLUOUT0
+!
+LUNIT_MODEL(1)%TLUOUT => TLUOUT0
+ILUOUT0=TLUOUT0%NLU
+!
+!JUAN
+CALL IO_File_add2list(TZNMLFILE,'PRE_PGD1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE,KRESP=IRESP)
+ILUNAM = TZNMLFILE%NLU
+IF (IRESP.NE.0 ) THEN
+ WRITE(YMSG,*) 'file PRE_PGD1.nam not found, IRESP=', IRESP
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_PGD',YMSG)
+ENDIF
+!JUAN
+
+CALL POSNAM( TZNMLFILE, 'NAM_PGDFILE', GFOUND )
+IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
+CALL POSNAM( TZNMLFILE, 'NAM_ZSFILTER', GFOUND )
+IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_ZSFILTER)
+CALL POSNAM( TZNMLFILE, 'NAM_SLEVE', GFOUND )
+IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_SLEVE)
+!JUANZ
+CALL POSNAM( TZNMLFILE, 'NAM_CONFZ', GFOUND )
+IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFZ)
+CALL POSNAM( TZNMLFILE, 'NAM_CONF_PGD', GFOUND )
+IF (GFOUND) THEN
+ NHALO_MNH = NHALO_CONF_MNH
+ READ(UNIT=ILUNAM,NML=NAM_CONF_PGD)
+ NHALO_CONF_MNH = NHALO_MNH
+ENDIF
+!JUANZ
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
+IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
+CALL IO_Config_set()
+!
+CALL IO_File_close(TZNMLFILE)
+!
+!
+CALL SURFEX_ALLOC_LIST(1)
+YSURF_CUR => YSURF_LIST(1)
+CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
+!
+CALL INI_FIELD_LIST()
+!
+CALL GOTO_MODEL(1)
+CALL GOTO_SURFEX(1)
+!
+CALL VERSION
+CSTORAGE_TYPE = 'PG'
+!
+CALL INI_CST
+!
+!
+!* 2. Preparation of surface physiographic fields
+! -------------------------------------------
+!
+!* Initializes the grid
+! --------------------
+!
+CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',&
+ ' ',' ',.FALSE.,HDIR='-')
+!
+CALL EXTEND_GRID_ON_HALO('MESONH',YSURF_CUR%UG, YSURF_CUR%U,&
+ YSURF_CUR%UG%G%NGRID_PAR, YSURF_CUR%UG%G%XGRID_PAR)
+!
+!
+!* Initializes all physiographic fields
+! ------------------------------------
+!
+CALL PGD_SURF_ATM(YSURF_CUR,'MESONH',' ',' ',.FALSE.)
+!
+!
+!* 3. Writes the physiographic fields
+! -------------------------------
+!
+CALL IO_File_add2list(TZFILE,CPGDFILE,'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
+!
+CALL IO_File_open(TZFILE)
+!
+CALL IO_Header_write(TZFILE)
+!
+CALL IO_Field_write(TZFILE,'SURF','EXTE')
+CALL IO_Field_write(TZFILE,'L1D', L1D)
+CALL IO_Field_write(TZFILE,'L2D', L2D)
+CALL IO_Field_write(TZFILE,'PACK',LPACK)
+IF ( NDXRATIO <= 0 .AND. NDYRATIO <= 0 ) THEN
+ NDXRATIO = 1
+ NDYRATIO = 1
+ENDIF
+IF ( NXSIZE < 0 .AND. NYSIZE < 0 ) THEN
+ NXSIZE = 0
+ NYSIZE = 0
+ENDIF
+IF ( NXOR <= 0 .AND. NYOR <= 0 ) THEN
+ NXOR = 1
+ NYOR = 1
+ENDIF
+CALL IO_Field_write(TZFILE,'DXRATIO',NDXRATIO)
+CALL IO_Field_write(TZFILE,'DYRATIO',NDYRATIO)
+CALL IO_Field_write(TZFILE,'XSIZE', NXSIZE)
+CALL IO_Field_write(TZFILE,'YSIZE', NYSIZE)
+CALL IO_Field_write(TZFILE,'XOR', NXOR)
+CALL IO_Field_write(TZFILE,'YOR', NYOR)
+CALL IO_Field_write(TZFILE,'JPHEXT', JPHEXT)
+!
+TFILE_SURFEX => TZFILE
+ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
+CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
+NULLIFY(TFILE_SURFEX) !Probably not necessary
+!
+!* 4. Computes and writes smooth orography for SLEVE coordinate
+! ---------------------------------------------------------
+CALL ZSMT_PGD(TZFILE,NZSFILTER,NSLEVE,NLOCZSFILTER,LHSLOP,XHSLOP,XSMOOTH_ZS)
+!
+IF (.NOT.LCARTESIAN) THEN
+!!!! WRITE LAT and LON
+ CALL GET_DIM_PHYS_ll('B',IIMAX,IJMAX)
+ ALLOCATE(ZWORK(IIMAX+NHALO*2,IJMAX+NHALO*2))
+ ALLOCATE(ZWORK_LAT(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
+ ALLOCATE(ZWORK_LON(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
+ ZWORK=RESHAPE(YSURF_CUR%UG%G%XLAT, (/ (IIMAX+NHALO*2),(IJMAX+NHALO*2) /) )
+ IF (NHALO/=0) THEN
+ ZWORK_LAT=ZWORK(NHALO:(IIMAX+NHALO+1),NHALO:(IJMAX+NHALO+1))
+ ELSE
+ ZWORK_LAT(2:IIMAX+1,2:IJMAX+1)=ZWORK
+ ZWORK_LAT(1,:) = ZWORK_LAT(2,:)
+ ZWORK_LAT(IIMAX+2,:) = ZWORK_LAT(IIMAX+1,:)
+ ZWORK_LAT(:,1) = ZWORK_LAT(:,2)
+ ZWORK_LAT(:,IJMAX+2) = ZWORK_LAT(:,IJMAX+1)
+ ENDIF
+ ZWORK=RESHAPE(YSURF_CUR%UG%G%XLON, (/ IIMAX+NHALO*2,IJMAX+NHALO*2 /) )
+ IF (NHALO/=0) THEN
+ ZWORK_LON=ZWORK(NHALO:(IIMAX+NHALO+1),NHALO:(IJMAX+NHALO+1))
+ ELSE
+ ZWORK_LON(2:IIMAX+1,2:IJMAX+1)=ZWORK
+ ZWORK_LON(1,:) = ZWORK_LON(2,:)
+ ZWORK_LON(IIMAX+2,:) = ZWORK_LON(IIMAX+1,:)
+ ZWORK_LON(:,1) = ZWORK_LON(:,2)
+ ZWORK_LON(:,IJMAX+2) = ZWORK_LON(:,IJMAX+1)
+ ENDIF
+ CALL IO_Field_write(TZFILE,'LAT',ZWORK_LAT)
+ CALL IO_Field_write(TZFILE,'LON',ZWORK_LON)
+ !
+ DEALLOCATE(ZWORK,ZWORK_LAT,ZWORK_LON)
+END IF
+!
+!
+WRITE(ILUOUT0,*)
+WRITE(ILUOUT0,*) '***************************'
+WRITE(ILUOUT0,*) '* PREP_PGD ends correctly *'
+WRITE(ILUOUT0,*) '***************************'
+!
+!* 6. Close parallelized I/O
+! ----------------------
+!
+CALL IO_File_close(TZFILE)
+!
+CALL FINALIZE_MNH()
+!
+!-------------------------------------------------------------------------------
+!
+END PROGRAM PREP_PGD
diff --git a/src/PHYEX/ext/prep_real_case.f90 b/src/PHYEX/ext/prep_real_case.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8cedd2db6306022147be0c79c5aeaa100a8d237d
--- /dev/null
+++ b/src/PHYEX/ext/prep_real_case.f90
@@ -0,0 +1,1451 @@
+!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ 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_BUDGET, ONLY: TBUCONF_ASSOCIATE
+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_LES, ONLY: LES_ASSOCIATE
+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_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 MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT, NMOD_CCN, NMOD_IFN
+USE MODE_INI_CST, ONLY: INI_CST
+!
+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,&
+ XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT, &
+ LDSTCAMS, LSLTCAMS,CACTCCN,CCLOUD, NMOD_IFN, NMOD_CCN, LAERINIT
+
+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
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXRHO, ZLBYRHO
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXZZ, ZLBYZZ
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXPABST, ZLBYPABST
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXRM, ZLBYRM
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXTHM, ZLBYTHM
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZLBXSVM, ZLBYSVM
+!
+INTEGER :: ILBX,ILBY,IIB,IJB,IIE,IJE
+LOGICAL :: GAERINIT
+!-------------------------------------------------------------------------------
+!
+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 TBUCONF_ASSOCIATE()
+CALL LES_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( TZPRE_REAL1FILE, 'NAM_REAL_CONF', GFOUND )
+IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
+CALL PARAM_LIMA_INIT(CPROGRAM, TZPRE_REAL1FILE, .FALSE., ILUOUT0, .FALSE., .TRUE., .FALSE., 0)
+!
+CALL INI_FIELD_LIST()
+!
+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( TZPRE_REAL1FILE, 'NAM_REAL_CONF', GFOUND )
+IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_HURR_CONF', GFOUND )
+IF (GFOUND) READ(IPRE_REAL1,NAM_HURR_CONF)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_CH_CONF', GFOUND )
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CH_CONF)
+CALL UPDATE_MODD_FROM_NMLVAR
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
+IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_CONFZ', GFOUND )
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
+CALL POSNAM( TZPRE_REAL1FILE, 'NAM_IBM_LSF' , GFOUND )
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF)
+!
+GAERINIT = LAERINIT
+
+! 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
+LAERINIT = GAERINIT
+!
+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( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
+! 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( TZPRE_REAL1FILE, 'NAM_AERO_CONF', GFOUND )
+ 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, XXHATM, XYHATM, 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(ZLBXTHM(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
+ ALLOCATE(ZLBYTHM(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)))
+ ALLOCATE(ZLBXRM(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
+ ALLOCATE(ZLBYRM(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
+ ALLOCATE(ZLBXSVM(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3), SIZE(XLBXSVM,4)))
+ ALLOCATE(ZLBYSVM(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3), SIZE(XLBXSVM,4)))
+
+ 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,:)
+ ZLBXTHM(1:ILBX+1,:,:) = XTHT(IIB-1:IIB-1+ILBX,:,:)
+ ZLBXTHM(ILBX+2:2*ILBX+2,:,:) = XTHT(IIE+1-ILBX:IIE+1,:,:)
+ ZLBYTHM(:,1:ILBY+1,:) = XTHT(:,IJB-1:IJB-1+ILBY,:)
+ ZLBYTHM(:,ILBY+2:2*ILBY+2,:) = XTHT(:,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,:)
+ ZLBXSVM(1:ILBX+1,:,:,:) = XSVT(IIB-1:IIB-1+ILBX,:,:,:)
+ ZLBXSVM(ILBX+2:2*ILBX+2,:,:,:) = XSVT(IIE+1-ILBX:IIE+1,:,:,:)
+ ZLBYSVM(:,1:ILBY+1,:,:) = XSVT(:,IJB-1:IJB-1+ILBY,:,:)
+ ZLBYSVM(:,ILBY+2:2*ILBY+2,:,:) = XSVT(:,IJE+1-ILBY:IJE+1,:,:)
+ ZLBXRM(1:ILBX+1,:,:) = XRT(IIB-1:IIB-1+ILBX,:,:,1)
+ ZLBXRM(ILBX+2:2*ILBX+2,:,:) = XRT(IIE+1-ILBX:IIE+1,:,:,1)
+ ZLBYRM(:,1:ILBY+1,:) = XRT(:,IJB-1:IJB-1+ILBY,:,1)
+ ZLBYRM(:,ILBY+2:2*ILBY+2,:) = XRT(:,IJE+1-ILBY:IJE+1,:,1)
+
+
+ CALL AER2LIMA(ZLBXSVM, ZLBXRHO, ZLBXRM(:,:,:), ZLBXPABST, ZLBXTHM, ZLBXZZ)
+ CALL AER2LIMA(ZLBYSVM, ZLBYRHO, ZLBYRM(:,:,:), ZLBYPABST, ZLBYTHM, ZLBYZZ)
+
+ DEALLOCATE(ZLBXRHO)
+ DEALLOCATE(ZLBYRHO)
+ DEALLOCATE(ZLBXPABST)
+ DEALLOCATE(ZLBYPABST)
+ DEALLOCATE(ZLBXTHM)
+ DEALLOCATE(ZLBYTHM)
+ DEALLOCATE(ZLBXZZ)
+ DEALLOCATE(ZLBYZZ)
+ DEALLOCATE(ZLBXRM)
+ DEALLOCATE(ZLBYRM)
+ DEALLOCATE(ZLBXSVM)
+ DEALLOCATE(ZLBYSVM)
+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/prep_surfex.f90 b/src/PHYEX/ext/prep_surfex.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6c3c81277095e0087f0f7d63a998dbade6008a07
--- /dev/null
+++ b/src/PHYEX/ext/prep_surfex.f90
@@ -0,0 +1,208 @@
+!MNH_LIC Copyright 2004-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_SURFEX
+! #############################
+!
+!!**** *PREP_SURFEX* - program to write an initial FM file from real case
+!! situation containing only surface fields.
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/2004 (P. Le Moigne)
+!! 10/10/2011 J.Escobar call INI_PARAZ_ll
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! 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
+!! 2021 B.Vie LIMA - CAMS coupling
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF, ONLY : CPROGRAM,&
+ L1D, L2D, LPACK
+USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
+USE MODD_IO, ONLY : TFILEDATA, TFILE_SURFEX
+USE MODD_LUNIT, ONLY : TPGDFILE, TLUOUT0
+USE MODD_LUNIT_n, ONLY : CINIFILE, TINIFILE
+USE MODD_MNH_SURFEX_n
+USE MODD_PARAMETERS, ONLY : JPMODELMAX,JPHEXT,JPVEXT, NUNDEF, XUNDEF
+USE MODD_TIME_n, ONLY : TDTCUR
+!
+use mode_field, only: Ini_field_list, Ini_field_scalars
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_IO, only: IO_Init
+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_MSG
+USE MODE_MODELN_HANDLER
+USE MODE_SPLITTINGZ_ll
+!
+USE MODI_OPEN_PRC_FILES
+USE MODI_PREP_SURF_MNH
+USE MODI_READ_ALL_NAMELISTS
+USE MODI_VERSION
+USE MODE_INI_CST, ONLY: INI_CST
+!
+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 (not used)
+CHARACTER(LEN=6) :: YCHEMFILETYPE ! type of the Chemical file (not used)
+CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file
+CHARACTER(LEN=6) :: YCAMSFILETYPE ! type of the input CAMS file
+CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file (not used)
+CHARACTER(LEN=6) :: YSURFFILETYPE ! type of the Surface file (not used)
+CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data
+! ! file
+!
+!* file management variables and counters
+!
+INTEGER :: ILUOUT0 ! logical unit for listing file
+INTEGER :: IRESP ! return code in FM routines
+!
+INTEGER :: IINFO_ll ! return code of // routines
+CHARACTER (LEN=100) :: HCOMMENT
+INTEGER :: II, IJ, IGRID, ILENGTH
+!
+TYPE(TFILEDATA),POINTER :: TZATMFILE => NULL()
+TYPE(TFILEDATA),POINTER :: TZPRE_REAL1FILE => NULL()
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. SET DEFAULT VALUES
+! ------------------
+!
+CALL GOTO_MODEL(1)
+!
+CALL VERSION
+CPROGRAM='REAL '
+CSTORAGE_TYPE='SU'
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. OPENNING OF THE FILES
+! ---------------------
+CALL IO_Init()
+!
+CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
+ ,YCHEMFILE,YCHEMFILETYPE &
+ ,YSURFFILE,YSURFFILETYPE &
+ ,YPGDFILE,TPGDFILE &
+ ,YCAMSFILE,YCAMSFILETYPE)
+ILUOUT0 = TLUOUT0%NLU
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITIALIZATION OF PHYSICAL CONSTANTS
+! ------------------------------------
+!
+CALL INI_CST
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. READING OF NAMELIST
+! -------------------
+!
+!* 4.1 reading of configuration variables
+!
+CALL IO_File_close(TZPRE_REAL1FILE)
+!
+!* 4.2 reading of values of some configuration variables in namelist
+!
+CALL INI_FIELD_LIST()
+!
+CALL INI_FIELD_SCALARS()
+!
+CALL IO_Field_read(TPGDFILE,'IMAX',II)
+CALL IO_Field_read(TPGDFILE,'JMAX',IJ)
+CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DAD0_ll()
+CALL SET_DIM_ll(II, IJ, 1)
+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(II+2*JPHEXT, 1)
+CALL SET_YOR_ll(1, 1)
+CALL SET_YEND_ll(IJ+2*JPHEXT, 1)
+CALL SET_DAD_ll(0, 1)
+!JUANZ CALL INI_PARA_ll(IINFO_ll)
+CALL INI_PARAZ_ll(IINFO_ll)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. PREPARATION OF SURFACE FIELDS
+! -----------------------------
+!
+!* reading of date
+!
+IF (YATMFILETYPE=='MESONH') THEN
+ CALL IO_File_add2list(TZATMFILE,TRIM(YATMFILE),'MNH','READ',KLFITYPE=1,KLFIVERB=1)
+ CALL IO_File_open(TZATMFILE)
+ CALL IO_Field_read(TZATMFILE,'DTCUR',TDTCUR)
+ CALL IO_File_close(TZATMFILE)
+ELSE
+ TDTCUR%nyear = NUNDEF
+ TDTCUR%nmonth = NUNDEF
+ TDTCUR%nday = NUNDEF
+ TDTCUR%xtime = XUNDEF
+END IF
+!
+CALL SURFEX_ALLOC_LIST(1)
+YSURF_CUR => YSURF_LIST(1)
+CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
+CALL GOTO_SURFEX(1)
+!
+CALL IO_File_add2list(TINIFILE,TRIM(CINIFILE),'PGD','WRITE',KLFITYPE=1,KLFIVERB=1)
+!The open is done later in PREP_SURF_MNH when domain dimensions are known
+!
+TFILE_SURFEX => TINIFILE
+CALL PREP_SURF_MNH(YATMFILE,YATMFILETYPE,OINIFILEOPEN=.TRUE.)
+NULLIFY(TFILE_SURFEX)
+!
+!-------------------------------------------------------------------------------
+!
+CALL IO_Header_write(TINIFILE)
+CALL IO_Field_write(TINIFILE,'SURF','EXTE')
+CALL IO_Field_write(TINIFILE,'L1D', L1D)
+CALL IO_Field_write(TINIFILE,'L2D', L2D)
+CALL IO_Field_write(TINIFILE,'PACK',LPACK)
+!
+!-------------------------------------------------------------------------------
+WRITE(ILUOUT0,*) ' '
+WRITE(ILUOUT0,*) '----------------------------------'
+WRITE(ILUOUT0,*) '| |'
+WRITE(ILUOUT0,*) '| PREP_SURFEX ends correctly |'
+WRITE(ILUOUT0,*) '| |'
+WRITE(ILUOUT0,*) '----------------------------------'
+CALL IO_File_close(TINIFILE)
+!
+CALL FINALIZE_MNH()
+!-------------------------------------------------------------------------------
+!
+END PROGRAM PREP_SURFEX
diff --git a/src/PHYEX/ext/profilern.f90 b/src/PHYEX/ext/profilern.f90
new file mode 100644
index 0000000000000000000000000000000000000000..425ddf294fe45f0831ace0799a09e9cdf660735d
--- /dev/null
+++ b/src/PHYEX/ext/profilern.f90
@@ -0,0 +1,383 @@
+!MNH_LIC Copyright 2002-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+MODULE MODI_PROFILER_n
+! ##########################
+!
+INTERFACE
+!
+ SUBROUTINE PROFILER_n( PZ, PRHODREF, &
+ PU, PV, PW, PTH, PR, PSV, PTKE, &
+ PTS, PP, PAER, PCIT, PSEA )
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! horizontal wind X component
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! horizontal wind Y component
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW ! vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! potential temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratios
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSV ! Scalar variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE ! turbulent kinetic energy
+REAL, DIMENSION(:,:), INTENT(IN) :: PTS ! surface temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PAER ! aerosol extinction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! ice concentration
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! for radar
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE PROFILER_n
+!
+END INTERFACE
+!
+END MODULE MODI_PROFILER_n
+!
+! ########################################################
+ SUBROUTINE PROFILER_n( PZ, PRHODREF, &
+ PU, PV, PW, PTH, PR, PSV, PTKE, &
+ PTS, PP, PAER, PCIT, PSEA )
+! ########################################################
+!
+!
+!
+!!**** *PROFILER_n* - (advects and) stores
+!! stations/s in the model
+!!
+!! PURPOSE
+!! -------
+!
+!
+!!** METHOD
+!! ------
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Pierre TULET / Valery Masson * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/02/2002
+!! March 2013 : C.Lac : Corrections for 1D + new fields (RARE,THV,DD,FF)
+!! April 2014 : C.Lac : Call RADAR only if ICE3
+!! C.Lac 10/2016 Add visibility diagnostic
+!! March,28, 2018 (P. Wautelet) replace TEMPORAL_DIST by DATETIME_DISTANCE
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! M. Taufour 05/07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
+! P. Wautelet 09/02/2022: add message when some variables not computed
+! + bugfix: put values in variables in this case
+! + move some operations outside a do loop
+! P. Wautelet 04/2022: restructure profilers for better performance, reduce memory usage and correct some problems/bugs
+! P. Wautelet 01/06/2023: deduplicate code => moved to modd/mode_sensors.f90
+! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ALLPROFILER_n, ONLY: LDIAG_SURFRAD_PROF
+USE MODD_CST, ONLY: XCPD, XG, XP00, XPI, XRD, XRV
+USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_TKE_DISS
+USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
+USE MODD_NSV, ONLY: NSV_C2R2BEG, NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
+USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
+USE MODD_PROFILER_n
+!
+USE MODE_FGAU, ONLY: GAULAG
+USE MODE_MSG
+USE MODE_SENSOR, ONLY: Sensor_rare_compute, Sensor_wc_compute
+USE MODE_STATPROF_TOOLS, ONLY: STATPROF_DIAG_SURFRAD
+!
+USE MODI_GPS_ZENITH_GRID
+USE MODI_WATER_SUM
+!
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! horizontal wind X component
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! horizontal wind Y component
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW ! vertical wind
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! potential temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratios
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSV ! Scalar variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE ! turbulent kinetic energy
+REAL, DIMENSION(:,:), INTENT(IN) :: PTS ! surface temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PAER ! aerosol extinction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! ice concentration
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! for radar
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+!
+INTEGER :: IKB
+INTEGER :: IKE
+INTEGER :: IKU
+!
+!
+REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)) :: ZWORK
+REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PAER,4)) :: ZWORK2
+!
+INTEGER :: IN ! time index
+INTEGER :: JSV ! loop counter
+INTEGER :: JK ! loop
+INTEGER :: JP ! loop for profilers
+INTEGER :: IKRAD
+!
+REAL,DIMENSION(SIZE(PZ,3)) :: ZU_PROFILER ! horizontal wind speed profile at station location (along x)
+REAL,DIMENSION(SIZE(PZ,3)) :: ZV_PROFILER ! horizontal wind speed profile at station location (along y)
+REAL,DIMENSION(SIZE(PZ,3)) :: ZFF ! horizontal wind speed profile at station location
+REAL,DIMENSION(SIZE(PZ,3)) :: ZDD ! horizontal wind speed profile at station location
+REAL,DIMENSION(SIZE(PZ,3)) :: ZRHOD ! dry air density in moist mixing profile at station location
+REAL,DIMENSION(SIZE(PZ,3)) :: ZRV ! water vapour mixing ratio profile at station location
+REAL,DIMENSION(SIZE(PZ,3)) :: ZT ! temperature profile at station location
+REAL,DIMENSION(SIZE(PZ,3)) :: ZTV ! virtual temperature profile at station location
+REAL,DIMENSION(SIZE(PZ,3)) :: ZPRES ! pressure profile at station location
+REAL,DIMENSION(SIZE(PZ,3)) :: ZE ! water vapour partial pressure profile at station location
+REAL,DIMENSION(SIZE(PZ,3)) :: ZZ ! altitude of model levels at station location
+REAL,DIMENSION(SIZE(PZ,3)-1) :: ZZHATM ! altitude of mass point levels at station location
+REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
+!
+REAL :: XZS_GPS ! GPS station altitude
+REAL :: ZIWV ! integrated water vapour at station location
+REAL :: ZZM_STAT ! altitude at station location
+REAL :: ZTM_STAT ! temperature at station location
+REAL :: ZTV_STAT ! virtual temperature at station location
+REAL :: ZPM_STAT ! pressure at station location
+REAL :: ZEM_STAT ! water vapour partial pressure at station location
+REAL :: ZZTD_PROFILER ! ZTD at station location
+REAL :: ZZHD_PROFILER ! ZHD at station location
+REAL :: ZZWD_PROFILER ! ZWD at station location
+REAL :: ZZHDR ! ZHD correction at station location
+REAL :: ZZWDR ! ZWD correction at station location
+!
+REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZZTD,ZZHD,ZZWD
+REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZTEMP,ZTHV,ZTEMPV
+REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZVISIGUL, ZVISIKUN
+REAL :: ZK1,ZK2,ZK3 ! k1, k2 and K3 atmospheric refractivity constants
+REAL :: ZRDSRV ! XRD/XRV
+!
+!----------------------------------------------------------------------------
+!
+!* 2. PRELIMINARIES
+! -------------
+!
+!* 2.0 Refractivity coeficients
+! ------------------------
+! Bevis et al. (1994)
+ZK1 = 0.776 ! K/Pa
+ZK2 = 0.704 ! K/Pa
+ZK3 = 3739. ! K2/Pa
+ZRDSRV=XRD/XRV
+!
+!* 2.1 Indices
+! -------
+!
+IKU = SIZE(PZ,3) ! nombre de niveaux sur la verticale
+IKB = JPVEXT+1
+IKE = IKU-JPVEXT
+!
+!----------------------------------------------------------------------------
+!
+!* 3.4 instant of storage
+! ------------------
+!
+IF ( .NOT. TPROFILERS_TIME%STORESTEP_CHECK_AND_SET( IN ) ) RETURN !No profiler storage at this time step
+!
+!----------------------------------------------------------------------------
+!
+!* 8. DATA RECORDING
+! --------------
+!
+ZTEMP(:,:,:)=PTH(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
+! Theta_v
+ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
+! virtual temperature
+ZTEMPV(:,:,:)=ZTHV(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
+CALL GPS_ZENITH_GRID(PR(:,:,:,1),ZTEMP,PP,ZZTD,ZZHD,ZZWD)
+
+IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) THEN
+ ! Gultepe formulation
+ ZVISIGUL(:,:,:) = 10E5 !default value
+ WHERE ( (PR(:,:,:,2) /=0. ) .AND. (PSV(:,:,:,NSV_C2R2BEG+1) /=0. ) )
+ ZVISIGUL(:,:,:) =1.002/(PR(:,:,:,2)*PRHODREF(:,:,:)*PSV(:,:,:,NSV_C2R2BEG+1))**0.6473
+ END WHERE
+END IF
+
+IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
+ ! Kunkel formulation
+ ZVISIKUN(:,:,:) = 10E5 !default value
+ WHERE ( PR(:,:,:,2) /=0 )
+ ZVISIKUN(:,:,:) =0.027/(10**(-8)+(PR(:,:,:,2)/(1+PR(:,:,:,2))*PRHODREF(:,:,:)*1000))**0.88
+ END WHERE
+END IF
+!
+PROFILER: DO JP = 1, NUMBPROFILER_LOC
+ TPROFILERS(JP)%NSTORE_CUR = IN
+
+ ZZ(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PZ )
+ ZRHOD(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PRHODREF )
+ ZPRES(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PP )
+ ZU_PROFILER(:) = TPROFILERS(JP)%INTERP_HOR_FROM_UPOINT( PU )
+ ZV_PROFILER(:) = TPROFILERS(JP)%INTERP_HOR_FROM_VPOINT( PV )
+ ZGAM = (XRPK * (TPROFILERS(JP)%XLON_CUR - XLON0) - XBETA)*(XPI/180.)
+ ZFF(:) = SQRT(ZU_PROFILER(:)**2 + ZV_PROFILER(:)**2)
+ DO JK=1,IKU
+ IF (ZU_PROFILER(JK) >=0. .AND. ZV_PROFILER(JK) > 0.) &
+ ZDD(JK) = ATAN(ABS(ZU_PROFILER(JK)/ZV_PROFILER(JK))) * 180./XPI + 180.
+ IF (ZU_PROFILER(JK) >0. .AND. ZV_PROFILER(JK) <= 0.) &
+ ZDD(JK) = ATAN(ABS(ZV_PROFILER(JK)/ZU_PROFILER(JK))) * 180./XPI + 270.
+ IF (ZU_PROFILER(JK) <=0. .AND. ZV_PROFILER(JK) < 0.) &
+ ZDD(JK) = ATAN(ABS(ZU_PROFILER(JK)/ZV_PROFILER(JK))) * 180./XPI
+ IF (ZU_PROFILER(JK) <0. .AND. ZV_PROFILER(JK) >= 0.) &
+ ZDD(JK) = ATAN(ABS(ZV_PROFILER(JK)/ZU_PROFILER(JK))) * 180./XPI + 90.
+ IF (ZU_PROFILER(JK) == 0. .AND. ZV_PROFILER(JK) == 0.) &
+ ZDD(JK) = XUNDEF
+ END DO
+ ! GPS IWV and ZTD
+ XZS_GPS=TPROFILERS(JP)%XZ_CUR
+ IF ( ABS( ZZ(IKB)-XZS_GPS ) < 150 ) THEN ! distance between real and model orography ok
+ ZRV(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,1) )
+ ZT(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTEMP )
+ ZE(:) = ZPRES(:)*ZRV(:)/(ZRDSRV+ZRV(:))
+ ZTV(:) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTEMPV )
+ ZZTD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZTD )
+ ZZHD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZHD )
+ ZZWD_PROFILER = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZZWD )
+ ZIWV = 0.
+ DO JK=IKB,IKE
+ ZIWV=ZIWV+ZRHOD(JK)*ZRV(JK)*(ZZ(JK+1)-ZZ(JK))
+ END DO
+ IF (ZZ(IKB) < XZS_GPS) THEN ! station above the model orography
+ DO JK=IKB+1,IKE
+ IF ( ZZ(JK) < XZS_GPS) THEN ! whole layer to remove
+ ZZHDR=( 1.E-6 * ZK1 * ZPRES(JK-1) * ( ZZ(JK) - ZZ(JK-1) ) / ZTV(JK-1))
+ ZZWDR=( 1.E-6 * ( (ZK2-ZRDSRV*ZK1) + ( ZK3/ZT(JK-1) ) ) * &
+ ZE(JK-1)* ( ZZ(JK) - ZZ(JK-1) ) / ZT(JK-1) )
+ ZZHD_PROFILER=ZZHD_PROFILER-ZZHDR
+ ZZWD_PROFILER=ZZWD_PROFILER-ZZWDR
+ ZZTD_PROFILER=ZZTD_PROFILER-ZZHDR-ZZWDR
+ ELSE ! partial layer to remove
+ ZZHDR=( 1.E-6 * ZK1 * ZPRES(JK-1) * ( XZS_GPS - ZZ(JK-1) ) / ZTV(JK-1))
+ ZZWDR=( 1.E-6 * ( (ZK2-ZRDSRV*ZK1) + ( ZK3/ZT(JK-1) ) ) * &
+ ZE(JK-1)* ( XZS_GPS - ZZ(JK-1) ) / ZT(JK-1) )
+ ZZHD_PROFILER=ZZHD_PROFILER-ZZHDR
+ ZZWD_PROFILER=ZZWD_PROFILER-ZZWDR
+ ZZTD_PROFILER=ZZTD_PROFILER-ZZHDR-ZZWDR
+ EXIT
+ END IF
+ END DO
+ ELSE ! station below the model orography
+! Extrapolate variables below the model orography assuming constant T&Tv gradients,
+! constant rv and hydrostatic law
+ ZZHATM(:)=0.5*(ZZ(1:IKU-1)+ZZ(2:IKU))
+ ZZM_STAT=0.5*(XZS_GPS+ZZ(IKB))
+ ZTM_STAT=ZT(IKB) + ( (ZZM_STAT-ZZHATM(IKB))*&
+ ( ZT(IKB)- ZT(IKB+1) )/(ZZHATM(IKB)-ZZHATM(IKB+1)) )
+ ZTV_STAT=ZTV(IKB) + ( (ZZM_STAT-ZZHATM(IKB))*&
+ ( ZTV(IKB)- ZTV(IKB+1) )/(ZZHATM(IKB)-ZZHATM(IKB+1)) )
+ ZPM_STAT = ZPRES(IKB) * EXP(XG *(ZZM_STAT-ZZHATM(IKB))&
+ /(XRD* 0.5 *(ZTV_STAT+ZTV(IKB))))
+ ZEM_STAT = ZPM_STAT * ZRV(IKB) / ( ZRDSRV + ZRV(IKB) )
+! add contribution below the model orography
+ ZZHDR=( 1.E-6 * ZK1 * ZPM_STAT * ( ZZ(IKB) - XZS_GPS ) / ZTV_STAT )
+ ZZWDR=( 1.E-6 * ( (ZK2-ZRDSRV*ZK1) + (ZK3/ZTM_STAT) )&
+ * ZEM_STAT* ( ZZ(IKB) - XZS_GPS ) / ZTM_STAT )
+ ZZHD_PROFILER=ZZHD_PROFILER+ZZHDR
+ ZZWD_PROFILER=ZZWD_PROFILER+ZZWDR
+ ZZTD_PROFILER=ZZTD_PROFILER+ZZHDR+ZZWDR
+ END IF
+ TPROFILERS(JP)%XIWV(IN)= ZIWV
+ TPROFILERS(JP)%XZTD(IN)= ZZTD_PROFILER
+ TPROFILERS(JP)%XZWD(IN)= ZZWD_PROFILER
+ TPROFILERS(JP)%XZHD(IN)= ZZHD_PROFILER
+ ELSE
+ CMNHMSG(1) = 'altitude of profiler ' // TRIM( TPROFILERS(JP)%CNAME ) // ' is too far from orography'
+ CMNHMSG(2) = 'some variables are therefore not computed (IWV, ZTD, ZWD, ZHD)'
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'PROFILER_n', OLOCAL = .TRUE. )
+ TPROFILERS(JP)%XIWV(IN)= XUNDEF
+ TPROFILERS(JP)%XZTD(IN)= XUNDEF
+ TPROFILERS(JP)%XZWD(IN)= XUNDEF
+ TPROFILERS(JP)%XZHD(IN)= XUNDEF
+ END IF
+ TPROFILERS(JP)%XZON (:,IN) = ZU_PROFILER(:) * COS(ZGAM) + ZV_PROFILER(:) * SIN(ZGAM)
+ TPROFILERS(JP)%XMER (:,IN) = - ZU_PROFILER(:) * SIN(ZGAM) + ZV_PROFILER(:) * COS(ZGAM)
+ TPROFILERS(JP)%XFF (:,IN) = ZFF(:)
+ TPROFILERS(JP)%XDD (:,IN) = ZDD(:)
+ TPROFILERS(JP)%XW (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PW )
+ TPROFILERS(JP)%XTH (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTH )
+ TPROFILERS(JP)%XTHV (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZTHV )
+ IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) &
+ TPROFILERS(JP)%XVISIGUL(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZVISIGUL )
+ IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) &
+ TPROFILERS(JP)%XVISIKUN(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZVISIKUN )
+ TPROFILERS(JP)%XZZ (:,IN) = ZZ(:)
+ TPROFILERS(JP)%XRHOD(:,IN) = ZRHOD(:)
+ IF (CCLOUD=="LIMA") THEN
+ TPROFILERS(JP)%XCIZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NI) )
+ TPROFILERS(JP)%XCCZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NC) )
+ TPROFILERS(JP)%XCRZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PSV(:,:,:,NSV_LIMA_NR) )
+ ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
+ TPROFILERS(JP)%XCIZ(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PCIT )
+ END IF
+
+ CALL Sensor_wc_compute( TPROFILERS(JP), IN, PR, PRHODREF )
+ CALL Sensor_rare_compute( TPROFILERS(JP), IN, PR, PSV, PRHODREF, PCIT, ZTEMP, ZZ, PSEA )
+ !!
+ TPROFILERS(JP)%XP (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PP )
+ !
+ DO JSV=1,SIZE(PR,4)
+ TPROFILERS(JP)%XR (:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PR(:,:,:,JSV) )
+ END DO
+ ZWORK(:,:,:,:)=PSV(:,:,:,:)
+ ZWORK(:,:,1,:)=PSV(:,:,2,:)
+ DO JSV=1,SIZE(PSV,4)
+ TPROFILERS(JP)%XSV (:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZWORK(:,:,:,JSV) )
+ END DO
+ ZWORK2(:,:,:,:) = 0.
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK2(:,:,JK,:)=PAER(:,:,IKRAD,:)
+ END DO
+ DO JSV=1,SIZE(PAER,4)
+ TPROFILERS(JP)%XAER(:,IN,JSV) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( ZWORK2(:,:,:,JSV) )
+ END DO
+ IF (SIZE(PTKE)>0) TPROFILERS(JP)%XTKE (:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTKE )
+
+ ! XRHOD_SENSOR is not computed for profilers because not very useful
+ ! If needed, the interpolation must also be done vertically
+ ! (and therefore the vertical interpolation coefficients have to be computed)
+ ! TPROFILERS(JP)%XRHOD_SENSOR(IN) = ...
+
+ IF ( CRAD /= 'NONE' ) TPROFILERS(JP)%XTSRAD(IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( PTS )
+ !
+ IF ( LDIAG_SURFRAD_PROF ) CALL STATPROF_DIAG_SURFRAD(TPROFILERS(JP), IN )
+ TPROFILERS(JP)%XTKE_DISS(:,IN) = TPROFILERS(JP)%INTERP_HOR_FROM_MASSPOINT( XCURRENT_TKE_DISS )
+END DO PROFILER
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE PROFILER_n
diff --git a/src/PHYEX/ext/radar_scattering.f90 b/src/PHYEX/ext/radar_scattering.f90
new file mode 100644
index 0000000000000000000000000000000000000000..047cb5800666f7797f23594b33835e2a59d99dd9
--- /dev/null
+++ b/src/PHYEX/ext/radar_scattering.f90
@@ -0,0 +1,2088 @@
+!MNH_LIC Copyright 2004-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_RADAR_SCATTERING
+! #############################
+!
+INTERFACE
+ SUBROUTINE RADAR_SCATTERING(PT_RAY,PRHODREF_RAY,PR_RAY,PI_RAY,PCIT_RAY,PS_RAY,PG_RAY,PVDOP_RAY, &
+ PELEV,PX_H,PX_V,PW_H,PW_V,PZE,PBU_MASK_RAY,PCR_RAY,PH_RAY)
+REAL, DIMENSION(:,:,:,:,:,:),INTENT(IN) :: PT_RAY ! temperature interpolated along the rays
+REAL, DIMENSION(:,:,:,:,:,:),INTENT(IN) :: PRHODREF_RAY !
+REAL, DIMENSION(:,:,:,:,:,:),INTENT(IN) :: PR_RAY ! rainwater mixing ratio interpolated along the rays
+REAL, DIMENSION(:,:,:,:,:,:),INTENT(IN) :: PI_RAY ! pristine ice mixing ratio interpolated along the rays
+REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PCIT_RAY ! pristine ice concentration interpolated along the rays
+REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PS_RAY !aggregates mixing ratio interpolated along the rays
+REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PG_RAY ! graupel mixing ratio interpolated along the rays
+REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVDOP_RAY !Doppler radial velocity interpolated along the rays
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PELEV ! elevation
+REAL, DIMENSION(:), INTENT(IN) :: PX_H ! Gaussian horizontal nodes
+REAL, DIMENSION(:), INTENT(IN) :: PX_V ! Gaussian vertical nodes
+REAL, DIMENSION(:), INTENT(IN) :: PW_H ! Gaussian horizontal weights
+REAL, DIMENSION(:), INTENT(IN) :: PW_V ! Gaussian vertical weights
+REAL,DIMENSION(:,:,:,:,:), INTENT(INOUT) :: PZE ! 5D matrix (iradar, ielev, iaz, irangestep, ivar) containing the radar variables that will be calculated
+!in polar or cartesian projection (same projection as the observation grid)
+! convective/stratiform
+REAL, DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PBU_MASK_RAY
+REAL, DIMENSION(:,:,:,:,:,:),OPTIONAL,INTENT(IN) :: PCR_RAY ! rainwater concentration interpolated along the rays
+REAL, DIMENSION(:,:,:,:,:,:),OPTIONAL,INTENT(IN) :: PH_RAY ! hail mixing ratio interpolated along the rays
+ END SUBROUTINE RADAR_SCATTERING
+END INTERFACE
+END MODULE MODI_RADAR_SCATTERING
+!
+! ######spl
+ SUBROUTINE RADAR_SCATTERING(PT_RAY,PRHODREF_RAY,PR_RAY,PI_RAY,PCIT_RAY, &
+ PS_RAY,PG_RAY,PVDOP_RAY,PELEV,PX_H,PX_V,PW_H,PW_V,PZE,PBU_MASK_RAY,PCR_RAY,PH_RAY)
+! ##############################
+!
+!!**** *RADAR_SCATTERING* - computes radar reflectivities.
+!!
+!! PURPOSE
+!! -------
+!! Compute equivalent reflectivities of a mixed phase cloud.
+!!
+!!** METHOD
+!! ------
+!! The reflectivities are computed using the n(D) * sigma(D) formula. The
+!! equivalent reflectiviy is the sum of the reflectivity produced by the
+!! the raindrops and the equivalent reflectivities of the ice crystals.
+!! The latter are computed using the mass-equivalent diameter.
+!! Four types of diffusion are possible : Rayleigh, Mie, T-matrix, and
+!! Rayleigh-Gans (Kerker, 1969, Chap. 10; Battan, 1973, Sec. 5.4; van de
+!! Hulst, 1981, Sec. 6.32; Doviak and Zrnic, 1993, p. 249; Bringi and
+!! Chandrasekar, 2001, Chap. 2).
+!! The integration over diameters for Mie and T-matrix methods is done by
+!! using Gauss-Laguerre quadrature (Press et al. 1986). Attenuation is taken
+!! into account by computing the extinction efficiency and correcting
+!! reflectivities along the beam path.
+!! Gaussian quadrature methods are used to model the beam broadening (Gauss-
+!! Hermite or Gauss-Legendre, see Press et al. 1986).
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XLIGHTSPEED
+!! XPI
+!! Module MODD_ARF
+!!
+!! REFERENCE
+!! ---------
+!! Press, W. H., B. P. Flannery, S. A. Teukolsky et W. T. Vetterling, 1986:
+!! Numerical Recipes: The Art of Scientific Computing. Cambridge University
+!! Press, 818 pp.
+!! Probert-Jones, J. R., 1962 : The radar equation in meteorology. Quart.
+!! J. Roy. Meteor. Soc., 88, 485-495.
+!!
+!! AUTHOR
+!! ------
+!! O. Caumont & V. Ducrocq * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/03/2004
+!! O. Caumont 09/09/2009 minor changes to compute radial velocities when no
+!! hydrometeors so as to emulate wind lidar
+!! O. Caumont 21/12/2009 correction of bugs to compute KDP.
+!! O. Caumont 11/02/2010 thresholding and conversion from linear to
+!! log values after interpolation instead of before.
+!! G.Tanguy 25/03/2010 Introduction of MODD_TMAT and ALLOCATE/DEALLOCATE
+!! C.Augros 2014 New simulator for T matrice
+!! G.Delautier 10/2014 : Mise a jour simulateur T-matrice pour LIMA
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I=>LSNOW_T
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XDR_I=>XDR,XLBEXR_I=>XLBEXR,&
+ XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XCR_I=>XCR,&
+ XALPHAS_I=>XALPHAS,XNUS_I=>XNUS,XDS_I=>XDS,XLBEXS_I=>XLBEXS,&
+ XLBS_I=>XLBS,XCCS_I=>XCCS,XNS_I=>XNS,XAS_I=>XAS,XBS_I=>XBS,XCXS_I=>XCXS,XCS_I=>XCS,&
+ XALPHAG_I=>XALPHAG,XNUG_I=>XNUG,XDG_I=>XDG,XLBEXG_I=>XLBEXG,&
+ XLBG_I=>XLBG,XCCG_I=>XCCG,XAG_I=>XAG,XBG_I=>XBG,XCXG_I=>XCXG,XCG_I=>XCG,&
+ XALPHAH_I=>XALPHAH,XNUH_I=>XNUH,XDH_I=>XDH,XLBEXH_I=>XLBEXH,&
+ XLBH_I=>XLBH,XCCH_I=>XCCH,XAH_I=>XAH,XBH_I=>XBH,XCXH_I=>XCXH,XCH_I=>XCH,&
+ XALPHAI_I=>XALPHAI,XNUI_I=>XNUI,XDI_I=>XDI,XLBEXI_I=>XLBEXI,&
+ XLBI_I=>XLBI,XAI_I=>XAI,XBI_I=>XBI,XC_I_I=>XC_I,&
+ XRTMIN_I=>XRTMIN, &
+ XLBDAS_MAX_I=>XLBDAS_MAX,XLBDAS_MIN_I=>XLBDAS_MIN,XTRANS_MP_GAMMAS_I=>XTRANS_MP_GAMMAS
+!!LIMA
+USE MODD_PARAM_LIMA_WARM, ONLY: XDR_L=>XDR,XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XCR_L=>XCR
+USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,&
+ XDS_L=>XDS,XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,XNS_L=>XNS,XAS_L=>XAS,XBS_L=>XBS,&
+ XCXS_L=>XCXS,XCS_L=>XCS,&
+ XLBDAS_MAX_L=>XLBDAS_MAX,XLBDAS_MIN_L=>XLBDAS_MIN,XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
+
+USE MODD_PARAM_LIMA_MIXED, ONLY:XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG
+USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,&
+ XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,&
+ XRTMIN_L=>XRTMIN, LSNOW_T_L=>LSNOW_T
+!!LIMA
+USE MODD_RADAR, ONLY:XLAM_RAD,XSTEP_RAD,NBELEV,NDIFF,LATT,NPTS_GAULAG,LQUAD,XVALGROUND,NDGS, &
+ LFALL,LWBSCS,LWREFL,XREFLVDOPMIN,XREFLMIN,LSNRT,XSNRMIN
+USE MODD_TMAT
+!
+USE MODE_ARF
+USE MODE_FSCATTER
+USE MODE_READTMAT
+USE MODE_FGAU , ONLY:GAULAG
+USE MODI_GAMMA, ONLY:GAMMA
+!
+USE MODD_LUNIT
+USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
+USE MODE_MSG
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PT_RAY ! temperature interpolated along the rays
+REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PRHODREF_RAY !
+REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PR_RAY ! rainwater mixing ratio interpolated along the rays
+REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PI_RAY ! pristine ice mixing ratio interpolated along the rays
+REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PCIT_RAY !pristine ice concentration interpolated along the rays
+REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PS_RAY !aggregates mixing ratio interpolated along the rays
+REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PG_RAY ! graupel mixing ratio interpolated along the rays
+REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVDOP_RAY !Doppler radial velocity interpolated along the rays
+REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PELEV ! elevation
+REAL,DIMENSION(:), INTENT(IN) :: PX_H ! Gaussian horizontal nodes
+REAL,DIMENSION(:), INTENT(IN) :: PX_V ! Gaussian vertical nodes
+REAL,DIMENSION(:), INTENT(IN) :: PW_H ! Gaussian horizontal weights
+REAL,DIMENSION(:), INTENT(IN) :: PW_V ! Gaussian vertical weights
+REAL,DIMENSION(:,:,:,:,:), INTENT(INOUT) :: PZE ! gate equivalent reflectivity factor (horizontal & vertical)
+! convective/stratiform
+REAL,DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PBU_MASK_RAY
+! /convective/stratiform
+REAL, DIMENSION(:,:,:,:,:,:),OPTIONAL,INTENT(IN) :: PCR_RAY ! rainwater concentration interpolated along the rays
+REAL, DIMENSION(:,:,:,:,:,:),OPTIONAL,INTENT(IN) :: PH_RAY ! hail mixing ratio interpolated along the rays
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(:,:,:,:,:,:,:),ALLOCATABLE :: ZREFL
+!1: ZHH (dBZ), 2: ZDR, 3: KDP, 4: CSR (0 pr air clair, 1 pour stratiforme, 2 pour convectif)
+!5-8: ZER, ZEI, ZES,ZEG
+!9 : VRU (vitesse radiale)
+!10-13 : AER, AEI, AES, AEG
+!14-17: ATR, ATI, ATS, ATG
+!18-20: RhoHV, PhiDP, DeltaHV
+
+REAL, DIMENSION(:,:,:,:,:,:,:),ALLOCATABLE :: ZAELOC ! local attenuation
+REAL, DIMENSION(:,:,:),ALLOCATABLE :: ZAETOT ! 1: total attenuation, 2: // vertical
+REAL :: ZAERINT,ZAEIINT,ZAESINT,ZAEGINT,ZAEHINT ! total attenuation horizontal
+REAL :: ZAVRINT,ZAVSINT,ZAVGINT,ZAVHINT ! total attenuation vertical
+!
+REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
+!
+REAL,DIMENSION(4) :: ZREFLOC
+REAL,DIMENSION(2) :: ZAETMP
+REAL,DIMENSION(:),ALLOCATABLE :: ZVTEMP ! temp var for Gaussian quadrature 8 : r_r, 9 : r_i, 10 : r_s , 11 : r_g
+REAL :: ZCXR=-1.0 ! for rain N ~ 1/N_0 (in Kessler parameterization)
+REAL :: ZDMELT_FACT ! factor used to compute the equivalent melted diameter
+REAL :: ZEQICE=0.224! factor used to convert the ice crystals reflectivity into an equivalent liquid water reflectivity (from Smith, JCAM 84)
+REAL :: ZEXP ! anciliary parameter
+REAL :: ZLBDA ! slope distribution parameter
+REAL :: ZN ! Number concentration
+REAL :: ZFRAC_ICE,ZD,ZDE ! auxiliary variables
+REAL :: ZQSCA
+REAL,DIMENSION(2) :: ZQEXT
+REAL,DIMENSION(3) :: ZQBACK ! Q_b(HH),Q_b(VV) (backscattering efficiencies at horizontal and vertical polarizations, resp.)
+!REAL :: P=DACOS(-1D0)
+REAL :: ZRHOI ! pristine ice density (from m=a*D**b),
+REAL :: ZRHOPI=916. !pure ice density (kg/m3)
+COMPLEX :: ZNUM, ZDEN !for calculation of ice dielectri cconstant
+COMPLEX :: ZQM,ZQMW,ZQMI,ZQK,ZQB, ZEPSI ! dielectric parameters
+REAL :: ZS11_CARRE_R,ZS22_CARRE_R,ZRE_S22S11_R,ZIM_S22S11_R
+REAL :: ZS11_CARRE_I,ZS22_CARRE_I,ZRE_S22S11_I,ZIM_S22S11_I
+REAL :: ZS11_CARRE_S,ZS22_CARRE_S,ZRE_S22S11_S,ZIM_S22S11_S
+REAL :: ZS11_CARRE_G,ZS22_CARRE_G,ZRE_S22S11_G,ZIM_S22S11_G
+REAL :: ZS11_CARRE_H,ZS22_CARRE_H,ZRE_S22S11_H,ZIM_S22S11_H
+REAL :: ZS11_CARRE_T,ZS22_CARRE_T,ZRE_S22S11_T,ZIM_S22S11_T
+REAL :: ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT
+
+REAL :: ZM
+!
+INTEGER :: INBRAD,IIELV,INBAZIM,INBSTEPMAX,INPTS_H,INPTS_V ! sizes of the arrays
+INTEGER :: IEL
+INTEGER :: JI,JL,JEL,JAZ,JH,JV,JJ,JT ! Loop variables of control
+REAL :: ZLB ! depolarization factor along the spheroid symmetry axis
+REAL :: ZCXI=0. ! should be defined with other parameters of microphysical scheme
+REAL :: ZCR,ZCI,ZCS,ZCG,ZCH ! coefficients to take into account fall speeds when simulating Doppler winds
+REAL, DIMENSION(:,:,:,:),ALLOCATABLE :: ZCONC_BIN
+INTEGER :: IMAX
+LOGICAL :: LPART_MASK ! indicates a partial mask along the beam
+
+!
+INTEGER :: IZER,IZEI,IZES,IZEG
+INTEGER :: IVDOP,IRHV,IPDP,IDHV
+INTEGER :: IAER,IAEI,IAES,IAEG
+INTEGER :: IAVR,IAVI,IAVS,IAVG
+INTEGER :: IATR,IATI,IATS,IATG
+INTEGER :: IRHR, IRHS, IRHG, IZDA, IZDS, IZDG, IKDR, IKDS, IKDG
+INTEGER :: IZEH, IRHH,IKDH,IZDH ! hail
+INTEGER :: IAEH,IAVH,IATH
+!
+!for ZSNR threshold
+REAL ::ZDISTRAD,ZSNR,ZSNR_R,ZSNR_S,ZSNR_I,ZSNR_G,ZSNR_H,ZZHH,ZZE_R,ZZE_I,ZZE_S,ZZE_G,ZZE_H
+LOGICAL :: GTHRESHOLD_V, GTHRESHOLD_Z,GTHRESHOLD_ZR,GTHRESHOLD_ZI,GTHRESHOLD_ZS,GTHRESHOLD_ZG,GTHRESHOLD_ZH
+
+!--------- TO READ T-MATRIX TABLE --------
+CHARACTER(LEN=6) :: YBAND
+CHARACTER(LEN=1) ::YTYPE
+CHARACTER(LEN=1),DIMENSION(5) :: YTAB_TYPE
+CHARACTER(LEN=25),DIMENSION(5) :: YFILE_COEFINT
+
+REAL,DIMENSION(5) :: ZELEV_MIN,ZELEV_MAX,ZELEV_STEP,&
+ZTC_MIN,ZTC_MAX,ZTC_STEP,ZFW_MIN,ZFW_MAX,ZFW_STEP
+INTEGER :: IRESP,ILINE,INB_M
+INTEGER,DIMENSION(5) :: INB_ELEV,INB_TC,INB_FW,INB_LINE
+
+REAL, DIMENSION(:),ALLOCATABLE :: ZTC_T_R, ZTC_T_S, ZTC_T_G, ZTC_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZELEV_T_R, ZELEV_T_S, ZELEV_T_G, ZELEV_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZFW_T_S, ZFW_T_G, ZFW_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZM_T_R, ZM_T_S, ZM_T_G, ZM_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZS11_CARRE_T_R, ZS11_CARRE_T_S, ZS11_CARRE_T_G, ZS11_CARRE_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZS22_CARRE_T_R, ZS22_CARRE_T_S, ZS22_CARRE_T_G, ZS22_CARRE_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZRE_S22S11_T_R, ZRE_S22S11_T_S, ZRE_S22S11_T_G, ZRE_S22S11_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZIM_S22S11_T_R, ZIM_S22S11_T_S, ZIM_S22S11_T_G, ZIM_S22S11_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZIM_S22FT_T_R, ZIM_S22FT_T_S, ZIM_S22FT_T_G, ZIM_S22FT_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZIM_S11FT_T_R, ZIM_S11FT_T_S, ZIM_S11FT_T_G, ZIM_S11FT_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZRE_S22FMS11FT_T_R, ZRE_S22FMS11FT_T_S, ZRE_S22FMS11FT_T_G, ZRE_S22FMS11FT_T_W
+REAL, DIMENSION(:),ALLOCATABLE :: ZTC_T_H ,ZELEV_T_H ,ZFW_T_H,ZM_T_H,ZS11_CARRE_T_H,ZS22_CARRE_T_H,ZRE_S22S11_T_H
+REAL, DIMENSION(:),ALLOCATABLE :: ZIM_S22S11_T_H,ZIM_S22FT_T_H,ZIM_S11FT_T_H,ZRE_S22FMS11FT_T_H
+INTEGER,DIMENSION(16):: ITMAT
+REAL:: ZELEV_RED,ZTC_RED,ZM_RED,ZFW_RED
+INTEGER :: JIND
+REAL,DIMENSION(7,16) :: KMAT_COEF !matrice contenant tous les coef interpolés
+ !pour chaque val inf et sup de ELEV_t
+REAL :: ZEXPM_MIN, ZEXPM_STEP, ZEXPM_MAX,ZM_MIN
+REAL :: ZFW !water fraction inside melting graupel (ZFW=0 for rain, snow and dry graupel). used only with NDIFF=7: Tmatrix
+INTEGER :: ILUOUT0,IUNIT
+!
+! MODIF GAELLE POUR LIMA
+!
+LOGICAL :: GLIMA,GHAIL
+REAL,DIMENSION(5) :: ZCC_MIN,ZCC_MAX, ZCC_STEP
+INTEGER,DIMENSION(5):: INB_CC
+REAL, DIMENSION(:),ALLOCATABLE :: ZCC_T_R
+REAL :: ZCC_RED
+LOGICAL :: GCALC
+REAL :: ZCC
+REAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: ZM_6D,ZCC_6D
+REAL :: ZC
+!
+REAL :: ZCCR,ZLBR,ZLBEXR,ZDR,ZALPHAR,ZNUR,ZBR
+REAL :: ZCCS,ZLBS,ZLBEXS,ZDS,ZALPHAS,ZNUS,ZAS,ZBS,ZCXS,ZNS
+REAL :: ZCCG,ZLBG,ZLBEXG,ZDG,ZALPHAG,ZNUG,ZAG,ZBG,ZCXG
+REAL :: ZCCH,ZLBH,ZLBEXH,ZDH,ZALPHAH,ZNUH,ZAH,ZBH,ZCXH
+REAL :: ZLBI,ZLBEXI,ZDI,ZALPHAI,ZNUI,ZAI,ZBI
+REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN
+CHARACTER(LEN=100) :: YMSG
+TYPE(TFILEDATA),POINTER :: TZFILE
+!
+!* 1. INITIALISATION
+!--------------
+ILUOUT0 = TLUOUT0%NLU
+TZFILE => NULL()
+!
+IF (PRESENT(PCR_RAY)) THEN
+ GLIMA=.TRUE.
+ELSE
+ GLIMA=.FALSE.
+ENDIF
+IF (PRESENT(PH_RAY)) THEN
+ GHAIL=.TRUE.
+ELSE
+ GHAIL=.FALSE.
+ENDIF
+!
+!
+!
+ ZS11_CARRE_R=0
+ ZS22_CARRE_R=0
+ ZRE_S22S11_R=0
+ ZIM_S22S11_R=0
+ ZS11_CARRE_I=0
+ ZS22_CARRE_I=0
+ ZRE_S22S11_I=0
+ ZIM_S22S11_I=0
+ ZS11_CARRE_S=0
+ ZS22_CARRE_S=0
+ ZRE_S22S11_S=0
+ ZIM_S22S11_S=0
+ ZS11_CARRE_G=0
+ ZS22_CARRE_G=0
+ ZRE_S22S11_G=0
+ ZIM_S22S11_G=0
+ ZS11_CARRE_H=0
+ ZS22_CARRE_H=0
+ ZRE_S22S11_H=0
+ ZIM_S22S11_H=0
+! Initialisation varibales microphysiques
+IF (GLIMA) THEN ! LIMA
+ ZLBR=XLBR_L
+ ZLBEXR=XLBEXR_L
+ ZDR=XDR_L
+ ZALPHAR=XALPHAR_L
+ ZNUR=XNUR_L
+ ZBR=XBR_L
+ ZCCS=XCCS_L
+ ZCXS=XCXS_L
+ ZLBS=XLBS_L
+ ZLBEXS=XLBEXS_L
+ ZNS=XNS_L
+ ZDS=XDS_L
+ ZALPHAS=XALPHAS_L
+ ZNUS=XNUS_L
+ ZAS=XAS_L
+ ZBS=XBS_L
+ ZCCG=XCCG_L
+ ZCXG=XCXG_L
+ ZLBG=XLBG_L
+ ZLBEXG=XLBEXG_L
+ ZDG=XDG_L
+ ZALPHAG=XALPHAG_L
+ ZNUG=XNUG_L
+ ZAG=XAG_L
+ ZBG=XBG_L
+ ZLBI=XLBI_L
+ ZLBEXI=XLBEXI_L
+ ZDI=XDI_L
+ ZALPHAI=XALPHAI_L
+ ZNUI=XNUI_L
+ ZAI=XAI_L
+ ZBI=XBI_L
+ ALLOCATE(ZRTMIN(SIZE(XRTMIN_L)))
+ ZRTMIN=XRTMIN_L
+ELSE ! ICE3
+ ZCCR=XCCR_I
+ ZLBR=XLBR_I
+ ZLBEXR=XLBEXR_I
+ ZDR=XDR_I
+ ZALPHAR=XALPHAR_I
+ ZNUR=XNUR_I
+ ZBR=XBR_I
+ ZCCS=XCCS_I
+ ZCXS=XCXS_I
+ ZLBS=XLBS_I
+ ZLBEXS=XLBEXS_I
+ ZNS=XNS_I
+ ZDS=XDS_I
+ ZALPHAS=XALPHAS_I
+ ZNUS=XNUS_I
+ ZAS=XAS_I
+ ZBS=XBS_I
+ ZCCG=XCCG_I
+ ZCXG=XCXG_I
+ ZLBG=XLBG_I
+ ZLBEXG=XLBEXG_I
+ ZDG=XDG_I
+ ZALPHAG=XALPHAG_I
+ ZNUG=XNUG_I
+ ZAG=XAG_I
+ ZBG=XBG_I
+ ZLBI=XLBI_I
+ ZLBEXI=XLBEXI_I
+ ZDI=XDI_I
+ ZALPHAI=XALPHAI_I
+ ZNUI=XNUI_I
+ ZAI=XAI_I
+ ZBI=XBI_I
+ ALLOCATE(ZRTMIN(SIZE(XRTMIN_I)))
+ ZRTMIN=XRTMIN_I
+ IF (GHAIL) THEN
+ ZCCH=XCCH_I
+ ZCXH=XCXH_I
+ ZLBH=XLBH_I
+ ZLBEXH=XLBEXH_I
+ ZDH=XDH_I
+ ZALPHAH=XALPHAH_I
+ ZNUH=XNUH_I
+ ZAH=XAH_I
+ ZBH=XBH_I
+ ENDIF
+ENDIF
+!
+! initialisation of refractivity indices
+! 1 : ZHH
+! 2 : ZDR
+! 3 : KDP
+! 4 : CSR
+IZER=5 ! ZER
+IZEI=IZER+1 ! ZEI
+IZES=IZEI+1 ! ZES
+IZEG=IZES+1 ! ZEG
+IF (GHAIL) THEN
+ IZEH=IZEG+1 !ZEH
+ IVDOP=IZEH+1 !VRU
+ELSE
+ IVDOP=IZEG+1 !VRU
+END IF
+IF (LATT) THEN
+ IF (GHAIL) THEN
+ IAER=IVDOP+1
+ IAEI=IAER+1
+ IAES=IAEI+1
+ IAEG=IAES+1
+ IAEH=IAEG+1
+ IAVR=IAEH+1
+ IAVI=IAVR+1
+ IAVS=IAVI+1
+ IAVG=IAVS+1
+ IAVH=IAVG+1
+ IATR=IAVH+1
+ IATI=IATR+1
+ IATS=IATI+1
+ IATG=IATS+1
+ IATH=IATG+1
+ IRHV=IATH+1
+ ELSE
+ IAER=IVDOP+1
+ IAEI=IAER+1
+ IAES=IAEI+1
+ IAEG=IAES+1
+ IAVR=IAEG+1
+ IAVI=IAVR+1
+ IAVS=IAVI+1
+ IAVG=IAVS+1
+ IATR=IAVG+1
+ IATI=IATR+1
+ IATS=IATI+1
+ IATG=IATS+1
+ IRHV=IATG+1
+ ENDIF
+ELSE
+ IRHV=IVDOP+1
+ENDIF
+IPDP=IRHV+1
+IDHV=IPDP+1
+IRHR=IDHV+1
+IRHS=IRHR+1
+IRHG=IRHS+1
+IF (GHAIL) THEN
+ IRHH=IRHG+1
+ IZDA=IRHH+1
+ELSE
+ IZDA=IRHG+1
+ENDIF
+IZDS=IZDA+1
+IZDG=IZDS+1
+IF (GHAIL) THEN
+ IZDH=IZDG+1
+ IKDR=IZDH+1
+ELSE
+ IKDR=IZDG+1
+ENDIF
+IKDS=IKDR+1
+IKDG=IKDS+1
+IF (GHAIL) THEN
+ IKDH=IKDG+1
+ENDIF
+!
+!
+!
+INBRAD=SIZE(PT_RAY,1)
+IIELV=SIZE(PT_RAY,2)
+INBAZIM=SIZE(PT_RAY,3)
+INBSTEPMAX=SIZE(PT_RAY,4)
+INPTS_H=SIZE(PT_RAY,5)
+INPTS_V=SIZE(PT_RAY,6)
+!
+! Initialisation for radial winds
+IF(LFALL) THEN
+ IF (GLIMA) THEN
+ ZCR=XCR_L
+ ZCI=XC_I_L
+ ZCS=XCS_L
+ ZCG=XCG_L
+ ELSE
+ ZCR=XCR_I
+ ZCI=XC_I_I
+ ZCS=XCS_I
+ ZCG=XCG_I
+ IF (GHAIL) ZCH=XCH_I
+ ENDIF
+ELSE
+ ZCR=0.
+ ZCI=0.
+ ZCS=0.
+ ZCG=0.
+ IF (GHAIL) ZCH=0.
+END IF
+
+! Calculation of nodes and weights for the Gauss-Laguerre quadrature
+! for Mie and T-matrix and RG
+IF(NDIFF/=0) THEN
+ ALLOCATE(ZX(NPTS_GAULAG),ZW(NPTS_GAULAG)) !NPTS_GAULAG : number of points for the quadrature
+ CALL GAULAG(NPTS_GAULAG,ZX,ZW)
+END IF
+!
+!
+IMAX=SIZE(PZE,5)
+WRITE(ILUOUT0,*) "-----------------"
+WRITE(ILUOUT0,*) "Radar scattering"
+WRITE(ILUOUT0,*) "-----------------"
+WRITE(ILUOUT0,*) 'Nombre de variables dans PZE: ',IMAX
+
+IF(.NOT.LWREFL) IMAX=IMAX+1
+
+ALLOCATE(ZREFL(INBRAD,IIELV,INBAZIM,INBSTEPMAX,INPTS_H,INPTS_V,IMAX))
+ZREFL(:,:,:,:,:,:,:)=0.
+IF(LATT) THEN
+ ZREFL(:,:,:,:,:,:,IATR:IATG)=1.
+ IF (GHAIL) ZREFL(:,:,:,:,:,:,IATH)=1.
+END IF
+PZE(:,:,:,:,:)=0.
+IF (LATT)THEN
+ ALLOCATE(ZAELOC(INBRAD,IIELV,INBAZIM,INBSTEPMAX,INPTS_H,INPTS_V,2))
+ ALLOCATE(ZAETOT(INPTS_H,INPTS_V,2))
+ ZAELOC(:,:,:,:,:,:,:)=0. ! initialization of attenuation stuff (alpha_e for first gate)
+ ZAETOT(:,:,:)=1. ! initialization of attenuation stuff (total attenuation)
+END IF
+WRITE(ILUOUT0,*) 'BEFORE LOOP DIFFUSION'
+
+IF(LWBSCS) THEN
+ ALLOCATE(ZCONC_BIN(INBRAD,IIELV,INBAZIM,INBSTEPMAX))
+ ZCONC_BIN(:,:,:,:)=0.
+END IF
+
+WRITE(ILUOUT0,*) "XCCR:",ZCCR
+WRITE(ILUOUT0,*) "XLBR:",ZLBR
+WRITE(ILUOUT0,*) "XLBEXR:",ZLBEXR
+
+WRITE(ILUOUT0,*) "XCCS:",ZCCS
+WRITE(ILUOUT0,*) "XLBS:",ZLBS
+WRITE(ILUOUT0,*) "XLBEXS:",ZLBEXS
+
+WRITE(ILUOUT0,*) "XCCG:",ZCCG
+WRITE(ILUOUT0,*) "XLBG:",ZLBG
+WRITE(ILUOUT0,*) "XLBEXG:",ZLBEXG
+
+IF (GHAIL) THEN
+ WRITE(ILUOUT0,*) "XCCH:",ZCCH
+ WRITE(ILUOUT0,*) "XLBH:",ZLBH
+ WRITE(ILUOUT0,*) "XLBEXH:",ZLBEXH
+ENDIF
+!
+IF (GLIMA .AND. NDIFF==7) THEN
+ IF (ZALPHAR/=1 .AND. ZNUR /=2.) THEN
+ WRITE(ILUOUT0,*) " ERROR : TMATRICE TABLE ARE MADE WITH XALPHAR=1 XNUR=2"
+ WRITE(ILUOUT0,*) " FOR CCLOUD=LIMA. PLEASE CHANGE THIS VALUES OR PROVIDE "
+ WRITE(ILUOUT0,*) " NEW TMATRICE TABLES "
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING','')
+ ENDIF
+ELSE
+ IF (ZALPHAR/=1 .AND. ZNUR /=1.) THEN
+ WRITE(ILUOUT0,*) " ERROR : TMATRICE TABLE ARE MADE WITH XALPHAR=1 XNUR=1"
+ WRITE(ILUOUT0,*) " FOR CCLOUD=ICE3. PLEASE CHANGE THIS VALUEs OR PROVIDE "
+ WRITE(ILUOUT0,*) " NEW TMATRICE TABLES "
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING','')
+ ENDIF
+ENDIF
+
+!---------------------------------------------
+! LOOP OVER EVERYTHING
+!--------------------------------------------
+IF(NDIFF==7) THEN
+ YTAB_TYPE(1)='r'
+ YTAB_TYPE(2)='s'
+ YTAB_TYPE(3)='g'
+ YTAB_TYPE(4)='w'
+ YTAB_TYPE(5)='h'
+ ! definition des paramètres de lecture de la table T-matrice
+ ! all mixing ratio
+ ZEXPM_MIN=-7.
+ ZEXPM_STEP=0.01
+ ZEXPM_MAX=-2.
+ ZM_MIN=10**ZEXPM_MIN
+ ! rain
+ ZELEV_MIN(1)=0.0
+ ZELEV_STEP(1)=4.0
+ ZELEV_MAX(1)=12.0
+ ZTC_MIN(1)=-20.0
+ ZTC_STEP(1)=1.0
+ ZTC_MAX(1)=40.0
+ ZFW_MIN(1)=0.0
+ ZFW_STEP(1)=0.1
+ ZFW_MAX(1)=0.0
+ IF (GLIMA) THEN
+ ZCC_MIN(1)=1.8
+ ZCC_STEP(1)=0.02
+ ZCC_MAX(1)=6
+ ELSE
+ ZCC_MIN(1)=1.
+ ZCC_STEP(1)=1.
+ ZCC_MAX(1)=1.
+ ENDIF
+ ! snow + graupel
+ ZELEV_MIN(2:3)=0.0
+ ZELEV_STEP(2:3)=12.0
+ ZELEV_MAX(2:3)=12.0
+ ZTC_MIN(2:3)=-70.0
+ ZTC_STEP(2:3)=1.0
+ ZTC_MAX(2:3)=10.0
+ ZFW_MIN(2:3)=0.0
+ ZFW_STEP(2:3)=0.1
+ ZFW_MAX(2:3)=0.0
+ ZCC_MIN(2:3)=1.
+ ZCC_STEP(2:3)=1.
+ ZCC_MAX(2:3)=1.
+ ! wet graupel
+ ZELEV_MIN(4)=0.0
+ ZELEV_STEP(4)=4.0
+ ZELEV_MAX(4)=12.0
+ ZTC_MIN(4)=-10.0
+ ZTC_STEP(4)=1.0
+ ZTC_MAX(4)=10.0
+ ZFW_MIN(4)=0.0
+ ZFW_STEP(4)=0.1
+ ZFW_MAX(4)=1.0
+ ZCC_MIN(4)=1.
+ ZCC_STEP(4)=1.
+ ZCC_MAX(4)=1.
+ ! hail
+ ZELEV_MIN(5)=0.0
+ ZELEV_STEP(5)=4.0
+ ZELEV_MAX(5)=12.0
+ ZTC_MIN(5)=-20.0
+ ZTC_STEP(5)=1.0
+ ZTC_MAX(5)=30.0
+ ZFW_MIN(5)=0.
+ ZFW_STEP(5)=0.1
+ ZFW_MAX(5)=0.0
+ ZCC_MIN(5)=1.
+ ZCC_STEP(5)=1.
+ ZCC_MAX(5)=1.
+ DO JT=1,5
+ INB_ELEV(JT)=NINT((ZELEV_MAX(JT)-ZELEV_MIN(JT))/ZELEV_STEP(JT))+1
+ INB_TC(JT)=NINT((ZTC_MAX(JT)-ZTC_MIN(JT))/ZTC_STEP(JT))+1
+ INB_FW(JT)=NINT((ZFW_MAX(JT)-ZFW_MIN(JT))/ZFW_STEP(JT))+1
+ INB_M=NINT((ZEXPM_MAX-ZEXPM_MIN)/ZEXPM_STEP)+1
+ INB_CC(JT)=NINT((ZCC_MAX(JT)-ZCC_MIN(JT))/ZCC_STEP(JT))+1
+ INB_LINE(JT)=INB_ELEV(JT)*INB_TC(JT)*INB_FW(JT)*INB_M*INB_CC(JT)
+ ENDDO
+ENDIF
+
+!---------------------------------------------
+! LOOP OVER EVERYTHING
+!--------------------------------------------
+ !============== loop over radars =================
+WRITE(ILUOUT0,*) "INBRAD",INBRAD
+DO JI=1,INBRAD
+ WRITE(ILUOUT0,*) "JI",JI
+ WRITE(ILUOUT0,*) "XLAM_RAD(JI):",XLAM_RAD(JI)
+
+ IF(NDIFF==7) THEN ! If T-MATRIX
+ !---------------------------------------------------------------------------------------------
+ ! 0. LECTURE DES TABLES TMAT POUR PLUIE, NEIGE, GRAUPEL
+ ! en fonction de la bande frequence
+ !---------------------------------------------------------------------------------------------
+ IF ( XLAM_RAD(JI)==0.1062) THEN
+ YBAND='S106.2'
+ ELSEIF (XLAM_RAD(JI) ==0.0532 ) THEN
+ YBAND='C053.2'
+ ELSEIF (XLAM_RAD(JI)==0.0319 ) THEN
+ YBAND='X031.9'
+ ELSE
+ WRITE(ILUOUT0,*) "ERROR RADAR_SCATTERING"
+ WRITE(ILUOUT0,*) "Tmatrice tables are only available for XLAM_RAD=0.1062"
+ WRITE(ILUOUT0,*) "or XLAM_RAD=0.0532 or XLAM_RAD=0.0319"
+ WRITE(ILUOUT0,*) "change XLAM_RAD in namelist or compute new tmatrice table"
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING','')
+ ENDIF
+
+ !************ fichiers Min Max Pas et Coef Tmat ***********
+ DO JT=1,5 !types (r, s, g, w, h)
+
+ YTYPE=YTAB_TYPE(JT)
+ IF (JT .EQ. 1) THEN
+ IF (GLIMA) THEN
+ YFILE_COEFINT(JT)='TmatCoefInt_LIMA_'//YBAND//YTYPE
+ ELSE
+ YFILE_COEFINT(JT)='TmatCoefInt_ICE3_'//YBAND//YTYPE
+ ENDIF
+ ELSE
+ YFILE_COEFINT(JT)='TmatCoefInt_'//YBAND//YTYPE
+ ENDIF
+ YFILE_COEFINT(JT)=TRIM(ADJUSTL(YFILE_COEFINT(JT)))
+ ENDDO
+ !lookup tables for rain
+ ALLOCATE (ZTC_T_R(INB_LINE(1)),ZELEV_T_R(INB_LINE(1)),ZCC_T_R(INB_LINE(1)),ZM_T_R(INB_LINE(1)),&
+ ZS11_CARRE_T_R(INB_LINE(1)),ZS22_CARRE_T_R(INB_LINE(1)), ZRE_S22S11_T_R(INB_LINE(1)),ZIM_S22S11_T_R(INB_LINE(1)),&
+ ZRE_S22FMS11FT_T_R(INB_LINE(1)),ZIM_S22FT_T_R(INB_LINE(1)),ZIM_S11FT_T_R(INB_LINE(1)))
+
+ !lookup tables for snow
+ ALLOCATE (ZTC_T_S(INB_LINE(2)),ZELEV_T_S(INB_LINE(2)),ZFW_T_S(INB_LINE(2)),ZM_T_S(INB_LINE(2)),&
+ ZS11_CARRE_T_S(INB_LINE(2)),ZS22_CARRE_T_S(INB_LINE(2)),ZRE_S22S11_T_S(INB_LINE(2)),ZIM_S22S11_T_S(INB_LINE(2)),&
+ ZRE_S22FMS11FT_T_S(INB_LINE(2)),ZIM_S22FT_T_S(INB_LINE(2)),ZIM_S11FT_T_S(INB_LINE(2)))
+
+ !lookup tables for graupel
+ ALLOCATE (ZTC_T_G(INB_LINE(3)),ZELEV_T_G(INB_LINE(3)),ZFW_T_G(INB_LINE(3)),ZM_T_G(INB_LINE(3)),&
+ ZS11_CARRE_T_G(INB_LINE(3)),ZS22_CARRE_T_G(INB_LINE(3)), ZRE_S22S11_T_G(INB_LINE(3)),ZIM_S22S11_T_G(INB_LINE(3)),&
+ ZRE_S22FMS11FT_T_G(INB_LINE(3)),ZIM_S22FT_T_G(INB_LINE(3)),ZIM_S11FT_T_G(INB_LINE(3)))
+
+ !lookup tables for wet graupel
+ ALLOCATE (ZTC_T_W(INB_LINE(4)),ZELEV_T_W(INB_LINE(4)),ZFW_T_W(INB_LINE(4)),ZM_T_W(INB_LINE(4)),&
+ ZS11_CARRE_T_W(INB_LINE(4)),ZS22_CARRE_T_W(INB_LINE(4)), ZRE_S22S11_T_W(INB_LINE(4)),ZIM_S22S11_T_W(INB_LINE(4)),&
+ ZRE_S22FMS11FT_T_W(INB_LINE(4)),ZIM_S22FT_T_W(INB_LINE(4)),ZIM_S11FT_T_W(INB_LINE(4)))
+
+ IF (GHAIL) THEN
+ !lookup tables for hail
+ ALLOCATE (ZTC_T_H(INB_LINE(5)),ZELEV_T_H(INB_LINE(5)),ZFW_T_H(INB_LINE(5)),ZM_T_H(INB_LINE(5)),&
+ ZS11_CARRE_T_H(INB_LINE(5)),ZS22_CARRE_T_H(INB_LINE(5)), ZRE_S22S11_T_H(INB_LINE(5)),ZIM_S22S11_T_H(INB_LINE(5)),&
+ ZRE_S22FMS11FT_T_H(INB_LINE(5)),ZIM_S22FT_T_H(INB_LINE(5)),ZIM_S11FT_T_H(INB_LINE(5)))
+ ENDIF
+ !===== Lecture des tables ===========
+
+ 6003 FORMAT (E11.4,2X,E9.3,2X,E10.4,2X,E10.4,2X,E12.5,2X,E12.5,2X,&
+ E12.5,2X,E12.5,2X,E12.5,2X,E12.5,2X,E12.5)
+
+ !rain
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(1),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
+ IUNIT = TZFILE%NLU
+ IF ( IRESP /= 0 ) THEN
+ WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(1))
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
+ ENDIF
+ ILINE=1
+ DO WHILE (ILINE .LE. INB_LINE(1))
+ READ( UNIT=IUNIT,FMT=6003, IOSTAT=IRESP ) ZTC_T_R(ILINE),ZELEV_T_R(ILINE),&
+ ZCC_T_R(ILINE),ZM_T_R(ILINE),ZS11_CARRE_T_R(ILINE),ZS22_CARRE_T_R(ILINE),ZRE_S22S11_T_R(ILINE),&
+ ZIM_S22S11_T_R(ILINE),ZRE_S22FMS11FT_T_R(ILINE),ZIM_S22FT_T_R(ILINE),ZIM_S11FT_T_R(ILINE)
+ ILINE=ILINE+1
+ ENDDO
+ CALL IO_File_close(TZFILE)
+ TZFILE => NULL()
+ WRITE(ILUOUT0,*) "NLIGNE rain",ILINE
+ ILINE=2
+ WRITE(ILUOUT0,*) "ILINE=",ILINE
+ WRITE(ILUOUT0,*) "ZTC_T_R(ILINE),ZELEV_T_R(ILINE),ZCC_T_R(ILINE)",&
+ ZTC_T_R(ILINE),ZELEV_T_R(ILINE),ZCC_T_R(ILINE)
+ WRITE(ILUOUT0,*) "ZM_T_R(ILINE),ZS11_CARRE_T_R(ILINE),ZS22_CARRE_T_R(ILINE),ZRE_S22S11_T_R(ILINE)",&
+ ZM_T_R(ILINE),ZS11_CARRE_T_R(ILINE),ZS22_CARRE_T_R(ILINE),ZRE_S22S11_T_R(ILINE)
+ WRITE(ILUOUT0,*) "ZIM_S22S11_T_R(ILINE),ZRE_S22FMS11FT_T_R(ILINE),ZIM_S22FT_T_R(ILINE),ZIM_S11FT_T_R(ILINE)",&
+ ZIM_S22S11_T_R(ILINE),ZRE_S22FMS11FT_T_R(ILINE),ZIM_S22FT_T_R(ILINE),ZIM_S11FT_T_R(ILINE)
+
+ !snow
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(2),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
+ IUNIT = TZFILE%NLU
+ IF ( IRESP /= 0 ) THEN
+ WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(2))
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
+ ENDIF
+ ILINE=1
+ DO WHILE (ILINE .LE. INB_LINE(2))
+ READ( UNIT=IUNIT,FMT=6003, IOSTAT=IRESP ) ZTC_T_S(ILINE),ZELEV_T_S(ILINE),&
+ ZFW_T_S(ILINE),ZM_T_S(ILINE),ZS11_CARRE_T_S(ILINE),ZS22_CARRE_T_S(ILINE),ZRE_S22S11_T_S(ILINE),&
+ ZIM_S22S11_T_S(ILINE),ZRE_S22FMS11FT_T_S(ILINE),ZIM_S22FT_T_S(ILINE),ZIM_S11FT_T_S(ILINE)
+ ILINE=ILINE+1
+ ENDDO
+ CALL IO_File_close(TZFILE)
+ TZFILE => NULL()
+ WRITE(ILUOUT0,*) "NLIGNE snow",ILINE
+ ILINE=2
+ WRITE(ILUOUT0,*) "ILINE=",ILINE
+ WRITE(ILUOUT0,*) "ZTC_T_S(ILINE),ZELEV_T_S(ILINE),ZFW_T_S(ILINE)",&
+ ZTC_T_S(ILINE),ZELEV_T_S(ILINE),ZFW_T_S(ILINE)
+ WRITE(ILUOUT0,*) "ZM_T_S(ILINE),ZS11_CARRE_T_S(ILINE),ZS22_CARRE_T_S(ILINE),ZRE_S22S11_T_S(ILINE)",&
+ ZM_T_S(ILINE),ZS11_CARRE_T_S(ILINE),ZS22_CARRE_T_S(ILINE),ZRE_S22S11_T_S(ILINE)
+ WRITE(ILUOUT0,*) "ZIM_S22S11_T_S(ILINE),ZRE_S22FMS11FT_T_S(ILINE),ZIM_S22FT_T_S(ILINE),ZIM_S11FT_T_S(ILINE)",&
+ ZIM_S22S11_T_S(ILINE),ZRE_S22FMS11FT_T_S(ILINE),ZIM_S22FT_T_S(ILINE),ZIM_S11FT_T_S(ILINE)
+
+ !graupel
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(3),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
+ IUNIT = TZFILE%NLU
+ IF ( IRESP /= 0 ) THEN
+ WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(3))
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
+ ENDIF
+ ILINE=1
+ DO WHILE (ILINE .LE. INB_LINE(3))
+ READ( UNIT=IUNIT, FMT=6003,IOSTAT=IRESP ) ZTC_T_G(ILINE),ZELEV_T_G(ILINE),&
+ ZFW_T_G(ILINE),ZM_T_G(ILINE),ZS11_CARRE_T_G(ILINE),ZS22_CARRE_T_G(ILINE),ZRE_S22S11_T_G(ILINE),&
+ ZIM_S22S11_T_G(ILINE),ZRE_S22FMS11FT_T_G(ILINE),ZIM_S22FT_T_G(ILINE),ZIM_S11FT_T_G(ILINE)
+ ILINE=ILINE+1
+ ENDDO
+ CALL IO_File_close(TZFILE)
+ TZFILE => NULL()
+ WRITE(ILUOUT0,*) "NLIGNE graupel",ILINE
+ ILINE=2
+ WRITE(ILUOUT0,*) "ILINE=",ILINE
+ WRITE(ILUOUT0,*) "ZTC_T_G(ILINE),ZELEV_T_G(ILINE)",&
+ ZTC_T_G(ILINE),ZELEV_T_G(ILINE)
+ WRITE(ILUOUT0,*) "ZM_T_G(ILINE),ZS11_CARRE_T_G(ILINE),ZS22_CARRE_T_G(ILINE),ZRE_S22S11_T_G(ILINE)",&
+ ZM_T_G(ILINE),ZS11_CARRE_T_G(ILINE),ZS22_CARRE_T_G(ILINE),ZRE_S22S11_T_G(ILINE)
+ WRITE(ILUOUT0,*) "ZIM_S22S11_T_G(ILINE),ZRE_S22FMS11FT_T_G(ILINE),ZIM_S22FT_T_G(ILINE),ZIM_S11FT_T_G(ILINE)",&
+ ZIM_S22S11_T_G(ILINE),ZRE_S22FMS11FT_T_G(ILINE),ZIM_S22FT_T_G(ILINE),ZIM_S11FT_T_G(ILINE)
+
+ !wet graupel
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(4),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
+ IUNIT = TZFILE%NLU
+ IF ( IRESP /= 0 ) THEN
+ WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(4))
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
+ ENDIF
+ ILINE=1
+ DO WHILE (ILINE .LE. INB_LINE(4))
+ READ( UNIT=IUNIT, FMT=6003,IOSTAT=IRESP ) ZTC_T_W(ILINE),ZELEV_T_W(ILINE),&
+ ZFW_T_W(ILINE),ZM_T_W(ILINE),ZS11_CARRE_T_W(ILINE),ZS22_CARRE_T_W(ILINE),ZRE_S22S11_T_W(ILINE),&
+ ZIM_S22S11_T_W(ILINE),ZRE_S22FMS11FT_T_W(ILINE),ZIM_S22FT_T_W(ILINE),ZIM_S11FT_T_W(ILINE)
+ ILINE=ILINE+1
+ ENDDO
+ CALL IO_File_close(TZFILE)
+ TZFILE => NULL()
+ WRITE(ILUOUT0,*) "NLIGNE wet graupel",ILINE
+ ILINE=2
+ WRITE(ILUOUT0,*) "ILINE=",ILINE
+ WRITE(ILUOUT0,*) "ZTC_T_W(ILINE),ZELEV_T_W(ILINE)", ZTC_T_W(ILINE),ZELEV_T_W(ILINE)
+ WRITE(ILUOUT0,*) "ZM_T_W(ILINE),ZS11_CARRE_T_W(ILINE),ZS22_CARRE_T_W(ILINE),ZRE_S22S11_T_W(ILINE)",&
+ ZM_T_W(ILINE),ZS11_CARRE_T_W(ILINE),ZS22_CARRE_T_W(ILINE),ZRE_S22S11_T_W(ILINE)
+ WRITE(ILUOUT0,*) "ZIM_S22S11_T_W(ILINE),ZRE_S22FMS11FT_T_W(ILINE),ZIM_S22FT_T_W(ILINE),ZIM_S11FT_T_W(ILINE)",&
+ ZIM_S22S11_T_W(ILINE),ZRE_S22FMS11FT_T_W(ILINE),ZIM_S22FT_T_W(ILINE),ZIM_S11FT_T_W(ILINE)
+
+ !hail
+ IF (GHAIL) THEN
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(5),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
+ IUNIT = TZFILE%NLU
+ IF ( IRESP /= 0 ) THEN
+ WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(5))
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
+ ENDIF
+ ILINE=1
+ DO WHILE (ILINE .LE. INB_LINE(5))
+ READ( UNIT=IUNIT, FMT=6003,IOSTAT=IRESP ) ZTC_T_H(ILINE),ZELEV_T_H(ILINE),&
+ ZFW_T_H(ILINE),ZM_T_H(ILINE),ZS11_CARRE_T_H(ILINE),ZS22_CARRE_T_H(ILINE),ZRE_S22S11_T_H(ILINE),&
+ ZIM_S22S11_T_H(ILINE),ZRE_S22FMS11FT_T_H(ILINE),ZIM_S22FT_T_H(ILINE),ZIM_S11FT_T_H(ILINE)
+ ILINE=ILINE+1
+ ENDDO
+ CALL IO_File_close(TZFILE)
+ TZFILE => NULL()
+ WRITE(ILUOUT0,*) "NLIGNE hail",ILINE
+ ILINE=2
+ WRITE(ILUOUT0,*) "ILINE=",ILINE
+ WRITE(ILUOUT0,*) "ZTC_T_H(ILINE),ZELEV_T_H(ILINE)", ZTC_T_H(ILINE),ZELEV_T_H(ILINE)
+ WRITE(ILUOUT0,*) "ZM_T_H(ILINE),ZS11_CARRE_T_H(ILINE),ZS22_CARRE_T_H(ILINE),ZRE_S22S11_T_H(ILINE)",&
+ ZM_T_W(ILINE),ZS11_CARRE_T_H(ILINE),ZS22_CARRE_T_H(ILINE),ZRE_S22S11_T_H(ILINE)
+ WRITE(ILUOUT0,*) "ZIM_S22S11_T_H(ILINE),ZRE_S22FMS11FT_T_H(ILINE),ZIM_S22FT_T_H(ILINE),ZIM_S11FT_T_H(ILINE)",&
+ ZIM_S22S11_T_H(ILINE),ZRE_S22FMS11FT_T_H(ILINE),ZIM_S22FT_T_H(ILINE),ZIM_S11FT_T_H(ILINE)
+ ENDIF
+ ENDIF !END IF T-MATRIX => END OF LOOKUP TABLE READING
+
+ !============== loop over elevations =================
+ IEL=NBELEV(JI)
+ WRITE(ILUOUT0,*) "NBELEV(JI)",NBELEV(JI)
+ WRITE(ILUOUT0,*) "INPTS_V",INPTS_V
+ DO JEL=1,IEL
+ WRITE(ILUOUT0,*) "JEL",JEL
+ JL=1
+ JV=1
+ WRITE(ILUOUT0,*) "JL,JV",JL,JV
+ WRITE(ILUOUT0,*) "PELEV(JI,JEL,JL,JV)*180./XPI",PELEV(JI,JEL,JL,JV)*180./XPI
+ JL=INBSTEPMAX
+ JV=INPTS_V
+ WRITE(ILUOUT0,*) "JL,JV",JL,JV
+ WRITE(ILUOUT0,*) "PELEV(JI,JEL,JL,JV)*180./XPI",PELEV(JI,JEL,JL,JV)*180./XPI
+ !============== loop over azimuths =================
+ DO JAZ=1,INBAZIM
+ DO JH=1,INPTS_H !horizontal discretization of the beam
+ DO JV=1,INPTS_V ! vertical discretization (we go down to check partial masks)
+ IF(LATT) THEN
+ ZAERINT=1.
+ ZAVRINT=1.
+ ZAEIINT=1.
+ ZAESINT=1.
+ ZAVSINT=1.
+ ZAEGINT=1.
+ ZAVGINT=1.
+ ZAEHINT=1.
+ ZAVHINT=1.
+ END IF
+ !Loop over the ranges for one azimuth. If the range is masked, the reflectivity for all the consecutive ranges is set to 0
+ LPART_MASK=.FALSE.
+ LOOPJL: DO JL=1,INBSTEPMAX
+ IF(LPART_MASK) THEN ! THIS RAY IS MASKED
+ ZREFL(JI,JEL,JAZ,JL:INBSTEPMAX,JH,JV,1)=0.
+ EXIT LOOPJL
+ ELSE
+ ! if not underground or outside of the MESO-NH domain (PT_RAY : temperature interpolated along the rays)
+ IF(PT_RAY(JI,JEL,JAZ,JL,JH,JV) /= -XUNDEF) THEN
+ !
+ !---------------------------------------------------------------------------------------------------
+ !* 2. RAINDROPS
+ ! ---------
+ !
+ IF(SIZE(PR_RAY,1) > 0) THEN ! if PR_RAY is available for at least one radar
+ !contenu en hydrometeore
+ ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PR_RAY(JI,JEL,JAZ,JL,JH,JV)
+ IF (GLIMA) ZCC=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PCR_RAY(JI,JEL,JAZ,JL,JH,JV)
+ !ZM_MIN : min value for rain content (10**-7 <=> Z=-26 dBZ)mixing ratio
+ IF (GLIMA) THEN
+ GCALC=((ZM > ZM_MIN).AND.(ZCC > 10**ZCC_MIN(1)))
+ ELSE
+ GCALC=(ZM > ZM_MIN)
+ ENDIF
+ IF(GCALC ) THEN
+ !calculation of the dielectrique constant (permittitivité relative)
+ ! for liquid water from function QEPSW
+ !(defined in mode_fscatter.f90 => equation 3.6 p 64)
+ YTYPE='r'
+ ZQMW=SQRT(QEPSW(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XLIGHTSPEED/XLAM_RAD(JI)))
+ !ZLBDA : slope distribution parameter (equation 2.6 p 23)
+ IF (GLIMA) THEN
+ ZLBDA=( ZLBR*ZCC / ZM )**ZLBEXR
+ ELSE
+ ZLBDA=ZLBR*(ZM)**ZLBEXR
+ ENDIF
+ ZQK=(ZQMW**2-1.)/(ZQMW**2+2.) !dielectric factor (3.43 p 56)
+ ZFW=0 !Liquid water fraction (only for melting graupel => 0 for rain)
+
+ !compteur=compteur+1
+ !---------------------------------------------------
+ ! ------------ DIFFUSION --------------
+ !---------------------------------------------------
+ !******************************* NDIFF=0 or 4 *********************************
+ IF(NDIFF==0.OR.NDIFF==4) THEN ! Rayleigh
+ !ZREFLOC(1:2) : Zh et Zv = int(sigma(D)*N(D)) (eq 1.6 p 16)
+ !with N(D) formulation (eq 2.2 p 23) and sigma Rayleigh (3.41 p 55)
+ !MOMG : gamma function defined in mong.f90
+ !XCCR = 1.E7; XLBEXR = -0.25! Marshall-Palmer law (radar_rain_ice.f90)
+ !ZCXR : -1 (Xi coeff in equation 2.3 p 23)
+ ZREFLOC(1:2)=1.E18*ZCCR*ZLBDA**(ZCXR-6.)*MOMG(ZALPHAR,ZNUR,6.)
+ IF(LWREFL) THEN ! weighting by reflectivities
+ !ZREFL(...,IVDOP)=radial velocity (IVDOP=9), weighted by reflectivity and
+ !taking into account raindrops fall velocity (ZCR = 842, XDR = 0.8 -> 2.8 p23 et 2.1 p24)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=-ZCR*SIN(PELEV(JI,JEL,JL,JV)) &
+ *1.E18*ZCCR*ZLBDA**(ZCXR-6.-ZDR)*MOMG(ZALPHAR,ZNUR,6.+ZDR)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZCCR*ZLBDA**ZCXR ! N0j of equation 2.3 p23 (density of particules)
+ !projection of fall velocity only
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=-ZCR*SIN(PELEV(JI,JEL,JL,JV)) &
+ *ZCCR*ZLBDA**(ZCXR-ZDR)*MOMG(ZALPHAR,ZNUR,ZDR)
+ END IF ! end weighting by reflectivities
+ IF(LATT) THEN ! Calculation of Extinction coefficient
+ IF(NDIFF==0) THEN ! Rayleigh 3rd order : calculation from equations
+ ! 3.39 p55 : extinction coeff = int(extinction_section(D) * N(D))
+ ! 2.2 and 2.3 p23: simplification of int(D**p * N(D)) and N0j
+ ! 3.42 p57 : extinction_section(D)
+ ZAETMP(:)=ZCCR*ZLBDA**ZCXR*(XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
+ *MOMG(ZALPHAR,ZNUR,ZBR)/ZLBDA**ZBR)
+ ELSE ! Rayleigh 6th order ! eq 3.52 p 58 for extinction coefficient
+ ZAETMP(:)=ZCCR*ZLBDA**ZCXR*(XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
+ *MOMG(ZALPHAR,ZNUR,ZBR)/ZLBDA**ZBR &
+ +XPI**4/15./XLAM_RAD(JI)**3*AIMAG(ZQK**2*(ZQMW**4+27.*ZQMW**2+38.) &
+ /(2.*ZQMW**2+3.))*MOMG(ZALPHAR,ZNUR,5.*ZBR/3.)/ZLBDA**(5.*ZBR/3.)&
+ +2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2) &
+ *MOMG(ZALPHAR,ZNUR,2.*ZBR) /ZLBDA**(2.*ZBR))
+ END IF
+ END IF ! end IF(LATT)
+ ZRE_S22S11_R=0
+ ZIM_S22S11_R=0
+ ZS22_CARRE_R=0
+ ZS11_CARRE_R=0
+ !******************************* NDIFF==7 ************************************
+ ELSE IF(NDIFF==7) THEN !T-matrix
+ ZREFLOC(:)=0
+ IF(LATT) ZAETMP(:)=0
+ IF (GLIMA) THEN
+ CALL CALC_KTMAT_LIMA(PELEV(JI,JEL,JL,JV),&
+ PT_RAY(JI,JEL,JAZ,JL,JH,JV),ZCC,ZM,&
+ ZELEV_MIN(1),ZELEV_MAX(1),ZELEV_STEP(1),&
+ ZTC_MIN(1),ZTC_MAX(1),ZTC_STEP(1),&
+ ZCC_MIN(1),ZCC_MAX(1),ZCC_STEP(1),&
+ ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
+ ITMAT,ZELEV_RED,ZTC_RED,ZCC_RED,ZM_RED)
+ ELSE
+ CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV),&
+ PT_RAY(JI,JEL,JAZ,JL,JH,JV),ZFW,ZM,&
+ ZELEV_MIN(1),ZELEV_MAX(1),ZELEV_STEP(1),&
+ ZTC_MIN(1),ZTC_MAX(1),ZTC_STEP(1),&
+ ZFW_MIN(1),ZFW_MAX(1),ZFW_STEP(1),&
+ ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
+ ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
+ ENDIF
+ IF (ITMAT(1) .NE. -NUNDEF) THEN
+ DO JIND=1,SIZE(KMAT_COEF,2),1
+ KMAT_COEF(1,JIND)=ZS11_CARRE_T_R(ITMAT(JIND))
+ KMAT_COEF(2,JIND)=ZS22_CARRE_T_R(ITMAT(JIND))
+ KMAT_COEF(3,JIND)=ZRE_S22S11_T_R(ITMAT(JIND))
+ KMAT_COEF(4,JIND)=ZIM_S22S11_T_R(ITMAT(JIND))
+ KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_R(ITMAT(JIND))
+ KMAT_COEF(6,JIND)=ZIM_S22FT_T_R(ITMAT(JIND))
+ KMAT_COEF(7,JIND)=ZIM_S11FT_T_R(ITMAT(JIND))
+ ENDDO
+ IF (GLIMA) THEN
+ CALL INTERPOL(ZELEV_RED,ZTC_RED,ZCC_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_R,ZS22_CARRE_R,&
+ ZRE_S22S11_R,ZIM_S22S11_R,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
+ ELSE
+ CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_R,ZS22_CARRE_R,&
+ ZRE_S22S11_R,ZIM_S22S11_R,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
+ ENDIF
+ ELSE
+ ZS11_CARRE_R=0
+ ZS22_CARRE_R=0
+ ZRE_S22S11_R=0
+ ZIM_S22S11_R=0
+ ZRE_S22FMS11F=0
+ ZIM_S22FT=0
+ ZIM_S11FT=0
+ END IF
+ ZREFLOC(1)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS22_CARRE_R
+ ZREFLOC(2)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS11_CARRE_R
+ ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F
+ IF (GLIMA) THEN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCR*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCC/4./ZLBDA**(2+ZDR)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCR*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCR/4./ZLBDA**(3+ZDR)
+ ENDIF
+ IF(LATT) THEN
+ ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2
+ ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2
+ END IF
+ !******************************* NDIFF=1 or 3 *********************************
+ ! Gauss Laguerre integration
+ ELSE ! MIE OR T-MATRIX OR RAYLEIGH FOR ELLIPSOIDES
+ ZREFLOC(:)=0.
+ IF(LATT) ZAETMP(:)=0.
+ DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
+ SELECT CASE(NDIFF)
+ CASE(1) ! *************** NDIFF=1 MIE *****************
+ ! subroutine BHMIE defined in mode_fscatter.f90
+ ! calculate extinction coefficient ZQEXT(1),scattering : ZQSCA
+ ! and backscattering ZQBACK(1) on the horizontal plan (spheroid)
+ CALL BHMIE(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA,ZQMW,ZQEXT(1),ZQSCA,ZQBACK(1))
+ ZQBACK(2)=ZQBACK(1) !=> same because sphere
+ ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
+ ZQBACK(3)=0. !=> 0 because sphere
+ CASE(3) !****************** NDIFF==3 RG RAYLEIGH FOR ELLIPSOIDES ***********************
+ IF(ARF(ZX(JJ)/ZLBDA)==1.) THEN
+ ZLB=1./3.
+ ELSE
+ ZLB=1./(ARF(ZX(JJ)/ZLBDA))**2-1. ! f**2
+ ZLB=(1.+ZLB)/ZLB*(1.-ATAN(SQRT(ZLB))/SQRT(ZLB)) ! lambda_b
+ IF(ZX(JJ)/ZLBDA>16.61E-3) PRINT*, 'Negative axis ratio; reduce NPTS_GAULAG.'
+ END IF
+ ! equation 3.44 p 56 (ZX**4 instead of ZX**6 but ZQBACK is multiplied after by ZX**2)
+ ZQBACK(1)=4.*(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA)**4&
+ *ABS((ZQMW**2-1.)/3./(1.+.5*(1.-ZLB)*(ZQMW**2-1.)))**2
+ ! equation 3.45 p 56
+ ZQBACK(2)=4.*(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA)**4*ABS((ZQMW**2-1.)/3.*&
+ (SIN(PELEV(JI,JEL,JL,JV))**2/(1.+.5*(1.-ZLB)*(ZQMW**2-1.))+& ! PELEV=PI+THETA_I
+ COS(PELEV(JI,JEL,JL,JV))**2/(1.+ZLB*(ZQMW**2-1.))) )**2 !
+ ! KDP from equation 3.49
+ ZQBACK(3)=ZX(JJ)/ZLBDA**3*REAL((ZQMW**2-1.)**2*(3.*ZLB-1.)/(2.+(ZQMW**2-1.)*(ZLB+1.) &
+ +ZLB*(1.-ZLB)*(ZQMW**2-1.)**2))
+ IF(LATT) THEN
+ ! equations 3.48 and 3.49 p57
+ ZQEXT(1)=4.*(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA)*AIMAG((ZQMW**2-1.)/3./(1.+.5*(1.-ZLB)*(ZQMW**2-1.)))
+ ZQEXT(2)=4.*(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA)*AIMAG((ZQMW**2-1.)/3.*&
+ (SIN(PELEV(JI,JEL,JL,JV))**2/(1.+.5*(1.-ZLB)*(ZQMW**2-1.))+& ! PELEV=PI+THETA_I
+ COS(PELEV(JI,JEL,JL,JV))**2/(1.+ZLB*(ZQMW**2-1.))))
+ END IF
+ END SELECT !end SELECT NDIFF
+ !incrementation of the reflectivity and Kdp(1,2,3,4 for Zh, Zv, )
+ !with the backscattering coefficients for each point of the GAULAG distribution
+ ! or each diameter D
+ ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**2*ZW(JJ)
+ ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(2+ZDR)*ZW(JJ)
+ !same for attenuation with extinction coefficient
+ IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**2*ZW(JJ)
+ END DO ! ****** end loop Gauss-Laguerre quadrature
+
+ ZREFLOC(1:2)=1.E18*ZREFLOC(1:2)*(XLAM_RAD(JI)/XPI)**4/.93*ZCCR/4./ZLBDA**3
+ ZREFLOC(3)=ZREFLOC(3)*XPI**2/6./XLAM_RAD(JI)*ZCCR/ZLBDA &
+ *180.E3/XPI ! (in deg/km)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCR*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCR/4./ZLBDA**(3+ZDR)
+
+ !********* for all cases with Gauss-Laguerre integration
+ ZRE_S22S11_R=0
+ ZIM_S22S11_R=0
+ ZS22_CARRE_R=0
+ ZS11_CARRE_R=0
+ IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZCCR*ZLBDA**(ZCXR-2.*ZBR/3.)/(4.*GAMMA(ZNUR))
+ END IF ! ****************** End if for each type of diffusion ************************
+ !incrementation of ZHH, ZDR and KDP
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
+ ! ZER (Z due to raindrops)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZER)=ZREFLOC(1)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDA)=ZREFLOC(2) !Zvv for ZDR due to rain
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IKDR)=ZREFLOC(3) !Zvv for ZDR due to rain
+
+ ! RhoHV due to rain
+ IF (ZS22_CARRE_R*ZS11_CARRE_R .GT. 0) THEN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHR)=SQRT(ZRE_S22S11_R**2+ZIM_S22S11_R**2)/SQRT(ZS22_CARRE_R*ZS11_CARRE_R)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHR)=1
+ END IF
+ IF(LATT) THEN
+ ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAETMP(:) ! specific attenuation due to rain
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAER)=ZAETMP(1)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVR)=ZAETMP(2)
+ ! for ranges over 1, correction of attenuation on reflectivity due to rain
+ IF(JL>1) THEN
+ ZAERINT=ZAERINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAER)*XSTEP_RAD)
+ ZAVRINT=ZAVRINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAVR)*XSTEP_RAD)
+ END IF
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZER)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZER)*ZAERINT ! Z_r attenuated
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDA)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDA)*ZAVRINT ! ZVr attenuated
+ END IF !end IF(LATT)
+ END IF
+ ! mimimum rainwater mixing ratio
+ ! Total attenuation even if no hydrometeors (equation 1.7 p 17)
+ IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATR)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATR) &
+ *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAER)*XSTEP_RAD)
+ END IF ! **************** end RAIN (end IF SIZE(PR_RAY,1) > 0)
+ !
+ !---------------------------------------------------------------------------------------------------
+ !* 3. PRISTINE ICE
+ ! ---------
+ !
+ IF (SIZE(PI_RAY,1)>0) THEN
+ ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PI_RAY(JI,JEL,JAZ,JL,JH,JV) !ice content
+ IF (PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)==-XUNDEF .OR. PI_RAY(JI,JEL,JAZ,JL,JH,JV)==-XUNDEF) ZM=-XUNDEF
+ IF (GLIMA) THEN
+ ZC=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PCIT_RAY(JI,JEL,JAZ,JL,JH,JV)
+ IF (PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)==-XUNDEF .OR. PCIT_RAY(JI,JEL,JAZ,JL,JH,JV)==-XUNDEF) ZC=-XUNDEF
+ ELSE
+ ZC=PCIT_RAY(JI,JEL,JAZ,JL,JH,JV)
+ ENDIF
+ IF(ZM>ZM_MIN .AND. ZC> 527.82) THEN
+ ! cit > 527.82 otherwise pbs due to interpolation
+ !ice dielectric constant (QPESI defined in mode_fscatter, equation 3.65 p 65)
+ ZEPSI=QEPSI(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XLIGHTSPEED/XLAM_RAD(JI))
+ ZQMI=SQRT(ZEPSI)
+ ZQK=(ZQMI**2-1.)/(ZQMI**2+2.)
+ !see 3.77 p68 : to replace Dg by an equivalent diameter De of pure ice, a multiplicative
+ !melting factor has to be added
+ ZDMELT_FACT=(6.*ZAI)/(XPI*.92*XRHOLW)
+ ZEXP=2.*ZBI !XBI = 2.5 (Plates) in ini_radar.f90 (bj tab 2.1 p24)
+ !ZLBDA : slope distribution parameter (equation 2.6 p 23)
+ IF (GLIMA) THEN
+ ZLBDA=(ZLBI*ZC/ZM)**ZLBEXI
+ ELSE
+ ZLBDA=ZLBI*(ZM/ZC)**ZLBEXI
+ ENDIF
+ ! Rayleigh or Rayleigh-Gans (=> Rayleigh) or Rayleigh with 6th order for attenuation
+ ! (pristine ice = sphere),
+ IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN
+ !ZREFLOC(1:2) : Zh et Zv from equation 2.2 p23 and Cristals parameters
+ !ZEQICE=0.224 (radar_rain_ice.f90) factor used to convert the ice crystals
+ !reflectivity into an equivalent liquid water reflectivity (from Smith, JCAM 84)
+ ZREFLOC(1:2)=ZEQICE*.92**2*ZDMELT_FACT**2*1.E18*ZC &
+ *ZLBDA**(ZCXI-ZEXP)*MOMG(ZALPHAI,ZNUI,ZEXP)
+ ZREFLOC(3)=0.
+ IF(LWREFL) THEN ! weighting by reflectivities
+ !calculation of radial velocity
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ -ZCI*SIN(PELEV(JI,JEL,JL,JV))*ZEQICE*.92**2*ZDMELT_FACT**2&
+ *1.E18*ZC*ZLBDA**(ZCXI-ZEXP-ZDI)&
+ *MOMG(ZALPHAI,ZNUI,ZEXP+ZDI)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)&
+ +ZC*ZLBDA**ZCXI
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ -ZCI*SIN(PELEV(JI,JEL,JL,JV))&
+ *ZC&
+ *ZLBDA**(ZCXI-ZDI)*MOMG(ZALPHAI,ZNUI,ZDI)
+ END IF
+ IF(LATT) THEN ! Calculation of Extinction coefficient
+ ! Rayleigh 3rd order
+ IF(NDIFF==0.OR.NDIFF==3) THEN
+ ZAETMP(:)=ZC*ZLBDA**ZCXI&
+ *(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
+ *MOMG(ZALPHAI,ZNUI,ZBI)/ZLBDA**ZBI)
+ ! Rayleigh 6th order
+ ELSE
+ ZAETMP(:)=ZC*ZLBDA**ZCXI*(&
+ ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
+ *MOMG(ZALPHAI,ZNUI,ZBI)/ZLBDA**ZBI&
+ +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3&
+ *AIMAG(ZQK**2*(ZQMI**4+27.*ZQMI**2+38.)&
+ /(2.*ZQMI**2+3.))*MOMG(ZALPHAI,ZNUI,5.*ZBI/3.)/ZLBDA**(5.*ZBI/3.) &
+ +ZDMELT_FACT**2*2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2)&
+ *MOMG(ZALPHAI,ZNUI,2.*ZBI)/ZLBDA**(2.*ZBI))
+ END IF
+ END IF
+ ELSE ! (if NDIFF=1 or NDIFF=7) => MIE (if choice=T-Matrix => Mie)
+ ZREFLOC(:)=0.
+ IF(LATT) ZAETMP(:)=0.
+ DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
+ ZD=ZX(JJ)**(1./ZALPHAI)/ZLBDA !equivaut au ZDELTA_EQUIV olivier
+ ZRHOI=6*ZAI*ZD**(ZBI-3.)/XPI !pristine ice density
+ ZNUM=1.+2.*ZRHOI*(ZEPSI-1.)/(ZRHOPI*(ZEPSI+2.))
+ ZDEN=1.-ZRHOI*(ZEPSI-1.)/(ZRHOPI*(ZEPSI+2.))
+ ZQM=sqrt(ZNUM/ZDEN)
+ CALL BHMIE(XPI/XLAM_RAD(JI)*ZD,ZQM,ZQEXT(1),ZQSCA,ZQBACK(1))
+ ZQBACK(2)=ZQBACK(1)
+ ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
+ ZQBACK(3)=0.
+ ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**(ZNUI-1.)*ZD**2*ZW(JJ)
+ ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUI-1.+ZDI/ZALPHAI)*ZD**2*ZW(JJ)
+ IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUI-1.)*ZD**2*ZW(JJ)
+ END DO ! **************** end loop Gauss-Laguerre quadrature
+
+ ZREFLOC(1:2)=ZREFLOC(1:2)*1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZC &
+ *ZLBDA**(ZCXI)/(4.*GAMMA(ZNUI))
+
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCI*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4*ZC &
+ *ZLBDA**(ZCXI-ZDI)/(4.*GAMMA(ZNUI)*.93)
+ IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZC*ZLBDA**(ZCXI)/(4.*GAMMA(ZNUI))
+ END IF !**************** end loop for each type of diffusion
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEI)=ZREFLOC(1) ! z_e due to pristine ice
+ IF(LATT) THEN
+ ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)+ZAETMP(:)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAEI)=ZAETMP(1)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVI)=ZAETMP(2)
+ IF(JL>1) ZAEIINT=ZAEIINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEI)*XSTEP_RAD)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEI)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEI)*ZAEIINT ! Z_i attenuated
+ END IF
+ END IF !********************* end IF (SIZE(PI_RAY,1)>0)
+
+ ! Total attenuation even if no hydrometeors
+ IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATI)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATI) &
+ *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEI)*XSTEP_RAD)
+ ZRE_S22S11_I=0
+ ZIM_S22S11_I=0
+ ZS22_CARRE_I=0
+ ZS11_CARRE_I=0
+ END IF !******************** end IF (SIZE(PI_RAY,1)>0)
+ !---------------------------------------------------------------------------------------------------
+ !* 4. SNOW
+ ! -----
+ IF (SIZE(PS_RAY,1)>0) THEN
+ ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PS_RAY(JI,JEL,JAZ,JL,JH,JV) !snow content
+ IF(ZM > ZM_MIN) THEN
+ YTYPE='s'
+ !ZQMI: same formulation than for ice because snow is simulated only
+ !above melting leyer (3.5.4 p 67)
+ ZFW=0
+ ZQMI=SQRT(QEPSI(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XLIGHTSPEED/XLAM_RAD(JI)))
+ ZQK=(ZQMI**2-1.)/(ZQMI**2+2.) !ajout de Clotilde 23/04/2012
+ ZDMELT_FACT=6.*ZAS/(XPI*.92*XRHOLW)
+ ZEXP=2.*ZBS !XBS = 1.9 in ini_radar.f90 (bj tab 2.1 p24)
+ !dans ini_rain_ice.f90 :
+ IF (GLIMA .AND. LSNOW_T_L) THEN
+ IF (PT_RAY(JI,JEL,JAZ,JL,JH,JV)>263.15) THEN
+ ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*PT_RAY(JI,JEL,JAZ,JL,JH,JV))),XLBDAS_MIN_L) &
+ *XTRANS_MP_GAMMAS_L
+ ELSE
+ ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*PT_RAY(JI,JEL,JAZ,JL,JH,JV))),XLBDAS_MIN_L) &
+ *XTRANS_MP_GAMMAS_L
+ END IF
+ ZN=ZNS*ZM*ZLBDA**ZBS
+ ELSE IF (.NOT.GLIMA .AND. LSNOW_T_I) THEN
+ IF (PT_RAY(JI,JEL,JAZ,JL,JH,JV)>263.15) THEN
+ ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*PT_RAY(JI,JEL,JAZ,JL,JH,JV))),XLBDAS_MIN_I) &
+ *XTRANS_MP_GAMMAS_I
+ ELSE
+ ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*PT_RAY(JI,JEL,JAZ,JL,JH,JV))),XLBDAS_MIN_I) &
+ *XTRANS_MP_GAMMAS_I
+ END IF
+ ZN=ZNS*ZM*ZLBDA**ZBS
+ ELSE
+ ZLBDA= ZLBS*(ZM)**ZLBEXS
+ ZN=ZCCS*ZLBDA**ZCXS
+ END IF
+ ! Rayleigh or Rayleigh-Gans or Rayleigh with 6th order for attenuation
+ IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN
+ ZREFLOC(1:2)=ZEQICE*.92**2*ZDMELT_FACT**2*1.E18*ZN*ZLBDA**(ZEXP)*MOMG(ZALPHAS,ZNUS,ZEXP)
+ ZREFLOC(3)=0.
+ IF(LWREFL) THEN ! weighting by reflectivities
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZEQICE*.92**2*ZDMELT_FACT**2&
+ *1.E18*ZN*ZLBDA**(ZEXP-ZDS)*MOMG(ZALPHAS,ZNUS,ZEXP+ZDS)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)+ZN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ -ZCS*SIN(PELEV(JI,JEL,JL,JV))&
+ *ZN*ZLBDA**(ZDS)*MOMG(ZALPHAS,ZNUS,ZDS)
+ END IF
+ IF(LATT) THEN
+ IF(NDIFF==0.OR.NDIFF==3) THEN
+ ZAETMP(:)=ZN*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
+ *MOMG(ZALPHAS,ZNUS,ZBS)/ZLBDA**ZBS)
+ ELSE
+ ZAETMP(:)=ZN*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
+ *MOMG(ZALPHAS,ZNUS,ZBS)/ZLBDA**ZBS &
+ +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3 &
+ *AIMAG(ZQK**2*(ZQMI**4+27.*ZQMI**2+38.) &
+ /(2.*ZQMI**2+3.))*MOMG(ZALPHAS,ZNUS,5.*ZBS/3.)/ZLBDA**(5.*ZBS/3.) &
+ +ZDMELT_FACT**2 *2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2) &
+ *MOMG(ZALPHAS,ZNUS,2.*ZBS)/ZLBDA**(2.*ZBS))
+ END IF
+ END IF
+ ZRE_S22S11_S=0
+ ZIM_S22S11_S=0
+ ZS22_CARRE_S=0
+ ZS11_CARRE_S=0
+ !******************************* NDIFF==7 ************************************
+ ELSE IF(NDIFF==7) THEN
+
+ ZREFLOC(:)=0
+ IF(LATT) ZAETMP(:)=0
+ CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV), PT_RAY(JI,JEL,JAZ,JL,JH,JV),&
+ ZFW,ZM,&
+ ZELEV_MIN(2),ZELEV_MAX(2),ZELEV_STEP(2),&
+ ZTC_MIN(2),ZTC_MAX(2),ZTC_STEP(2),&
+ ZFW_MIN(2),ZFW_MAX(2),ZFW_STEP(2),&
+ ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
+ ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
+
+ IF (ITMAT(1) .NE. -NUNDEF) THEN
+ DO JIND=1,SIZE(KMAT_COEF,2),1
+ KMAT_COEF(1,JIND)=ZS11_CARRE_T_S(ITMAT(JIND))
+ KMAT_COEF(2,JIND)=ZS22_CARRE_T_S(ITMAT(JIND))
+ KMAT_COEF(3,JIND)=ZRE_S22S11_T_S(ITMAT(JIND))
+ KMAT_COEF(4,JIND)=ZIM_S22S11_T_S(ITMAT(JIND))
+ KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_S(ITMAT(JIND))
+ KMAT_COEF(6,JIND)=ZIM_S22FT_T_S(ITMAT(JIND))
+ KMAT_COEF(7,JIND)=ZIM_S11FT_T_S(ITMAT(JIND))
+ ENDDO
+ CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_S,ZS22_CARRE_S,&
+ ZRE_S22S11_S,ZIM_S22S11_S,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
+ ELSE
+ ZS11_CARRE_S=0
+ ZS22_CARRE_S=0
+ ZRE_S22S11_S=0
+ ZIM_S22S11_S=0
+ ZRE_S22FMS11F=0
+ ZIM_S22FT=0
+ ZIM_S11FT=0
+ END IF
+ ZREFLOC(1)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS22_CARRE_S
+ ZREFLOC(2)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS11_CARRE_S
+ ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*(ZN*ZLBDA**(-ZCXS))/4./ZLBDA**(3+ZDS)
+ IF(LATT) THEN
+ ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2
+ ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2
+ END IF
+ ELSE ! MIE
+ ZREFLOC(:)=0.
+ IF(LATT) ZAETMP(:)=0.
+ DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
+ ZD=ZX(JJ)**(1./ZALPHAS)/ZLBDA
+ ZDE=ZDMELT_FACT**(1./3.)*ZD**(ZBS/3.)
+ CALL BHMIE(XPI/XLAM_RAD(JI)*ZDE,ZQMI,ZQEXT(1),ZQSCA,ZQBACK(1))
+ ZQBACK(2)=ZQBACK(1)
+ ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
+ ZQBACK(3)=0.
+ ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**(ZNUS-1.+2.*ZBS/3./ZALPHAS)*ZW(JJ)
+ ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUS-1.+2.*ZBS/3./ZALPHAS+ZDS/ZALPHAS)*ZW(JJ)
+ IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUS-1.+2.*ZBS/3./ZALPHAS)*ZW(JJ)
+ END DO ! ****** end loop Gauss-Laguerre quadrature
+ ZREFLOC(1:2)=1.E18*(XLAM_RAD(JI)/XPI)**4*ZN*ZLBDA**(-2.*ZBS/3.)/&
+ (4.*GAMMA(ZNUS)*.93)*ZDMELT_FACT**(2./3.)*ZREFLOC(1:2)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4*ZN &
+ *ZLBDA**(2.*ZBS/3.-ZDS)/ &
+ (4.*GAMMA(ZNUS)*.93)*ZDMELT_FACT**(2./3.)
+ IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZN*ZLBDA**(-2.*ZBS/3.)/(4.*GAMMA(ZNUS))&
+ *ZDMELT_FACT**(2./3.)
+ ZRE_S22S11_S=0
+ ZIM_S22S11_S=0
+ ZS22_CARRE_S=0
+ ZS11_CARRE_S=0
+ END IF !**************** end loop for each type of diffusion
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZES)=ZREFLOC(1) ! Z_e due to snow
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDS)=ZREFLOC(2) !Zvv for ZDR due to snow
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IKDS)=ZREFLOC(3) !Zvv for ZDR due to snow
+ IF (ZS22_CARRE_S*ZS11_CARRE_S .GT. 0) THEN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHS)=SQRT(ZRE_S22S11_S**2+ZIM_S22S11_S**2)/SQRT(ZS22_CARRE_S*ZS11_CARRE_S)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHS)=1
+ END IF
+ IF(LATT) THEN
+ ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)+ZAETMP(:)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAES)=ZAETMP(1)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVS)=ZAETMP(2)
+ IF(JL>1) THEN
+ ZAESINT=ZAESINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAES)*XSTEP_RAD)
+ ZAVSINT=ZAVSINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAVS)*XSTEP_RAD)
+ ENDIF
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZES)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZES)*ZAESINT ! Z_s attenuated
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDS)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDS)*ZAVSINT ! ZVs attenuated
+ END IF !end IF(LATT)
+ END IF !end IF(PS_RAY(JI,JEL,JAZ,JL,JH,JV) > ...)
+
+
+ ! Total attenuation even if no hydrometeors
+ IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATS)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATS) &
+ *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAES)*XSTEP_RAD)
+ END IF !END IF (SIZE(PS_RAY,1)>0)
+ !---------------------------------------------------------------------------------------------------
+ !* 5. GRAUPEL
+ ! -------
+ !
+ !ZDG=.5 ! from Bringi & Chandrasekar 2001, p. 433
+ IF (SIZE(PG_RAY,1)>0) THEN
+ ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PG_RAY(JI,JEL,JAZ,JL,JH,JV) !graupel content
+ IF(ZM > ZM_MIN) THEN
+ YTYPE='g'
+ ZQMI=SQRT(QEPSI(MIN(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XTT),XLIGHTSPEED/XLAM_RAD(JI)))
+ ZQMW=SQRT(QEPSW(MAX(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XTT),XLIGHTSPEED/XLAM_RAD(JI)))
+ !ini_radar.f90 : ZCXG = -0.5 XBG = 2.8 ( Xj et bj tab 2.1 p 24)
+ !ini_rain_ice.f90 : XLBEXG = 1.0/(XCXG-XBG) XAG = 19.6 (aj tab 2.1 p 24)
+ !XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG) )**(-XLBEXG) (eq 2.6 p 23)
+ IF (PR_RAY(JI,JEL,JAZ,JL,JH,JV) > ZRTMIN(3) ) THEN
+ ZFW=PR_RAY(JI,JEL,JAZ,JL,JH,JV)/(PR_RAY(JI,JEL,JAZ,JL,JH,JV)+PG_RAY(JI,JEL,JAZ,JL,JH,JV))
+ ELSE
+ ZFW=0.
+ END IF
+ ZLBDA=ZLBG*(PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PG_RAY(JI,JEL,JAZ,JL,JH,JV))**ZLBEXG
+ !XTT : température du point triple de l'eau (273.16 K <=> 0.1 °C)
+ IF(PT_RAY(JI,JEL,JAZ,JL,JH,JV) > XTT) THEN ! mixture of ice and water
+ ZFRAC_ICE = .85 !(see p 68)
+ ELSE ! only ice
+ ZFRAC_ICE=1.
+ END IF
+ ! from eq 3.77 p 68
+ !XRHOLW=1000 (initialized in ini_cst.f90)
+ ZDMELT_FACT=6.*ZAG/(XPI*XRHOLW*((1.-ZFRAC_ICE)+ZFRAC_ICE*0.92))
+ ZEXP=2.*ZBG
+ !Calculation of the refractive index from Bohren and Battan (3.72 p66)
+ ZQB=2.*ZQMW**2*(2.*ZQMI**2*LOG(ZQMI/ZQMW)/(ZQMI**2-ZQMW**2)-1.)/(ZQMI**2-ZQMW**2) !Beta (3.73 p66)
+ ZQM=SQRT(((1.-ZFRAC_ICE)*ZQMW**2+ZFRAC_ICE*ZQB*ZQMI**2)/(1.-ZFRAC_ICE+ZFRAC_ICE*ZQB)) ! Bohren & Battan (1982) 3.72 p66
+ ZQK=(ZQM**2-1.)/(ZQM**2+2.)
+ !Rayleigh, Rayleigh for ellipsoides or Rayleigh 6th order
+ IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN
+ ZREFLOC(1:2)=ABS(ZQK)**2/.93*ZDMELT_FACT**2*1.E18*ZCCG*ZLBDA**(ZCXG-ZEXP)*MOMG(ZALPHAG,ZNUG,ZEXP)
+ ZREFLOC(3)=0.
+ IF(LWREFL) THEN ! weighting by reflectivities
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ -ZCG*SIN(PELEV(JI,JEL,JL,JV))*ABS(ZQK)**2/.93*ZDMELT_FACT**2&
+ *1.E18*ZCCG*ZLBDA**(ZCXG-ZEXP-ZDG)*MOMG(ZALPHAG,ZNUG,ZEXP+ZDG)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)+ZCCG*ZLBDA**ZCXG
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ -ZCG*SIN(PELEV(JI,JEL,JL,JV))&
+ *ZCCG*ZLBDA**(ZCXG-ZDG)*MOMG(ZALPHAG,ZNUG,ZDG)
+ END IF !end IF(LWREFL)
+ IF(LATT) THEN
+ IF(NDIFF==0.OR.NDIFF==3) THEN
+ ZAETMP(:)=ZCCG*ZLBDA**ZCXG*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
+ *MOMG(ZALPHAG,ZNUG,ZBG)/ZLBDA**ZBG)
+ ELSE
+ ZAETMP(:)=ZCCG*ZLBDA**ZCXG*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
+ *MOMG(ZALPHAG,ZNUG,ZBG)/ZLBDA**ZBG&
+ +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3 &
+ *AIMAG(ZQK**2*(ZQM**4+27.*ZQM**2+38.) &
+ /(2.*ZQM**2+3.))*MOMG(ZALPHAG,ZNUG,5.*ZBG/3.)/ZLBDA**(5.*ZBG/3.)&
+ +ZDMELT_FACT**2 *2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2) &
+ *MOMG(ZALPHAG,ZNUG,2.*ZBG) /ZLBDA**(2.*ZBG))
+ END IF ! end IF(NDIFF==0.OR.NDIFF==3)
+ END IF ! end IF(LATT)
+ ZRE_S22S11_G=0
+ ZIM_S22S11_G=0
+ ZS22_CARRE_G=0
+ ZS11_CARRE_G=0
+ !******************************* NDIFF==7 TmatInt ************************************
+ ELSE IF(NDIFF==7) THEN
+ ZREFLOC(:)=0
+ IF(LATT) ZAETMP(:)=0
+ IF (ZFW < 0.01) THEN !******** DRY GRAUPEL
+ CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV), PT_RAY(JI,JEL,JAZ,JL,JH,JV),&
+ ZFW,ZM,&
+ ZELEV_MIN(3),ZELEV_MAX(3),ZELEV_STEP(3),&
+ ZTC_MIN(3),ZTC_MAX(3),ZTC_STEP(3),&
+ ZFW_MIN(3),ZFW_MAX(3),ZFW_STEP(3),&
+ ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
+ ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
+ IF (ITMAT(1) .NE. -NUNDEF) THEN
+ DO JIND=1,SIZE(KMAT_COEF,2),1
+ KMAT_COEF(1,JIND)=ZS11_CARRE_T_G(ITMAT(JIND))
+ KMAT_COEF(2,JIND)=ZS22_CARRE_T_G(ITMAT(JIND))
+ KMAT_COEF(3,JIND)=ZRE_S22S11_T_G(ITMAT(JIND))
+ KMAT_COEF(4,JIND)=ZIM_S22S11_T_G(ITMAT(JIND))
+ KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_G(ITMAT(JIND))
+ KMAT_COEF(6,JIND)=ZIM_S22FT_T_G(ITMAT(JIND))
+ KMAT_COEF(7,JIND)=ZIM_S11FT_T_G(ITMAT(JIND))
+ ENDDO
+ CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_G,ZS22_CARRE_G,&
+ ZRE_S22S11_G,ZIM_S22S11_G,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
+ ELSE
+ ZS11_CARRE_G=0
+ ZS22_CARRE_G=0
+ ZRE_S22S11_G=0
+ ZIM_S22S11_G=0
+ ZRE_S22FMS11F=0
+ ZIM_S22FT=0
+ ZIM_S11FT=0
+ END IF
+ ELSE !ZFW >= 0.01 ************** WET GRAUPEL
+ CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV),PT_RAY(JI,JEL,JAZ,JL,JH,JV),&
+ ZFW,ZM,&
+ ZELEV_MIN(4),ZELEV_MAX(4),ZELEV_STEP(4),&
+ ZTC_MIN(4),ZTC_MAX(4),ZTC_STEP(4),&
+ ZFW_MIN(4),ZFW_MAX(4),ZFW_STEP(4),&
+ ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
+ ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
+ IF (ITMAT(1) .NE. -NUNDEF) THEN
+ DO JIND=1,SIZE(KMAT_COEF,2),1
+ KMAT_COEF(1,JIND)=ZS11_CARRE_T_W(ITMAT(JIND))
+ KMAT_COEF(2,JIND)=ZS22_CARRE_T_W(ITMAT(JIND))
+ KMAT_COEF(3,JIND)=ZRE_S22S11_T_W(ITMAT(JIND))
+ KMAT_COEF(4,JIND)=ZIM_S22S11_T_W(ITMAT(JIND))
+ KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_W(ITMAT(JIND))
+ KMAT_COEF(6,JIND)=ZIM_S22FT_T_W(ITMAT(JIND))
+ KMAT_COEF(7,JIND)=ZIM_S11FT_T_W(ITMAT(JIND))
+ ENDDO
+ CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_G,ZS22_CARRE_G,&
+ ZRE_S22S11_G,ZIM_S22S11_G,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
+ ELSE
+ ZS11_CARRE_G=0
+ ZS22_CARRE_G=0
+ ZRE_S22S11_G=0
+ ZIM_S22S11_G=0
+ ZRE_S22FMS11F=0
+ ZIM_S22FT=0
+ ZIM_S11FT=0
+ END IF
+ END IF!END IF (ZFW<0.01)
+ ZREFLOC(1)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS22_CARRE_G
+ ZREFLOC(2)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS11_CARRE_G
+ ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCG*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCG/4./ZLBDA**(3+ZDG)
+ IF(LATT) THEN
+ ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2
+ ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2
+ END IF
+ ELSE ! Mie (NDIFF=1)
+ ZREFLOC(:)=0.
+ IF(LATT) ZAETMP(:)=0.
+ DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
+ ZD=ZX(JJ)**(1./ZALPHAG)/ZLBDA
+ ZDE=ZDMELT_FACT**(1./3.)*ZD**(ZBG/3.)
+ CALL BHMIE(XPI/XLAM_RAD(JI)*ZDE,ZQM,ZQEXT(1),ZQSCA,ZQBACK(1))
+ ZQBACK(2)=ZQBACK(1)
+ ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
+ ZQBACK(3)=0.
+ ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**(ZNUG-1.+2.*ZBG/3./ZALPHAG)*ZW(JJ)
+ ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUG-1.+2.*ZBG/3./ZALPHAG+ZDG/ZALPHAG)*ZW(JJ)
+ IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUG-1.+2.*ZBG/3./ZALPHAG)*ZW(JJ)
+ END DO ! ****** end loop on diameter (Gauss-Laguerre)
+ ZREFLOC(1:2)=ZREFLOC(1:2)*1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCG &
+ *ZLBDA**(ZCXG-2.*ZBG/3.)/(4.*GAMMA(ZNUG)*.93)*ZDMELT_FACT**(2./3.)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP) &
+ +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCG*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCG &
+ *ZLBDA**(ZCXG-2.*ZBG/3.-ZDG)/(4.*GAMMA(ZNUG)*.93)*ZDMELT_FACT**(2./3.)
+ IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZCCG*ZLBDA**(ZCXG-2.*ZBG/3.)/(4.*GAMMA(ZNUG)) &
+ *ZDMELT_FACT**(2./3.)
+ ZRE_S22S11_G=0
+ ZIM_S22S11_G=0
+ ZS22_CARRE_G=0
+ ZS11_CARRE_G=0 !0 in case of Mie
+ END IF !**************** end loop for each type of diffusion : IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEG)=ZREFLOC(1) ! z_e due to graupel
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDG)=ZREFLOC(2) !Zvv for ZDR due to graupel
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IKDG)=ZREFLOC(3) !Zvv for ZDR due to graupel
+
+ IF (ZS22_CARRE_G*ZS11_CARRE_G .GT. 0) THEN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHG)=SQRT(ZRE_S22S11_G**2+ZIM_S22S11_G**2)/SQRT(ZS22_CARRE_G*ZS11_CARRE_G)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHG)=1
+ END IF
+ IF(LATT) THEN
+ ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)+ZAETMP(:)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAEG)=ZAETMP(1)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVG)=ZAETMP(2)
+ IF(JL>1) THEN
+ ZAEGINT=ZAEGINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEG)*XSTEP_RAD)
+ ZAVGINT=ZAVGINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAVG)*XSTEP_RAD)
+ END IF
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEG)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEG)*ZAEGINT ! Z_g attenuated
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDG)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDG)*ZAVGINT ! Z_g attenuated
+ END IF !end IF(LATT)
+ END IF !**************** IF(PG_RAY(JI,JEL,JAZ,JL,JH,JV) > XRTMIN(6))
+
+ ! Total attenuation even if no hydrometeors
+ IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATG)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATG) &
+ *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEG)*XSTEP_RAD)
+
+ END IF ! **************** end GRAUPEL (end IF SIZE(PG_RAY,1) > 0)
+ !-----------------------------------------------------------------------------------------------
+ !-----------------------------------------------------------------------------------------------
+!**********************************
+!**********************************
+!**********************************
+!**********************************
+
+
+!---------------------------------------------------------------------------------------------------
+ !* 6. HAIL
+ ! -------
+ !
+ !
+ IF (GHAIL) THEN
+ ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PH_RAY(JI,JEL,JAZ,JL,JH,JV) !graupel content
+ IF(ZM > ZM_MIN) THEN
+ YTYPE='h'
+ ZQMI=SQRT(QEPSI(MIN(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XTT),XLIGHTSPEED/XLAM_RAD(JI)))
+ ZQMW=SQRT(QEPSW(MAX(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XTT),XLIGHTSPEED/XLAM_RAD(JI)))
+ !ini_radar.f90 : ZCXG = -0.5 XBG = 2.8 ( Xj et bj tab 2.1 p 24)
+ !ini_rain_ice.f90 : XLBEXG = 1.0/(XCXG-XBG) XAG = 19.6 (aj tab 2.1 p 24)
+ !XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG) )**(-XLBEXG) (eq 2.6 p 23)
+ZFW=0 !????????
+ ZLBDA=ZLBH*(PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PH_RAY(JI,JEL,JAZ,JL,JH,JV))**ZLBEXH
+ !XTT : température du point triple de l'eau (273.16 K <=> 0.1 °C)
+ IF(PT_RAY(JI,JEL,JAZ,JL,JH,JV) > XTT) THEN ! mixture of ice and water
+ ZFRAC_ICE = .85 !(see p 68)
+ ELSE ! only ice
+ ZFRAC_ICE=1.
+ END IF
+ ! from eq 3.77 p 68
+ !XRHOLW=1000 (initialized in ini_cst.f90)
+ ZDMELT_FACT=6.*ZAG/(XPI*XRHOLW*((1.-ZFRAC_ICE)+ZFRAC_ICE*0.92))
+ ZEXP=2.*ZBH
+ !Calculation of the refractive index from Bohren and Battan (3.72 p66)
+ ZQB=2.*ZQMW**2*(2.*ZQMI**2*LOG(ZQMI/ZQMW)/(ZQMI**2-ZQMW**2)-1.)/(ZQMI**2-ZQMW**2) !Beta (3.73 p66)
+ ZQM=SQRT(((1.-ZFRAC_ICE)*ZQMW**2+ZFRAC_ICE*ZQB*ZQMI**2)/(1.-ZFRAC_ICE+ZFRAC_ICE*ZQB)) ! Bohren & Battan (1982) 3.72 p66
+ ZQK=(ZQM**2-1.)/(ZQM**2+2.)
+ !Rayleigh, Rayleigh for ellipsoides or Rayleigh 6th order
+ IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN
+ ZREFLOC(1:2)=ABS(ZQK)**2/.93*ZDMELT_FACT**2*1.E18*ZCCH*ZLBDA**(ZCXH-ZEXP)*MOMG(ZALPHAH,ZNUH,ZEXP)
+ ZREFLOC(3)=0.
+ IF(LWREFL) THEN ! weighting by reflectivities
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ -ZCH*SIN(PELEV(JI,JEL,JL,JV))*ABS(ZQK)**2/.93*ZDMELT_FACT**2&
+ *1.E18*ZCCH*ZLBDA**(ZCXH-ZEXP-ZDH)*MOMG(ZALPHAH,ZNUH,ZEXP+ZDH)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)+ZCCH*ZLBDA**ZCXH
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ -ZCH*SIN(PELEV(JI,JEL,JL,JV))&
+ *ZCCH*ZLBDA**(ZCXH-ZDH)*MOMG(ZALPHAH,ZNUH,ZDH)
+ END IF !end IF(LWREFL)
+ IF(LATT) THEN
+ IF(NDIFF==0.OR.NDIFF==3) THEN
+ ZAETMP(:)=ZCCH*ZLBDA**ZCXH*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
+ *MOMG(ZALPHAH,ZNUH,ZBH)/ZLBDA**ZBH)
+ ELSE
+ ZAETMP(:)=ZCCH*ZLBDA**ZCXH*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
+ *MOMG(ZALPHAH,ZNUH,ZBH)/ZLBDA**ZBH&
+ +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3 &
+ *AIMAG(ZQK**2*(ZQM**4+27.*ZQM**2+38.) &
+ /(2.*ZQM**2+3.))*MOMG(ZALPHAH,ZNUH,5.*ZBH/3.)/ZLBDA**(5.*ZBH/3.)&
+ +ZDMELT_FACT**2 *2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2) &
+ *MOMG(ZALPHAH,ZNUH,2.*ZBH) /ZLBDA**(2.*ZBH))
+ END IF ! end IF(NDIFF==0.OR.NDIFF==3)
+ END IF ! end IF(LATT)
+ ZRE_S22S11_H=0
+ ZIM_S22S11_H=0
+ ZS22_CARRE_H=0
+ ZS11_CARRE_H=0
+ !******************************* NDIFF==7 TmatInt ************************************
+ ELSE IF(NDIFF==7) THEN
+ ZREFLOC(:)=0
+ IF(LATT) ZAETMP(:)=0
+ CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV), PT_RAY(JI,JEL,JAZ,JL,JH,JV),&
+ ZFW,ZM,&
+ ZELEV_MIN(3),ZELEV_MAX(3),ZELEV_STEP(3),&
+ ZTC_MIN(3),ZTC_MAX(3),ZTC_STEP(3),&
+ ZFW_MIN(3),ZFW_MAX(3),ZFW_STEP(3),&
+ ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
+ ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
+ IF (ITMAT(1) .NE. -NUNDEF) THEN
+ DO JIND=1,SIZE(KMAT_COEF,2),1
+ KMAT_COEF(1,JIND)=ZS11_CARRE_T_H(ITMAT(JIND))
+ KMAT_COEF(2,JIND)=ZS22_CARRE_T_H(ITMAT(JIND))
+ KMAT_COEF(3,JIND)=ZRE_S22S11_T_H(ITMAT(JIND))
+ KMAT_COEF(4,JIND)=ZIM_S22S11_T_H(ITMAT(JIND))
+ KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_H(ITMAT(JIND))
+ KMAT_COEF(6,JIND)=ZIM_S22FT_T_H(ITMAT(JIND))
+ KMAT_COEF(7,JIND)=ZIM_S11FT_T_H(ITMAT(JIND))
+ ENDDO
+ CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_H,ZS22_CARRE_H,&
+ ZRE_S22S11_H,ZIM_S22S11_H,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
+ ELSE
+ ZS11_CARRE_H=0
+ ZS22_CARRE_H=0
+ ZRE_S22S11_H=0
+ ZIM_S22S11_H=0
+ ZRE_S22FMS11F=0
+ ZIM_S22FT=0
+ ZIM_S11FT=0
+ END IF
+ ZREFLOC(1)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS22_CARRE_H
+ ZREFLOC(2)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS11_CARRE_H
+ ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCH*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCH/4./ZLBDA**(3+ZDH)
+ IF(LATT) THEN
+ ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2
+ ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2
+ END IF
+ ELSE ! Mie (NDIFF=1)
+ ZREFLOC(:)=0.
+ IF(LATT) ZAETMP(:)=0.
+ DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
+ ZD=ZX(JJ)**(1./ZALPHAH)/ZLBDA
+ ZDE=ZDMELT_FACT**(1./3.)*ZD**(ZBH/3.)
+ CALL BHMIE(XPI/XLAM_RAD(JI)*ZDE,ZQM,ZQEXT(1),ZQSCA,ZQBACK(1))
+ ZQBACK(2)=ZQBACK(1)
+ ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
+ ZQBACK(3)=0.
+ ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**(ZNUH-1.+2.*ZBH/3./ZALPHAH)*ZW(JJ)
+ ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUH-1.+2.*ZBH/3./ZALPHAH+ZDH/ZALPHAH)*ZW(JJ)
+ IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUH-1.+2.*ZBH/3./ZALPHAH)*ZW(JJ)
+ END DO ! ****** end loop on diameter (Gauss-Laguerre)
+ ZREFLOC(1:2)=ZREFLOC(1:2)*1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCH &
+ *ZLBDA**(ZCXH-2.*ZBH/3.)/(4.*GAMMA(ZNUH)*.93)*ZDMELT_FACT**(2./3.)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP) &
+ +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
+ -ZCH*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
+ *1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCH &
+ *ZLBDA**(ZCXH-2.*ZBH/3.-ZDH)/(4.*GAMMA(ZNUH)*.93)*ZDMELT_FACT**(2./3.)
+ IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZCCH*ZLBDA**(ZCXH-2.*ZBH/3.)/(4.*GAMMA(ZNUH)) &
+ *ZDMELT_FACT**(2./3.)
+ ZRE_S22S11_H=0
+ ZIM_S22S11_H=0
+ ZS22_CARRE_H=0
+ ZS11_CARRE_H=0 !0 in case of Mie
+ END IF !**************** end loop for each type of diffusion : IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEH)=ZREFLOC(1) ! z_e due to graupel
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDH)=ZREFLOC(2) !Zvv for ZDR due to graupel
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IKDH)=ZREFLOC(3) !Zvv for ZDR due to graupel
+
+ IF (ZS22_CARRE_H*ZS11_CARRE_H .GT. 0) THEN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHH)=SQRT(ZRE_S22S11_H**2+ZIM_S22S11_H**2)/SQRT(ZS22_CARRE_H*ZS11_CARRE_H)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHH)=1
+ END IF
+ IF(LATT) THEN
+ ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)+ZAETMP(:)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAEH)=ZAETMP(1)
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVH)=ZAETMP(2)
+ IF(JL>1) THEN
+ ZAEHINT=ZAEHINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEH)*XSTEP_RAD)
+ ZAVHINT=ZAVHINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAVH)*XSTEP_RAD)
+ END IF
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEH)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEH)*ZAEHINT ! Z_g attenuated
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDH)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDH)*ZAVHINT ! Z_g attenuated
+ END IF !end IF(LATT)
+ END IF !**************** IF(PH_RAY(JI,JEL,JAZ,JL,JH,JV) > XRTMIN(6))
+
+ ! Total attenuation even if no hydrometeors
+ IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATH)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATH) &
+ *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEH)*XSTEP_RAD)
+
+ END IF ! **************** end HAIL (end IF SIZE(PH_RAY,1) > 0)
+ !-----------------------------------------------------------------------------------------------
+ !-----------------------------------------------------------------------------------------------
+!**********************************
+!**********************************
+!**********************************
+!**********************************
+
+ IF(LWREFL) THEN ! weighting by reflectivities
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFL(JI,JEL,JAZ,JL,JH,JV,1)
+ ELSE IF(LWBSCS) THEN ! weighting by hydrometeor concentrations
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
+ +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)
+ ELSE IF(ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)/=0.) THEN ! no weighting
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)/ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)&
+ +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)
+ END IF
+ !Calculation of Phidp (ZREFL(JI,JEL,JAZ,JL,JH,JV,IPDP) is initialized to 0 before the loop
+ IF (JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IPDP)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IPDP)+ &
+ 2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,3)*XSTEP_RAD*1D-3
+
+ !Calculation of RhoHV and DeltaHV
+ ZRE_S22S11_T=ZRE_S22S11_R+ZRE_S22S11_I+ZRE_S22S11_S+ZRE_S22S11_G+ZRE_S22S11_H
+ ZIM_S22S11_T=ZIM_S22S11_R+ZIM_S22S11_I+ZIM_S22S11_S+ZIM_S22S11_G+ZIM_S22S11_H
+ ZS22_CARRE_T=ZS22_CARRE_R+ZS22_CARRE_I+ZS22_CARRE_S+ZS22_CARRE_G+ZS22_CARRE_H
+ ZS11_CARRE_T=ZS11_CARRE_R+ZS11_CARRE_I+ZS11_CARRE_S+ZS11_CARRE_G+ZS11_CARRE_H
+ !RhoHV
+ IF ((ZS22_CARRE_T*ZS11_CARRE_T)>0.) THEN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHV)=SQRT(ZRE_S22S11_T**2+ZIM_S22S11_T**2)/SQRT(ZS22_CARRE_T*ZS11_CARRE_T)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHV)=-XUNDEF
+ END IF
+ !DeltaHV
+ IF (ZRE_S22S11_T/=0) THEN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IDHV)=180/XPI*ATAN(ZIM_S22S11_T/ZRE_S22S11_T)
+ ELSE
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IDHV)=0
+ END IF
+ ELSE !if temperature is not defined
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,1:2)=XVALGROUND
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=XVALGROUND
+ LPART_MASK=.TRUE.
+ END IF !end condition : IF(PT_RAY(JI,JEL,JAZ,JL,JH,JV) /= -XUNDEF) => if temperature is defined
+ END IF !end condition : IF(LPART_MASK) => if pixel is not masked
+ END DO LOOPJL
+ END DO !JV
+ END DO !JH
+ END DO !JAZ
+ END DO !JEL
+ !
+ IF (NDIFF == 7 ) THEN
+ !lookup tables for rain
+ DEALLOCATE (ZTC_T_R,ZELEV_T_R,ZM_T_R,ZS11_CARRE_T_R,ZS22_CARRE_T_R,&
+ ZRE_S22S11_T_R,ZIM_S22S11_T_R,ZRE_S22FMS11FT_T_R,ZIM_S22FT_T_R,ZIM_S11FT_T_R)
+ !lookup tables for snow
+ DEALLOCATE (ZTC_T_S,ZELEV_T_S,ZM_T_S,ZS11_CARRE_T_S,ZS22_CARRE_T_S,&
+ ZRE_S22S11_T_S,ZIM_S22S11_T_S,ZRE_S22FMS11FT_T_S,ZIM_S22FT_T_S,ZIM_S11FT_T_S)
+ !lookup tables for graupel
+ DEALLOCATE (ZTC_T_G,ZELEV_T_G,ZM_T_G,ZS11_CARRE_T_G,ZS22_CARRE_T_G,&
+ ZRE_S22S11_T_G,ZIM_S22S11_T_G,ZRE_S22FMS11FT_T_G,ZIM_S22FT_T_G,ZIM_S11FT_T_G)
+ !lookup tables for wet graupel
+ DEALLOCATE (ZTC_T_W,ZELEV_T_W,ZM_T_W,ZS11_CARRE_T_W,ZS22_CARRE_T_W,&
+ ZRE_S22S11_T_W,ZIM_S22S11_T_W,ZRE_S22FMS11FT_T_W,ZIM_S22FT_T_W,ZIM_S11FT_T_W)
+ IF (GHAIL) THEN
+ !lookup tables for hail
+ DEALLOCATE (ZTC_T_H,ZELEV_T_H,ZM_T_H,ZS11_CARRE_T_H,ZS22_CARRE_T_H,&
+ ZRE_S22S11_T_H,ZIM_S22S11_T_H,ZRE_S22FMS11FT_T_H,ZIM_S22FT_T_H,ZIM_S11FT_T_H)
+ ENDIF
+ ENDIF
+END DO !JI
+!
+! attenuation in dB/km
+IF(LATT) ZREFL(:,:,:,:,:,:,IAER:IAEH)=4343.*2.*ZREFL(:,:,:,:,:,:,IAER:IAEH) ! horizontal specific attenuation
+IF(LATT) ZREFL(:,:,:,:,:,:,IAVR:IAVH)=4343.*2.*ZREFL(:,:,:,:,:,:,IAVR:IAVH) ! vertical specific attenuation
+! convective/stratiform
+ZREFL(:,:,:,:,:,:,4)=PBU_MASK_RAY(:,:,:,:,:,:) ! CSR
+! /convective/stratiform
+
+WRITE(ILUOUT0,*) 'NB ZREFL MIN MAX :', MINVAL(ZREFL(:,:,:,:,:,:,:)),MAXVAL(ZREFL(:,:,:,:,:,:,:))
+WRITE(ILUOUT0,*) 'NB ZREFL VALGROUND :', COUNT(ZREFL(:,:,:,:,:,:,:) ==XVALGROUND)
+WRITE(ILUOUT0,*) 'NB ZREFL -XUNDEF :', COUNT(ZREFL(:,:,:,:,:,:,:) ==-XUNDEF)
+WRITE(ILUOUT0,*) 'NB ZREFL > 0 :', COUNT(ZREFL(:,:,:,:,:,:,:)>0.)
+WRITE(ILUOUT0,*) 'NB ZREFL = 0 :', COUNT(ZREFL(:,:,:,:,:,:,:)==0.)
+WRITE(ILUOUT0,*) 'NB ZREFL < 0 :', COUNT(ZREFL(:,:,:,:,:,:,:) < 0.)-COUNT( ZREFL(:,:,:,:,:,:,:)==XVALGROUND)
+!---------------------------------------------------------------------------------------------------
+!* 6. FINAL STEP : TOTAL ATTENUATION AND EQUIVALENT REFLECTIVITY FACTOR
+! ---------------------------------------------------------------
+!
+ALLOCATE(ZVTEMP(IMAX))
+DO JI=1,INBRAD
+ IEL=NBELEV(JI)
+ DO JEL=1,IEL
+ DO JAZ=1,INBAZIM
+ IF (LATT) ZAETOT(:,:,1:2)=1.
+ PZE(JI,JEL,JAZ,1,IPDP)=0
+ DO JL=1,INBSTEPMAX
+ ! if no undef point in gate JL and at least one point where T is defined
+ IF(COUNT(ZREFL(JI,JEL,JAZ,JL,:,:,1)==-XUNDEF)==0.AND. &
+ COUNT(ZREFL(JI,JEL,JAZ,JL,:,:,1)==XVALGROUND)==0.AND. &
+ COUNT(PT_RAY(JI,JEL,JAZ,JL,:,:)/=-XUNDEF)/=0) THEN
+ DO JH=1,INPTS_H
+ ZVTEMP(:)=0.
+ DO JV=1,INPTS_V ! Loop on Jv
+ !if range is over 1, attenuation is added
+ IF (JL > 1) THEN
+ IF(LATT) THEN ! we use ZALPHAE0=alpha_0 from last gate
+ !Total attenuation
+ ZAETOT(JH,JV,1:2)=ZAETOT(JH,JV,1:2)*EXP(-2.*ZAELOC(JI,JEL,JAZ,JL-1,JH,JV,:)*XSTEP_RAD)
+ !Zhh, Zvv
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,1:2)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:2)*ZAETOT(JH,JV,1:2)!attenuated reflectivity
+ !Z for Radial velocity
+ IF(LWREFL) ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)*ZAETOT(JH,JV,1)
+ END IF !end IF(LATT)
+ END IF !end IF (JL > 1)
+ IF(.NOT.(LWREFL.AND.LWBSCS)) THEN
+ ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)
+ END IF
+ ! Quadrature on vertical reflectivities +VDOP
+ IF(LQUAD) THEN
+ ZVTEMP(:)=ZVTEMP(:)+ZREFL(JI,JEL,JAZ,JL,JH,JV,:)*PW_V(ABS((2*JV-INPTS_V-1)/2)+1) &
+ *EXP(-2.*LOG(2.)*PX_V(ABS((2*JV-INPTS_V-1)/2)+1)**2)
+ ELSE
+ ZVTEMP(:)=ZVTEMP(:)+ZREFL(JI,JEL,JAZ,JL,JH,JV,:)*PW_V(ABS((2*JV-INPTS_V-1)/2)+1)
+ END IF
+ END DO ! End loop on JV
+!
+ IF(LQUAD) THEN
+ PZE(JI,JEL,JAZ,JL,:)=PZE(JI,JEL,JAZ,JL,:)+ZVTEMP(1:SIZE(PZE,5))*PW_H(ABS((2*JH-INPTS_H-1)/2)+1) &
+ *EXP(-2.*LOG(2.)*PX_H(ABS((2*JH-INPTS_H-1)/2)+1)**2)
+ IF(LWBSCS) ZCONC_BIN(JI,JEL,JAZ,JL)=ZCONC_BIN(JI,JEL,JAZ,JL)+ZVTEMP(IMAX)* &
+ PW_H(ABS((2*JH-INPTS_H-1)/2)+1)*EXP(-2.*LOG(2.)*PX_H(ABS((2*JH-INPTS_H-1)/2)+1)**2)
+ ELSE
+ PZE(JI,JEL,JAZ,JL,:)=PZE(JI,JEL,JAZ,JL,:)+ZVTEMP(1:SIZE(PZE,5))*PW_H(ABS((2*JH-INPTS_H-1)/2)+1)
+ IF(LWBSCS) ZCONC_BIN(JI,JEL,JAZ,JL)=ZCONC_BIN(JI,JEL,JAZ,JL)+ZVTEMP(IMAX)* &
+ PW_H(ABS((2*JH-INPTS_H-1)/2)+1)
+ END IF !end IF(LQUAD)
+ END DO ! End loop on JH
+
+ IF(LQUAD) THEN
+ PZE(JI,JEL,JAZ,JL,:)=PZE(JI,JEL,JAZ,JL,:)*2.*LOG(2.)/XPI
+ IF(LWBSCS) ZCONC_BIN(JI,JEL,JAZ,JL)=ZCONC_BIN(JI,JEL,JAZ,JL)*2.*LOG(2.)/XPI
+ ELSE
+ PZE(JI,JEL,JAZ,JL,:)=PZE(JI,JEL,JAZ,JL,:)/XPI
+ IF(LWBSCS) ZCONC_BIN(JI,JEL,JAZ,JL)=ZCONC_BIN(JI,JEL,JAZ,JL)/XPI
+ END IF !end IF(LQUAD)
+!
+ !**** Thresholding: with ZSNR, or with XREFLVDOPMIN and XREFLMIN
+ ZSNR=-XUNDEF
+ ZSNR_R=-XUNDEF
+ ZSNR_I=-XUNDEF
+ ZSNR_S=-XUNDEF
+ ZSNR_G=-XUNDEF
+ ZSNR_H=-XUNDEF
+ ZZHH=PZE(JI,JEL,JAZ,JL,1)
+ ZZE_R=PZE(JI,JEL,JAZ,JL,IZER)
+ ZZE_I=PZE(JI,JEL,JAZ,JL,IZEI)
+ ZZE_S=PZE(JI,JEL,JAZ,JL,IZES)
+ ZZE_G=PZE(JI,JEL,JAZ,JL,IZEG)
+ IF (GHAIL) ZZE_H=PZE(JI,JEL,JAZ,JL,IZEH)
+ ZDISTRAD=JL*XSTEP_RAD !radar distance in meters
+ IF (LSNRT) THEN
+ IF (ZZHH/=XVALGROUND .AND. ZZHH/=-XUNDEF.AND.ZZHH/=0) THEN
+ ZSNR=10*LOG10(ZZHH)-20*LOG10(ZDISTRAD/(100*10**3))
+ END IF
+ IF (ZZE_R/=XVALGROUND .AND. ZZE_R/=-XUNDEF.AND.ZZE_R/=0) THEN
+ ZSNR_R=10*LOG10(ZZE_R)-20*LOG10(ZDISTRAD/(100*10**3))
+ END IF
+ IF (ZZE_I/=XVALGROUND .AND. ZZE_I/=-XUNDEF.AND.ZZE_I/=0) THEN
+ ZSNR_I=10*LOG10(ZZE_I)-20*LOG10(ZDISTRAD/(100*10**3))
+ END IF
+ IF (ZZE_S/=XVALGROUND .AND. ZZE_S/=-XUNDEF.AND.ZZE_S/=0) THEN
+ ZSNR_S=10*LOG10(ZZE_S)-20*LOG10(ZDISTRAD/(100*10**3))
+ END IF
+ IF (ZZE_G/=XVALGROUND .AND. ZZE_G/=-XUNDEF.AND.ZZE_G/=0) THEN
+ ZSNR_G=10*LOG10(ZZE_G)-20*LOG10(ZDISTRAD/(100*10**3))
+ END IF
+ IF (GHAIL) THEN
+ IF (ZZE_H/=XVALGROUND .AND. ZZE_H/=-XUNDEF.AND.ZZE_H/=0) THEN
+ ZSNR_H=10*LOG10(ZZE_H)-20*LOG10(ZDISTRAD/(100*10**3))
+ END IF
+ END IF
+ GTHRESHOLD_V=(ZSNR>=XSNRMIN)
+ GTHRESHOLD_Z=GTHRESHOLD_V
+ GTHRESHOLD_ZR=(ZSNR_R>=XSNRMIN)
+ GTHRESHOLD_ZI=(ZSNR_I>=XSNRMIN)
+ GTHRESHOLD_ZS=(ZSNR_S>=XSNRMIN)
+ GTHRESHOLD_ZG=(ZSNR_G>=XSNRMIN)
+ IF (GHAIL) GTHRESHOLD_ZH=(ZSNR_H>=XSNRMIN)
+ ELSE
+ GTHRESHOLD_V=(ZZHH>=10**(XREFLVDOPMIN/10.))
+ GTHRESHOLD_Z=(ZZHH>=10**(XREFLMIN/10.))
+ GTHRESHOLD_ZR=(ZZE_R>=10**(XREFLMIN/10.))
+ GTHRESHOLD_ZI=(ZZE_I>=10**(XREFLMIN/10.))
+ GTHRESHOLD_ZS=(ZZE_S>=10**(XREFLMIN/10.))
+ GTHRESHOLD_ZG=(ZZE_G>=10**(XREFLMIN/10.))
+ IF (GHAIL) GTHRESHOLD_ZH=(ZZE_H>=10**(XREFLMIN/10.))
+ END IF
+ !--- Doppler velocities
+ IF(GTHRESHOLD_V) THEN
+ IF(LWREFL) THEN
+ !change Clotilde 27/04/2012 to avoid division by zero and floating point exception
+ IF (PZE(JI,JEL,JAZ,JL,1)/=0) THEN
+ PZE(JI,JEL,JAZ,JL,IVDOP)=PZE(JI,JEL,JAZ,JL,IVDOP)/PZE(JI,JEL,JAZ,JL,1)
+ END IF
+ ELSE IF(LWBSCS) THEN
+ IF(ZCONC_BIN(JI,JEL,JAZ,JL)>0.) THEN
+ PZE(JI,JEL,JAZ,JL,IVDOP)=PZE(JI,JEL,JAZ,JL,IVDOP)/ZCONC_BIN(JI,JEL,JAZ,JL)
+ ELSE
+ PZE(JI,JEL,JAZ,JL,IVDOP)=-XUNDEF
+ END IF !end IF(ZCONC_BIN(JI,JEL,JAZ,JL)>0.)
+ END IF !end IF(LWREFL)
+ ELSE
+ PZE(JI,JEL,JAZ,JL,IVDOP)=-XUNDEF
+ END IF !end IF(GTHRESHOLD_V)
+
+ !--- Zhh, Zvv et variables globales
+ IF(GTHRESHOLD_Z .EQV. .FALSE.) THEN
+ PZE(JI,JEL,JAZ,JL,1:4)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IRHV:IDHV)=-XUNDEF
+ END IF
+ !--- ZER, ZDA, KDR, RHR
+ IF(GTHRESHOLD_ZR .EQV. .FALSE.) THEN
+ PZE(JI,JEL,JAZ,JL,IZER)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IZDA)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IKDR)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IRHR)=-XUNDEF
+ END IF
+ !--- ZES, ZDS, KDS, RHS
+ IF(GTHRESHOLD_ZS .EQV. .FALSE.) THEN
+ PZE(JI,JEL,JAZ,JL,IZES)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IZDS)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IKDS)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IRHS)=-XUNDEF
+ END IF
+
+ !--- ZEG, ZDG, KDG, RHG
+ IF(GTHRESHOLD_ZG .EQV. .FALSE.) THEN
+ PZE(JI,JEL,JAZ,JL,IZEG)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IZDG)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IKDG)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IRHG)=-XUNDEF
+ END IF
+ !--- ZEH, ZDH, KDH, RHH
+ IF (GHAIL) THEN
+ IF(GTHRESHOLD_ZH .EQV. .FALSE.) THEN
+ PZE(JI,JEL,JAZ,JL,IZEH)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IZDH)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IKDH)=-XUNDEF
+ PZE(JI,JEL,JAZ,JL,IRHH)=-XUNDEF
+ END IF
+ END IF
+ !--- ZEI
+ IF(GTHRESHOLD_ZI .EQV. .FALSE.) THEN
+ PZE(JI,JEL,JAZ,JL,IZEI)=-XUNDEF
+ END IF
+ ELSE
+ ! ground clutter or outside Meso-NH domain
+ !(IF T not defined or if one undef point at least in gate)
+ PZE(JI,JEL,JAZ,JL,:)=XVALGROUND
+ END IF
+ IF(PZE(JI,JEL,JAZ,JL,1) < 0. .AND. PZE(JI,JEL,JAZ,JL,1)/=-XUNDEF) THEN ! flag bin when underground => xvalground si < 0?
+ PZE(JI,JEL,JAZ,JL,:)=XVALGROUND
+ END IF ! end IF(PZE(JI,JEL,JAZ,JL,1) < 0.)
+ END DO ! end DO JL=1,INBSTEPMAX
+ END DO !end DO JAZ=1,INBAZIM
+ END DO !end DO JEL=1,IEL
+END DO !end DO JI=1,INBRAD
+DEALLOCATE(ZREFL,ZVTEMP,ZRTMIN)
+WRITE(ILUOUT0,*) '*****************FIN RADAR_SCATTERING ***********************'
+WRITE(ILUOUT0,*) 'NB PZE MIN MAX :', MINVAL(PZE(:,:,:,:,IZEI)),MAXVAL(PZE(:,:,:,:,IZEI))
+WRITE(ILUOUT0,*) 'NB PZE VALGROUND :', COUNT(PZE(:,:,:,:,IZEI) ==XVALGROUND)
+WRITE(ILUOUT0,*) 'NB PZE -XUNDEF :', COUNT(PZE(:,:,:,:,IZEI) ==-XUNDEF)
+WRITE(ILUOUT0,*) 'NB PZE > 0 :', COUNT(PZE(:,:,:,:,IZEI)>0.)
+WRITE(ILUOUT0,*) 'NB PZE = 0 :', COUNT(PZE(:,:,:,:,IZEI)==0.)
+WRITE(ILUOUT0,*) 'NB PZE < 0 :', COUNT(PZE(:,:,:,:,IZEI) < 0.)-COUNT(PZE(:,:,:,:,IZEI) ==XVALGROUND)
+IF(NDIFF/=0) DEALLOCATE(ZX,ZW)
+IF (LATT) DEALLOCATE(ZAELOC,ZAETOT)
+WRITE(ILUOUT0,*) 'END OF RADAR SCATTERING'
+END SUBROUTINE RADAR_SCATTERING
+
diff --git a/src/PHYEX/ext/radiations.f90 b/src/PHYEX/ext/radiations.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f4db08bfc04972b30b309785a0a7e1a05b2bcd1c
--- /dev/null
+++ b/src/PHYEX/ext/radiations.f90
@@ -0,0 +1,3504 @@
+!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_RADIATIONS
+! ########################
+!
+CONTAINS
+!
+! ############################################################################
+ SUBROUTINE RADIATIONS (TPFILE,OCLEAR_SKY,OCLOUD_ONLY, &
+ KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW, &
+ PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB_OLD, &
+ KSWB_MNH,KLWB_MNH, KSTATM,KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL, &
+ PDIR_ALB, PSCA_ALB,PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM, &
+ PTHT, PRT, PPABST, POZON, PAER, PDST_WL, PAER_CLIM, PSVT, &
+ PDTHRAD, PSRFLWD, PSRFSWD_DIR,PSRFSWD_DIF, PRHODREF, PZZ, &
+ PRADEFF, PSWU, PSWD, PLWU,PLWD, PDTHRADSW, PDTHRADLW )
+! ############################################################################
+!
+!!**** *RADIATIONS * - routine to call the SW and LW radiation calculations
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to prepare the temperature, water vapor
+!! liquid water, cloud fraction, ozone profiles for the ECMWF radiation
+!! calculations. There is a great number of available radiative fluxes in
+!! the output, but only the potential temperature radiative tendency and the
+!! SW and LW surface fluxes are provided in the output of the routine.
+!! Two simplified computations are available (switches OCLEAR_SKY and
+!! OCLOUD_ONLY). When OCLOUD_ONLY is .TRUE. the computations are performed
+!! for the cloudy columns only. Furthermore with OCLEAR_SKY being .TRUE.
+!! the clear sky columns are averaged and the computations are made for
+!! the cloudy columns plus a single ensemble-mean clear sky column.
+!!
+!!** METHOD
+!! ------
+!! First the temperature, water vapor, liquid water, cloud fraction
+!! and profile arrays are built using the current model fields and
+!! the standard atmosphere for the upper layer filling.
+!! The standard atmosphere is used between the levels IKUP and
+!! KFLEV where KFLEV is the number of vertical levels for the radiation
+!! computations.
+!! The aerosols optical thickness and the ozone fields come directly
+!! from ini_radiation step (climatlogies used) and are already defined for KFLEV.
+!! Surface parameter ( albedo, emiss ) are also defined from current surface fields.
+!! In the case of clear-sky or cloud-only approximations, the cloudy
+!! columns are selected by testing the vertically integrated cloud fraction
+!! and the radiation computations are performed for these columns plus the
+!! mean clear-sky one. In addition, columns where cloud have disapeared are determined
+!! by saving cloud trace between radiation step and they are also recalculated
+!! in cloud only step. In all case, the sun position correponds to the centered
+!! time between 2 full radiation steps (determined in physparam).
+!! Then the ECMWF radiation package is called and the radiative
+!! heating/cooling tendancies are reformatted in case of partial
+!! computations. In case of "cloud-only approximation" the only cloudy
+!! column radiative fields are updated.
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine ECMWF_RADIATION_VERS2 : ECMWF interface calling radiation routines
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : constants
+!! XP00 : reference pressure
+!! XCPD : calorific capacity of dry air at constant pressure
+!! XRD : gas constant for dry air
+!! Module MODD_PARAMETERS : parameters
+!! JPHEXT : Extra columns on the horizontal boundaries
+!! JPVEXT : Extra levels on the vertical boundaries
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine RADIATIONS )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/02/95
+!! J.Stein 20/12/95 add the array splitting in order to save memory
+!! J.-P. Pinty 19/11/96 change the split arrays, specific humidity
+!! and add the ice phase
+!! J.Stein 22/06/97 use of the absolute pressure
+!! P.Jabouille 31/07/97 impose a zero humidity for dry simulation
+!! V.Masson 22/09/97 case of clear-sky approx. with no clear-sky column
+!! V.Masson 07/11/97 half level pressure defined from averaged Exner
+!! function
+!! V.Masson 07/11/97 modification of junction between standard atm
+!! and model for half level variables (top model
+!! pressure and temperatures are used preferentially
+!! to atm standard profile for the first point).
+!! P.Jabouille 24/08/98 impose positivity for ZQLAVE
+!! J.-P. Pinty 29/01/98 add storage for diagnostics
+!! J. Stein 18/07/99 add the ORAD_DIAG switch and keep inside the
+!! subroutine the partial tendencies
+!!
+!! F.Solmon 04/03/01 MAJOR MODIFICATIONS, updated version of ECMWF radiation scheme
+!! P.Jabouille 05/05/03 bug in humidity conversion
+!! Y.Seity 25/08/03 KSWB=6 for SW direct and scattered surface
+!! downward fluxes used in surface scheme.
+!! P. Tulet 01/20/05 climatologic SSA
+!! A. Grini 05/20/05 dust direct effect (optical properties)
+!! V.Masson, C.Lac 08/10 Correction of inversion of Diffuse and direct albedo
+!! B.Aouizerats 2010 Explicit aerosol optical properties
+!! C.Lac 11/2015 Correction on aerosols
+!! B.Vie /13 LIMA
+!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
+!! J.Escobar 29/06/2017 : Check if Pressure Decreasing with height <-> elsif PB & STOP
+!! Q.LIBOIS 06/2017 : correction on CLOUD_ONLY
+!! Q.Libois 02/2018 : ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar 28/06/2018 : Reproductible parallelisation of CLOUD_ONLY case
+!! J.Escobar 20/07/2018 : for real*4 compilation, convert with REAL(X) argument to SUM_DD...
+!! P.Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 06/09/2022: small fix: GSURF_CLOUD was not set outside of physical domain
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY: JPRB
+USE OYOESW , ONLY : RTAUA ,RPIZA ,RCGA
+!
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_CONF, ONLY: LCARTESIAN
+USE MODD_CST
+USE MODD_DUST, ONLY: LDUST
+use modd_field, only: tfieldmetadata, TYPEREAL
+USE MODD_GRID , ONLY: XLAT0, XLON0
+USE MODD_GRID_n , ONLY: XLAT, XLON
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV, ONLY: NSV_C2R2,NSV_C2R2BEG,NSV_C2R2END, &
+ NSV_C1R3,NSV_C1R3BEG,NSV_C1R3END, &
+ NSV_DSTBEG, NSV_DSTEND, &
+ NSV_AERBEG, NSV_AEREND, &
+ NSV_SLTBEG, NSV_SLTEND, &
+ NSV_LIMA,NSV_LIMA_BEG,NSV_LIMA_END, &
+ NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
+USE MODD_PARAM_RAD_n, ONLY: CAOP
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TIME
+!
+USE MODE_DUSTOPT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
+use mode_msg
+USE MODE_REPRO_SUM, ONLY : SUM_DD_R2_R1_ll,SUM_DD_R1_ll
+!
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+USE MODE_SALTOPT
+USE MODE_SUM_ll, ONLY: MIN_ll
+USE MODE_SUM2_ll, ONLY: GMINLOC_ll
+USE MODE_THERMO
+!
+USE MODI_AEROOPT_GET
+USE MODI_ECMWF_RADIATION_VERS2
+USE MODI_ECRAD_INTERFACE
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+LOGICAL, INTENT(IN) :: OCLOUD_ONLY! flag for the cloud column
+ ! computations only
+LOGICAL, INTENT(IN) :: OCLEAR_SKY !
+INTEGER, INTENT(IN) :: KDLON ! number of columns where the
+ ! radiation calculations are
+ ! performed
+INTEGER, INTENT(IN) :: KFLEV ! number of vertical levels
+ ! where the radiation
+ ! calculations are performed
+INTEGER, INTENT(IN) :: KRAD_DIAG ! index for the number of
+ ! fields in the output
+INTEGER, INTENT(IN) :: KFLUX ! number of top and ground
+ ! fluxes for the ZFLUX array
+INTEGER, INTENT(IN) :: KRAD ! number of satellite radiances
+ ! for the ZRAD and ZRADCS arrays
+INTEGER, INTENT(IN) :: KAER ! number of AERosol classes
+
+INTEGER, INTENT(IN) :: KSWB_OLD ! number of SW band ECMWF
+INTEGER, INTENT(IN) :: KSWB_MNH ! number of SW band ECRAD
+INTEGER, INTENT(IN) :: KLWB_MNH ! number of LW band ECRAD
+INTEGER, INTENT(IN) :: KSTATM ! index of the standard
+ ! atmosphere level just above
+ ! the model top
+INTEGER, INTENT(IN) :: KRAD_COLNBR ! factor by which the memory
+ ! is split
+ !
+ !Choice of :
+CHARACTER (LEN=*), INTENT (IN) :: HEFRADL !
+CHARACTER (LEN=*), INTENT (IN) :: HEFRADI !
+CHARACTER (LEN=*), INTENT (IN) :: HOPWSW !cloud water SW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPISW !ice water SW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPWLW !cloud water LW optical properties
+CHARACTER (LEN=*), INTENT (IN) :: HOPILW !ice water LW optical properties
+REAL, INTENT(IN) :: PFUDG ! subgrid cloud inhomogenity factor
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSZEN ! COS(zenithal solar angle)
+REAL, INTENT(IN) :: PCORSOL ! SOLar constant CORrection
+REAL, DIMENSION(:,:), INTENT(IN) :: PSEA ! Land-sea mask
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIR_ALB! Surface direct ALBedo
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSCA_ALB! Surface diffuse ALBedo
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMIS ! Surface IR EMISsivity
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! CLouD FRaction
+REAL, INTENT(IN) :: PCCO2 ! CO2 content
+REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD ! RADiative Surface Temperature
+REAL, DIMENSION(:,:), INTENT(IN) :: PSTATM ! selected standard atmosphere
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! THeta at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! moist variables at t (humidity, cloud water, rain water, ice water)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! pressure at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! scalar variable ( C2R2 and C1R3 particle)
+!
+REAL, DIMENSION(:,:,:), POINTER :: POZON ! OZONE field from clim.
+REAL, DIMENSION(:,:,:,:), POINTER :: PAER ! AERosols optical thickness from clim.
+REAL, DIMENSION(:,:,:,:), POINTER :: PDST_WL ! AERosols Extinction by wavelength .
+REAL, DIMENSION(:,:,:,:), POINTER :: PAER_CLIM ! AERosols optical thickness from clim.
+ ! note : the vertical dimension of
+ ! these fields include the "radiation levels"
+ ! above domain top
+ !
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ![kg/m3] air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ![m] height of layers
+
+INTEGER, DIMENSION(:,:), INTENT(INOUT) :: KCLEARCOL_TM1 ! trace of cloud/clear col
+ ! at the previous radiation step
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRAD ! THeta RADiative Tendancy
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSRFLWD ! Downward SuRFace LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRFSWD_DIR ! Downward SuRFace SW Flux DIRect
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRFSWD_DIF ! Downward SuRFace SW Flux DIFfuse
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSWU ! upward SW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSWD ! downward SW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLWU ! upward LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLWD ! downward LW Flux
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRADSW ! dthrad sw
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRADLW ! dthradsw
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRADEFF ! effective radius
+!
+!
+!* 0.2 DECLARATIONS OF LOCAL VARIABLES
+!
+LOGICAL :: GNOCL ! .TRUE. when no cloud is present
+ ! with OCLEAR_SKY .TRUE.
+LOGICAL :: GAOP ! .TRUE. when CAOP='EXPL'
+LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLOUD ! .TRUE. for the cloudy columns
+LOGICAL, DIMENSION(KFLEV,KDLON) :: GCLOUDT ! transpose of the GCLOUD array
+LOGICAL, DIMENSION(KDLON) :: GCLEAR_2D ! .TRUE. for the clear-sky columns
+LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLEAR ! .TRUE. for all the levels of the
+ ! clear-sky columns
+LOGICAL, DIMENSION(KDLON,KSWB_MNH) :: GCLEAR_SWB! .TRUE. for all the bands of the
+ ! clear-sky columns
+INTEGER, DIMENSION(:), ALLOCATABLE :: ICLEAR_2D_TM1 !
+!
+INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JALBS! loop indices
+!
+INTEGER :: IIB ! I index value of the first inner mass point
+INTEGER :: IJB ! J index value of the first inner mass point
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IIE ! I index value of the last inner mass point
+INTEGER :: IJE ! J index value of the last inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: IKU ! array size for the third index
+INTEGER :: IIJ ! reformatted array index
+INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
+INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
+ ! are filled in
+!
+INTEGER :: ICLEAR_COL ! number of clear-sky columns
+INTEGER :: ICLOUD_COL ! number of cloudy columns
+INTEGER :: ICLOUD ! number of levels corresponding of the cloudy columns
+INTEGER :: IDIM ! effective number of columns for which the radiation
+ ! code is run
+INTEGER :: INIR ! index corresponding to NIR fisrt band (in SW)
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE ! mean-layer temperature
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZTAVE_RAD ! mean-layer temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPAVE ! mean-layer pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPAVE_RAD ! mean-layer pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQSAVE ! saturation specific humidity
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQVAVE ! mean-layer specific humidity
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLAVE ! Liquid water KG/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRAVE ! Rain water KG/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIAVE ! Ice water Kg/KG
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLWC ! liquid water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRWC ! Rain water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIWC ! ice water content kg/m3
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCFAVE ! mean-layer cloud fraction
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZO3AVE ! mean-layer ozone content
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL ! half-level pressure
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZT_HL ! half-level temperature
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! layer pressure thickness
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_C2R2! Cloud water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_C2R2! Rain water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_C1R3! Ice water Concentarion (C2R2)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_LIMA! Cloud water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_LIMA! Rain water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_LIMA! Ice water Concentration(LIMA)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZAER ! aerosol optical thickness
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP ! spectral surface albedo for direct radiations
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBD ! spectral surface albedo for diffuse radiations
+REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZEMIS ! surface LW emissivity
+REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZEMIW ! surface LW WINDOW emissivity
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZTS ! reformatted surface PTSRAD array
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLSM ! reformatted land sea mask
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZRMU0 ! Reformatted ZMU0 array
+REAL(KIND=JPRB) :: ZRII0 ! corrected solar constant
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW ! LW temperature tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW ! SW temperature tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS ! CLEAR-SKY LW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW ! TOTAL LW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS ! CLEAR-SKY SW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW ! TOTAL SW NET FLUXES
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR ! Top and
+ ! Ground radiative FLUXes
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN ! DowNward SW Flux profiles
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP ! UPward SW Flux profiles
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW ! LW Flux profiles
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_CS ! LW Clear-Sky temp. tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_CS ! SW Clear-Sky temp. tendency
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS ! Top and
+ ! Ground Clear-Sky radiative FLUXes
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIR !surface SW direct flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIF !surface SW diffuse flux
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_VIS, ZPLAN_ALB_NIR
+ ! PLANetary ALBedo in VISible, Near-InfraRed regions
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_VIS, ZPLAN_TRA_NIR
+ ! PLANetary TRANsmission in VISible, Near-InfraRed regions
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_VIS, ZPLAN_ABS_NIR
+ ! PLANetary ABSorption in VISible, Near-InfraRed regions
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWD, ZEFCL_LWU
+ ! EFective DOWNward and UPward LW nebulosity (equivalent emissivities)
+ ! undefined if RRTM is used for LW
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLWP, ZFIWP
+ ! Liquid and Ice Water Path
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADLP, ZRADIP
+ ! Cloud liquid water and ice effective radius
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_RRTM, ZCLSW_TOTAL
+ ! effective LW nebulosity ( RRTM case)
+ ! and SW CLoud fraction for mixed phase clouds
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL, ZOMEGA_TOTAL, ZCG_TOTAL
+ ! effective optical thickness, single scattering albedo
+ ! and asymetry factor for mixed phase clouds
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS
+ ! Clear-Sky DowNward and UPward SW Flux profiles
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS
+ ! Thicknes of the mesh
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDZ
+!
+REAL, DIMENSION(KDLON,KFLEV) :: ZZDTSW ! SW diabatic heating
+REAL, DIMENSION(KDLON,KFLEV) :: ZZDTLW ! LW diabatic heating
+REAL, DIMENSION(KDLON) :: ZZTGVIS! SW surface flux in the VIS band
+REAL, DIMENSION(KDLON) :: ZZTGNIR! SW surface flux in the NIR band
+REAL, DIMENSION(KDLON) :: ZZTGIR ! LW surface flux in the IR bands
+REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIR
+! ! SW direct surface flux
+REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIF
+! ! SW diffuse surface flux
+!
+REAL, DIMENSION(KDLON) :: ZCLOUD ! vertically summed cloud fraction
+!
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZEXNT ! Exner function
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZLWD ! surface Downward LW flux
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIR ! surface
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIF ! surface Downward SW diffuse flux
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZPIZAZ ! Aerosols SSA
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZTAUAZ ! Aerosols Optical Detph
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZCGAZ ! Aerosols Asymetric factor
+REAL :: ZZTGVISC ! downward surface SW flux (VIS band) for clear_sky
+REAL :: ZZTGNIRC ! downward surface SW flux (NIR band) for clear_sky
+REAL :: ZZTGIRC ! downward surface LW flux for clear_sky
+REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIRC
+! ! downward surface SW direct flux for clear sky
+REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIFC
+! ! downward surface SW diffuse flux for clear sky
+REAL, DIMENSION(KFLEV) :: ZT_CLEAR ! ensemble mean clear-sky temperature
+REAL, DIMENSION(KFLEV) :: ZP_CLEAR ! ensemble mean clear-sky temperature
+REAL, DIMENSION(KFLEV) :: ZQV_CLEAR ! ensemble mean clear-sky specific humidity
+REAL, DIMENSION(KFLEV) :: ZOZ_CLEAR ! ensemble mean clear-sky ozone
+REAL, DIMENSION(KFLEV) :: ZHP_CLEAR ! ensemble mean clear-sky half-lev. pression
+REAL, DIMENSION(KFLEV) :: ZHT_CLEAR ! ensemble mean clear-sky half-lev. temp.
+REAL, DIMENSION(KFLEV) :: ZDP_CLEAR ! ensemble mean clear-sky pressure thickness
+REAL, DIMENSION(KFLEV,KAER) :: ZAER_CLEAR ! ensemble mean clear-sky aerosols optical thickness
+REAL, DIMENSION(KSWB_MNH) :: ZALBP_CLEAR ! ensemble mean clear-sky surface albedo (parallel)
+REAL, DIMENSION(KSWB_MNH) :: ZALBD_CLEAR ! ensemble mean clear-sky surface albedo (diffuse)
+REAL :: ZEMIS_CLEAR ! ensemble mean clear-sky surface emissivity
+REAL :: ZEMIW_CLEAR ! ensemble mean clear-sky LW window
+REAL :: ZRMU0_CLEAR ! ensemble mean clear-sky MU0
+REAL :: ZTS_CLEAR ! ensemble mean clear-sky surface temperature.
+REAL :: ZLSM_CLEAR ! ensemble mean clear-sky land sea-mask
+REAL :: ZLAT_CLEAR,ZLON_CLEAR
+!
+!work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1, ZWORK2, ZWORK3, ZWORK
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK4, ZWORK1AER, ZWORK2AER, ZWORK_GRID
+LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZWORKL
+!
+! split arrays used to split the memory required by the ECMWF_radiation
+! subroutine, the fields have the same meaning as their complete counterpart
+!
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP_SPLIT, ZALBD_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZEMIS_SPLIT, ZEMIW_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZRMU0_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCFAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZO3AVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZT_HL_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZTAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZAER_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDPRES_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLSM_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQVAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQSAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRAVE_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIWC_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDZ_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_C2R2_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_C2R2_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_C1R3_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_LIMA_SPLIT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZTS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIF_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_NIR_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_NIR_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_VIS_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_NIR_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWD_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWU_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLWP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIWP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADLP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADIP_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_RRTM_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLSW_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOMEGA_TOTAL_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCG_TOTAL_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_CS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP_CS_SPLIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS_SPLIT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_EQ_TMP !Single scattering albedo of aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZIR !Real part of the aerosol refractive index(lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZII !Imaginary part of the aerosol refractive index (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_EQ_TMP !Assymetry factor aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_EQ_TMP !tau/tau_{550} aerosols (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_DST_TMP !Single scattering albedo of dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_DST_TMP !Assymetry factor dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_DST_TMP !tau/tau_{550} dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_AER_TMP !Single scattering albedo of aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_AER_TMP !Assymetry factor aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_AER_TMP !tau/tau_{550} aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_SLT_TMP !Single scattering albedo of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_SLT_TMP !Assymetry factor of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_SLT_TMP !tau/tau_{550} of sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_AER !tau/tau_{550} aerosol from ORILAM (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_SLT !tau/tau_{550} sea salt (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_DST !tau/tau_{550} dust (lon,lat,lev,wvl)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU550_EQ_TMP !tau/tau_{550} aerosols (lon,lat,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZPIZA_EQ !Single scattering albedo of aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZCGA_EQ !Assymetry factor aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZTAUREL_EQ !tau/tau_{550} aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZPIZA_EQ_SPLIT !Single scattering albedo of aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZCGA_EQ_SPLIT !Assymetry factor aerosols (points,lev,wvl)
+REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZTAUREL_EQ_SPLIT !tau/tau_{550} aerosols (points,lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZPIZA_EQ_CLEAR !Single scattering albedo of aerosols (lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZCGA_EQ_CLEAR !Assymetry factor aerosols (lev,wvl)
+REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZTAUREL_EQ_CLEAR !tau/tau_{550} aerosols (lev,wvl)
+INTEGER :: WVL_IDX !Counter for wavelength
+
+!
+INTEGER :: JI_SPLIT ! loop on the split array
+INTEGER :: INUM_CALL ! number of CALL of the radiation scheme
+INTEGER :: IDIM_EFF ! effective number of air-columns to compute
+INTEGER :: IDIM_RESIDUE ! number of remaining air-columns to compute
+INTEGER :: IBEG, IEND ! auxiliary indices
+!
+!
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZDTRAD_LW! LW temperature tendency
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZDTRAD_SW! SW temperature tendency
+INTEGER :: ILUOUT ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM routines
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
+ :: ZSTORE_3D, ZSTORE_3D2! 3D work array for storage
+REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2)) &
+ :: ZSTORE_2D ! 2D work array for storage!
+INTEGER :: JBAND ! Solar band index
+CHARACTER (LEN=4), DIMENSION(KSWB_OLD) :: YBAND_NAME ! Solar band name
+CHARACTER (LEN=2) :: YDIR ! Type of the data field
+!
+INTEGER :: ISWB ! number of SW spectral bands (between radiations and surface schemes)
+INTEGER :: JSWB ! loop on SW spectral bands
+INTEGER :: JAE ! loop on aerosol class
+TYPE(TFIELDMeTaDATA) :: TZFIELD2D, TZFIELD3D
+!
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZDZPABST
+REAL :: ZMINVAL
+INTEGER, DIMENSION(3) :: IMINLOC
+INTEGER :: IINFO_ll
+LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: GCLOUD_SURF
+!
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLON,ZLAT
+REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLON_SPLIT,ZLAT_SPLIT
+!
+INTEGER :: ICLEAR_COL_ll
+INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_ICLEAR_COL
+REAL, DIMENSION(KFLEV) :: ZT_CLEAR_DD ! ensemble mean clear-sky temperature
+REAL :: ZCLEAR_COL_ll , ZDLON_ll
+!-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
+! ----------------------------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) ! this definition must be coherent with
+ ! the one used in ini_radiations routine
+IKU = SIZE(PTHT,3)
+IKB = 1 + JPVEXT
+IKE = IKU - JPVEXT
+!
+IKSTAE = SIZE(PSTATM,1)
+IKUP = IKE-JPVEXT+1
+!
+ISWB = SIZE(PSRFSWD_DIR,3)
+!
+!-------------------------------------------------------------------------------
+!* 1.1 CHECK PRESSURE DECREASING
+! -------------------------
+ZDZPABST(:,:,1:IKU-1) = PPABST(:,:,1:IKU-1) - PPABST(:,:,2:IKU)
+ZDZPABST(:,:,IKU) = ZDZPABST(:,:,IKU-1)
+!
+ZMINVAL=MIN_ll(ZDZPABST,IINFO_ll)
+!
+IF ( ZMINVAL <= 0.0 ) THEN
+ ILUOUT = TLUOUT%NLU
+ IMINLOC=GMINLOC_ll( ZDZPABST )
+ WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '
+ WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ', IMINLOC
+ FLUSH(unit=ILUOUT)
+ call Print_msg( NVERB_FATAL, 'GEN', 'RADIATIONS', 'something wrong with pressure: ZDZPABST <= 0.0' )
+
+ENDIF
+!------------------------------------------------------------------------------
+ALLOCATE(ZLAT(KDLON))
+ALLOCATE(ZLON(KDLON))
+IF(LCARTESIAN) THEN
+ ZLAT(:) = XLAT0*(XPI/180.)
+ ZLON(:) = XLON0*(XPI/180.)
+ELSE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZLAT(IIJ) = XLAT(JI,JJ)*(XPI/180.)
+ ZLON(IIJ) = XLON(JI,JJ)*(XPI/180.)
+ END DO
+ END DO
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 2. INITIALIZES THE MEAN-LAYER VARIABLES
+! ------------------------------------
+!
+ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Columns where radiation is computed are put on a single line
+ALLOCATE(ZTAVE(KDLON,KFLEV))
+ALLOCATE(ZQVAVE(KDLON,KFLEV))
+ALLOCATE(ZQLAVE(KDLON,KFLEV))
+ALLOCATE(ZQIAVE(KDLON,KFLEV))
+ALLOCATE(ZCFAVE(KDLON,KFLEV))
+ALLOCATE(ZQRAVE(KDLON,KFLEV))
+ALLOCATE(ZQLWC(KDLON,KFLEV))
+ALLOCATE(ZQIWC(KDLON,KFLEV))
+ALLOCATE(ZQRWC(KDLON,KFLEV))
+ALLOCATE(ZDZ(KDLON,KFLEV))
+!
+ZQVAVE(:,:) = 0.0
+ZQLAVE(:,:) = 0.0
+ZQIAVE(:,:) = 0.0
+ZQRAVE(:,:) = 0.0
+ZCFAVE(:,:) = 0.0
+ZQLWC(:,:) = 0.0
+ZQIWC(:,:) = 0.0
+ZQRWC(:,:) = 0.0
+ZDZ(:,:)=0.0
+!
+!COMPUTE THE MESH SIZE
+DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZDZ(IIJ,JKRAD) = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZTAVE(IIJ,JKRAD) = PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK) ! Conversion potential temperature -> actual temperature
+ END DO
+ END DO
+END DO
+!
+! Check if the humidity mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQVAVE(IIJ,JKRAD) =MAX(0., PRT(JI,JJ,JK,1))
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the cloudwater mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQLAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2))
+ ZQLWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2)*PRHODREF(JI,JJ,JK))
+ ZCFAVE(IIJ,JKRAD) = PCLDFR(JI,JJ,JK)
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the rainwater mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 3 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQRWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3)*PRHODREF(JI,JJ,JK))
+ ZQRAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3))
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Check if the cloudice mixing ratio is available
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 4 ) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZQIWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,4)*PRHODREF(JI,JJ,JK))
+! ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4)-XRTMIN(4),0.0 )
+ ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4),0.0 )
+ END DO
+ END DO
+ END DO
+END IF
+!
+! Standard atmosphere extension
+!
+DO JK=IKUP,KFLEV
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ JK2 = JK1+1
+ ZTAVE(:,JK) = 0.5*( PSTATM(JK1,3)+PSTATM(JK2,3) )
+ ZQVAVE(:,JK) = 0.5*( PSTATM(JK1,5)/PSTATM(JK1,4)+ &
+ PSTATM(JK2,5)/PSTATM(JK2,4) )
+END DO
+!
+! 2.1 pronostic water concentation fields (C2R2 coupling)
+!
+IF( NSV_C2R2 /= 0 ) THEN
+ ALLOCATE (ZCCT_C2R2(KDLON, KFLEV))
+ ALLOCATE (ZCRT_C2R2(KDLON, KFLEV))
+ ZCCT_C2R2(:, :) = 0.
+ ZCRT_C2R2 (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZCCT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+1))
+ ZCRT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+2))
+ END DO
+ END DO
+ END DO
+ELSE
+ ALLOCATE (ZCCT_C2R2(0,0))
+ ALLOCATE (ZCRT_C2R2(0,0))
+END IF
+!
+IF( NSV_C1R3 /= 0 ) THEN
+ ALLOCATE (ZCIT_C1R3(KDLON, KFLEV))
+ ZCIT_C1R3 (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZCIT_C1R3 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C1R3BEG))
+ END DO
+ END DO
+ END DO
+ELSE
+ ALLOCATE (ZCIT_C1R3(0,0))
+END IF
+!
+!
+! 2.1*bis pronostic water concentation fields (LIMA coupling)
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ ALLOCATE (ZCCT_LIMA(KDLON, KFLEV))
+ ALLOCATE (ZCRT_LIMA(KDLON, KFLEV))
+ ALLOCATE (ZCIT_LIMA(KDLON, KFLEV))
+ ZCCT_LIMA(:, :) = 0.
+ ZCRT_LIMA (:,:) = 0.
+ ZCIT_LIMA (:,:) = 0.
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ IF (NMOM_C.GE.2) ZCCT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NC))
+ IF (NMOM_R.GE.2) ZCRT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NR))
+ IF (NMOM_I.GE.2) ZCIT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NI))
+ END DO
+ END DO
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITIALIZES THE HALF-LEVEL VARIABLES
+! ------------------------------------
+!
+ALLOCATE(ZPRES_HL(KDLON,KFLEV+1))
+ALLOCATE(ZT_HL(KDLON,KFLEV+1))
+!
+DO JK=IKB,IKE+1
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZPRES_HL(IIJ,JKRAD) = XP00 * (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
+ END DO
+ END DO
+END DO
+
+! Standard atmosphere extension - pressure
+!* begining at ikup+1 level allows to use a model domain higher than 50km
+!
+DO JK=IKUP+1,KFLEV+1
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ ZPRES_HL(:,JK) = PSTATM(JK1,2)*100.0 ! mb -> Pa
+END DO
+!
+! Surface temperature at the first level
+! and surface radiative temperature
+ALLOCATE(ZTS(KDLON))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZT_HL(IIJ,1) = PTSRAD(JI,JJ)
+ ZTS(IIJ) = PTSRAD(JI,JJ)
+ END DO
+END DO
+!
+! Temperature at half levels
+!
+ZT_HL(:,2:IKE-JPVEXT) = 0.5*(ZTAVE(:,1:IKE-JPVEXT-1)+ZTAVE(:,2:IKE-JPVEXT))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZT_HL(IIJ,IKE-JPVEXT+1) = 0.5*PTHT(JI,JJ,IKE )*ZEXNT(JI,JJ,IKE ) &
+ + 0.5*PTHT(JI,JJ,IKE+1)*ZEXNT(JI,JJ,IKE+1)
+ END DO
+END DO
+!
+! Standard atmosphere extension - temperature
+!* begining at ikup+1 level allows to use a model domain higher than 50km
+!
+DO JK=IKUP+1,KFLEV+1
+ JK1 = (KSTATM-1)+(JK-IKUP)
+ ZT_HL(:,JK) = PSTATM(JK1,3)
+END DO
+!
+!mean layer pressure and layer differential pressure (from half level variables)
+!
+ALLOCATE(ZPAVE(KDLON,KFLEV))
+ALLOCATE(ZDPRES(KDLON,KFLEV))
+DO JKRAD=1,KFLEV
+ ZPAVE(:,JKRAD)=0.5*(ZPRES_HL(:,JKRAD)+ZPRES_HL(:,JKRAD+1))
+ ZDPRES(:,JKRAD)=ZPRES_HL(:,JKRAD)-ZPRES_HL(:,JKRAD+1)
+END DO
+!-----------------------------------------------------------------------
+!* 4. INITIALIZES THE AEROSOLS and OZONE PROFILES from climatology
+! -------------------------------------------
+!
+! 4.1 AEROSOL optical thickness
+! EXPL -> defined online, otherwise climatology
+IF (CAOP=='EXPL') THEN
+ GAOP = .TRUE.
+ELSE
+ GAOP = .FALSE.
+ENDIF
+!
+IF (CAOP=='EXPL') THEN
+ ALLOCATE(ZPIZA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+
+ ALLOCATE(ZPIZA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_DST(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+ ALLOCATE(ZPIZA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_AER(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+ ALLOCATE(ZPIZA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZCGA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(ZTAUREL_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
+ ALLOCATE(PAER_SLT(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
+
+
+ ALLOCATE(ZII(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB_OLD))
+ ALLOCATE(ZIR(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB_OLD))
+
+ ZPIZA_EQ_TMP = 0.
+ ZCGA_EQ_TMP = 0.
+ ZTAUREL_EQ_TMP = 0.
+
+ ZPIZA_DST_TMP = 0.
+ ZCGA_DST_TMP = 0.
+ ZTAUREL_DST_TMP = 0
+
+ ZPIZA_SLT_TMP = 0.
+ ZCGA_SLT_TMP = 0.
+ ZTAUREL_SLT_TMP = 0
+
+ ZPIZA_AER_TMP = 0.
+ ZCGA_AER_TMP = 0.
+ ZTAUREL_AER_TMP = 0
+
+ PAER_DST=0.
+ PAER_SLT=0.
+ PAER_AER=0.
+
+ IF (LORILAM) THEN
+ CALL AEROOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_AERBEG:NSV_AEREND) & !I [ppv] aerosols concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,ZPIZA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of aerosols
+ ,ZCGA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for aerosols
+ ,ZTAUREL_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_AER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of aerosols at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ ,ZIR(IIB:IIE,IJB:IJE,:,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,ZII(IIB:IIE,IJB:IJE,:,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ )
+ ENDIF
+ IF(LDUST) THEN
+ CALL DUSTOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_DSTBEG:NSV_DSTEND) & !I [ppv] Dust scalar concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,ZPIZA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of dust
+ ,ZCGA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for dust
+ ,ZTAUREL_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_DST(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of dust at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ )
+ DO WVL_IDX=1,KSWB_OLD
+ PDST_WL(:,:,:,WVL_IDX) = ZTAUREL_DST_TMP(:,:,:,WVL_IDX)* PAER(:,:,:,3)
+ ENDDO
+ ENDIF
+ IF(LSALT) THEN
+ CALL SALTOPT_GET( &
+ PSVT(IIB:IIE,IJB:IJE,:,NSV_SLTBEG:NSV_SLTEND) & !I [ppv] sea salt scalar concentration
+ ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
+ ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,PTHT(IIB:IIE,IJB:IJE,:) & !I [K] potential temperature
+ ,PPABST(IIB:IIE,IJB:IJE,:) & !I [hPa] pressure
+ ,PRT(IIB:IIE,IJB:IJE,:,:) & !I [kg/kg] water mixing ratio
+ ,ZPIZA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of sea salt
+ ,ZCGA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for sea salt
+ ,ZTAUREL_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
+ ,PAER_SLT(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of sea salt at wvl=550nm
+ ,KSWB_OLD & !I |nbr] number of shortwave bands
+ )
+ ENDIF
+
+ ZTAUREL_EQ_TMP(:,:,:,:)=ZTAUREL_DST_TMP(:,:,:,:)+ZTAUREL_AER_TMP(:,:,:,:)+ZTAUREL_SLT_TMP(:,:,:,:)
+
+ PAER(:,:,:,2)=PAER_SLT(:,:,:)
+ PAER(:,:,:,3)=PAER_DST(:,:,:)
+ PAER(:,:,:,4)=PAER_AER(:,:,:)
+
+
+ WHERE (ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0)
+ ZPIZA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)+&
+ ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)+&
+ ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:))/&
+ ZTAUREL_EQ_TMP(:,:,:,:)
+ END WHERE
+ WHERE ((ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0).AND.(ZPIZA_EQ_TMP(:,:,:,:).GT.0.0))
+ ZCGA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)*ZCGA_DST_TMP(:,:,:,:)+&
+ ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)*ZCGA_AER_TMP(:,:,:,:)+&
+ ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:)*ZCGA_SLT_TMP(:,:,:,:))/&
+ (ZTAUREL_EQ_TMP(:,:,:,:)*ZPIZA_EQ_TMP(:,:,:,:))
+ END WHERE
+
+ ZTAUREL_EQ_TMP(:,:,:,:)=max(1.E-8,ZTAUREL_EQ_TMP(:,:,:,:))
+ ZCGA_EQ_TMP(:,:,:,:)=max(1.E-8,ZCGA_EQ_TMP(:,:,:,:))
+ ZPIZA_EQ_TMP(:,:,:,:)=max(1.E-8,ZPIZA_EQ_TMP(:,:,:,:))
+ PAER(:,:,:,3)=max(1.E-8,PAER(:,:,:,3))
+ ZPIZA_EQ_TMP(:,:,:,:)=min(0.99,ZPIZA_EQ_TMP(:,:,:,:))
+
+
+ENDIF
+!
+! Computes SSA, optical depth and assymetry factor for clear sky (aerosols)
+ZTAUAZ(:,:,:,:) = 0.
+ZPIZAZ(:,:,:,:) = 0.
+ZCGAZ(:,:,:,:) = 0.
+DO WVL_IDX=1,KSWB_OLD
+ DO JAE=1,KAER
+ !Special optical properties for dust
+ IF (CAOP=='EXPL'.AND.(JAE==3)) THEN
+ !Ponderation of aerosol optical in case of explicit optical factor
+ !ti
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ !wi*ti
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ !wi*ti*gi
+ ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
+ ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
+ ZCGA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
+ ELSE
+
+ !Ponderation of aerosol optical properties
+ !ti
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * RTAUA(WVL_IDX,JAE)
+ !wi*ti
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
+ RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)
+ !wi*ti*gi
+ ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) +&
+ PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
+ RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)*RCGA(WVL_IDX,JAE)
+ ENDIF
+ ENDDO
+! assymetry factor:
+
+ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
+ ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
+! SSA:
+ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
+ ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
+ENDDO
+!
+
+!
+ALLOCATE(ZAER(KDLON,KFLEV,KAER))
+! Aerosol classes
+! 1=Continental 2=Maritime 3=Desert 4=Urban 5=Volcanic 6=Stratos.Bckgnd
+! Loaded from climatology
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,:) = PAER_CLIM (JI,JJ,:,:)
+ END DO
+END DO
+IF ((CAOP=='EXPL') .AND. LDUST ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,3) = PAER (JI,JJ,:,3)
+ END DO
+ END DO
+END IF
+IF ((CAOP=='EXPL') .AND. LSALT ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,2) = PAER (JI,JJ,:,2)
+ END DO
+ END DO
+END IF
+IF ((CAOP=='EXPL') .AND. LORILAM ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZAER (IIJ,:,4) = PAER (JI,JJ,:,4)
+ END DO
+ END DO
+END IF
+!
+ALLOCATE(ZPIZA_EQ(KDLON,KFLEV,KSWB_OLD))
+ALLOCATE(ZCGA_EQ(KDLON,KFLEV,KSWB_OLD))
+ALLOCATE(ZTAUREL_EQ(KDLON,KFLEV,KSWB_OLD))
+IF(CAOP=='EXPL')THEN
+ !Transform from vector of type #lon #lat #lev #wvl
+ !to vectors of type #points, #levs, #wavelengths
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZPIZA_EQ(IIJ,:,:) = ZPIZA_EQ_TMP(JI,JJ,:,:)
+ ZCGA_EQ(IIJ,:,:)= ZCGA_EQ_TMP(JI,JJ,:,:)
+ ZTAUREL_EQ(IIJ,:,:)=ZTAUREL_EQ_TMP(JI,JJ,:,:)
+ END DO
+ END DO
+ DEALLOCATE(ZPIZA_EQ_TMP)
+ DEALLOCATE(ZCGA_EQ_TMP)
+ DEALLOCATE(ZTAUREL_EQ_TMP)
+ DEALLOCATE(ZPIZA_DST_TMP)
+ DEALLOCATE(ZCGA_DST_TMP)
+ DEALLOCATE(ZTAUREL_DST_TMP)
+ DEALLOCATE(ZPIZA_AER_TMP)
+ DEALLOCATE(ZCGA_AER_TMP)
+ DEALLOCATE(ZTAUREL_AER_TMP)
+ DEALLOCATE(ZPIZA_SLT_TMP)
+ DEALLOCATE(ZCGA_SLT_TMP)
+ DEALLOCATE(ZTAUREL_SLT_TMP)
+ DEALLOCATE(PAER_DST)
+ DEALLOCATE(PAER_AER)
+ DEALLOCATE(PAER_SLT)
+ DEALLOCATE(ZIR)
+ DEALLOCATE(ZII)
+END IF
+
+
+!
+! 4.2 OZONE content
+!
+ALLOCATE(ZO3AVE(KDLON,KFLEV))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZO3AVE(IIJ,:) = POZON (JI,JJ,:)
+ END DO
+END DO
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+POZON = POZON
+#endif
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. CALLS THE E.C.M.W.F. RADIATION CODE
+! -----------------------------------
+!
+!
+!* 5.1 INITIALIZES 2D AND SURFACE FIELDS
+!
+ALLOCATE(ZRMU0(KDLON))
+ALLOCATE(ZLSM(KDLON))
+!
+ALLOCATE(ZALBP(KDLON,KSWB_MNH))
+ALLOCATE(ZALBD(KDLON,KSWB_MNH))
+!
+ALLOCATE(ZEMIS(KDLON,KLWB_MNH))
+ALLOCATE(ZEMIW(KDLON,KLWB_MNH))
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZEMIS(IIJ,:) = PEMIS(JI,JJ,:)
+ ZRMU0(IIJ) = PCOSZEN(JI,JJ)
+ ZLSM(IIJ) = 1.0 - PSEA(JI,JJ)
+ END DO
+END DO
+!
+! spectral albedo
+!
+IF ( SIZE(PDIR_ALB,3)==1 ) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ! sw direct and diffuse albedos
+ ZALBP(IIJ,:) = PDIR_ALB(JI,JJ,1)
+ ZALBD(IIJ,:) = PSCA_ALB(JI,JJ,1)
+ !
+ END DO
+ END DO
+ELSE
+ DO JK=1, SIZE(PDIR_ALB,3)
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ! sw direct and diffuse albedos
+ ZALBP(IIJ,JK) = PDIR_ALB(JI,JJ,JK)
+ ZALBD(IIJ,JK) = PSCA_ALB(JI,JJ,JK)
+ ENDDO
+ END DO
+ ENDDO
+END IF
+!
+!
+! LW emissivity
+ZEMIW(:,:)= ZEMIS(:,:)
+!
+!solar constant
+ZRII0= PCORSOL*XI0 ! solar constant multiplied by seasonal variations due to Earth-Sun distance
+!
+!
+!* 5.2 ACCOUNTS FOR THE CLEAR-SKY APPROXIMATION
+!
+! Performs the horizontal average of the fields when no cloud
+!
+ZCLOUD(:) = SUM( ZCFAVE(:,:),DIM=2 ) ! one where no cloud on the vertical
+!
+! MODIF option CLLY
+ALLOCATE ( ICLEAR_2D_TM1(KDLON) )
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ICLEAR_2D_TM1(IIJ) = KCLEARCOL_TM1(JI,JJ)
+ END DO
+END DO
+!
+IF(OCLOUD_ONLY .OR. OCLEAR_SKY) THEN
+ !
+ GCLEAR_2D(:) = .TRUE.
+ WHERE( (ZCLOUD(:) > 0.0) .OR. (ICLEAR_2D_TM1(:)==0) ) ! FALSE on cloudy columns
+ GCLEAR_2D(:) = .FALSE.
+ END WHERE
+ !
+ ICLEAR_COL = COUNT( GCLEAR_2D(:) ) ! number of clear sky columns
+ !
+ ALLOCATE(INDEX_ICLEAR_COL(ICLEAR_COL))
+ IIJ = 0
+ DO JI=1,KDLON
+ IF ( GCLEAR_2D(JI) ) THEN
+ IIJ = IIJ + 1
+ INDEX_ICLEAR_COL(IIJ) = JI
+ END IF
+ END DO
+
+ IF( ICLEAR_COL == KDLON ) THEN ! No cloud case so only the mean clear-sky
+!!$ GCLEAR_2D(1) = .FALSE. ! column is selected
+!!$ ICLEAR_COL = KDLON-1
+ GNOCL = .TRUE. ! TRUE if no cloud at all
+ ELSE
+ GNOCL = .FALSE.
+ END IF
+
+ GCLEAR(:,:) = SPREAD( GCLEAR_2D(:),DIM=2,NCOPIES=KFLEV ) ! vertical extension of clear columns 2D map
+ ICLOUD_COL = KDLON - ICLEAR_COL ! number of cloudy columns
+!
+ ZCLEAR_COL_ll = REAL(ICLEAR_COL)
+ CALL REDUCESUM_ll(ZCLEAR_COL_ll,IINFO_ll)
+ !ZDLON_ll = KDLON
+ !CALL REDUCESUM_ll(ZDLON_ll,IINFO_ll)
+
+ !IF (IP == 1 )
+ !print*,",RADIATIOn COULD_ONLY=OCLOUD_ONLY,OCLEAR_SKY,ZCLEAR_COL_ll,ICLEAR_COL,ICLOUD_COL,KDON,ZDLON_ll,GNOCL=", &
+ ! OCLOUD_ONLY,OCLEAR_SKY,ZCLEAR_COL_ll,ICLEAR_COL,ICLOUD_COL,KDLON,ZDLON_ll,GNOCL
+!
+!!$ IF( ICLEAR_COL /=0 ) THEN ! at least one clear-sky column exists -> average profiles on clear columns
+ IF( ZCLEAR_COL_ll /= 0.0 ) THEN ! at least one clear-sky column exists -> average profiles on clear columns
+ ZT_CLEAR(:) = SUM_DD_R2_R1_ll(ZTAVE(INDEX_ICLEAR_COL(:),:)) / ZCLEAR_COL_ll
+ ZP_CLEAR(:) = SUM_DD_R2_R1_ll(ZPAVE(INDEX_ICLEAR_COL(:),:)) / ZCLEAR_COL_ll
+ ZQV_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZQVAVE(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZOZ_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZO3AVE(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZDP_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZDPRES(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+
+ DO JK1=1,KAER
+ ZAER_CLEAR(:,JK1) = SUM_DD_R2_R1_ll(REAL(ZAER(INDEX_ICLEAR_COL(:),:,JK1))) / ZCLEAR_COL_ll
+ END DO
+ !Get an average value for the clear column
+ IF(CAOP=='EXPL')THEN
+ DO WVL_IDX=1,KSWB_OLD
+ ZPIZA_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZPIZA_EQ( INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ZCGA_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZCGA_EQ( INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ZTAUREL_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZTAUREL_EQ(INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
+ ENDDO
+ ENDIF
+ !
+ ZHP_CLEAR(1:KFLEV) = SUM_DD_R2_R1_ll(REAL(ZPRES_HL(INDEX_ICLEAR_COL(:),1:KFLEV))) / ZCLEAR_COL_ll
+ ZHT_CLEAR(1:KFLEV) = SUM_DD_R2_R1_ll(REAL(ZT_HL (INDEX_ICLEAR_COL(:),1:KFLEV))) / ZCLEAR_COL_ll
+ !
+ ZALBP_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZALBP(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ ZALBD_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZALBD(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
+ !
+ ZEMIS_CLEAR = SUM_DD_R1_ll(REAL(ZEMIS(INDEX_ICLEAR_COL(:),1))) / ZCLEAR_COL_ll
+ ZEMIW_CLEAR = SUM_DD_R1_ll(REAL(ZEMIW(INDEX_ICLEAR_COL(:),1))) / ZCLEAR_COL_ll
+ ZRMU0_CLEAR = SUM_DD_R1_ll(REAL(ZRMU0(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZTS_CLEAR = SUM_DD_R1_ll(REAL(ZTS(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLSM_CLEAR = SUM_DD_R1_ll(REAL(ZLSM(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLAT_CLEAR = SUM_DD_R1_ll(REAL(ZLAT(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+ ZLON_CLEAR = SUM_DD_R1_ll(REAL(ZLON(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
+!
+ ELSE ! no clear columns -> the first column is chosen, without physical meaning: it will not be
+ ! unpacked after the call to the radiation ecmwf routine
+ ZT_CLEAR(:) = ZTAVE(1,:)
+ ZP_CLEAR(:) = ZPAVE(1,:)
+ ZQV_CLEAR(:) = ZQVAVE(1,:)
+ ZOZ_CLEAR(:) = ZO3AVE(1,:)
+ ZDP_CLEAR(:) = ZDPRES(1,:)
+ ZAER_CLEAR(:,:) = ZAER(1,:,:)
+ IF(CAOP=='EXPL')THEN
+ ZPIZA_EQ_CLEAR(:,:)=ZPIZA_EQ(1,:,:)
+ ZCGA_EQ_CLEAR(:,:)=ZCGA_EQ(1,:,:)
+ ZTAUREL_EQ_CLEAR(:,:)=ZTAUREL_EQ(1,:,:)
+ ENDIF
+!
+ ZHP_CLEAR(1:KFLEV) = ZPRES_HL(1,1:KFLEV)
+ ZHT_CLEAR(1:KFLEV) = ZT_HL(1,1:KFLEV)
+ ZALBP_CLEAR(:) = ZALBP(1,:)
+ ZALBD_CLEAR(:) = ZALBD(1,:)
+!
+ ZEMIS_CLEAR = ZEMIS(1,1)
+ ZEMIW_CLEAR = ZEMIW(1,1)
+ ZRMU0_CLEAR = ZRMU0(1)
+ ZTS_CLEAR = ZTS(1)
+ ZLSM_CLEAR = ZLSM(1)
+ ZLAT_CLEAR = ZLAT(1)
+ ZLON_CLEAR = ZLON(1)
+ END IF
+ !
+ GCLOUD(:,:) = .NOT.GCLEAR(:,:) ! .true. where the column is cloudy
+ GCLOUDT(:,:)=TRANSPOSE(GCLOUD(:,:))
+ ICLOUD = ICLOUD_COL*KFLEV ! total number of voxels in cloudy columns
+ ALLOCATE(ZWORK1(ICLOUD))
+ ALLOCATE(ZWORK2(ICLOUD+KFLEV)) ! allocation for the KFLEV levels of
+ ! the ICLOUD cloudy columns
+ ! and of the KFLEV levels of the clear sky one
+ !
+ ! temperature profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZTAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZT_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZTAVE)
+ ALLOCATE(ZTAVE(ICLOUD_COL+1,KFLEV))
+ ZTAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! vapor mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQVAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZQV_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZQVAVE)
+ ALLOCATE(ZQVAVE(ICLOUD_COL+1,KFLEV))
+ ZQVAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! mesh size
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZDZ(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZDZ)
+ ALLOCATE(ZDZ(ICLOUD_COL+1,KFLEV))
+ ZDZ(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! liquid water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQLAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQLAVE)
+ ALLOCATE(ZQLAVE(ICLOUD_COL+1,KFLEV))
+ ZQLAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !rain
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQRAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQRAVE)
+ ALLOCATE(ZQRAVE(ICLOUD_COL+1,KFLEV))
+ ZQRAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! ice water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQIAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQIAVE)
+ ALLOCATE(ZQIAVE(ICLOUD_COL+1,KFLEV))
+ ZQIAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! liquid water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQLWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQLWC)
+ ALLOCATE(ZQLWC(ICLOUD_COL+1,KFLEV))
+ ZQLWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !rain
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQRWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQRWC)
+ ALLOCATE(ZQRWC(ICLOUD_COL+1,KFLEV))
+ ZQRWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! ice water mixing ratio profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZQIWC(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZQIWC)
+ ALLOCATE(ZQIWC(ICLOUD_COL+1,KFLEV))
+ ZQIWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !
+ ! cloud fraction profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZCFAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCFAVE)
+ ALLOCATE(ZCFAVE(ICLOUD_COL+1,KFLEV))
+ ZCFAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ! C2R2 water particle concentration
+ !
+ IF ( SIZE(ZCCT_C2R2) > 0 ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCCT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCCT_C2R2)
+ ALLOCATE(ZCCT_C2R2(ICLOUD_COL+1,KFLEV))
+ ZCCT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ IF ( SIZE (ZCRT_C2R2) > 0 ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCRT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCRT_C2R2)
+ ALLOCATE(ZCRT_C2R2(ICLOUD_COL+1,KFLEV))
+ ZCRT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ IF ( SIZE (ZCIT_C1R3) > 0) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCIT_C1R3(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCIT_C1R3)
+ ALLOCATE(ZCIT_C1R3(ICLOUD_COL+1,KFLEV))
+ ZCIT_C1R3 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ !
+ ! LIMA water particle concentration
+ !
+ IF( CCLOUD == 'LIMA' ) THEN
+ ZWORK1(:) = PACK( TRANSPOSE(ZCCT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCCT_LIMA)
+ ALLOCATE(ZCCT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCCT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+!
+ ZWORK1(:) = PACK( TRANSPOSE(ZCRT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCRT_LIMA)
+ ALLOCATE(ZCRT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCRT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+!
+ ZWORK1(:) = PACK( TRANSPOSE(ZCIT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
+ DEALLOCATE(ZCIT_LIMA)
+ ALLOCATE(ZCIT_LIMA(ICLOUD_COL+1,KFLEV))
+ ZCIT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDIF
+ !
+ ! ozone content profiles
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZO3AVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZOZ_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZO3AVE)
+ ALLOCATE(ZO3AVE(ICLOUD_COL+1,KFLEV))
+ ZO3AVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZPAVE(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZPAVE)
+ ALLOCATE(ZPAVE(ICLOUD_COL+1,KFLEV))
+ ZPAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !pressure thickness
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZDPRES(:,:)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZDP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZDPRES)
+ ALLOCATE(ZDPRES(ICLOUD_COL+1,KFLEV))
+ ZDPRES(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ !
+ !aerosols
+ !
+ ALLOCATE(ZWORK1AER(ICLOUD,KAER))
+ ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KAER))
+ DO JK=1,KAER
+ ZWORK1AER(:,JK) = PACK( TRANSPOSE(ZAER(:,:,JK)),MASK=GCLOUDT(:,:) )
+ ZWORK2AER(1:ICLOUD,JK)=ZWORK1AER(:,JK)
+ ZWORK2AER(ICLOUD+1:,JK)=ZAER_CLEAR(:,JK)
+ END DO
+ DEALLOCATE(ZAER)
+ ALLOCATE(ZAER(ICLOUD_COL+1,KFLEV,KAER))
+ DO JK=1,KAER
+ ZAER(:,:,JK) = TRANSPOSE( RESHAPE( ZWORK2AER(:,JK),(/KFLEV,ICLOUD_COL+1/) ) )
+ END DO
+ DEALLOCATE (ZWORK1AER)
+ DEALLOCATE (ZWORK2AER)
+ !
+ IF(CAOP=='EXPL')THEN
+ ALLOCATE(ZWORK1AER(ICLOUD,KSWB_OLD)) !New vector with value for all cld. points
+ ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KSWB_OLD)) !New vector with value for all cld.points + 1 clr column
+ !Single scattering albedo
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK( TRANSPOSE(ZPIZA_EQ(:,:,WVL_IDX)),MASK=GCLOUDT(:,:) )
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZPIZA_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZPIZA_EQ)
+ ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZPIZA_EQ(:,:,WVL_IDX) = TRANSPOSE( RESHAPE( ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/) ) )
+ ENDDO
+ !Assymetry factor
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZCGA_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZCGA_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZCGA_EQ)
+ ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZCGA_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
+ ENDDO
+ !Relative wavelength-distributed optical depth
+ DO WVL_IDX=1,KSWB_OLD
+ ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZTAUREL_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
+ ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
+ ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZTAUREL_EQ_CLEAR(:,WVL_IDX)
+ ENDDO
+ DEALLOCATE(ZTAUREL_EQ)
+ ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DO WVL_IDX=1,KSWB_OLD
+ ZTAUREL_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
+ ENDDO
+ DEALLOCATE(ZWORK1AER)
+ DEALLOCATE(ZWORK2AER)
+ ELSE
+ DEALLOCATE(ZPIZA_EQ)
+ ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DEALLOCATE(ZCGA_EQ)
+ ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ DEALLOCATE(ZTAUREL_EQ)
+ ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
+ ENDIF !Check on LDUST
+
+ ! half-level variables
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZPRES_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZHP_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZPRES_HL)
+ ALLOCATE(ZPRES_HL(ICLOUD_COL+1,KFLEV+1))
+ ZPRES_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ZPRES_HL(:,KFLEV+1) = PSTATM(IKSTAE,2)*100.0
+ !
+ ZWORK1(:) = PACK( TRANSPOSE(ZT_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
+ ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
+ ZWORK2(ICLOUD+1:)= ZHT_CLEAR(1:) ! and the single clear_sky one
+ DEALLOCATE(ZT_HL)
+ ALLOCATE(ZT_HL(ICLOUD_COL+1,KFLEV+1))
+ ZT_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
+ ZT_HL(:,KFLEV+1) = PSTATM(IKSTAE,3)
+ !
+ ! surface fields
+ !
+ ALLOCATE(ZWORK3(ICLOUD_COL))
+ ALLOCATE(ZWORK4(ICLOUD_COL,KSWB_MNH))
+ ALLOCATE(ZWORK(KDLON))
+ DO JALBS=1,KSWB_MNH
+ ZWORK(:) = ZALBP(:,JALBS)
+ ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
+ ZWORK4(:,JALBS) = ZWORK3(:)
+ END DO
+ DEALLOCATE(ZALBP)
+ ALLOCATE(ZALBP(ICLOUD_COL+1,KSWB_MNH))
+ ZALBP(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
+ ZALBP(ICLOUD_COL+1,:) = ZALBP_CLEAR(:)
+ !
+ DO JALBS=1,KSWB_MNH
+ ZWORK(:) = ZALBD(:,JALBS)
+ ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
+ ZWORK4(:,JALBS) = ZWORK3(:)
+ END DO
+ DEALLOCATE(ZALBD)
+ ALLOCATE(ZALBD(ICLOUD_COL+1,KSWB_MNH))
+ ZALBD(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
+ ZALBD(ICLOUD_COL+1,:) = ZALBD_CLEAR(:)
+ !
+ DEALLOCATE(ZWORK4)
+ !
+ ZWORK3(:) = PACK( ZEMIS(:,1),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZEMIS)
+ ALLOCATE(ZEMIS(ICLOUD_COL+1,1))
+ ZEMIS(1:ICLOUD_COL,1) = ZWORK3(1:ICLOUD_COL)
+ ZEMIS(ICLOUD_COL+1,1) = ZEMIS_CLEAR
+ !
+ !
+ ZWORK3(:) = PACK( ZEMIW(:,1),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZEMIW)
+ ALLOCATE(ZEMIW(ICLOUD_COL+1,1))
+ ZEMIW(1:ICLOUD_COL,1) = ZWORK3(1:ICLOUD_COL)
+ ZEMIW(ICLOUD_COL+1,1) = ZEMIW_CLEAR
+ !
+ !
+ ZWORK3(:) = PACK( ZRMU0(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZRMU0)
+ ALLOCATE(ZRMU0(ICLOUD_COL+1))
+ ZRMU0(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZRMU0(ICLOUD_COL+1) = ZRMU0_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLSM(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLSM)
+ ALLOCATE(ZLSM(ICLOUD_COL+1))
+ ZLSM(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLSM (ICLOUD_COL+1)= ZLSM_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLAT(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLAT)
+ ALLOCATE(ZLAT(ICLOUD_COL+1))
+ ZLAT(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLAT (ICLOUD_COL+1)= ZLAT_CLEAR
+ !
+ ZWORK3(:) = PACK( ZLON(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZLON)
+ ALLOCATE(ZLON(ICLOUD_COL+1))
+ ZLON(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZLON (ICLOUD_COL+1)= ZLON_CLEAR
+ !
+ ZWORK3(:) = PACK( ZTS(:),MASK=.NOT.GCLEAR_2D(:) )
+ DEALLOCATE(ZTS)
+ ALLOCATE(ZTS(ICLOUD_COL+1))
+ ZTS(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
+ ZTS(ICLOUD_COL+1) = ZTS_CLEAR
+ !
+ DEALLOCATE(ZWORK1)
+ DEALLOCATE(ZWORK2)
+ DEALLOCATE(ZWORK3)
+ DEALLOCATE(ZWORK)
+ !
+ IDIM = ICLOUD_COL +1 ! Number of columns where RT is computed
+!
+ELSE
+ !
+ !* 5.3 RADIATION COMPUTATIONS FOR THE FULL COLUMN NUMBER (KDLON)
+ !
+ IDIM = KDLON
+END IF
+!
+! initialisation of cloud trace for the next radiation time step
+! (if unchanged columns are not recomputed)
+WHERE ( ZCLOUD(:) <= 0.0 )
+ ICLEAR_2D_TM1(:) = 1
+ELSEWHERE
+ ICLEAR_2D_TM1(:) = 0
+END WHERE
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ KCLEARCOL_TM1(JI,JJ) = ICLEAR_2D_TM1(IIJ) ! output to be saved for next time step
+ END DO
+END DO
+!
+!
+!* 5.4 VERTICAL grid modification(up-down) for compatibility with ECMWF
+! radiation vertical grid. ALLOCATION of the outputs.
+!
+!
+ALLOCATE (ZWORK_GRID(SIZE(ZPRES_HL,1),KFLEV+1))
+!
+!half level pressure
+ZWORK_GRID(:,:)=ZPRES_HL(:,:)
+DO JKRAD=1, KFLEV+1
+ JK1=(KFLEV+1)+1-JKRAD
+ ZPRES_HL(:,JKRAD) = ZWORK_GRID(:,JK1)
+END DO
+!
+!half level temperature
+ZWORK_GRID(:,:)=ZT_HL(:,:)
+DO JKRAD=1, KFLEV+1
+ JK1=(KFLEV+1)+1-JKRAD
+ ZT_HL(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+DEALLOCATE(ZWORK_GRID)
+!
+!mean layer variables
+!-------------------------------------
+ALLOCATE(ZWORK_GRID(SIZE(ZTAVE,1),KFLEV))
+!
+!mean layer temperature
+ZWORK_GRID(:,:)=ZTAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZTAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer pressure
+ZWORK_GRID(:,:)=ZPAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZPAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer pressure thickness
+ZWORK_GRID(:,:)=ZDPRES(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZDPRES(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mesh size
+ZWORK_GRID(:,:)=ZDZ(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZDZ(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+!mean layer cloud fraction
+ZWORK_GRID(:,:)=ZCFAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCFAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!mean layer water vapor mixing ratio
+ZWORK_GRID(:,:)=ZQVAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQVAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!ice
+ZWORK_GRID(:,:)=ZQIAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQIAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!liquid water
+ZWORK_GRID(:,:)=ZQLAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQLAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!rain water
+ZWORK_GRID(:,:)=ZQRAVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQRAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!ice water content
+ZWORK_GRID(:,:)=ZQIWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQIWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!liquid water content
+ZWORK_GRID(:,:)=ZQLWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQLWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!rain water content
+ZWORK_GRID(:,:)=ZQRWC(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZQRWC(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+
+
+!C2R2 water particle concentration
+!
+IF (SIZE(ZCCT_C2R2) > 0) THEN
+ ZWORK_GRID(:,:)=ZCCT_C2R2(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCCT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+IF (SIZE(ZCRT_C2R2) > 0) THEN
+ ZWORK_GRID(:,:)=ZCRT_C2R2(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCRT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+IF (SIZE(ZCIT_C1R3) > 0) THEN
+ ZWORK_GRID(:,:)=ZCIT_C1R3(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCIT_C1R3(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+!
+!LIMA water particle concentration
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ ZWORK_GRID(:,:)=ZCCT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCCT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+!
+ ZWORK_GRID(:,:)=ZCRT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCRT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+!
+ ZWORK_GRID(:,:)=ZCIT_LIMA(:,:)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCIT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
+ END DO
+END IF
+!
+!ozone content
+ZWORK_GRID(:,:)=ZO3AVE(:,:)
+DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZO3AVE(:,JKRAD)=ZWORK_GRID(:,JK1)
+END DO
+!
+!aerosol optical depth
+DO JI=1,KAER
+ ZWORK_GRID(:,:)=ZAER(:,:,JI)
+ DO JKRAD=1, KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZAER(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ END DO
+END DO
+IF (CAOP=='EXPL') THEN
+!TURN MORE FIELDS UPSIDE DOWN...
+!Dust single scattering albedo
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZPIZA_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZPIZA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+!Dust asymmetry factor
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZCGA_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZCGA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+DO JI=1,KSWB_OLD
+ ZWORK_GRID(:,:)=ZTAUREL_EQ(:,:,JI)
+ DO JKRAD=1,KFLEV
+ JK1=KFLEV+1-JKRAD
+ ZTAUREL_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
+ ENDDO
+ENDDO
+
+END IF
+
+!
+DEALLOCATE(ZWORK_GRID)
+!
+!mean layer saturation specific humidity
+!
+ALLOCATE(ZQSAVE(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
+!
+WHERE (ZTAVE(:,:) > XTT)
+ ZQSAVE(:,:) = QSAT(ZTAVE, ZPAVE)
+ELSEWHERE
+ ZQSAVE(:,:) = QSATI(ZTAVE, ZPAVE)
+END WHERE
+!
+! allocations for the radiation code outputs
+!
+ALLOCATE(ZDTLW(IDIM,KFLEV))
+ALLOCATE(ZDTSW(IDIM,KFLEV))
+ALLOCATE(ZFLUX_TOP_GND_IRVISNIR(IDIM,KFLUX))
+ALLOCATE(ZSFSWDIR(IDIM,ISWB))
+ALLOCATE(ZSFSWDIF(IDIM,ISWB))
+ALLOCATE(ZDTLW_CS(IDIM,KFLEV))
+ALLOCATE(ZDTSW_CS(IDIM,KFLEV))
+ALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS(IDIM,KFLUX))
+!
+!
+ALLOCATE(ZFLUX_LW(IDIM,2,KFLEV+1))
+ALLOCATE(ZFLUX_SW_DOWN(IDIM,KFLEV+1))
+ALLOCATE(ZFLUX_SW_UP(IDIM,KFLEV+1))
+ALLOCATE(ZRADLP(IDIM,KFLEV))
+IF( KRAD_DIAG >= 1) THEN
+ ALLOCATE(ZNFLW(IDIM,KFLEV+1))
+ ALLOCATE(ZNFSW(IDIM,KFLEV+1))
+ELSE
+ ALLOCATE(ZNFLW(0,0))
+ ALLOCATE(ZNFSW(0,0))
+END IF
+!
+IF( KRAD_DIAG >= 2) THEN
+ ALLOCATE(ZFLUX_SW_DOWN_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZFLUX_SW_UP_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZFLUX_LW_CS(IDIM,2,KFLEV+1))
+ ALLOCATE(ZNFLW_CS(IDIM,KFLEV+1))
+ ALLOCATE(ZNFSW_CS(IDIM,KFLEV+1))
+ELSE
+ ALLOCATE(ZFLUX_SW_DOWN_CS(0,0))
+ ALLOCATE(ZFLUX_SW_UP_CS(0,0))
+ ALLOCATE(ZFLUX_LW_CS(0,0,0))
+ ALLOCATE(ZNFSW_CS(0,0))
+ ALLOCATE(ZNFLW_CS(0,0))
+END IF
+!
+IF( KRAD_DIAG >= 3) THEN
+ ALLOCATE(ZPLAN_ALB_VIS(IDIM))
+ ALLOCATE(ZPLAN_ALB_NIR(IDIM))
+ ALLOCATE(ZPLAN_TRA_VIS(IDIM))
+ ALLOCATE(ZPLAN_TRA_NIR(IDIM))
+ ALLOCATE(ZPLAN_ABS_VIS(IDIM))
+ ALLOCATE(ZPLAN_ABS_NIR(IDIM))
+ELSE
+ ALLOCATE(ZPLAN_ALB_VIS(0))
+ ALLOCATE(ZPLAN_ALB_NIR(0))
+ ALLOCATE(ZPLAN_TRA_VIS(0))
+ ALLOCATE(ZPLAN_TRA_NIR(0))
+ ALLOCATE(ZPLAN_ABS_VIS(0))
+ ALLOCATE(ZPLAN_ABS_NIR(0))
+END IF
+!
+IF( KRAD_DIAG >= 4) THEN
+ ALLOCATE(ZEFCL_RRTM(IDIM,KFLEV))
+ ALLOCATE(ZCLSW_TOTAL(IDIM,KFLEV))
+ ALLOCATE(ZTAU_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZOMEGA_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZCG_TOTAL(IDIM,KSWB_OLD,KFLEV))
+ ALLOCATE(ZEFCL_LWD(IDIM,KFLEV))
+ ALLOCATE(ZEFCL_LWU(IDIM,KFLEV))
+ ALLOCATE(ZFLWP(IDIM,KFLEV))
+ ALLOCATE(ZFIWP(IDIM,KFLEV))
+ ALLOCATE(ZRADIP(IDIM,KFLEV))
+ELSE
+ ALLOCATE(ZEFCL_RRTM(0,0))
+ ALLOCATE(ZCLSW_TOTAL(0,0))
+ ALLOCATE(ZTAU_TOTAL(0,0,0))
+ ALLOCATE(ZOMEGA_TOTAL(0,0,0))
+ ALLOCATE(ZCG_TOTAL(0,0,0))
+ ALLOCATE(ZEFCL_LWD(0,0))
+ ALLOCATE(ZEFCL_LWU(0,0))
+ ALLOCATE(ZFLWP(0,0))
+ ALLOCATE(ZFIWP(0,0))
+ ALLOCATE(ZRADIP(0,0))
+END IF
+!
+!* 5.6 CALLS THE ECMWF_RADIATION ROUTINES
+!
+! mixing ratio -> specific humidity conversion (for ECMWF routine)
+! mixing ratio = mv/md ; specific humidity = mv/(mv+md)
+
+ZQVAVE(:,:) = ZQVAVE(:,:) / (1.+ZQVAVE(:,:)) ! Because
+! ZAER = 1e-5*ZAER
+! ZO3AVE = 1e-5*ZO3AVE!
+IF( IDIM <= KRAD_COLNBR ) THEN
+!
+! there is less than KRAD_COLNBR columns to be considered therefore
+! no split of the arrays is performed
+! Note that radiation scheme only takes scalar emissivities so only fist value of the spectral emissivity is taken
+ ALLOCATE(ZTAVE_RAD(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
+ ALLOCATE(ZPAVE_RAD(SIZE(ZPAVE,1),SIZE(ZPAVE,2)))
+ ZTAVE_RAD = ZTAVE
+ ZPAVE_RAD = ZPAVE
+ IF (CCLOUD == 'LIMA') THEN
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_LIMA, ZCRT_LIMA, ZCIT_LIMA, &
+ ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ )
+
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_LIMA, ZCRT_LIMA, ZCIT_LIMA, &
+ ZNFLW, ZNFSW, ZNFLW_CS, ZNFSW_CS, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ,ZLAT,ZLON )
+ ENDIF
+
+ ELSE
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3, &
+ ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
+ PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
+ ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
+ ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3, &
+ ZNFLW, ZNFSW, ZNFLW_CS, ZNFSW_CS, &
+ ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
+ ZSFSWDIR, ZSFSWDIF, &
+ ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
+ ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
+ ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
+ ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
+ ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
+ ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
+ ZOMEGA_TOTAL,ZCG_TOTAL, &
+ GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ ,ZLAT,ZLON )
+ END IF
+
+
+ END IF
+ DEALLOCATE(ZTAVE_RAD,ZPAVE_RAD)
+!
+ELSE
+!
+! the splitting of the arrays will be performed
+!
+ INUM_CALL = CEILING( REAL( IDIM ) / REAL( KRAD_COLNBR ) )
+ IDIM_RESIDUE = IDIM
+!
+ DO JI_SPLIT = 1 , INUM_CALL
+ IDIM_EFF = MIN( IDIM_RESIDUE,KRAD_COLNBR )
+ !
+ IF( JI_SPLIT == 1 .OR. JI_SPLIT == INUM_CALL ) THEN
+ ALLOCATE( ZALBP_SPLIT(IDIM_EFF,KSWB_MNH))
+ ALLOCATE( ZALBD_SPLIT(IDIM_EFF,KSWB_MNH))
+ ALLOCATE( ZEMIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZEMIW_SPLIT(IDIM_EFF))
+ ALLOCATE( ZRMU0_SPLIT(IDIM_EFF))
+ ALLOCATE( ZLAT_SPLIT(IDIM_EFF))
+ ALLOCATE( ZLON_SPLIT(IDIM_EFF))
+ ALLOCATE( ZCFAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZO3AVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZT_HL_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZPRES_HL_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZDZ_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQLAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQIAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQRAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQLWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQIWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQRWC_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZQVAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZPAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZAER_SPLIT( IDIM_EFF,KFLEV,KAER))
+ ALLOCATE( ZPIZA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZCGA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZTAUREL_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
+ ALLOCATE( ZDPRES_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZLSM_SPLIT(IDIM_EFF))
+ ALLOCATE( ZQSAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTS_SPLIT(IDIM_EFF))
+ ! output pronostic
+ ALLOCATE( ZDTLW_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZDTSW_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLUX_TOP_GND_IRVISNIR_SPLIT(IDIM_EFF,KFLUX))
+ ALLOCATE( ZSFSWDIR_SPLIT(IDIM_EFF,ISWB))
+ ALLOCATE( ZSFSWDIF_SPLIT(IDIM_EFF,ISWB))
+ ALLOCATE( ZDTLW_CS_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZDTSW_CS_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(IDIM_EFF,KFLUX))
+!
+ ALLOCATE( ZFLUX_LW_SPLIT(IDIM_EFF,2,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_DOWN_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_UP_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZRADLP_SPLIT(IDIM_EFF,KFLEV))
+ IF(KRAD_DIAG >=1) THEN
+ ALLOCATE( ZNFSW_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZNFLW_SPLIT(IDIM_EFF,KFLEV+1))
+ ELSE
+ ALLOCATE( ZNFSW_SPLIT(0,0))
+ ALLOCATE( ZNFLW_SPLIT(0,0))
+ END IF
+!
+ IF( KRAD_DIAG >= 2) THEN
+ ALLOCATE( ZFLUX_SW_DOWN_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_SW_UP_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZFLUX_LW_CS_SPLIT(IDIM_EFF,2,KFLEV+1))
+ ALLOCATE( ZNFSW_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZNFLW_CS_SPLIT(IDIM_EFF,KFLEV+1))
+ ELSE
+ ALLOCATE( ZFLUX_SW_DOWN_CS_SPLIT(0,0))
+ ALLOCATE( ZFLUX_SW_UP_CS_SPLIT(0,0))
+ ALLOCATE( ZFLUX_LW_CS_SPLIT(0,0,0))
+ ALLOCATE( ZNFSW_CS_SPLIT(0,0))
+ ALLOCATE( ZNFLW_CS_SPLIT(0,0))
+ END IF
+!
+ IF( KRAD_DIAG >= 3) THEN
+ ALLOCATE( ZPLAN_ALB_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ALB_NIR_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_TRA_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_TRA_NIR_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ABS_VIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZPLAN_ABS_NIR_SPLIT(IDIM_EFF))
+ ELSE
+ ALLOCATE( ZPLAN_ALB_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_ALB_NIR_SPLIT(0))
+ ALLOCATE( ZPLAN_TRA_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_TRA_NIR_SPLIT(0))
+ ALLOCATE( ZPLAN_ABS_VIS_SPLIT(0))
+ ALLOCATE( ZPLAN_ABS_NIR_SPLIT(0))
+ END IF
+!
+ IF( KRAD_DIAG >= 4) THEN
+ ALLOCATE( ZEFCL_RRTM_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZCLSW_TOTAL_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTAU_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZOMEGA_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZCG_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
+ ALLOCATE( ZEFCL_LWD_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZEFCL_LWU_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFLWP_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZFIWP_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZRADIP_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE( ZEFCL_RRTM_SPLIT(0,0))
+ ALLOCATE( ZCLSW_TOTAL_SPLIT(0,0))
+ ALLOCATE( ZTAU_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZOMEGA_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZCG_TOTAL_SPLIT(0,0,0))
+ ALLOCATE( ZEFCL_LWD_SPLIT(0,0))
+ ALLOCATE( ZEFCL_LWU_SPLIT(0,0))
+ ALLOCATE( ZFLWP_SPLIT(0,0))
+ ALLOCATE( ZFIWP_SPLIT(0,0))
+ ALLOCATE( ZRADIP_SPLIT(0,0))
+ END IF
+!
+! C2R2 coupling
+!
+ IF (SIZE (ZCCT_C2R2) > 0) THEN
+ ALLOCATE (ZCCT_C2R2_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCCT_C2R2_SPLIT(0,0))
+ END IF
+!
+ IF (SIZE (ZCRT_C2R2) > 0) THEN
+ ALLOCATE (ZCRT_C2R2_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCRT_C2R2_SPLIT(0,0))
+ END IF
+!
+ IF (SIZE (ZCIT_C1R3) > 0) THEN
+ ALLOCATE (ZCIT_C1R3_SPLIT(IDIM_EFF,KFLEV))
+ ELSE
+ ALLOCATE (ZCIT_C1R3_SPLIT(0,0))
+ END IF
+!
+! LIMA coupling
+!
+ IF( CCLOUD == 'LIMA' ) THEN
+ ALLOCATE (ZCCT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE (ZCRT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE (ZCIT_LIMA_SPLIT(IDIM_EFF,KFLEV))
+ END IF
+ END IF
+!
+! fill the split arrays with their values taken from the full arrays
+!
+ IBEG = IDIM-IDIM_RESIDUE+1
+ IEND = IBEG+IDIM_EFF-1
+!
+ ZALBP_SPLIT(:,:) = ZALBP( IBEG:IEND ,:)
+ ZALBD_SPLIT(:,:) = ZALBD( IBEG:IEND ,:)
+ ZEMIS_SPLIT(:) = ZEMIS ( IBEG:IEND,1 )
+ ZEMIW_SPLIT(:) = ZEMIW ( IBEG:IEND,1 )
+ ZRMU0_SPLIT(:) = ZRMU0 ( IBEG:IEND )
+ ZLAT_SPLIT(:) = ZLAT ( IBEG:IEND )
+ ZLON_SPLIT(:) = ZLON ( IBEG:IEND )
+ ZCFAVE_SPLIT(:,:) = ZCFAVE( IBEG:IEND ,:)
+ ZO3AVE_SPLIT(:,:) = ZO3AVE( IBEG:IEND ,:)
+ ZT_HL_SPLIT(:,:) = ZT_HL( IBEG:IEND ,:)
+ ZPRES_HL_SPLIT(:,:) = ZPRES_HL( IBEG:IEND ,:)
+ ZQLAVE_SPLIT(:,:) = ZQLAVE( IBEG:IEND , :)
+ ZDZ_SPLIT(:,:) = ZDZ( IBEG:IEND , :)
+ ZQIAVE_SPLIT(:,:) = ZQIAVE( IBEG:IEND ,:)
+ ZQRAVE_SPLIT (:,:) = ZQRAVE (IBEG:IEND ,:)
+ ZQLWC_SPLIT(:,:) = ZQLWC( IBEG:IEND , :)
+ ZQIWC_SPLIT(:,:) = ZQIWC( IBEG:IEND ,:)
+ ZQRWC_SPLIT(:,:) = ZQRWC (IBEG:IEND ,:)
+ ZQVAVE_SPLIT(:,:) = ZQVAVE( IBEG:IEND ,:)
+ ZTAVE_SPLIT(:,:) = ZTAVE ( IBEG:IEND ,:)
+ ZPAVE_SPLIT(:,:) = ZPAVE ( IBEG:IEND ,:)
+ ZAER_SPLIT (:,:,:) = ZAER ( IBEG:IEND ,:,:)
+ IF(CAOP=='EXPL')THEN
+ ZPIZA_EQ_SPLIT(:,:,:)=ZPIZA_EQ(IBEG:IEND,:,:)
+ ZCGA_EQ_SPLIT(:,:,:)=ZCGA_EQ(IBEG:IEND,:,:)
+ ZTAUREL_EQ_SPLIT(:,:,:)=ZTAUREL_EQ(IBEG:IEND,:,:)
+ ENDIF
+ ZDPRES_SPLIT(:,:) = ZDPRES (IBEG:IEND ,:)
+ ZLSM_SPLIT (:) = ZLSM (IBEG:IEND)
+ ZQSAVE_SPLIT (:,:) = ZQSAVE (IBEG:IEND ,:)
+ ZTS_SPLIT (:) = ZTS (IBEG:IEND)
+!
+! CALL the ECMWF radiation with the split array
+!
+ IF (CCLOUD == 'LIMA') THEN
+! LIMA concentrations
+ ZCCT_LIMA_SPLIT(:,:) = ZCCT_LIMA (IBEG:IEND ,:)
+ ZCRT_LIMA_SPLIT(:,:) = ZCRT_LIMA (IBEG:IEND ,:)
+ ZCIT_LIMA_SPLIT(:,:) = ZCIT_LIMA (IBEG:IEND ,:)
+
+ IF (CRAD == "ECMW") THEN
+!
+ CALL ECMWF_RADIATION_VERS2 ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, &
+ ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
+ ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT, &
+ ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT, ZT_HL_SPLIT, &
+ ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_LIMA_SPLIT,ZCRT_LIMA_SPLIT,ZCIT_LIMA_SPLIT, &
+ ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, &
+ ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT, &
+ ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT, &
+ ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, &
+ ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT, &
+ GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM_EFF ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, ZPAVE_SPLIT, &
+ PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, ZLSM_SPLIT, ZRMU0_SPLIT, &
+ ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,ZQLAVE_SPLIT,ZQLWC_SPLIT, &
+ ZQSAVE_SPLIT, ZQRAVE_SPLIT, ZQRWC_SPLIT, &
+ ZT_HL_SPLIT,ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_LIMA_SPLIT, &
+ ZCRT_LIMA_SPLIT, ZCIT_LIMA_SPLIT, &
+ ZNFLW_SPLIT, ZNFSW_SPLIT, ZNFLW_CS_SPLIT, ZNFSW_CS_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, ZPLAN_TRA_NIR_SPLIT, &
+ ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, &
+ ZFLWP_SPLIT, ZFIWP_SPLIT,ZRADLP_SPLIT, ZRADIP_SPLIT, &
+ ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, ZTAU_TOTAL_SPLIT, &
+ ZOMEGA_TOTAL_SPLIT,ZCG_TOTAL_SPLIT, &
+ GAOP, ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT,ZLAT_SPLIT,ZLON_SPLIT )
+ END IF
+ ELSE
+! C2R2 concentrations
+ IF (SIZE (ZCCT_C2R2) > 0) ZCCT_C2R2_SPLIT(:,:) = ZCCT_C2R2 (IBEG:IEND ,:)
+ IF (SIZE (ZCRT_C2R2) > 0) ZCRT_C2R2_SPLIT(:,:) = ZCRT_C2R2 (IBEG:IEND ,:)
+ IF (SIZE (ZCIT_C1R3) > 0) ZCIT_C1R3_SPLIT(:,:) = ZCIT_C1R3 (IBEG:IEND ,:)
+ IF (CRAD == "ECMW") THEN
+ CALL ECMWF_RADIATION_VERS2 ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, &
+ ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
+ ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT, &
+ ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT, ZT_HL_SPLIT, &
+ ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT,ZCRT_C2R2_SPLIT,ZCIT_C1R3_SPLIT, &
+ ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, &
+ ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT, &
+ ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT, &
+ ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, &
+ ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT, &
+ GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT )
+
+ ELSE IF (CRAD == "ECRA") THEN
+ CALL ECRAD_INTERFACE ( IDIM_EFF ,KFLEV, KRAD_DIAG, KAER, &
+ ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
+ ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, ZPAVE_SPLIT, &
+ PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, ZLSM_SPLIT, ZRMU0_SPLIT, &
+ ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,ZQLAVE_SPLIT,ZQLWC_SPLIT, &
+ ZQSAVE_SPLIT, ZQRAVE_SPLIT, ZQRWC_SPLIT, &
+ ZT_HL_SPLIT,ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT, &
+ ZCRT_C2R2_SPLIT, ZCIT_C1R3_SPLIT, &
+ ZNFLW_SPLIT, ZNFSW_SPLIT, ZNFLW_CS_SPLIT, ZNFSW_CS_SPLIT, &
+ ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
+ ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
+ ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
+ ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
+ ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
+ ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, ZPLAN_TRA_NIR_SPLIT, &
+ ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, &
+ ZFLWP_SPLIT, ZFIWP_SPLIT,ZRADLP_SPLIT, ZRADIP_SPLIT, &
+ ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, ZTAU_TOTAL_SPLIT, &
+ ZOMEGA_TOTAL_SPLIT,ZCG_TOTAL_SPLIT, &
+ GAOP, ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT,ZLAT_SPLIT,ZLON_SPLIT )
+ END IF
+ END IF
+!
+! fill the full output arrays with the split arrays
+!
+ ZDTLW( IBEG:IEND ,:) = ZDTLW_SPLIT(:,:)
+ ZDTSW( IBEG:IEND ,:) = ZDTSW_SPLIT(:,:)
+ ZFLUX_TOP_GND_IRVISNIR( IBEG:IEND ,:)= ZFLUX_TOP_GND_IRVISNIR_SPLIT(:,:)
+ ZSFSWDIR (IBEG:IEND,:) = ZSFSWDIR_SPLIT(:,:)
+ ZSFSWDIF (IBEG:IEND,:) = ZSFSWDIF_SPLIT(:,:)
+!
+ ZDTLW_CS( IBEG:IEND ,:) = ZDTLW_CS_SPLIT(:,:)
+ ZDTSW_CS( IBEG:IEND ,:) = ZDTSW_CS_SPLIT(:,:)
+ ZFLUX_TOP_GND_IRVISNIR_CS( IBEG:IEND ,:) = &
+ ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(:,:)
+ ZFLUX_LW( IBEG:IEND ,:,:) = ZFLUX_LW_SPLIT(:,:,:)
+ ZFLUX_SW_DOWN( IBEG:IEND ,:) = ZFLUX_SW_DOWN_SPLIT(:,:)
+ ZFLUX_SW_UP( IBEG:IEND ,:) = ZFLUX_SW_UP_SPLIT(:,:)
+ ZRADLP( IBEG:IEND ,:) = ZRADLP_SPLIT(:,:)
+ IF ( tpfile%lopened ) THEN
+ IF( KRAD_DIAG >= 1) THEN
+ ZNFLW(IBEG:IEND ,:)= ZNFLW_SPLIT(:,:)
+ ZNFSW(IBEG:IEND ,:)= ZNFSW_SPLIT(:,:)
+ IF( KRAD_DIAG >= 2) THEN
+ ZFLUX_SW_DOWN_CS( IBEG:IEND ,:) = ZFLUX_SW_DOWN_CS_SPLIT(:,:)
+ ZFLUX_SW_UP_CS( IBEG:IEND ,:) = ZFLUX_SW_UP_CS_SPLIT(:,:)
+ ZFLUX_LW_CS( IBEG:IEND ,:,:) = ZFLUX_LW_CS_SPLIT(:,:,:)
+ ZNFLW_CS(IBEG:IEND ,:)= ZNFLW_CS_SPLIT(:,:)
+ ZNFSW_CS(IBEG:IEND ,:)= ZNFSW_CS_SPLIT(:,:)
+ IF( KRAD_DIAG >= 3) THEN
+ ZPLAN_ALB_VIS( IBEG:IEND ) = ZPLAN_ALB_VIS_SPLIT(:)
+ ZPLAN_ALB_NIR( IBEG:IEND ) = ZPLAN_ALB_NIR_SPLIT(:)
+ ZPLAN_TRA_VIS( IBEG:IEND ) = ZPLAN_TRA_VIS_SPLIT(:)
+ ZPLAN_TRA_NIR( IBEG:IEND ) = ZPLAN_TRA_NIR_SPLIT(:)
+ ZPLAN_ABS_VIS( IBEG:IEND ) = ZPLAN_ABS_VIS_SPLIT(:)
+ ZPLAN_ABS_NIR( IBEG:IEND ) = ZPLAN_ABS_NIR_SPLIT(:)
+ IF( KRAD_DIAG >= 4) THEN
+ ZEFCL_LWD( IBEG:IEND ,:) = ZEFCL_LWD_SPLIT(:,:)
+ ZEFCL_LWU( IBEG:IEND ,:) = ZEFCL_LWU_SPLIT(:,:)
+ ZFLWP( IBEG:IEND ,:) = ZFLWP_SPLIT(:,:)
+ ZFIWP( IBEG:IEND ,:) = ZFIWP_SPLIT(:,:)
+ ZRADIP( IBEG:IEND ,:) = ZRADIP_SPLIT(:,:)
+ ZEFCL_RRTM( IBEG:IEND ,:) = ZEFCL_RRTM_SPLIT(:,:)
+ ZCLSW_TOTAL( IBEG:IEND ,:) = ZCLSW_TOTAL_SPLIT(:,:)
+ ZTAU_TOTAL( IBEG:IEND ,:,:) = ZTAU_TOTAL_SPLIT(:,:,:)
+ ZOMEGA_TOTAL( IBEG:IEND ,:,:)= ZOMEGA_TOTAL_SPLIT(:,:,:)
+ ZCG_TOTAL( IBEG:IEND ,:,:) = ZCG_TOTAL_SPLIT(:,:,:)
+ END IF
+ END IF
+ END IF
+ END IF
+ END IF
+!
+ IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
+!
+! desallocation of the split arrays
+!
+ IF( JI_SPLIT >= INUM_CALL-1 ) THEN
+ DEALLOCATE( ZALBP_SPLIT )
+ DEALLOCATE( ZALBD_SPLIT )
+ DEALLOCATE( ZEMIS_SPLIT )
+ DEALLOCATE( ZEMIW_SPLIT )
+ DEALLOCATE( ZLAT_SPLIT )
+ DEALLOCATE( ZLON_SPLIT )
+ DEALLOCATE( ZRMU0_SPLIT )
+ DEALLOCATE( ZCFAVE_SPLIT )
+ DEALLOCATE( ZO3AVE_SPLIT )
+ DEALLOCATE( ZT_HL_SPLIT )
+ DEALLOCATE( ZPRES_HL_SPLIT )
+ DEALLOCATE( ZDZ_SPLIT )
+ DEALLOCATE( ZQLAVE_SPLIT )
+ DEALLOCATE( ZQIAVE_SPLIT )
+ DEALLOCATE( ZQVAVE_SPLIT )
+ DEALLOCATE( ZTAVE_SPLIT )
+ DEALLOCATE( ZPAVE_SPLIT )
+ DEALLOCATE( ZAER_SPLIT )
+ DEALLOCATE( ZDPRES_SPLIT )
+ DEALLOCATE( ZLSM_SPLIT )
+ DEALLOCATE( ZQSAVE_SPLIT )
+ DEALLOCATE( ZQRAVE_SPLIT )
+ DEALLOCATE( ZQLWC_SPLIT )
+ DEALLOCATE( ZQRWC_SPLIT )
+ DEALLOCATE( ZQIWC_SPLIT )
+ IF ( ALLOCATED( ZCCT_C2R2_SPLIT ) ) DEALLOCATE( ZCCT_C2R2_SPLIT )
+ IF ( ALLOCATED( ZCRT_C2R2_SPLIT ) ) DEALLOCATE( ZCRT_C2R2_SPLIT )
+ IF ( ALLOCATED( ZCIT_C1R3_SPLIT ) ) DEALLOCATE( ZCIT_C1R3_SPLIT )
+ IF ( ALLOCATED( ZCCT_LIMA_SPLIT ) ) DEALLOCATE( ZCCT_LIMA_SPLIT )
+ IF ( ALLOCATED( ZCRT_LIMA_SPLIT ) ) DEALLOCATE( ZCRT_LIMA_SPLIT )
+ IF ( ALLOCATED( ZCIT_LIMA_SPLIT ) ) DEALLOCATE( ZCIT_LIMA_SPLIT )
+ DEALLOCATE( ZTS_SPLIT )
+ DEALLOCATE( ZNFLW_CS_SPLIT)
+ DEALLOCATE( ZNFLW_SPLIT)
+ DEALLOCATE( ZNFSW_CS_SPLIT)
+ DEALLOCATE( ZNFSW_SPLIT)
+ DEALLOCATE(ZDTLW_SPLIT)
+ DEALLOCATE(ZDTSW_SPLIT)
+ DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_SPLIT)
+ DEALLOCATE(ZSFSWDIR_SPLIT)
+ DEALLOCATE(ZSFSWDIF_SPLIT)
+ DEALLOCATE(ZFLUX_SW_DOWN_SPLIT)
+ DEALLOCATE(ZFLUX_SW_UP_SPLIT)
+ DEALLOCATE(ZFLUX_LW_SPLIT)
+ DEALLOCATE(ZDTLW_CS_SPLIT)
+ DEALLOCATE(ZDTSW_CS_SPLIT)
+ DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT)
+ DEALLOCATE(ZPLAN_ALB_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_ALB_NIR_SPLIT)
+ DEALLOCATE(ZPLAN_TRA_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_TRA_NIR_SPLIT)
+ DEALLOCATE(ZPLAN_ABS_VIS_SPLIT)
+ DEALLOCATE(ZPLAN_ABS_NIR_SPLIT)
+ DEALLOCATE(ZEFCL_LWD_SPLIT)
+ DEALLOCATE(ZEFCL_LWU_SPLIT)
+ DEALLOCATE(ZFLWP_SPLIT)
+ DEALLOCATE(ZRADLP_SPLIT)
+ DEALLOCATE(ZRADIP_SPLIT)
+ DEALLOCATE(ZFIWP_SPLIT)
+ DEALLOCATE(ZEFCL_RRTM_SPLIT)
+ DEALLOCATE(ZCLSW_TOTAL_SPLIT)
+ DEALLOCATE(ZTAU_TOTAL_SPLIT)
+ DEALLOCATE(ZOMEGA_TOTAL_SPLIT)
+ DEALLOCATE(ZCG_TOTAL_SPLIT)
+ DEALLOCATE(ZFLUX_SW_DOWN_CS_SPLIT)
+ DEALLOCATE(ZFLUX_SW_UP_CS_SPLIT)
+ DEALLOCATE(ZFLUX_LW_CS_SPLIT)
+ DEALLOCATE(ZPIZA_EQ_SPLIT)
+ DEALLOCATE(ZCGA_EQ_SPLIT)
+ DEALLOCATE(ZTAUREL_EQ_SPLIT)
+ END IF
+ END DO
+END IF
+
+!
+DEALLOCATE(ZTAVE)
+DEALLOCATE(ZPAVE)
+DEALLOCATE(ZQVAVE)
+DEALLOCATE(ZQLAVE)
+DEALLOCATE(ZDZ)
+DEALLOCATE(ZQIAVE)
+DEALLOCATE(ZCFAVE)
+DEALLOCATE(ZPRES_HL)
+DEALLOCATE(ZT_HL)
+DEALLOCATE(ZRMU0)
+DEALLOCATE(ZLSM)
+DEALLOCATE(ZQSAVE)
+DEALLOCATE(ZAER)
+DEALLOCATE(ZPIZA_EQ)
+DEALLOCATE(ZCGA_EQ)
+DEALLOCATE(ZTAUREL_EQ)
+DEALLOCATE(ZDPRES)
+DEALLOCATE(ZCCT_C2R2)
+DEALLOCATE(ZCRT_C2R2)
+DEALLOCATE(ZCIT_C1R3)
+DEALLOCATE(ZLAT)
+DEALLOCATE(ZLON)
+IF (CCLOUD == 'LIMA') THEN
+ DEALLOCATE(ZCCT_LIMA)
+ DEALLOCATE(ZCRT_LIMA)
+ DEALLOCATE(ZCIT_LIMA)
+END IF
+!
+DEALLOCATE(ZTS)
+DEALLOCATE(ZALBP)
+DEALLOCATE(ZALBD)
+DEALLOCATE(ZEMIS)
+DEALLOCATE(ZEMIW)
+DEALLOCATE(ZQRAVE)
+DEALLOCATE(ZQLWC)
+DEALLOCATE(ZQIWC)
+DEALLOCATE(ZQRWC)
+DEALLOCATE(ICLEAR_2D_TM1)
+!
+!* 5.6 UNCOMPRESSES THE OUTPUT FIELD IN CASE OF
+! CLEAR-SKY APPROXIMATION
+!
+IF(OCLEAR_SKY .OR. OCLOUD_ONLY) THEN
+ ALLOCATE(ZWORK1(ICLOUD))
+ ALLOCATE(ZWORK2(ICLOUD+KFLEV)) ! allocation for the KFLEV levels of
+ ALLOCATE(ZWORK4(KFLEV,KDLON))
+ ZWORK2(:) = PACK( TRANSPOSE(ZDTLW(:,:)),MASK=.TRUE. )
+!
+ DO JK=1,KFLEV
+ ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
+ END DO
+ ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
+ ZZDTLW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:) &
+ ,FIELD=ZWORK4(:,:) ) )
+ !
+ ZWORK2(:) = PACK( TRANSPOSE(ZDTSW(:,:)),MASK=.TRUE. )
+ DO JK=1,KFLEV
+ ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
+ END DO
+ ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
+ ZZDTSW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:) &
+ ,FIELD=ZWORK4(:,:) ) )
+ !
+ DEALLOCATE(ZWORK1)
+ DEALLOCATE(ZWORK2)
+ DEALLOCATE(ZWORK4)
+ !
+ ZZTGVISC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,5)
+ !
+ ZZTGVIS(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,5),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGVISC )
+ ZZTGNIRC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,6)
+ !
+ ZZTGNIR(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,6),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGNIRC )
+ ZZTGIRC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,4)
+ !
+ ZZTGIR (:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,4),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD=ZZTGIRC )
+ !
+ DO JSWB=1,ISWB
+ ZZSFSWDIRC(JSWB) = ZSFSWDIR (ICLOUD_COL+1,JSWB)
+ !
+ ZZSFSWDIR(:,JSWB) = UNPACK(ZSFSWDIR (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD= ZZSFSWDIRC(JSWB) )
+ !
+ ZZSFSWDIFC(JSWB) = ZSFSWDIF (ICLOUD_COL+1,JSWB)
+ !
+ ZZSFSWDIF(:,JSWB) = UNPACK(ZSFSWDIF (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
+ FIELD= ZZSFSWDIFC(JSWB) )
+ END DO
+!
+! No cloud case
+!
+ IF( GNOCL ) THEN
+ IF (SIZE(ZZDTLW,1)>1) THEN
+ ZZDTLW(1,:)= ZZDTLW(2,:)
+ ENDIF
+ IF (SIZE(ZZDTSW,1)>1) THEN
+ ZZDTSW(1,:)= ZZDTSW(2,:)
+ ENDIF
+ ZZTGVIS(1) = ZZTGVISC
+ ZZTGNIR(1) = ZZTGNIRC
+ ZZTGIR(1) = ZZTGIRC
+ ZZSFSWDIR(1,:) = ZZSFSWDIRC(:)
+ ZZSFSWDIF(1,:) = ZZSFSWDIFC(:)
+ END IF
+ELSE
+ ZZDTLW(:,:) = ZDTLW(:,:)
+ ZZDTSW(:,:) = ZDTSW(:,:)
+ ZZTGVIS(:) = ZFLUX_TOP_GND_IRVISNIR(:,5)
+ ZZTGNIR(:) = ZFLUX_TOP_GND_IRVISNIR(:,6)
+ ZZTGIR(:) = ZFLUX_TOP_GND_IRVISNIR(:,4)
+ ZZSFSWDIR(:,:) = ZSFSWDIR(:,:)
+ ZZSFSWDIF(:,:) = ZSFSWDIF(:,:)
+END IF
+!
+DEALLOCATE(ZDTLW)
+DEALLOCATE(ZDTSW)
+DEALLOCATE(ZSFSWDIR)
+DEALLOCATE(ZSFSWDIF)
+!
+!--------------------------------------------------------------------------------------------
+!
+!* 6. COMPUTES THE RADIATIVE SOURCES AND THE DOWNWARD SURFACE FLUXES in 2D horizontal
+! ------------------------------------------------------------------------------
+!
+! Computes the SW and LW radiative tendencies
+! note : tendencies in K/s for MNH (from K/day)
+!
+ZDTRAD_LW(:,:,:)=0.0
+ZDTRAD_SW(:,:,:)=0.0
+DO JK=IKB,IKE
+ JKRAD= JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZDTRAD_LW(JI,JJ,JK) = ZZDTLW(IIJ,JKRAD)/XDAY ! XDAY from modd_cst (day duration in s)
+ ZDTRAD_SW(JI,JJ,JK) = ZZDTSW(IIJ,JKRAD)/XDAY
+ END DO
+ END DO
+END DO
+!
+! Computes the downward SW and LW surface fluxes + diffuse and direct contribution
+!
+ZLWD(:,:)=0.
+ZSWDDIR(:,:,:)=0.
+ZSWDDIF(:,:,:)=0.
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZLWD(JI,JJ) = ZZTGIR(IIJ)
+ ZSWDDIR(JI,JJ,:) = ZZSFSWDIR (IIJ,:)
+ ZSWDDIF(JI,JJ,:) = ZZSFSWDIF (IIJ,:)
+ END DO
+END DO
+!
+!final THETA_radiative tendency and surface fluxes
+!
+IF(OCLOUD_ONLY) THEN
+
+ GCLOUD_SURF(:,:) = .FALSE.
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ GCLOUD_SURF(JI,JJ) = GCLOUD(IIJ,1)
+ END DO
+ END DO
+
+ ZWORKL(:,:) = GCLOUD_SURF(:,:)
+
+ DO JK = IKB,IKE
+ WHERE( ZWORKL(:,:) )
+ PDTHRAD(:,:,JK) = (ZDTRAD_LW(:,:,JK)+ZDTRAD_SW(:,:,JK))/ZEXNT(:,:,JK)
+ ENDWHERE
+ END DO
+ !
+ WHERE( ZWORKL(:,:) )
+ PSRFLWD(:,:) = ZLWD(:,:)
+ ENDWHERE
+ DO JSWB=1,ISWB
+ WHERE( ZWORKL(:,:) )
+ PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
+ PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
+ END WHERE
+ END DO
+ELSE
+ PDTHRAD(:,:,:) = (ZDTRAD_LW(:,:,:)+ZDTRAD_SW(:,:,:))/ZEXNT(:,:,:) ! tendency in potential temperature
+ PDTHRADSW(:,:,:) = ZDTRAD_SW(:,:,:)/ZEXNT(:,:,:)
+ PDTHRADLW(:,:,:) = ZDTRAD_LW(:,:,:)/ZEXNT(:,:,:)
+ PSRFLWD(:,:) = ZLWD(:,:)
+ DO JSWB=1,ISWB
+ PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
+ PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
+ END DO
+!
+!sw and lw fluxes
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ PSWU(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
+ PSWD(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
+ PLWU(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
+ PLWD(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD) ! in ECMWF all fluxes are upward
+ END DO
+ END DO
+ END DO
+!!!effective radius
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ PRADEFF(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. STORE SOME ADDITIONNAL RADIATIVE FIELDS
+! ---------------------------------------
+!
+IF( tpfile%lopened .AND. (KRAD_DIAG >= 1) ) THEN
+ ZSTORE_3D(:,:,:) = 0.0
+ ZSTORE_3D2(:,:,:) = 0.0
+ ZSTORE_2D(:,:) = 0.0
+ !
+ TZFIELD2D = TFIELDMETADATA( &
+ CMNHNAME = 'generic 2D for radiations', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+
+ TZFIELD3D = TFIELDMETADATA( &
+ CMNHNAME = 'generic 3D for radiations', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ IF( KRAD_DIAG >= 1) THEN
+ !
+ ILUOUT = TLUOUT%NLU
+ WRITE(UNIT=ILUOUT,FMT='(/," STORE ADDITIONNAL RADIATIVE FIELDS:", &
+ & " KRAD_DIAG=",I1,/)') KRAD_DIAG
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_DOWN'
+ TZFIELD3D%CLONGNAME = 'SWF_DOWN'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_UP'
+ TZFIELD3D%CLONGNAME = 'SWF_UP'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_DOWN'
+ TZFIELD3D%CLONGNAME = 'LWF_DOWN'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_UP'
+ TZFIELD3D%CLONGNAME = 'LWF_UP'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFLW(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_NET'
+ TZFIELD3D%CLONGNAME = 'LWF_NET'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_NET'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFSW(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_NET'
+ TZFIELD3D%CLONGNAME = 'SWF_NET'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_NET'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = ZDTRAD_LW (JI,JJ,JK)*XDAY
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_LW'
+ TZFIELD3D%CLONGNAME = 'DTRAD_LW'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_LW'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = ZDTRAD_SW (JI,JJ,JK)*XDAY
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_SW'
+ TZFIELD3D%CLONGNAME = 'DTRAD_SW'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_SW'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,5)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_VIS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+!
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,6)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_NIR'
+ TZFIELD2D%CLONGNAME = 'RADSWD_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,4)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADLWD'
+ TZFIELD2D%CLONGNAME = 'RADLWD'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADLWD'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ END IF
+ !
+ !
+ IF( KRAD_DIAG >= 2) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_DOWN_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_DOWN_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_DOWN_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_UP_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_UP_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_UP_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW_CS(IIJ,2,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_DOWN_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_DOWN_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_DOWN_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW_CS(IIJ,1,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_UP_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_UP_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_UP_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFLW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'LWF_NET_CS'
+ TZFIELD3D%CLONGNAME = 'LWF_NET_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_NET_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZNFSW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SWF_NET_CS'
+ TZFIELD3D%CLONGNAME = 'SWF_NET_CS'
+ TZFIELD3D%CUNITS = 'W m-2'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_NET_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZDTSW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_SW_CS'
+ TZFIELD3D%CLONGNAME = 'DTRAD_SW_CS'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_SW_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK-JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZDTLW_CS(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'DTRAD_LW_CS'
+ TZFIELD3D%CLONGNAME = 'DTRAD_LW_CS'
+ TZFIELD3D%CUNITS = 'K day-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_LW_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,5)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_VIS_CS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_VIS_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_VIS_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,6)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADSWD_NIR_CS'
+ TZFIELD2D%CLONGNAME = 'RADSWD_NIR_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_NIR_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,4)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'RADLWD_CS'
+ TZFIELD2D%CLONGNAME = 'RADLWD_CS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_RADLWD_CS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ END IF
+ !
+ !
+ IF( KRAD_DIAG >= 3) THEN
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ALB_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ALB_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_ALB_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ALB_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ALB_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ALB_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_ALB_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ALB_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_TRA_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_TRA_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_TRA_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_TRA_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_TRA_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_TRA_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_TRA_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_TRA_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ABS_VIS(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ABS_VIS'
+ TZFIELD2D%CLONGNAME = 'PLAN_ABS_VIS'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ABS_VIS'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_2D(JI,JJ) = ZPLAN_ABS_NIR(IIJ)
+ END DO
+ END DO
+ TZFIELD2D%CMNHNAME = 'PLAN_ABS_NIR'
+ TZFIELD2D%CLONGNAME = 'PLAN_ABS_NIR'
+ TZFIELD2D%CUNITS = ''
+ TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ABS_NIR'
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
+ !
+ !
+ END IF
+!
+!
+ IF( KRAD_DIAG >= 4) THEN
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWD(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFNEB_DOWN'
+ TZFIELD3D%CLONGNAME = 'EFNEB_DOWN'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_EFNEB_DOWN'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWU(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFNEB_UP'
+ TZFIELD3D%CLONGNAME = 'EFNEB_UP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_EFNEB_UP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFLWP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'FLWP'
+ TZFIELD3D%CLONGNAME = 'FLWP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_FLWP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZFIWP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'FIWP'
+ TZFIELD3D%CLONGNAME = 'FIWP'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_FIWP'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFRADL'
+ TZFIELD3D%CLONGNAME = 'EFRADL'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_RAD_microm'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZRADIP(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'EFRADI'
+ TZFIELD3D%CLONGNAME = 'EFRADI'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_RAD_microm'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZCLSW_TOTAL(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SW_NEB'
+ TZFIELD3D%CLONGNAME = 'SW_NEB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SW_NEB'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZEFCL_RRTM(IIJ,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'RRTM_LW_NEB'
+ TZFIELD3D%CLONGNAME = 'RRTM_LW_NEB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_LW_NEB'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ ! spectral bands
+ IF (KSWB_OLD==6) THEN
+ INIR = 4
+ ELSE
+ INIR = 2
+ END IF
+
+ DO JBAND=1,INIR-1
+ WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'VIS', JBAND
+ END DO
+ DO JBAND= INIR, KSWB_OLD
+ WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'NIR', JBAND
+ END DO
+!
+ DO JBAND=1,KSWB_OLD
+ TZFIELD3D%CMNHNAME = 'ODAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'ODAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_OD_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZTAUAZ(:,:,:,JBAND))
+ !
+ TZFIELD3D%CMNHNAME = 'SSAAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'SSAAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZPIZAZ(:,:,:,JBAND))
+ !
+ TZFIELD3D%CMNHNAME = 'GAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'GAER_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_G_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZCGAZ(:,:,:,JBAND))
+ ENDDO
+
+ DO JBAND=1,KSWB_OLD
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZTAU_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'OTH_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'OTH_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_OTH_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZOMEGA_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'SSA_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'SSA_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ !
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZCG_TOTAL(IIJ,JBAND,JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'ASF_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CLONGNAME = 'ASF_'//YBAND_NAME(JBAND)
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_ASF_'//YBAND_NAME(JBAND)
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+ END DO
+ END IF
+ !
+ !
+ IF (KRAD_DIAG >= 5) THEN
+!
+! OZONE and AER optical thickness climato entering the ecmwf_radiation_vers2
+! note the vertical grid is re-inversed for graphic !
+ DO JK=IKB,IKE
+ JKRAD = KFLEV+1 - JK + JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZSTORE_3D(JI,JJ,JK) = ZO3AVE(IIJ, JKRAD)
+ END DO
+ END DO
+ END DO
+ TZFIELD3D%CMNHNAME = 'O3CLIM'
+ TZFIELD3D%CLONGNAME = 'O3CLIM'
+ TZFIELD3D%CUNITS = 'Pa Pa-1'
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_O3'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
+!
+!cumulated optical thickness of aerosols
+!cumul begin from the top of the domain, not from the TOA !
+!
+!land
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,1)
+ END DO
+ END DO
+ END DO
+!
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+ TZFIELD3D%CMNHNAME = 'CUM_AER_LAND'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_LAND'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! sea
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,2)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_SEA'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_SEA'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! desert
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,3)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_DES'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_DES'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! urban
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,4)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_URB'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_URB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! Volcanoes
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,5)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_VOL'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_VOL'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+!
+! stratospheric background
+ DO JK=IKB,IKE
+ JKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,6)
+ END DO
+ END DO
+ END DO
+!sum
+ ZSTORE_2D (:,:) = 0.
+ DO JK=IKB,IKE
+ JK1=IKE-JK+IKB
+ ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
+ ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
+ END DO
+!
+ TZFIELD3D%CMNHNAME = 'CUM_AER_STRB'
+ TZFIELD3D%CLONGNAME = 'CUM_AER_STRB'
+ TZFIELD3D%CUNITS = ''
+ TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
+ CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
+ ENDIF
+END IF
+!
+DEALLOCATE(ZNFLW_CS)
+DEALLOCATE(ZNFLW)
+DEALLOCATE(ZNFSW_CS)
+DEALLOCATE(ZNFSW)
+DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR)
+DEALLOCATE(ZFLUX_SW_DOWN)
+DEALLOCATE(ZFLUX_SW_UP)
+DEALLOCATE(ZFLUX_LW)
+DEALLOCATE(ZDTLW_CS)
+DEALLOCATE(ZDTSW_CS)
+DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS)
+DEALLOCATE(ZPLAN_ALB_VIS)
+DEALLOCATE(ZPLAN_ALB_NIR)
+DEALLOCATE(ZPLAN_TRA_VIS)
+DEALLOCATE(ZPLAN_TRA_NIR)
+DEALLOCATE(ZPLAN_ABS_VIS)
+DEALLOCATE(ZPLAN_ABS_NIR)
+DEALLOCATE(ZEFCL_LWD)
+DEALLOCATE(ZEFCL_LWU)
+DEALLOCATE(ZFLWP)
+DEALLOCATE(ZFIWP)
+DEALLOCATE(ZRADLP)
+DEALLOCATE(ZRADIP)
+DEALLOCATE(ZEFCL_RRTM)
+DEALLOCATE(ZCLSW_TOTAL)
+DEALLOCATE(ZTAU_TOTAL)
+DEALLOCATE(ZOMEGA_TOTAL)
+DEALLOCATE(ZCG_TOTAL)
+DEALLOCATE(ZFLUX_SW_DOWN_CS)
+DEALLOCATE(ZFLUX_SW_UP_CS)
+DEALLOCATE(ZFLUX_LW_CS)
+DEALLOCATE(ZO3AVE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RADIATIONS
+!
+END MODULE MODI_RADIATIONS
diff --git a/src/PHYEX/ext/read_all_data_grib_case.f90 b/src/PHYEX/ext/read_all_data_grib_case.f90
new file mode 100644
index 0000000000000000000000000000000000000000..af2db5f9e53eeb8e755fc5435f1ae6a45c98a6e9
--- /dev/null
+++ b/src/PHYEX/ext/read_all_data_grib_case.f90
@@ -0,0 +1,2615 @@
+!MNH_LIC Copyright 1998-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_READ_ALL_DATA_GRIB_CASE
+! #################################
+INTERFACE
+SUBROUTINE READ_ALL_DATA_GRIB_CASE(HFILE,TPPRE_REAL1,HGRIB,TPPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+CHARACTER(LEN=4), INTENT(IN) :: HFILE ! which file ('ATM0','ATM1' or 'CHEM')
+TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HGRIB ! name of the GRIB file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL ! flag to interpolate dummy fields
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+!
+END SUBROUTINE READ_ALL_DATA_GRIB_CASE
+!
+END INTERFACE
+END MODULE MODI_READ_ALL_DATA_GRIB_CASE
+! ##########################################################################
+ SUBROUTINE READ_ALL_DATA_GRIB_CASE(HFILE,TPPRE_REAL1,HGRIB,TPPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+! ##########################################################################
+!
+!!**** *READ_ALL_DATA_GRIB_CASE* - reads data for the initialization of real cases.
+!!
+!! PURPOSE
+!! -------
+! This routine reads the two input files :
+! The PGD which is closed after reading
+! The GRIB file
+! Projection is read in READ_LFIFM_PGD (MODD_GRID).
+! Grid and definition of large domain are read in PGD file and Grib files.
+! The PGD files are also read in READ_LFIFM_PGD.
+! The PGD file is closed.
+! The MESO-NH domain is defined from PRE_REAL1.nam inputs in SET_SUBDOMAIN_CEP.
+! Vertical grid is defined in READ_VER_GRID.
+! PGD fields are stored on MESO-NH domain (in TRUNC_PGD).
+!!
+!!** METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Read PGD file
+!! 1. Domain restriction
+!! 2. Coordinate conversion to lat,lon system
+!! 2. Read Grib fields
+!! 3. Vertical grid
+!! 4. Free all temporary allocations
+!!
+!! EXTERNAL
+!! --------
+!! subroutine READ_LFIFM_PGD : to read PGD file
+!! subroutine SET_SUBDOMAIN : to define the horizontal MESO-NH domain.
+!! subroutine READ_VER_GRID : to read the vertical grid in namelist file.
+!! subroutine HORIBL : horizontal bilinear interpolation
+!! subroutine XYTOLATLON : projection from conformal to lat,lon
+!!
+!! Module MODI_SET_SUBDOMAIN : interface for subroutine SET_SUBDOMAIN
+!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID
+!! Module MODI_HORIBL : interface for subroutine HORIBL
+!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! TLUOUT0 : name of output-listing
+!! Module MODD_PGDDIM : contains dimension of PGD fields
+!! NPGDIMAX: dimension along x (no external point)
+!! NPGDJMAX: dimension along y (no external point)
+!! Module MODD_PARAMETERS
+!! JPHEXT
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 1 : Informations on ISBA model (soil moisture)
+!! "Encoding and decoding Grib data", John D.Chambers, ECMWF, October 95
+!! "A guide to Grib", John D.Stackpole, National weather service, March 94
+!!
+!! AUTHOR
+!! ------
+!!
+!! J. Pettre and V. Bousquet
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/11/98
+!! 15/03/99 (V. Masson) phasing with new PGD fields
+!! 21/04/99 (V. Masson) bug in mask definitions for max Y index
+!! 22/04/99 (V. Masson) optimizer bug in u,v loop
+!! --> splitting of the loop
+!! and splitting of the routine in more
+!! contains
+!! 28/05/99 (V. Bousquet) bug in wind interpolated variable for
+!! Arpege
+!! 31/05/99 (V. Masson) set pressure points (given on a regular grid at ECMWF)
+!! on orography points (assuming the last are included in the former)
+!! pressure computation from parameters A and B
+!! (instead of interpolation from grib grid)
+!! 20/07/00 (V. Masson) increase the threshold for land_sea index
+!! 22/11/00 (P. Tulet) add INTERPOL_SV to initialize SV fields
+!! (I. Mallet) from MOCAGE model (IMODE=3)
+!! 01/02/01 (D. Gazen) add INI_NSV
+!! 18/05/01 (P. Jabouille) problem with 129 grib code
+!! 05/12/01 (I. Mallet) add Aladin reunion model
+!! 02/10/02 (I. Mallet) 2 orography fields for CEP (SFC, ML=1)
+!! 01/12/03 (D. Gazen) change Chemical scheme interface
+!! 01/2004 (V. Masson) removes surface (externalization)
+!! 01/06/02 (O.Nuissier) filtering of tropical cyclone
+!! 01/05/04 (P. Tulet) add INTERPOL_SV to initialize SV dust
+!! and aerosol fields
+!! 08/06/2010 (G. Tanguy) replace GRIBEX by GRIB_API : change
+!! of all the subroutine
+!! 05/12/2016 (G.Delautier) length of HGRID for grib_api > 1.14
+!! 08/03/2018 (P.Wautelet) replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Pergaud : 2018 add GFS
+!! 01/2019 (G.Delautier via Q.Rodier) for GRIB2 ARPEGE and AROME from EPYGRAM
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! Q. Rodier 16/09/2019: switch of GRIB number ID for orography in ARPEGE/AROME in EPyGrAM
+! Q. Rodier 27/01/2020: switch of GRIB number ID for orography and hydrometeors in ARPEGE/AROME in EPyGrAM v1.3.7
+! Q. Rodier 21/04/2020: correction GFS u and v wind component written in the right vertical order
+! Q. Rodier 02/09/2020: Read and interpol geopotential height for interpolation on isobaric surface Grid of NCEP
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+!JP Chaboureau 02/08/2021: add ERA5 reanalysis in pressure levels
+!JP Chaboureau 18/10/2022: correction on vertical level for GFS and ERA5 reanalyses in pressure levels
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!------------
+!
+USE MODE_DATETIME
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+USE MODE_TIME
+USE MODE_THERMO
+USE MODE_TOOLS, ONLY: UPCASE
+use mode_tools_ll, only: GET_DIM_EXT_ll
+!
+USE MODI_READ_HGRID_n
+USE MODI_READ_VER_GRID
+USE MODI_XYTOLATLON
+USE MODI_HORIBL
+USE MODI_INI_NSV
+USE MODI_REMOVAL_VORTEX
+USE MODI_CH_OPEN_INPUT
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_FIELD_n, ONLY: XZWS, XZWS_DEFAULT
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_LUNIT
+USE MODD_PARAMETERS
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_DIM_n
+USE MODD_PARAM_n, ONLY : CTURB
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH
+USE MODD_CH_M9_n, ONLY : NEQ , CNAMES
+USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,&
+ JPMODE, LVARSIGI, LVARSIGJ
+USE MODD_NSV , ONLY : NSV
+USE MODD_HURR_CONF, ONLY : LFILTERING,CFILTERING
+USE MODD_PREP_REAL
+USE MODE_MODELN_HANDLER
+!JUAN REALZ
+USE MODE_MPPDB
+!JUAN REALZ
+!
+USE GRIB_API
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=4), INTENT(IN) :: HFILE ! which file ('ATM0','ATM1' or 'CHEM')
+TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPPRE_REAL1! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HGRIB ! name of the GRIB file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL ! flag to interpolate dummy fields
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+! General purpose variables
+INTEGER :: ILUOUT0 ! Unit used for output msg.
+INTEGER :: IRESP ! Return code of FM-routines
+INTEGER :: IRET ! Return code from subroutines
+INTEGER(KIND=kindOfInt) :: IRET_GRIB ! Return code from subroutines
+INTEGER, PARAMETER :: JP_GFS=31 ! number of pressure levels for GFS model
+INTEGER, PARAMETER :: JP_ERA=37 ! number of pressure levels for ERA5 reanalysis
+REAL :: ZA,ZB,ZC ! Dummy variables
+REAL :: ZD,ZE,ZF ! |
+REAL :: ZTEMP ! |
+INTEGER :: JI,JJ ! Dummy counters
+INTEGER :: JLOOP1,JLOOP2 ! |
+INTEGER :: JLOOP3,JLOOP4 ! |
+INTEGER :: JLOOP ! |
+! Variables used by the PGD reader
+CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument
+CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument
+CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument
+! PGD Grib definition variables
+INTEGER :: INO ! Number of points of the grid
+INTEGER :: IIU ! Number of points along X
+INTEGER :: IJU ! Number of points along Y
+REAL, DIMENSION(:), ALLOCATABLE :: ZXOUT ! mapping PGD -> Grib (lon.)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYOUT ! mapping PGD -> Grib (lat.)
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.)
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points
+! Variable involved in the task of reading the grib file
+INTEGER(KIND=kindOfInt) :: IUNIT ! unit of the grib file
+CHARACTER(LEN=50) :: HGRID ! type of grid
+INTEGER :: IPAR ! Parameter identifier
+INTEGER :: ITYP ! type of level (Grib code table 3)
+INTEGER :: ILEV1 ! level definition
+INTEGER :: ILEV2 ! level definition
+INTEGER :: IMODEL ! Type of Grib file :
+ ! 0 -> ECMWF
+ ! 1 -> METEO FRANCE - ALADIN/AROME
+ ! 2 -> METEO FRANCE - ALADIN-REUNION
+ ! 3 -> METEO FRANCE - ARPEGE
+ ! 4 -> METEO FRANCE - ARPEGE
+ ! 5 -> METEO FRANCE - MOCAGE
+ ! 10 -> NCEP - GFS
+INTEGER :: ICENTER ! number of center
+INTEGER :: ISIZE ! size of grib message
+INTEGER(KIND=kindOfInt) :: ICOUNT ! number of messages in the file
+INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: IGRIB ! number of the grib in memory
+INTEGER :: INUM ,INUM_ZS ! number of a grib message
+REAL,DIMENSION(:),ALLOCATABLE :: ZPARAM ! parameter of grib grid
+INTEGER,DIMENSION(:),ALLOCATABLE :: IINLO ! longitude of grib grid
+INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: IINLO_GRIB ! longitude of grib grid
+REAL,DIMENSION(:),ALLOCATABLE :: ZPARAM_ZS ! parameter of grib grid for ZS
+INTEGER,DIMENSION(:),ALLOCATABLE :: IINLO_ZS ! longitude of grib grid for ZS
+REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE ! Intermediate array
+REAL,DIMENSION(:),ALLOCATABLE :: ZOUT ! Intermediate arrays
+! Grib grid definition variables
+INTEGER :: INI ! Number of points
+INTEGER :: INLEVEL ! Number of levels
+INTEGER :: ISTARTLEVEL ! First level (0 or 1)
+TYPE(DATE_TIME) :: TPTCUR ! Date & time of the grib file data
+INTEGER :: ITWOZS
+! surface pressure
+REAL, DIMENSION(:), ALLOCATABLE :: ZPS_G ! Grib data : Ps
+REAL, DIMENSION(:), ALLOCATABLE :: ZLNPS_G ! Grib data : ln(Ps)
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK_LNPS ! Grib data on zs grid: ln(Ps)
+INTEGER :: INJ,INJ_ZS
+! orography
+CHARACTER(LEN=50) :: HGRID_ZS ! type of grid
+!
+! Reading and projection of the wind vectors u, v
+REAL :: ZALPHA ! Angle of rotation
+REAL, DIMENSION(:), ALLOCATABLE :: ZTU_LS ! Intermediate array for U
+REAL, DIMENSION(:), ALLOCATABLE :: ZTV_LS ! | V
+REAL :: ZLATPOLE ! Arpege stretching pole latitude
+REAL :: ZLONPOLE ! Arpege stretching pole longitude
+REAL :: ZLAT,ZLON ! Lat,lon of current point
+REAL :: ZCOS,ZSIN ! cos,sin of rotation matrix
+REAL, DIMENSION(:), ALLOCATABLE :: ZTU0_LS ! Arpege temp array for U
+REAL, DIMENSION(:), ALLOCATABLE :: ZTV0_LS ! | V
+!
+! variables for hurricane filtering
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTVF_LS,ZMSLP_LS
+REAL :: ZGAMREF ! Standard atmosphere lapse rate (K/m)
+! date
+INTEGER :: ITIME
+INTEGER :: IDATE
+INTEGER :: ITIMESTEP
+CHARACTER(LEN=10) :: CSTEPUNIT
+CHARACTER(LEN=15) :: YVAL
+!chemistery field
+CHARACTER(LEN=16) :: YPRE_MOC="PRE_MOC1.nam"
+INTEGER, DIMENSION(:), ALLOCATABLE :: INUMGRIB, INUMLEV ! grib
+INTEGER, DIMENSION(:), ALLOCATABLE :: INUMLEV1, INUMLEV2 !numbers
+INTEGER :: IMOC
+INTEGER :: IVAR
+INTEGER :: ICHANNEL
+INTEGER :: INDX
+INTEGER :: INACT
+CHARACTER(LEN=40) :: YINPLINE ! input line
+CHARACTER(LEN=16) :: YFIELD
+CHARACTER, PARAMETER :: YPTAB = CHAR(9) ! TAB character is ASCII : 9
+CHARACTER, PARAMETER :: YPCOM = CHAR(44)! COMma character is ASCII : 44
+CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YMNHNAME ! species names
+INTEGER :: JN, JNREAL ! loop control variables
+CHARACTER(LEN=40) :: YFORMAT
+CHARACTER(LEN=100) :: YMSG
+! temperature and humidity
+INTEGER :: IT,IQ
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPF_G ! Pressure (flux point)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPM_G ! Pressure (mass point)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEXNF_G ! Exner fct. (flux point)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEXNM_G ! Exner fct. (mass point)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZGH_G ! Geopotential Height
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZT_G ! Temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZQ_G ! Specific humidity
+REAL, DIMENSION(:), ALLOCATABLE :: ZH_G ! Relative humidity
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHV_G ! Theta V
+REAL, DIMENSION(:), ALLOCATABLE :: ZRV_G ! Vapor mixing ratio
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPF_LS ! Pressure (flux point)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPM_LS ! Pressure (mass point)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNF_LS ! Exner fct. (flux point)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNM_LS ! Exner fct. (mass point)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZH_LS ! Relative humidity
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_LS ! Vapor mixing ratio
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LS ! Theta V
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEV_LS ! T V
+REAL, DIMENSION(:), ALLOCATABLE :: ZPV ! vertical level in grib file
+INTEGER :: IPVPRESENT ,IPV
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZR_DUM
+INTEGER :: IMI
+TYPE(TFILEDATA),POINTER :: TZFILE
+INTEGER, DIMENSION(JP_GFS) :: IP_GFS ! list of pressure levels for GFS model
+INTEGER, DIMENSION(JP_ERA) :: IP_ERA ! list of pressure levels for ERA5 reanalysis
+INTEGER :: IVERSION,ILEVTYPE
+LOGICAL :: GFIND ! to test if sea wave height is found
+!---------------------------------------------------------------------------------------
+IP_GFS=(/1000,975,950,925,900,850,800,750,700,650,600,550,500,450,400,350,300,&
+ 250,200,150,100,70,50,30,20,10,7,5,3,2,1/)
+IP_ERA=(/1000,975,950,925,900,875,850,825,800,775,750,700,650,600,550,500,450,&
+ 400,350,300,250,225,200,175,150,125,100,70,50,30,20,10,7,5,3,2,1/)
+!
+TZFILE => NULL()
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1. READ PGD FILE
+! -------------
+!
+ILUOUT0 = TLUOUT0%NLU
+CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
+!
+! 1.1 Domain restriction
+!
+!JUAN REALZ
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+!!$IIU=NIMAX + 2*JPHEXT
+!!$IJU=NJMAX + 2*JPHEXT
+!JUAN REALZ
+INO = IIU * IJU
+!
+!
+! 1.2 Coordinate conversion to lat,lon system
+!
+ALLOCATE (ZXM(IIU,IJU))
+ALLOCATE (ZYM(IIU,IJU))
+ALLOCATE (ZLONM(IIU,IJU))
+ALLOCATE (ZLATM(IIU,IJU))
+ZXM(:,:) = SPREAD(XXHATM(:),2,IJU)
+ZYM(:,:) = SPREAD(XYHATM(:),1,IIU)
+CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, &
+ IIU,IJU)
+ALLOCATE (ZLONOUT(INO))
+ALLOCATE (ZLATOUT(INO))
+JLOOP1 = 0
+DO JJ = 1, IJU
+ ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ)
+ ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ)
+ JLOOP1 = JLOOP1 + IIU
+ENDDO
+DEALLOCATE (ZLATM)
+DEALLOCATE (ZLONM)
+DEALLOCATE (ZYM)
+DEALLOCATE (ZXM)
+!
+ALLOCATE (ZXOUT(INO))
+ALLOCATE (ZYOUT(INO))
+!
+!---------------------------------------------------------------------------------------
+!
+!* 2. READ GRIB FIELDS
+! ----------------
+!
+IF (HFILE(1:3)=='ATM' .OR. HFILE=='CHEM') THEN
+ WRITE (ILUOUT0,'(A,A4)') ' -- Grib reader started for ',HFILE
+ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','bad input argument')
+END IF
+!
+!* 2.1 Charge in memory the grib messages
+!
+! open grib file
+CALL GRIB_OPEN_FILE(IUNIT,HGRIB,'R',IRET_GRIB)
+IF (IRET_GRIB /= 0) THEN
+ WRITE(YMSG,*) 'Error opening the grib file ',TRIM(HGRIB),', error code ', IRET_GRIB
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+END IF
+! count the messages in the file
+CALL GRIB_COUNT_IN_FILE(IUNIT,ICOUNT,IRET_GRIB)
+IF (IRET_GRIB /= 0) THEN
+ WRITE(YMSG,*) 'Error in reading the grib file ',TRIM(HGRIB),', error code ', IRET_GRIB
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+END IF
+ALLOCATE(IGRIB(ICOUNT))
+! initialize the tabular with a negativ number
+! ( all the IGRIB will be different )
+IGRIB(:)=-12
+!charge all the message in memory
+DO JLOOP=1,ICOUNT
+CALL GRIB_NEW_FROM_FILE(IUNIT,IGRIB(JLOOP),IRET_GRIB)
+IF (IRET_GRIB /= 0) THEN
+ WRITE(YMSG,*) 'Error in reading the grib file - ILOOP=',JLOOP,' - error code ', IRET_GRIB
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+END IF
+END DO
+! close the grib file
+CALL GRIB_CLOSE_FILE(IUNIT)
+!
+!
+!---------------------------------------------------------------------------------------
+!* 2.2 Research center with the first message
+!---------------------------------------------------------------------------------------
+!
+CALL GRIB_GET(IGRIB(1),'centre',ICENTER,IRET_GRIB)
+IF (IRET_GRIB /= 0) THEN
+ WRITE(YMSG,*) 'Error in reading center - error code ', IRET_GRIB
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+END IF
+CALL GRIB_GET(IGRIB(1),'typeOfGrid',HGRID,IRET_GRIB)
+IF (IRET_GRIB /= 0) THEN
+ WRITE(YMSG,*) 'Error in reading type of grid - error code ', IRET_GRIB
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+END IF
+!
+IMODEL = -1
+SELECT CASE (ICENTER)
+ CASE (98)
+ WRITE (ILUOUT0,'(A)') &
+ ' | Grib file from European Center for Medium-range Weather Forecast'
+ IMODEL = 0
+ ALLOCATE(ZPARAM(6))
+ CASE (85)
+ SELECT CASE (HGRID)
+ CASE('lambert')
+ WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arome france model'
+ CALL GRIB_GET(IGRIB(1),'editionNumber',IVERSION,IRET_GRIB)
+ IF (IVERSION==2) THEN
+ IMODEL = 6 ! GRIB2 since summer 2018 (epygram)
+ ELSE
+ IMODEL = 1 ! GRIB1 befor summer 2018 (lfi2mv)
+ ENDIF
+ ALLOCATE(ZPARAM(10))
+ CASE('mercator')
+ WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Aladin reunion model'
+ IMODEL = 2
+ ALLOCATE(ZPARAM(9))
+
+ CASE('unknown_PLPresent','reduced_stretched_rotated_gg')
+ WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arpege model'
+ ALLOCATE(ZPARAM(10))
+ CALL GRIB_GET(IGRIB(1),'editionNumber',IVERSION,IRET_GRIB)
+ IF (IVERSION==2) THEN
+ IMODEL = 7 ! GRIB2 since summer 2018 (epygram)
+ ELSE
+ IMODEL = 3 ! GRIB1 befor summer 2018 (lfi2mv)
+ ENDIF
+
+ CASE('regular_gg')
+ WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arpege model'
+ WRITE (ILUOUT0,'(A)') 'but same grid as ECMWF model (unstretched)'
+ IMODEL = 4
+ ALLOCATE(ZPARAM(10))
+ CASE('regular_ll')
+ WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Mocage model'
+ IMODEL = 5
+ ALLOCATE(ZPARAM(6))
+ END SELECT
+ CASE (7)
+ WRITE (ILUOUT0,'(A)') ' | Grib file from National Center for Environmental Prediction'
+ IMODEL = 10
+ ALLOCATE(ZPARAM(6))
+END SELECT
+IF (IMODEL==-1) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','unsupported Grib file format')
+END IF
+!
+!---------------------------------------------------------------------------------------
+!* 2.3 Read and interpol orography
+!---------------------------------------------------------------------------------------
+!
+WRITE (ILUOUT0,'(A)') ' | Searching orography'
+SELECT CASE (IMODEL)
+ CASE(0) ! ECMWF
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KPARAM=129)
+ IF(INUM_ZS < 0) THEN
+ WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ END IF
+ CASE(3,4,5) ! arpege et mocage
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KPARAM=8)
+ IF(INUM_ZS < 0) THEN
+ WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ ENDIF
+ CASE(1,2) ! aladin et aladin reunion
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KPARAM=6)
+ IF(INUM_ZS < 0) THEN
+ WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ ENDIF
+ CASE(6,7) ! arpege and arome GRIB2
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=3,KNUMBER=4)
+ IF(INUM_ZS < 0) THEN
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=193,KNUMBER=5)
+ IF(INUM_ZS < 0) THEN
+ WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ END IF
+ ENDIF
+ CASE(10) ! NCEP
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=3,KNUMBER=5,KTFFS=1)
+ IF(INUM_ZS < 0) THEN
+ WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ ENDIF
+END SELECT
+ZPARAM(:)=-999.
+CALL GRIB_GET(IGRIB(INUM_ZS),'Nj',INJ,IRET_GRIB)
+ALLOCATE(IINLO(INJ))
+CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM_ZS),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ALLOCATE(ZPARAM_ZS(SIZE(ZPARAM)))
+ZPARAM_ZS=ZPARAM
+ALLOCATE(IINLO_ZS(SIZE(IINLO)))
+IINLO_ZS=IINLO
+CALL GRIB_GET_SIZE(IGRIB(INUM_ZS),'values',ISIZE)
+ALLOCATE(ZVALUE(ISIZE))
+CALL GRIB_GET(IGRIB(INUM_ZS),'values',ZVALUE)
+ALLOCATE(ZOUT(INO))
+CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+DEALLOCATE(IINLO)
+DEALLOCATE(ZVALUE)
+!
+IF (IMODEL/=10) THEN ! others than NCEP
+ ! Data given in archives are multiplied by the gravity acceleration
+ ZOUT = ZOUT / XG
+END IF
+!
+! Stores the field in a 2 dimension array
+IF (HFILE(1:3)=='ATM') THEN
+ ALLOCATE (XZS_LS(IIU,IJU))
+ ALLOCATE (XZSMT_LS(IIU,IJU))
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XZS_LS)
+ XZSMT_LS = XZS_LS ! no smooth orography in this case
+ELSE IF (HFILE=='CHEM') THEN
+ ALLOCATE (XZS_SV_LS(IIU,IJU))
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XZS_SV_LS)
+END IF
+DEALLOCATE (ZOUT)
+!
+!---------------------------------------------------------------------------------------
+!* 2.3 bis Read and interpol Sea Wave significant height
+!---------------------------------------------------------------------------------------
+WRITE (ILUOUT0,'(A)') ' | Searching sea wave significant height'
+SELECT CASE (IMODEL)
+ CASE(0) ! ECMWF
+ ALLOCATE (XZWS(IIU,IJU))
+ GFIND=.FALSE.
+ !
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=140229)
+ IF(INUM < 0) THEN
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=229)
+ !
+ IF(INUM < 0) THEN
+ WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
+ WRITE (ILUOUT0,'(A)')' | !!! WARNING !!! Sea wave height is missing in '// &
+ 'the GRIB file - the default value of '//TRIM(YVAL)//' meters is used'
+ XZWS = XZWS_DEFAULT
+ ELSE
+ GFIND=.TRUE.
+ END IF
+ ELSE
+ GFIND=.TRUE.
+ END IF
+ !
+ IF (GFIND) THEN
+ !!!!!!!!!!! Faire en sorte de le faire que pour le CASE(0)
+ ! Sea wave significant height disponible uniquement pour ECMWF
+ ! recuperation du tableau de valeurs
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(IINLO(INJ))
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ! Change 9999 value to -1
+ WHERE(ZVALUE.EQ.9999.) ZVALUE=0.
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ DEALLOCATE(IINLO)
+ DEALLOCATE(ZVALUE)
+ ! Stores the field in a 2 dimension array
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XZWS)
+ DEALLOCATE (ZOUT)
+ END IF
+END SELECT
+!
+!---------------------------------------------------------------------------------------
+!* 2.4 Interpolation surface pressure
+!---------------------------------------------------------------------------------------
+!
+!* 2.4.1 Read pressure
+!
+WRITE (ILUOUT0,'(A)') ' | Searching pressure'
+
+SELECT CASE (IMODEL)
+ CASE(0) ! ECMWF
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=152)
+ IF( INUM < 0 ) THEN
+ WRITE (ILUOUT0,'(A)') ' | Logarithm of surface pressure is missing. It is then supposed that'
+ WRITE (ILUOUT0,'(A)') ' | this ECMWF file has atmospheric fields on pressure levels (e.g. ERA5)'
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=134)
+ IMODEL = 11
+ END IF
+ CASE(1,2,3,4,5) ! arpege mocage aladin et aladin reunion
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=1)
+ CASE(6,7) ! NEW AROME,ARPEGE
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=0)
+ CASE(10) ! NCEP
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=134)
+END SELECT
+IF( INUM < 0 ) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'surface pressure is missing' )
+! recuperation du tableau de valeurs
+CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ALLOCATE(ZVALUE(ISIZE))
+CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+! determination des tableaux ZPS_G et ZLNPS_G
+SELECT CASE (IMODEL)
+ CASE(0,6,7) ! ECMWF
+ ALLOCATE (ZPS_G (ISIZE))
+ ALLOCATE (ZLNPS_G(ISIZE))
+ ZLNPS_G(:) = ZVALUE(1:ISIZE)
+ ZPS_G (:) = EXP(ZVALUE(1:ISIZE))
+ CASE(1,2,3,4,5,10,11) ! arpege mocage aladin aladin-reunion NCEP ERA5
+ ALLOCATE (ZPS_G (ISIZE))
+ ALLOCATE (ZLNPS_G(ISIZE))
+ ZPS_G (:) = ZVALUE(1:ISIZE)
+ ZLNPS_G(:) = LOG(ZVALUE(1:ISIZE))
+END SELECT
+DEALLOCATE (ZVALUE)
+!
+!* 2.4.2 Removes pressure points not on orography points
+! (if pressure is on a regular grid)
+CALL GRIB_GET(IGRIB(INUM),'typeOfGrid',HGRID)
+CALL GRIB_GET(IGRIB(INUM_ZS),'typeOfGrid',HGRID_ZS)
+CALL GRIB_GET(IGRIB(INUM),'Nj',INJ)
+CALL GRIB_GET(IGRIB(INUM_ZS),'Nj',INJ_ZS)
+!
+IF ( HGRID(1:7)=='regular' .AND. HGRID_ZS(1:7)=='reduced' .AND.&
+ INJ == INJ_ZS) THEN
+ call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', &
+ 'HGRID(1:7)==regular .AND. HGRID_ZS(1:7)==reduced .AND. INJ == INJ_ZS' )
+ELSE
+ ALLOCATE(ZWORK_LNPS(SIZE(ZLNPS_G)))
+ ZWORK_LNPS(:) = ZLNPS_G(:)
+ENDIF
+!
+IF (HFILE(1:3)=='ATM') THEN
+ ALLOCATE (XPS_LS(IIU,IJU))
+ELSE IF (HFILE=='CHEM') THEN
+ ALLOCATE (XPS_SV_LS(IIU,IJU))
+END IF
+!
+ALLOCATE(IINLO(INJ))
+CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ALLOCATE(ZOUT(INO))
+CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI,&
+ ZWORK_LNPS,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE. )
+DEALLOCATE(ZWORK_LNPS)
+DEALLOCATE(IINLO)
+!
+!* 2.4.3 conversion to surface pressure
+!
+ZOUT=EXP(ZOUT)
+IF (HFILE(1:3)=='ATM') THEN
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XPS_LS(:,:))
+ELSE IF (HFILE=='CHEM') THEN
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XPS_SV_LS(:,:))
+END IF
+!JUAN REALZ
+CALL MPPDB_CHECK2D(XZS_LS,"XZS_LS",PRECISION)
+!JUAN REALZ
+DEALLOCATE (ZOUT)
+DEALLOCATE (ZLNPS_G)
+!
+!---------------------------------------------------------------------------------------
+!* 2.5 Interpolation temperature and humidity
+!---------------------------------------------------------------------------------------
+!
+!* 2.5.1 Read T and Q on each level
+!
+WRITE (ILUOUT0,'(A)') ' | Reading T and Q fields'
+!
+IF (IMODEL==11) THEN
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=130,KLEV1=1000) !look for air temperature at pressure level 1000hPa
+ IF (INUM < 0) IMODEL = 0 ! This change is for handling IFS model level grib file obtained by python API
+END IF
+IF (IMODEL/=10.AND.IMODEL/=11) THEN
+ SELECT CASE (IMODEL)
+ CASE(0) ! ECMWF
+ ISTARTLEVEL=1
+ IT=130
+ IQ=133
+ CASE(1,2,3,4,5) ! arpege mocage aladin et aladin reunion
+ IT=11
+ IQ=51
+ ISTARTLEVEL=1
+ CASE(6,7) !GRIB2 AROME AND ARPEGE
+ IT=130
+ IQ=133
+ ISTARTLEVEL=1
+ END SELECT
+
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
+ IF(INUM < 0) THEN
+ ISTARTLEVEL=0
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
+ ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' )
+ELSEIF (IMODEL==10) THEN ! NCEP
+ ISTARTLEVEL=1000
+ IT=130
+ IQ=157
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric relative humidity is missing' )
+ELSE ! ERA5
+ ISTARTLEVEL=1000
+ IT=130
+ IQ=133
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' )
+ENDIF
+!
+IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5
+ CALL GRIB_GET(IGRIB(INUM),'NV',INLEVEL)
+ INLEVEL = NINT(INLEVEL / 2.) - 1
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ELSE
+ IF (IMODEL==10) THEN
+ INLEVEL=JP_GFS
+ ELSE
+ INLEVEL=JP_ERA
+ END IF
+END IF
+!
+ALLOCATE (ZT_G(ISIZE,INLEVEL))
+ALLOCATE (ZQ_G(ISIZE,INLEVEL))
+!
+IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1-1+ISTARTLEVEL
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
+ IF (INUM< 0) THEN
+ WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,INLEVEL-JLOOP1+1))
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1)
+ IF (INUM< 0) THEN
+ WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,INLEVEL-JLOOP1+1))
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ END DO
+ELSEIF (IMODEL==10) THEN ! NCEP
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = IP_GFS(JLOOP1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
+ IF (INUM< 0) THEN
+ WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,JLOOP1),IRET_GRIB)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=0,KNUMBER=0,KLEV1=ILEV1,KTFFS=100)
+ IF (INUM< 0) THEN
+ WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,JLOOP1),IRET_GRIB)
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ END DO
+ELSE ! ERA5
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = IP_ERA(JLOOP1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
+ IF (INUM< 0) THEN
+ WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,JLOOP1),IRET_GRIB)
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1)
+ IF (INUM< 0) THEN
+ WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,JLOOP1),IRET_GRIB)
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ END DO
+END IF
+
+ALLOCATE(IINLO(INJ))
+CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+!
+!* 2.5.2 Load level definition parameters A and B
+!
+IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5
+
+ IF (HFILE(1:3)=='ATM') THEN
+ XP00_LS = 101325.
+ ELSE IF (HFILE=='CHEM') THEN
+ XP00_SV_LS = 101325.
+ END IF
+!
+ IF (INLEVEL > 0) THEN
+ IF (HFILE(1:3)=='ATM') THEN
+ ALLOCATE (XA_LS(INLEVEL))
+ ALLOCATE (XB_LS(INLEVEL))
+ ELSE IF (HFILE=='CHEM') THEN
+ ALLOCATE (XA_SV_LS(INLEVEL))
+ ALLOCATE (XB_SV_LS(INLEVEL))
+ END IF
+!
+ CALL GRIB_GET(IGRIB(INUM),'PVPresent',IPVPRESENT)
+ IF (IPVPRESENT==1) THEN
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'pv',IPV)
+ ALLOCATE(ZPV(IPV))
+ CALL GRIB_GET(IGRIB(INUM),'pv',ZPV)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','there is no PV value in this message')
+ ENDIF
+ SELECT CASE (IMODEL)
+ CASE (0,3,4,6,7)
+ DO JLOOP1 = 1, INLEVEL
+ XA_LS(1 + INLEVEL - JLOOP1) = ZPV(1+JLOOP1) / XP00_LS
+ XB_LS(1 + INLEVEL - JLOOP1) = ZPV(2+INLEVEL+JLOOP1)
+ END DO
+ CASE (1,2)
+ JLOOP2 = 2
+ DO JLOOP1 = 1, INLEVEL
+ JLOOP2 = JLOOP2 + 1
+ XA_LS(1 + INLEVEL - JLOOP1) = ZPV(JLOOP2)
+ JLOOP2 = JLOOP2 + 1
+ XB_LS(1 + INLEVEL - JLOOP1) = ZPV(JLOOP2)
+ END DO
+ CASE (5)
+ DO JLOOP1 = 1, INLEVEL
+ IF (HFILE(1:3)=='ATM') THEN
+ XA_LS(1 + INLEVEL - JLOOP1) = ZPV(1+ JLOOP1) / XP00_LS**2
+ XB_LS(1 + INLEVEL - JLOOP1) = ZPV(2+INLEVEL+JLOOP1)
+ ELSE IF (HFILE=='CHEM') THEN
+ XA_SV_LS(1 + INLEVEL - JLOOP1) = ZPV(1+ JLOOP1) / XP00_LS**2
+ XB_SV_LS(1 + INLEVEL - JLOOP1) = ZPV(2+INLEVEL+JLOOP1)
+ END IF
+ END DO
+ END SELECT
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','level definition section is missing')
+ END IF
+ELSE
+ ALLOCATE (XA_LS(INLEVEL))
+ ALLOCATE (XB_LS(0))
+ IF (IMODEL==10) THEN
+ XA_LS = 100.*IP_GFS
+ ELSE
+ XA_LS = 100.*IP_ERA
+ END IF
+END IF
+!
+!* 2.5.3 Compute atmospheric pressure on grib grid
+!
+WRITE (ILUOUT0,'(A)') ' | Atmospheric pressure on Grib grid is being computed'
+
+ALLOCATE (ZPF_G(INI,INLEVEL))
+IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5
+ IF (HFILE(1:3)=='ATM') THEN
+ ZPF_G(:,:) = SPREAD(XA_LS,1,INI)*XP00_LS + &
+ SPREAD(XB_LS,1,INI)*SPREAD(ZPS_G(1:INI),2,INLEVEL)
+ ELSE IF (HFILE=='CHEM') THEN
+ ZPF_G(:,:) = SPREAD(XA_SV_LS,1,INI)*XP00_SV_LS + &
+ SPREAD(XB_SV_LS,1,INI)*SPREAD(ZPS_G(1:INI),2,INLEVEL)
+ END IF
+ELSE
+ IF (IMODEL==10) THEN
+ ZPF_G(:,:) = 100.*SPREAD(IP_GFS,1,INI)
+ ELSE
+ ZPF_G(:,:) = 100.*SPREAD(IP_ERA,1,INI)
+ END IF
+END IF
+DEALLOCATE (ZPS_G)
+!
+ALLOCATE (ZEXNF_G(INI,INLEVEL))
+ZEXNF_G(:,:) = (ZPF_G(:,:)/XP00)**(XRD/XCPD)
+!
+ALLOCATE (ZEXNM_G(INI,INLEVEL))
+ZEXNM_G(:,1:INLEVEL-1) = (ZEXNF_G(:,1:INLEVEL-1)-ZEXNF_G(:,2:INLEVEL)) / &
+ (LOG(ZEXNF_G(:,1:INLEVEL-1))-LOG(ZEXNF_G(:,2:INLEVEL)))
+ZEXNM_G(:,INLEVEL) = (ZPF_G(:,INLEVEL)/2./XP00)**(XRD/XCPD)
+!
+IF (IMODEL==10.OR.IMODEL==11) ZEXNM_G(:,:)=ZEXNF_G(:,:) ! for GFS and ERA5 on pressure levels
+!
+DEALLOCATE (ZEXNF_G)
+DEALLOCATE (ZPF_G)
+!
+ALLOCATE (ZPM_G(INI,INLEVEL))
+ZPM_G(:,:) = XP00*(ZEXNM_G(:,:))**(XCPD/XRD)
+!
+!* 2.5.4 Compute the relative humidity and the interpolate Thetav, P, Q and H
+!
+IF (IMODEL==1) THEN
+ ! search cloud_water in Arome case (forecast)
+ ISTARTLEVEL = 1
+ IPAR=246
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
+ IF (INUM < 0) THEN
+ ISTARTLEVEL = 0
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
+ END IF
+ IF (INUM > 0) THEN
+ WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arome model (forecast)'
+ LCPL_AROME=.TRUE.
+ NRR=6
+ END IF
+ ! search also turbulent kinetic energy
+ ISTARTLEVEL = 1
+ IPAR=251
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
+ IF (INUM < 0) THEN
+ ISTARTLEVEL = 0
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
+ END IF
+ IF (INUM > 0) CTURB='TKEL'
+END IF
+
+IF (IMODEL==6) THEN ! GRIB2 AROME
+! search cloud_water in Arome case (forecast)
+ ISTARTLEVEL = 1
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ISTARTLEVEL)
+ IF (INUM < 0) THEN
+ ISTARTLEVEL = 0
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ISTARTLEVEL)
+ END IF
+ IF (INUM < 0) THEN
+ ISTARTLEVEL = 1
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=0,KLEV1=ISTARTLEVEL)
+ END IF
+ IF (INUM > 0) THEN
+ WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arome model (forecast)'
+ LCPL_AROME=.TRUE.
+ NRR=6
+ END IF
+ ! search also turbulent kinetic energy
+ ISTARTLEVEL = 1
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=19,KNUMBER=11,KLEV1=ISTARTLEVEL)
+ IF (INUM < 0) THEN
+ ISTARTLEVEL = 0
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=19,KNUMBER=11,KLEV1=ISTARTLEVEL)
+ END IF
+ IF (INUM > 0) CTURB='TKEL'
+END IF
+!
+!
+WRITE (ILUOUT0,'(A)') ' | Computing relative humidity on each level'
+ALLOCATE (ZH_G(INI))
+ALLOCATE (ZH_LS(IIU,IJU,INLEVEL))
+IF (HFILE(1:3)=='ATM') THEN
+ ALLOCATE (XT_LS(IIU,IJU,INLEVEL))
+ ALLOCATE (XQ_LS(IIU,IJU,INLEVEL,NRR)) ; XQ_LS=0.
+ELSE IF (HFILE=='CHEM') THEN
+ ALLOCATE (XT_SV_LS(IIU,IJU,INLEVEL))
+ ALLOCATE (XQ_SV_LS(IIU,IJU,INLEVEL,1))
+END IF
+IF (CTURB=='TKEL') THEN
+ IF (ALLOCATED(XTKE_LS)) DEALLOCATE(XTKE_LS)
+ ALLOCATE(XTKE_LS(IIU,IJU,INLEVEL)) ; XTKE_LS=0.
+ELSE
+ IF (ALLOCATED(XTKE_LS)) DEALLOCATE(XTKE_LS)
+ ALLOCATE(XTKE_LS(0,0,0))
+END IF
+ALLOCATE (ZTHV_LS(IIU,IJU,INLEVEL))
+ALLOCATE (ZTHV_G(INI))
+ALLOCATE (ZRV_G(INI))
+ALLOCATE (ZOUT(INO))
+IF (IMODEL/=10) THEN ! others than NCEP
+ DO JLOOP1=1, INLEVEL
+ !
+ ! Compute Theta V and relative humidity on grib grid
+ !
+ ! (1/rv) = (1/q) - 1
+ ! Thetav = T . (P0/P)^(Rd/Cpd) . ( (1 + (Rv/Rd).rv) / (1 + rv) )
+ ! Hu = P / ( ( (Rd/Rv) . ((1/rv) - 1) + 1) . Es(T) )
+ !
+ ZRV_G(:) = 1. / (1./MAX(ZQ_G(:,JLOOP1),1.E-12) - 1.)
+ !
+ ZTHV_G(:)=ZT_G(:,JLOOP1) * ((XP00/ZPM_G(:,JLOOP1))**(XRD/XCPD)) * &
+ ((1. + XRV*ZRV_G(:)/XRD) / (1. + ZRV_G(:)))
+ !
+ ZH_G(1:INI) = 100. * ZPM_G(:,JLOOP1) / ( (XRD/XRV)*(1./ZRV_G(:)+1.)*SM_FOES(ZT_G(:,JLOOP1)) )
+ ZH_G(:) = MAX(MIN(ZH_G(:),100.),0.)
+ !
+ ! Interpolation : H
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZH_G,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,ZH_LS(:,:,JLOOP1))
+ ZH_LS(:,:,JLOOP1) = MAX(MIN(ZH_LS(:,:,JLOOP1),100.),0.)
+ !
+ ! interpolation : Theta V
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZTHV_G,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,ZTHV_LS(:,:,JLOOP1))
+ !
+ END DO
+ELSE !GFS and ERA5 on pressure levels
+ DO JLOOP1=1, INLEVEL
+ ZH_G(:) =ZQ_G(:,JLOOP1)
+ ZRV_G(:) = (XRD/XRV)*SM_FOES(ZT_G(:,JLOOP1))*0.01*ZH_G(:) &
+ /(ZPM_G(:,JLOOP1) -SM_FOES(ZT_G(:,JLOOP1))*0.01*ZH_G(:))
+ ZTHV_G(:)=ZT_G(:,JLOOP1) * ((XP00/ZPM_G(:,JLOOP1))**(XRD/XCPD)) * &
+ ((1. + XRV*ZRV_G(:)/XRD) / (1. + ZRV_G(:)))
+ !
+ ! Interpolation : H
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZH_G,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,ZH_LS(:,:,JLOOP1))
+ ZH_LS(:,:,JLOOP1) = MAX(MIN(ZH_LS(:,:,JLOOP1),100.),0.)
+ !
+ ! interpolation : Theta V
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZTHV_G,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,ZTHV_LS(:,:,JLOOP1))
+ !
+ END DO
+END IF
+
+DEALLOCATE (ZOUT)
+
+
+!---------------------------------------------------------------------------------------
+!* 2.5.4.2 Read and interpol geopotential height for interpolation on isobaric surface Grid of NCEP
+!---------------------------------------------------------------------------------------
+!
+ALLOCATE (ZGH_G(ISIZE,INLEVEL))
+!
+IF (IMODEL==10.OR.IMODEL==11) THEN !NCEP or ERA5 with pressure grid only
+ DO JLOOP1=1, INLEVEL
+ IF (IMODEL==10) THEN
+ ILEV1 = IP_GFS(JLOOP1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=5,KLEV1=ILEV1)
+ ELSE
+ ILEV1 = IP_ERA(JLOOP1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=129,KLEV1=ILEV1)
+ END IF
+ IF (INUM< 0) THEN
+ !callabortstop
+ WRITE(YMSG,*) 'Geopotential height level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ !
+ CALL GRIB_GET(IGRIB(INUM),'values',ZGH_G(:,JLOOP1),IRET_GRIB)
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ !
+ IF (IMODEL/=10) THEN
+ ! Data given in archives are multiplied by the gravity acceleration
+ ZGH_G(:,JLOOP1) = ZGH_G(:,JLOOP1) / XG
+ END IF
+ !
+ END DO
+ !
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM_ZS),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ !
+ ALLOCATE(ZOUT(INO))
+ ALLOCATE(XGH_LS(IIU,IJU,INLEVEL))
+ !
+ DO JLOOP1=1, INLEVEL
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZGH_G(:,JLOOP1),INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XGH_LS(:,:,JLOOP1))
+ END DO
+ DEALLOCATE(ZOUT)
+END IF
+!
+!* 2.5.5 Compute atmospheric pressure on MESO-NH grid
+!
+WRITE (ILUOUT0,'(A)') ' | Atmospheric pressure on the Meso-NH grid is being computed'
+ALLOCATE (ZPF_LS(IIU,IJU,INLEVEL))
+IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5
+ IF (HFILE(1:3)=='ATM') THEN
+ ZPF_LS(:,:,:) = SPREAD(SPREAD(XA_LS,1,IIU),2,IJU)*XP00_LS + &
+ SPREAD(SPREAD(XB_LS,1,IIU),2,IJU)*SPREAD(XPS_LS,3,INLEVEL)
+ ELSE IF (HFILE=='CHEM') THEN
+ ZPF_LS(:,:,:) = SPREAD(SPREAD(XA_SV_LS,1,IIU),2,IJU)*XP00_LS + &
+ SPREAD(SPREAD(XB_SV_LS,1,IIU),2,IJU)*SPREAD(XPS_SV_LS,3,INLEVEL)
+ END IF
+ELSE
+ IF(IMODEL==10) THEN
+ ZPF_LS(:,:,:) = 100.*SPREAD(SPREAD(IP_GFS,1,IIU),2,IJU)
+ ELSE
+ ZPF_LS(:,:,:) = 100.*SPREAD(SPREAD(IP_ERA,1,IIU),2,IJU)
+ END IF
+END IF
+!
+ALLOCATE (ZEXNF_LS(IIU,IJU,INLEVEL))
+ZEXNF_LS(:,:,:) = (ZPF_LS(:,:,:)/XP00)**(XRD/XCPD)
+!
+ALLOCATE (ZEXNM_LS(IIU,IJU,INLEVEL))
+ZEXNM_LS(:,:,1:INLEVEL-1) = (ZEXNF_LS(:,:,1:INLEVEL-1)-ZEXNF_LS(:,:,2:INLEVEL)) / &
+ (LOG(ZEXNF_LS(:,:,1:INLEVEL-1))-LOG(ZEXNF_LS(:,:,2:INLEVEL)))
+ZEXNM_LS(:,:,INLEVEL) = (ZPF_LS(:,:,INLEVEL)/2./XP00)**(XRD/XCPD)
+!
+IF (IMODEL==10.OR.IMODEL==11) ZEXNM_LS(:,:,:)=ZEXNF_LS(:,:,:) ! for GFS and ERA5 on pressure levels
+!
+DEALLOCATE (ZEXNF_LS)
+DEALLOCATE (ZPF_LS)
+!
+ALLOCATE (ZPM_LS(IIU,IJU,INLEVEL))
+ZPM_LS(:,:,:) = XP00*(ZEXNM_LS(:,:,:))**(XCPD/XRD)
+!
+!* 2.5.6 Compute the vapor mixing ratio and the final specific humdity
+!
+! The vapor mixing ratio is calculated by an interating process on rv and
+! Thetav. Have a look to MODE_THERMO for further informations.
+ALLOCATE (ZR_DUM(IIU,IJU,INLEVEL,1))
+ALLOCATE (ZRV_LS(IIU,IJU,INLEVEL))
+ALLOCATE (ZTEV_LS(IIU,IJU,INLEVEL))
+ZTEV_LS(:,:,:) = ZTHV_LS(:,:,:) * ZEXNM_LS(:,:,:)
+ZRV_LS(:,:,:) = SM_PMR_HU(ZPM_LS(:,:,:), &
+ZTEV_LS(:,:,:),ZH_LS(:,:,:),ZR_DUM(:,:,:,:),KITERMAX=100)
+IF (HFILE(1:3)=='ATM') THEN
+ XQ_LS(:,:,:,1) = ZRV_LS(:,:,:) / (1. + ZRV_LS(:,:,:))
+ELSE IF (HFILE=='CHEM') THEN
+ XQ_SV_LS(:,:,:,1) = ZRV_LS(:,:,:) / (1. + ZRV_LS(:,:,:))
+ENDIF
+!JUAN
+CALL MPPDB_CHECK3D(XQ_LS(:,:,:,1),"XQ_LS",PRECISION)
+!JUAN
+DEALLOCATE (ZTEV_LS)
+DEALLOCATE (ZH_LS)
+DEALLOCATE (ZR_DUM)
+!
+!* 2.5.7 Compute T from the interpolated Theta V
+!
+! T = Thetav . (P/P0)^(Rd/Cpd) . ((1 + rv) / (1 + (Rv/Rd).rv))
+!!
+IF (HFILE(1:3)=='ATM') THEN
+ XT_LS(:,:,:) = ZTHV_LS(:,:,:) * ZEXNM_LS(:,:,:) &
+ * ((1.+ZRV_LS(:,:,:))/(1.+(XRV/XRD)*ZRV_LS(:,:,:)))
+ CALL MPPDB_CHECK3D(XT_LS,"XT_LS",PRECISION)
+ELSE IF (HFILE=='CHEM') THEN
+ XT_SV_LS(:,:,:) = ZTHV_LS(:,:,:) * ZEXNM_LS(:,:,:) &
+ * ((1.+ZRV_LS(:,:,:))/(1.+(XRV/XRD)*ZRV_LS(:,:,:)))
+ CALL MPPDB_CHECK3D(XT_SV_LS,"XT_SV_LS",PRECISION)
+ENDIF
+!
+DEALLOCATE (ZRV_LS)
+DEALLOCATE (ZTHV_LS)
+DEALLOCATE (ZPM_LS)
+DEALLOCATE (ZEXNM_LS)
+!
+!* 2.5.8 Read the other specific ratios (if Arome model)
+!
+IF (NRR >1) THEN
+ IF (IMODEL==1) THEN
+ WRITE (ILUOUT0,'(A)') ' | Reading Q fields (except humidity)'
+ DO JLOOP2=1,NRR-1
+ IPAR=246+JLOOP2-1
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1-1+ISTARTLEVEL
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
+
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,1+JLOOP2))
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ END DO
+ END DO
+ ELSE ! GRIB2 AROME IMODEL =6
+ WRITE (ILUOUT0,'(A)') ' | Reading Q fields (except humidity)'
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1-1+ISTARTLEVEL
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=83,KLEV1=ILEV1)
+
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,2))
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ END DO
+
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1-1+ISTARTLEVEL
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=85,KLEV1=ILEV1)
+
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'Specific ratio for rain at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,3))
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ END DO
+
+
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1-1+ISTARTLEVEL
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=84,KLEV1=ILEV1)
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'Specific ratio for ICE at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,4))
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ END DO
+
+
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1-1+ISTARTLEVEL
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=86,KLEV1=ILEV1)
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,5))
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ END DO
+
+
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1-1+ISTARTLEVEL
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=201,KLEV1=ILEV1)
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,6))
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ END DO
+ END IF
+END IF
+!
+IF (CTURB=='TKEL') THEN
+ WRITE (ILUOUT0,'(A)') ' | Reading TKE field'
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1-1+ISTARTLEVEL
+ IF (IMODEL==1) THEN
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=251,KLEV1=ILEV1)
+ ELSE ! case 6 new arome
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=19,KNUMBER=11,KLEV1=ILEV1)
+ END IF
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'TKE at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XTKE_LS(:,:,INLEVEL-JLOOP1+1))
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ END DO
+END IF
+DEALLOCATE(IINLO)
+!
+!---------------------------------------------------------------------------------------
+!* 2.6 Interpolation of MOCAGE variable
+!---------------------------------------------------------------------------------------
+
+IF (IMODEL==5) THEN
+ LUSECHEM = .TRUE.
+ IF (LORILAM) THEN
+ CORGANIC = "MPMPO"
+ LVARSIGI = .TRUE.
+ LVARSIGJ = .TRUE.
+ END IF
+ ! initialise NSV_* variables
+ CALL INI_NSV(IMI)
+ IF( HFILE=='ATM0' ) THEN
+ ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
+ ELSE IF (HFILE=='CHEM' ) THEN
+ DEALLOCATE(XSV_LS)
+ ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','Mocage model: Bad input argument in read_all_data_grib_case')
+ END IF
+ XSV_LS(:,:,:,:) = 0.
+ ILEV1=-1
+!
+ WRITE (ILUOUT0,'(A,A4,A)') ' | Reading Mocage species (ppv) from ',HFILE,' file'
+!
+!* 2.6.1 read mocage species
+!
+! open input file
+ CALL CH_OPEN_INPUT(YPRE_MOC, "MOC2MESONH", TZFILE, ILUOUT0, KVERB)
+ ICHANNEL = TZFILE%NLU
+!
+! read number of mocage species to transfer into mesonh
+ READ(ICHANNEL, *) IMOC
+ IF (KVERB >= 5) WRITE(ILUOUT0,*) "number of mocage species to transfer into mesonh : ", IMOC
+!
+! read data input format
+ READ(ICHANNEL,"(A)") YFORMAT
+ YFORMAT=UPCASE(YFORMAT)
+ IF (KVERB >= 5) WRITE(ILUOUT0,*) "input format is: ", YFORMAT
+!
+! allocate fields
+ ALLOCATE(YMNHNAME(IMOC))
+ ALLOCATE(INUMGRIB(IMOC))
+!
+! read variables names and Grib code
+ IF (INDEX(YFORMAT,'A') < INDEX(YFORMAT,'I')) THEN
+ DO JI = 1, IMOC
+ READ(ICHANNEL,YFORMAT) YMNHNAME(JI), INUMGRIB(JI)
+ WRITE(ILUOUT0,YFORMAT) YMNHNAME(JI), INUMGRIB(JI)
+ END DO
+ ELSE
+ DO JI = 1, IMOC
+ READ(ICHANNEL,YFORMAT) INUMGRIB(JI), YMNHNAME(JI)
+ WRITE(ILUOUT0,YFORMAT) INUMGRIB(JI), YMNHNAME(JI)
+ END DO
+ ENDIF
+ !
+ ! close file
+ CALL IO_File_close(TZFILE)
+ TZFILE => NULL()
+ !
+ !* 2.6.2 exchange mocage values onto prognostic variables XSV_LS
+ !
+ IF (KVERB >= 10) WRITE(ILUOUT0,'(A,I4)') ' NEQ=',NEQ
+ !
+ DO JNREAL = 1, NEQ
+ INACT = 0
+ search_loop2 : DO JN = 1, IMOC
+ IF (CNAMES(JNREAL) .EQ. YMNHNAME(JN)) THEN
+ INACT = JN
+ EXIT search_loop2
+ END IF
+ END DO search_loop2
+ IF (INACT .NE. 0) THEN
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = JLOOP1
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=INUMGRIB(JN),KLEV1=ILEV1)
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'Atmospheric ',INUMGRIB(JN),' grib chemical species level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ ALLOCATE(IINLO(INJ))
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU, &
+ XSV_LS(:,:,INLEVEL-JLOOP1+1,JNREAL))
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ DEALLOCATE(IINLO)
+ END DO
+ END IF
+ END DO
+ XSV_LS(:,:,:,:) = MAX(XSV_LS(:,:,:,:),0.)
+ELSE
+ LORILAM = .FALSE.
+ LUSECHEM = .FALSE.
+ ! initialise NSV_* variables
+ CALL INI_NSV(1)
+ IF (NSV > 0) THEN
+ ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
+ XSV_LS(:,:,:,:) = 0.
+ ELSE
+ ALLOCATE(XSV_LS(0,0,0,0))
+ END IF
+END IF
+!
+!---------------------------------------------------------------------------------------
+!* 2.7 Search, read, interpolate and project winds
+!---------------------------------------------------------------------------------------
+!
+! The way winds are processed depends upon the type of archive :
+!
+! -> ECMWF, NCEP
+! Winds are projected from a standard lat,lon grid to MesoNH grid. This correcponds to
+! a rotation of an angle :
+! Alpha = k.(L-L0) - Beta
+! k,L0 and Beta definiiton parameter of MesoNH grid
+! L longitude of the point of the tangent coordinate system
+!
+! -> Aladin
+! The grid used by Aladin files is the same than the one of MesoNH. !
+! So we have 2 sets of parameters :
+! k L0 Beta for MesoNH
+! k' L0' Beta' for Aladin (Beta'=0 for Aladin)
+! We applied twice the formula seen for standard lat,lon grid and we get :
+! Alpha = k.(L-L0) - Beta - k'.(L-L0')
+!
+! -> Arpege
+! Arpege winds are given on the tangent coordinate system of the stretched grid.
+! Therefore they have first to be projected on a standard lat,lon grid. This is done
+! before the interpolation. The projection formulas were given by Meteo France.
+! After this projection, the file is simil
+!
+IF (HFILE(1:3)=='ATM') THEN
+ISTARTLEVEL = 1
+ALLOCATE (XU_LS(IIU,IJU,INLEVEL))
+ALLOCATE (XV_LS(IIU,IJU,INLEVEL))
+ALLOCATE (ZTU_LS(INO))
+ALLOCATE (ZTV_LS(INO))
+!
+SELECT CASE (IMODEL)
+ CASE (0,6,7)
+ IPAR = 131
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
+ IF (INUM< 0) THEN
+ ISTARTLEVEL = 0
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
+ END IF
+ CASE (1,2,3)
+ IPAR = 33
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
+ IF (INUM < 0) THEN
+ ISTARTLEVEL = 0
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
+ END IF
+ CASE (10,11)
+ IPAR = 131
+ ISTARTLEVEL = 1
+END SELECT
+
+DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1
+ IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5
+ ILEV1 = JLOOP1
+ ELSE
+ IF(IMODEL==10) THEN
+ ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1)
+ ELSE
+ ILEV1 = IP_ERA(INLEVEL+ISTARTLEVEL-JLOOP1)
+ END IF
+ END IF
+ ! read component u
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'wind vector component "u" at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ IF (IMODEL==3.OR.(IMODEL==7)) THEN
+ ALLOCATE(ZTU0_LS(INI))
+ ZTU0_LS(:) = ZVALUE(:)
+ ELSE
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ IF(ALLOCATED(IINLO)) DEALLOCATE (IINLO)
+ ALLOCATE(IINLO(INJ))
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.TRUE.,PTIME_HORI,.FALSE. )
+ ZTU_LS(:) = ZOUT(:)
+ DEALLOCATE(IINLO)
+ DEALLOCATE(ZOUT)
+ END IF
+ DEALLOCATE (ZVALUE)
+ ! read component v and perform interpolation if not Arpege grid
+ IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5
+ ILEV1 = JLOOP1
+ ELSE
+ IF(IMODEL==10) THEN
+ ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1)
+ ELSE
+ ILEV1 = IP_ERA(INLEVEL+ISTARTLEVEL-JLOOP1)
+ END IF
+ END IF
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR+1,KLEV1=ILEV1)
+ IF (INUM < 0) THEN
+ WRITE(YMSG,*) 'wind vector component "v" at level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ IF ((IMODEL==3).OR.(IMODEL==7)) THEN
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ ALLOCATE(IINLO(INJ))
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ ALLOCATE(ZTV0_LS(INI))
+ ZTV0_LS(:) = ZVALUE(:)
+ ELSE
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ ALLOCATE(IINLO(INJ))
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.TRUE.,PTIME_HORI,.FALSE.)
+ ZTV_LS(:) = ZOUT(:)
+ DEALLOCATE(ZOUT)
+ END IF
+ DEALLOCATE (ZVALUE)
+ ! interpolations for arpege grid
+ IF ((IMODEL==3).OR.(IMODEL==7)) THEN
+ ! Comes back to real winds instead of stretched winds
+ ! (but still with components according to Arpege grid axes)
+ ZLATPOLE = ZPARAM(7) * XPI/180.
+ ZLONPOLE = ZPARAM(8) * XPI/180.
+ ZC = ZPARAM(9)
+ ZD = ZC * ZC
+ JLOOP3 = 0
+ JLOOP4 = 1
+ ZLAT = ZPARAM(3) * XPI / 180.
+ DO JLOOP2=1, INI
+ ZLON = JLOOP3 * 2. * XPI / IINLO(JLOOP4)
+ ! Compute the scale factor
+ ZA = ((1.+ZD) - (1.-ZD)*SIN(ZLAT)) / (2. * ZC)
+ ZTU0_LS(JLOOP2) = ZTU0_LS(JLOOP2) * ZA
+ ZTV0_LS(JLOOP2) = ZTV0_LS(JLOOP2) * ZA
+ ! next parallel
+ JLOOP3 = JLOOP3 + 1
+ IF (JLOOP3 == IINLO(JLOOP4)) THEN
+ JLOOP3 = 0
+ ZLAT = ZLAT + (((ZPARAM(5)-ZPARAM(3))/(ZPARAM(2)-1)) * XPI / 180.)
+ JLOOP4 = JLOOP4 + 1
+ END IF
+ END DO
+ !
+ ! interpolation
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,&
+ INI,ZTU0_LS,INO,ZXOUT,ZYOUT,ZTU_LS,.TRUE.,PTIME_HORI,.FALSE.)
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,&
+ INI,ZTV0_LS,INO,ZXOUT,ZYOUT,ZTV_LS,.TRUE.,PTIME_HORI,.FALSE.)
+ DEALLOCATE(IINLO)
+ !
+ ! Rotation of the components from Arpege grid axes to real sphere axes
+ !
+ DO JLOOP2=1, INO
+ ZLAT = ZYOUT(JLOOP2) * XPI / 180.
+ ZLON = ZXOUT(JLOOP2) * XPI / 180.
+ ! Compute the rotation matrix
+ ZA = (ZD+1.) + (ZD-1.)*SIN(ZLAT)
+ ZB = (ZD-1.) + (ZD+1.)*SIN(ZLAT)
+ ZE = 2.*ZC*COS(ZLATPOLE)*COS(ZLAT)*COS(ZLON) + ZB*SIN(ZLATPOLE)
+ IF (ABS(ZE) .GE. ABS(ZA)) THEN
+ ZF = -2.*ZC*COS(ZLATPOLE)/ ( COS(ZLAT)* ((ZD+1.)+(ZD-1.)*SIN(ZLATPOLE)) )
+ ZSIN = -ZF*SIN(ZLONPOLE-ZLON)
+ ZCOS = ZF*COS(ZLONPOLE-ZLON)
+ ELSE
+ ZF = 1. / SQRT(ZA*ZA - ZE*ZE)
+ ZSIN = -COS(ZLATPOLE)*SIN(ZLON)*ZA*ZF
+ ZCOS = (2.*ZC*SIN(ZLATPOLE)*COS(ZLAT)-ZB*COS(ZLATPOLE)*COS(ZLON))*ZF
+ ENDIF
+ ZTEMP = ZTU_LS(JLOOP2)
+ ZTU_LS(JLOOP2) = ZCOS*ZTEMP - ZSIN*ZTV_LS(JLOOP2)
+ ZTV_LS(JLOOP2) = ZSIN*ZTEMP + ZCOS*ZTV_LS(JLOOP2)
+ END DO
+ END IF
+ !
+ ! Rotation of the components from the real sphere axes (Arpege, CEP)
+ ! or model axes (Aladin) to MESO-NH axes
+ !
+ JLOOP4=0
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ JLOOP4=JLOOP4+1
+ IF (IMODEL==2 .OR. IMODEL==1 ) THEN
+ IF (IMODEL==2) THEN ! ALADIN REUNION
+ ZALPHA=0
+ ELSE !ALADIN
+ ZALPHA = (XRPK*(ZLONOUT(JLOOP4)-XLON0)-XBETA) - &
+ (SIN(ZPARAM(9)*XPI/180.)*(ZLONOUT(JLOOP4)-ZPARAM(10)))
+ ENDIF
+ ELSE ! CEP, ARPEGE (after projection)
+ ZALPHA = XRPK*(ZLONOUT(JLOOP4)-XLON0)-XBETA
+ ENDIF
+ ZALPHA = ZALPHA * XPI / 180.
+ XU_LS(JI,JJ,INLEVEL+ISTARTLEVEL-JLOOP1)= &
+ ZTU_LS(JLOOP4)*COS(ZALPHA) - ZTV_LS(JLOOP4)*SIN(ZALPHA)
+ XV_LS(JI,JJ,INLEVEL+ISTARTLEVEL-JLOOP1)= &
+ ZTU_LS(JLOOP4)*SIN(ZALPHA) + ZTV_LS(JLOOP4)*COS(ZALPHA)
+ ENDDO
+ ENDDO
+ IF ((IMODEL==3).OR.(IMODEL==7)) THEN ! deallocation of Arpege arrays
+ DEALLOCATE (ZTU0_LS)
+ DEALLOCATE (ZTV0_LS)
+ END IF
+END DO
+DEALLOCATE (ZTU_LS)
+DEALLOCATE (ZTV_LS)
+IF(ALLOCATED(IINLO)) DEALLOCATE (IINLO)
+END IF
+!
+!-------------------------------------------------------------------------------
+!* 2.8 Filter the characteristics of the large-scale vortex
+!-------------------------------------------------------------------------------
+IF (HFILE(1:3)=='ATM' .AND. LFILTERING) THEN
+ WRITE (ILUOUT0,'(A)') ' | Starting the filtering of the fields to remove large-scale vortex'
+ IF (INDEX(CFILTERING,'Q')/=0) THEN
+ WRITE (ILUOUT0,'(A)') ' -> Filtering of Q is now available!'
+ WRITE (ILUOUT0,'(A,A5)') ' CFILTERING= ',CFILTERING
+ ENDIF
+ !
+ IF (INDEX(CFILTERING,'P')/=0) THEN
+ ! compute reduced surface pressure
+ ALLOCATE(ZTVF_LS(IIU,IJU),ZMSLP_LS(IIU,IJU))
+ ! compute pressure reduced to first level above mean sea level
+ ! (rather than above ground level)
+ ZGAMREF=-6.5E-3
+ !virtual temperature at the first level above ground
+ ZTVF_LS(:,:) = XT_LS(:,:,1)*(1.+XQ_LS(:,:,1,1)*(XRV/XRD-1))
+ !virtual temperature averaged between first level above ground
+ ! and first level above sea level
+ ZTVF_LS(:,:) = ZTVF_LS(:,:)-0.5*ZGAMREF*XZS_LS(:,:)
+ ZMSLP_LS(:,:)=XPS_LS(:,:)*EXP(XG*XZS_LS(:,:)/(XRD*ZTVF_LS(:,:)))
+ ENDIF
+ !
+ IF (INDEX(CFILTERING,'P')==0) THEN
+ IF (INDEX(CFILTERING,'Q')==0) THEN
+ CALL REMOVAL_VORTEX(XZS_LS,XU_LS,XV_LS,XT_LS)
+ ELSE
+ CALL REMOVAL_VORTEX(XZS_LS,XU_LS,XV_LS,XT_LS,PQ_LS=XQ_LS(:,:,:,1))
+ ENDIF
+ ELSE
+ IF (INDEX(CFILTERING,'Q')==0) THEN
+ CALL REMOVAL_VORTEX(XZS_LS,XU_LS,XV_LS,XT_LS,PPS_LS=ZMSLP_LS)
+ ELSE
+ CALL REMOVAL_VORTEX(XZS_LS,XU_LS,XV_LS,XT_LS,PQ_LS=XQ_LS(:,:,:,1),PPS_LS=ZMSLP_LS)
+ ENDIF
+ XPS_LS(:,:) = ZMSLP_LS(:,:)*EXP(-XG*XZS_LS(:,:)/(XRD*ZTVF_LS(:,:)))
+ DEALLOCATE(ZTVF_LS,ZMSLP_LS)
+ ENDIF
+ !
+END IF
+!
+!---------------------------------------------------------------------------------------
+!* 2.9 Read date
+!---------------------------------------------------------------------------------------
+!
+WRITE (ILUOUT0,'(A)') ' | Reading date'
+CALL GRIB_GET(IGRIB(INUM),'dataDate',IDATE,IRET_GRIB)
+CALL GRIB_GET(IGRIB(INUM),'dataTime',ITIME,IRET_GRIB)
+TPTCUR%xtime=ITIME/100*3600+(ITIME-(ITIME/100)*100)*60
+TPTCUR%nyear=IDATE/10000
+TPTCUR%nmonth=INT((IDATE-TPTCUR%nyear*10000)/100)
+TPTCUR%nday=IDATE-TPTCUR%nyear*10000-TPTCUR%nmonth*100
+CALL GRIB_GET(IGRIB(INUM),'startStep',ITIMESTEP,IRET_GRIB)
+CALL GRIB_GET(IGRIB(INUM),'stepUnits',CSTEPUNIT,IRET_GRIB)
+IF (IMODEL==0.OR.IMODEL==11) THEN
+ ITWOZS=0
+ IF ((TPTCUR%nyear ==2000).AND.(TPTCUR%nmonth >11)) ITWOZS=1
+ IF ((TPTCUR%nyear ==2000).AND.(TPTCUR%nmonth ==11)) THEN
+ IF ( (TPTCUR%nday >20 ) .OR. &
+ ((TPTCUR%nday ==20 ).AND.(TPTCUR%xtime >=64800 ))) ITWOZS=1
+ END IF
+ IF ( TPTCUR%nyear ==2001 ) ITWOZS=1
+ IF ((TPTCUR%nyear ==2002).AND.(TPTCUR%nmonth <11)) ITWOZS=1
+ IF ((TPTCUR%nyear ==2002).AND.(TPTCUR%nmonth ==11)) THEN
+ IF ( (TPTCUR%nday <24 ) .OR. &
+ ((TPTCUR%nday ==25 ).AND.(TPTCUR%xtime <64800 ))) ITWOZS=1
+ END IF
+ IF (ITWOZS==1) &
+ WRITE(ILUOUT0,*) ' Check that both orography fields on 1st model level and on surface are used.'
+END IF
+
+CALL MPPDB_CHECK3D(XU_LS,"XU_LS",PRECISION)
+CALL MPPDB_CHECK3D(XV_LS,"XV_LS",PRECISION)
+
+SELECT CASE (CSTEPUNIT) ! Time unit indicator
+ CASE ('h') !hour
+ TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP*3600.
+ CASE ('m') !minute
+ TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP*60.
+ CASE ('s') !minute
+ TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP
+ CASE DEFAULT
+ WRITE (ILUOUT0,'(A,A,A)') ' | error CSTEPUNIT=',CSTEPUNIT, ' is different of s,m or h'
+END SELECT
+CALL DATETIME_CORRECTDATE(TPTCUR)
+IF (HFILE(1:3)=='ATM') THEN
+ CALL SM_PRINT_TIME(TPTCUR,TLUOUT0,'MESONH current date')
+ TDTCUR = TPTCUR
+ TDTMOD = TPTCUR
+ TDTSEG = TPTCUR
+ TDTEXP = TPTCUR
+ELSE IF (HFILE=='CHEM') THEN
+ CALL SM_PRINT_TIME(TPTCUR,TLUOUT0,'current date in MesoNH format')
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!* 2.10 Read and interpolate dummy fields listed in free-format part of nml file
+!-------------------------------------------------------------------------------
+IF (ODUMMY_REAL) THEN
+ !
+ WRITE (ILUOUT0,'(A)') ' | Try to read 2D dummy fields'
+ !
+ !* 2.10.1 read 2D dummy fields
+ !
+ ! close file
+ CALL IO_File_close(TPPRE_REAL1)
+ ! open input file
+ CALL CH_OPEN_INPUT(TPPRE_REAL1%CNAME, "DUMMY_2D", TZFILE, ILUOUT0, KVERB)
+ ICHANNEL = TZFILE%NLU
+ !
+ ! read number of dummy 2D fields to transfer into mesonh
+ READ(ICHANNEL, *) IMOC
+ IF (KVERB >= 5) WRITE(ILUOUT0,*) "number of dummy fields to transfer into Mesonh : ", IMOC
+ ALLOCATE(XDUMMY_2D(IIU,IJU,IMOC),CDUMMY_2D(IMOC))
+ ALLOCATE(INUMGRIB(IMOC),INUMLEV(IMOC),INUMLEV1(IMOC),INUMLEV2(IMOC))
+ INUMLEV(:)=-1 ; INUMLEV1(:)=-1 ; INUMLEV2(:)=-1
+ !
+ IVAR=0
+ ! read variables names and Grib codes
+ DO JI = 1, IMOC
+ READ(ICHANNEL,'(A)') YINPLINE
+ YINPLINE= TRIM(ADJUSTL(YINPLINE))
+ IF (LEN_TRIM(YINPLINE) == 0) CYCLE ! skip blank line
+ ! transform tab and comma character into blank
+ DO JJ=1,LEN_TRIM(YINPLINE)
+ IF (YINPLINE(JJ:JJ)==YPTAB .OR. YINPLINE(JJ:JJ)==YPCOM) YINPLINE(JJ:JJ)= ' '
+ END DO
+ IF (KVERB >= 10) WRITE(ILUOUT0,*) 'Line read : ', YINPLINE
+ ! extract field name
+ INDX= INDEX(YINPLINE,' ')
+ YFIELD= YINPLINE(1:INDX-1)
+ IF (KVERB >= 5) WRITE(ILUOUT0,*) 'Field being treated : ', YFIELD
+ ITYP=105
+ ILEV1=-1
+ ILEV2=-1
+ ! extract the parameter indicator
+ YINPLINE= ADJUSTL(YINPLINE(INDX:))
+ INDX= INDEX(YINPLINE,' ')
+ IF (INDX == 1) THEN
+ WRITE(ILUOUT0,*) ' Parameter indicator is missing. ',YFIELD,' not treated.'
+ CYCLE
+ END IF
+ IVAR=IVAR+1
+ READ(YINPLINE(1:INDX-1),*) IPAR
+ IF (NVERB>=5) WRITE(ILUOUT0,*) ' Parameter indicator: ',IPAR
+ ! extract the level indicator (optional)
+ YINPLINE= ADJUSTL(YINPLINE(INDX:))
+ INDX= INDEX(YINPLINE,' ')
+ IF (INDX /= 1) THEN
+ READ(YINPLINE(1:INDX-1),*) ITYP
+ IF (NVERB>=5) WRITE(ILUOUT0,*) ' Level indicator is indicated: ',ITYP
+ END IF
+ ! extract the first level value (optional)
+ YINPLINE= ADJUSTL(YINPLINE(INDX:))
+ INDX= INDEX(YINPLINE,' ')
+ IF (INDX /= 1) THEN
+ READ(YINPLINE(1:INDX-1),*) ILEV1
+ IF (NVERB>=5) WRITE(ILUOUT0,*) ' Level1 value is indicated: ',ILEV1
+ END IF
+ ! extract the second level value (optional)
+ YINPLINE= ADJUSTL(YINPLINE(INDX:))
+ INDX= INDEX(YINPLINE,' ')
+ IF (INDX /= 1) THEN
+ READ(YINPLINE(1:INDX-1),*) ILEV2
+ IF (NVERB>=5) WRITE(ILUOUT0,*) ' Level2 value is indicated: ',ILEV2
+ END IF
+ !
+ CDUMMY_2D(IVAR)=YFIELD ; INUMGRIB(IVAR)=IPAR
+ INUMLEV(IVAR)=ITYP ; INUMLEV1(IVAR)=ILEV1 ; INUMLEV2(IVAR)=ILEV2
+ !
+ END DO
+ !
+ CALL IO_File_close(TZFILE)
+ TZFILE => NULL()
+ !
+ IF (NVERB>=10) THEN
+ WRITE(ILUOUT0,*) CDUMMY_2D(1:IVAR)
+ WRITE(ILUOUT0,*) INUMGRIB(1:IVAR)
+ WRITE(ILUOUT0,*) INUMLEV(1:IVAR)
+ WRITE(ILUOUT0,*) INUMLEV1(1:IVAR)
+ WRITE(ILUOUT0,*) INUMLEV2(1:IVAR)
+ END IF
+ !
+ IF (IVAR /= IMOC) THEN
+ WRITE (ILUOUT0,'(A,I3,A,I3,A)') ' -> Number of correct lines (',IVAR,') is different of ',IMOC,' - abort'
+ WRITE(YMSG,*) 'number of correct lines (',IVAR,') is different of ',IMOC
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ !
+ !* 2.10.2 read and interpolate variables onto dummy variables XDUMMY_2D
+ !
+ DO JI = 1, IMOC
+ WRITE(ILUOUT0,'(A,4(I3,1X))') CDUMMY_2D(JI),INUMGRIB(JI),INUMLEV(JI),INUMLEV1(JI),INUMLEV2(JI)
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
+ IF (INUM < 0) THEN
+ WRITE (ILUOUT0,'(A,I3,A,I2,A)') ' -> 2D field ',INUMGRIB(JI),' is missing - abort'
+ WRITE(YMSG,*) '2D field ',INUMGRIB(JI),' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ ALLOCATE(IINLO(INJ))
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM_ZS),'values',ZVALUE)
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE. )
+ DEALLOCATE(IINLO)
+ DEALLOCATE(ZVALUE)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XDUMMY_2D(:,:,JI))
+ DEALLOCATE (ZOUT)
+ END DO
+!
+ENDIF
+!
+!---------------------------------------------------------------------------------------
+!
+!* 3. VERTICAL GRID
+!
+IF (HFILE(1:3)=='ATM') THEN
+ WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress'
+ CALL READ_VER_GRID(TPPRE_REAL1)
+END IF
+
+!
+!---------------------------------------------------------------------------------------
+!
+!* 4. Free all temporary allocations
+!
+DEALLOCATE (ZLATOUT)
+DEALLOCATE (ZLONOUT)
+DEALLOCATE (ZXOUT)
+DEALLOCATE (ZYOUT)
+DEALLOCATE(ZPARAM)
+DEALLOCATE(ZPARAM_ZS)
+DEALLOCATE(IINLO_ZS)
+DO JLOOP=1,ICOUNT
+ CALL GRIB_RELEASE(IGRIB(JLOOP))
+ENDDO
+DEALLOCATE(IGRIB)
+
+WRITE (ILUOUT0,'(A,A4,A)') ' -- Grib decoder for ',HFILE,' file ended successfully'
+!
+!---------------------------------------------------------------------------------------
+!---------------------------------------------------------------------------------------
+!---------------------------------------------------------------------------------------
+!
+!
+
+!
+CONTAINS
+!
+!
+! ##########################################################################
+ SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2)
+! ##########################################################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KN1
+REAL,DIMENSION(KN1), INTENT(IN) :: P1
+INTEGER, INTENT(IN) :: KL1
+INTEGER, INTENT(IN) :: KL2
+REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2
+INTEGER :: JLOOP1_A1T2
+INTEGER :: JLOOP2_A1T2
+INTEGER :: JPOS_A1T2
+!
+IF (KN1 < KL1*KL2) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match')
+END IF
+JPOS_A1T2 = 1
+DO JLOOP2_A1T2 = 1, KL2
+ DO JLOOP1_A1T2 = 1, KL1
+ P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2)
+ JPOS_A1T2 = JPOS_A1T2 + 1
+ END DO
+END DO
+END SUBROUTINE ARRAY_1D_TO_2D
+!
+!
+!---------------------------------------------------------------------------------------
+!---------------------------------------------------------------------------------------
+!---------------------------------------------------------------------------------------
+!#################################################################################
+SUBROUTINE SEARCH_FIELD(KGRIB,KNUM,KPARAM,KDIS,KCAT,KNUMBER,KLEV1,KTFFS)
+!#################################################################################
+! search the grib message corresponding to KPARAM,KLTYPE,KLEV1,KLEV2 in all
+! the KGIRB messages
+!
+USE MODD_LUNIT
+USE GRIB_API
+!
+IMPLICIT NONE
+!
+!
+INTEGER(KIND=kindOfInt),DIMENSION(:),INTENT(IN) :: KGRIB ! number of grib messages
+INTEGER,INTENT(OUT) :: KNUM ! number of the message researched
+INTEGER,INTENT(IN),OPTIONAL :: KPARAM ! INdicator of parameter/paramId
+INTEGER,INTENT(IN),OPTIONAL :: KDIS ! Discipline (GRIB2)
+INTEGER,INTENT(IN),OPTIONAL :: KCAT ! Catégorie (GRIB2)
+INTEGER,INTENT(IN),OPTIONAL :: KNUMBER ! parameterNumber (GRIB2)
+INTEGER,INTENT(IN),OPTIONAL :: KLEV1 ! Level
+INTEGER,INTENT(IN),OPTIONAL :: KTFFS ! TypeOfFirstFixedSurface
+!
+! Declaration of local variables
+!
+INTEGER :: IFOUND ! Number of correct parameters
+INTEGER :: ISEARCH ! Number of correct parameters to find
+INTEGER :: IRET ! error code
+INTEGER :: IPARAM,IDIS,ICAT,INUMBER,ITFFS
+INTEGER :: ILEV1 ! Level parameter 1
+INTEGER :: JLOOP ! Dummy counter
+INTEGER :: IVERSION
+! Variables used to display messages
+INTEGER :: ILUOUT0 ! Logical unit number of the listing
+!
+ILUOUT0 = TLUOUT0%NLU
+!
+ISEARCH=0
+! Initialize as not found
+KNUM = -1
+!
+IF (PRESENT(KPARAM)) ISEARCH=ISEARCH+1
+IF (PRESENT(KDIS)) ISEARCH=ISEARCH+1
+IF (PRESENT(KCAT)) ISEARCH=ISEARCH+1
+IF (PRESENT(KNUMBER)) ISEARCH=ISEARCH+1
+IF (PRESENT(KLEV1)) ISEARCH=ISEARCH+1
+IF(PRESENT(KTFFS)) ISEARCH=ISEARCH+1
+!
+DO JLOOP=1,SIZE(KGRIB)
+ IFOUND = 0
+ !
+ CALL GRIB_GET(KGRIB(JLOOP),'editionNumber',IVERSION,IRET_GRIB)
+ IF (IRET_GRIB > 0) THEN
+ WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
+ CYCLE
+ ELSE IF (IRET_GRIB == -6) THEN
+ WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
+ CYCLE
+ ENDIF
+ !
+ IF (PRESENT(KTFFS)) THEN
+ CALL GRIB_GET(KGRIB(JLOOP),'typeOfFirstFixedSurface',ITFFS,IRET_GRIB)
+ IF (IRET_GRIB > 0) THEN
+ WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
+ CYCLE
+ ELSE IF (IRET_GRIB == -6) THEN
+ WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
+ CYCLE
+ ENDIF
+ IF (ITFFS==KTFFS) THEN
+ IFOUND = IFOUND + 1
+ ELSE
+ CYCLE
+ ENDIF
+ ENDIF
+
+ IF (PRESENT(KPARAM)) THEN
+ IF (IVERSION == 2) THEN
+ CALL GRIB_GET(KGRIB(JLOOP),'paramId',IPARAM,IRET_GRIB)
+ ELSE
+ CALL GRIB_GET(KGRIB(JLOOP),'indicatorOfParameter',IPARAM,IRET_GRIB)
+ ENDIF
+ IF (IRET_GRIB > 0) THEN
+ WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
+ CYCLE
+ ELSE IF (IRET_GRIB == -6) THEN
+ WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
+ CYCLE
+ ENDIF
+ IF (IPARAM==KPARAM) THEN
+ IFOUND = IFOUND + 1
+ ELSE
+ CYCLE
+ ENDIF
+ ENDIF
+ !
+ IF (PRESENT(KDIS)) THEN
+ CALL GRIB_GET(KGRIB(JLOOP),'discipline',IDIS,IRET_GRIB)
+ IF (IRET_GRIB > 0) THEN
+ WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
+ CYCLE
+ ELSE IF (IRET_GRIB == -6) THEN
+ WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
+ CYCLE
+ ENDIF
+ IF (IDIS==KDIS) THEN
+ IFOUND = IFOUND + 1
+ ELSE
+ CYCLE
+ ENDIF
+ ENDIF
+ IF (PRESENT(KCAT)) THEN
+ CALL GRIB_GET(KGRIB(JLOOP),'parameterCategory',ICAT,IRET_GRIB)
+ IF (IRET_GRIB > 0) THEN
+ WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
+ CYCLE
+ ELSE IF (IRET_GRIB == -6) THEN
+ WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
+ CYCLE
+ ENDIF
+ IF (ICAT==KCAT) THEN
+ IFOUND = IFOUND + 1
+ ELSE
+ CYCLE
+ ENDIF
+ ENDIF
+ IF (PRESENT(KNUMBER)) THEN
+ CALL GRIB_GET(KGRIB(JLOOP),'parameterNumber',INUMBER,IRET_GRIB)
+ IF (IRET_GRIB > 0) THEN
+ WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
+ CYCLE
+ ELSE IF (IRET_GRIB == -6) THEN
+ WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
+ CYCLE
+ ENDIF
+ IF (INUMBER==KNUMBER) THEN
+ IFOUND = IFOUND + 1
+ ELSE
+ CYCLE
+ ENDIF
+ ENDIF
+ !
+ IF(PRESENT(KLEV1)) THEN
+ CALL GRIB_GET(KGRIB(JLOOP),'topLevel',ILEV1,IRET_GRIB)
+ IF (IRET_GRIB > 0) THEN
+ WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
+ CYCLE
+ ELSE IF (IRET_GRIB == -6) THEN
+ WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
+ CYCLE
+ ENDIF
+ IF (ILEV1==KLEV1) THEN
+ IFOUND = IFOUND + 1
+ ELSE
+ CYCLE
+ ENDIF
+ ENDIF
+ !
+ IF (IFOUND == ISEARCH) THEN
+ KNUM=JLOOP
+ EXIT
+ ELSE ! field not found
+ KNUM=-1
+ END IF
+END DO
+!
+END SUBROUTINE SEARCH_FIELD
+!#################################################################################
+SUBROUTINE COORDINATE_CONVERSION(KMODEL,KGRIB,KNOLON,KNOLARG,&
+ PLONOUT,PLATOUT,PLXOUT,PLYOUT,KNI,PPARAM,KINLO)
+!#################################################################################
+!perform coordinate conversion from lat/lon system to x,y (depends on the grib
+! type)
+!! AUTHOR
+!! ------
+!!
+!! G. Tanguy
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 08/06/2010
+
+USE MODD_CST
+USE MODI_LATLONTOXY
+USE GRIB_API
+!
+IMPLICIT NONE
+!
+!
+INTEGER(KIND=kindOfInt),INTENT(IN) :: KGRIB ! number of the grib message
+INTEGER,INTENT(IN) :: KMODEL ! number of the model
+INTEGER,INTENT(OUT) :: KNI ! number of points
+INTEGER,INTENT(IN) :: KNOLON,KNOLARG ! Number of output points
+REAL,DIMENSION( KNOLON*KNOLARG),INTENT(IN) :: PLONOUT ! Output coordinate,
+REAL,DIMENSION( KNOLON*KNOLARG),INTENT(IN) :: PLATOUT ! lat/lon system
+REAL,DIMENSION( KNOLON*KNOLARG),INTENT(INOUT) :: PLXOUT ! Converted output coordinates
+REAL,DIMENSION( KNOLON*KNOLARG),INTENT(INOUT) :: PLYOUT ! (depends on Grib Grid type)
+REAL,DIMENSION(:),INTENT(INOUT) :: PPARAM ! output parameters of
+! the grid to avoid many calculations
+INTEGER,DIMENSION(:),INTENT(INOUT) :: KINLO ! Number of points along a parallel
+!===============================
+INTEGER :: IINLA ! Number of points along a meridian
+INTEGER :: JLOOP1,JLOOP2 ! Dummy counter
+INTEGER :: INO ! Number of output points
+REAL :: ZILA1 ! Grib first point latitude
+REAL :: ZILO1 ! Grib first point longitude
+REAL :: ZILA2 ! Grib last point latitude
+REAL :: ZILO2 ! Grib last point longitude
+REAL :: ZILASP ! Grib streching pole lat
+REAL :: ZILOSP ! Grib streching pole lon
+LOGICAL :: GREADY ! Used to test if projection is needed
+INTEGER :: ILENX ! nb points in X
+INTEGER :: ILENY ! nb points in Y
+INTEGER :: IEARTH !
+REAL :: ZSTRECH ! streching of arpege grid
+INTEGER(KIND=kindOfInt) :: IMISSING ! dummy variable
+! Aladin projection
+REAL :: ZALALAT0 ! Grid definition parameters
+REAL :: ZALALON0 ! |
+REAL :: ZALALATOR ! |
+REAL :: ZALALONOR ! |
+REAL :: ZALARPK ! |
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! Intermediate arrays
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! |
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! |
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! |
+! CEP projection
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATGRIB
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONGRIB
+INTEGER :: INBLATGRIB,INBLONGRIB
+!JUAN
+INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: INLO_GRIB ! Number of points along a parallel
+!JUAN
+!
+!--------------------------------------------------------------------------------
+!
+!JUAN
+ALLOCATE(INLO_GRIB(SIZE(KINLO)))
+!JUAN
+INO= KNOLON*KNOLARG
+SELECT CASE (KMODEL)
+!
+CASE(0,5,11) ! CEP/MOCAGE/ERA5
+! en theorie il faut ces 4 lignes
+! CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZILA1)
+! CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZILO1)
+! CALL GRIB_GET(KGRIB,'latitudeOfLastGridPointInDegrees',ZILA2)
+! CALL GRIB_GET(KGRIB,'longitudeOfLastGridPointInDegrees',ZILO2)
+! pourtant au passage de GRIB1 a GRIB2 les arrondi etait fait differement
+! et on n'obtenais pas les meme resultat entre un fichier grib1 et le meme
+! convertit en GRIB2
+! Du coup en faisant ce qui suit on prend une valeur recalculee par grib_api
+! suivant l'ordre N de la gausienne donc plus precise et donc la meme entre le
+! GRIB1 et le GRIB2
+ CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
+ CALL GRIB_GET_SIZE(KGRIB,'latitudes',INBLATGRIB)
+ CALL GRIB_GET_SIZE(KGRIB,'longitudes',INBLONGRIB)
+ ALLOCATE(ZLATGRIB(INBLATGRIB))
+ ALLOCATE(ZLONGRIB(INBLONGRIB))
+ CALL GRIB_GET(KGRIB,'latitudes',ZLATGRIB)
+ CALL GRIB_GET(KGRIB,'longitudes',ZLONGRIB)
+ ZILA1=MAXVAL(ZLATGRIB)
+ ZILO1=MINVAL(ZLONGRIB)
+ ZILA2=MINVAL(ZLATGRIB)
+ ZILO2=MAXVAL(ZLONGRIB)
+ KNI=0
+ CALL GRIB_IS_MISSING(KGRIB,'pl',IMISSING,IRET_GRIB)
+ IF (IRET_GRIB /= 0 .OR. IMISSING==1) THEN ! pl not present
+ CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
+ INLO_GRIB(2:)=INLO_GRIB(1)
+ KNI=IINLA*INLO_GRIB(1)
+ GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
+ PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
+ PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2)
+ PPARAM(1)=INLO_GRIB(1)
+ PPARAM(2)=IINLA
+ PPARAM(3)=ZILA1
+ PPARAM(4)=ZILO1
+ PPARAM(5)=ZILA2
+ PPARAM(6)=ZILO2
+ ELSE ! pl present in the grib
+ CALL GRIB_GET(KGRIB,'pl',INLO_GRIB)
+ DO JLOOP1=1 ,IINLA
+ KNI = KNI + INLO_GRIB(JLOOP1)
+ ENDDO
+ GREADY= (PPARAM(1)==INLO_GRIB(1) .AND.&
+ PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
+ PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2)
+ PPARAM(1)=INLO_GRIB(1)
+ PPARAM(2)=IINLA
+ PPARAM(3)=ZILA1
+ PPARAM(4)=ZILO1
+ PPARAM(5)=ZILA2
+ PPARAM(6)=ZILO2
+ END IF
+ IF (.NOT. GREADY) THEN
+ PLXOUT=PLONOUT
+ PLYOUT=PLATOUT
+ ENDIF
+!
+CASE(1,6) ! ALADIN
+!
+ CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
+ CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
+ INLO_GRIB(2:)=INLO_GRIB(1)
+ CALL GRIB_GET(KGRIB,'DxInMetres',ILENX)
+ CALL GRIB_GET(KGRIB,'DyInMetres',ILENY)
+ CALL GRIB_GET(KGRIB,'LoVInDegrees',ZALALON0)
+ CALL GRIB_GET(KGRIB,'Latin1InDegrees',ZALALAT0)
+ KNI = IINLA*INLO_GRIB(1)
+ ZILA1 = 0.
+ ZILO1 = 0.
+ ZILA2 = ZILA1 + (IINLA -1)*ILENY
+ ZILO2 = ZILO1 + (INLO_GRIB(1)-1)*ILENX
+ GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
+ PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
+ PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2.AND.&
+ PPARAM(7)==ILENX .AND. PPARAM(8)==ILENY.AND.&
+ PPARAM(9)==ZALALAT0 .AND. PPARAM(10)==ZALALON0)
+ IF(.NOT. GREADY) THEN
+ PPARAM(1)=INLO_GRIB(1)
+ PPARAM(2)=IINLA
+ PPARAM(3)=ZILA1
+ PPARAM(4)=ZILO1
+ PPARAM(5)=ZILA2
+ PPARAM(6)=ZILO2
+ PPARAM(7)=ILENX
+ PPARAM(8)=ILENY
+ PPARAM(9)=ZALALAT0
+ PPARAM(10)=ZALALON0
+!
+ IF (ZALALON0 > 180.) ZALALON0 = ZALALON0 - 360.
+ CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZALALATOR)
+ CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZALALONOR)
+ IF (ZALALONOR > 180.) ZALALONOR = ZALALONOR - 360.
+ ZALARPK = SIN(ZALALAT0/180.*XPI)
+ ALLOCATE (ZXM(KNOLON,KNOLARG))
+ ALLOCATE (ZYM(KNOLON,KNOLARG))
+ ALLOCATE (ZLONM(KNOLON,KNOLARG))
+ ALLOCATE (ZLATM(KNOLON,KNOLARG))
+ JLOOP1=0
+ DO JLOOP2=1, KNOLARG
+ ZLONM(1:KNOLON,JLOOP2) = PLONOUT(1+JLOOP1:KNOLON+JLOOP1)
+ ZLATM(1:KNOLON,JLOOP2) = PLATOUT(1+JLOOP1:KNOLON+JLOOP1)
+ JLOOP1 = JLOOP1+KNOLON
+ END DO
+ CALL SM_LATLONTOXY_A (ZALALAT0,ZALALON0,ZALARPK,ZALALATOR,ZALALONOR, &
+ ZXM,ZYM,ZLATM,ZLONM,KNOLON,KNOLARG,6367470.)
+ JLOOP1=0
+ DO JLOOP2=1, KNOLARG
+ PLXOUT(1+JLOOP1:KNOLON+JLOOP1)=ZXM(1:KNOLON,JLOOP2)
+ PLYOUT(1+JLOOP1:KNOLON+JLOOP1)=ZYM(1:KNOLON,JLOOP2)
+ JLOOP1 = JLOOP1+KNOLON
+ ENDDO
+ DEALLOCATE (ZLATM)
+ DEALLOCATE (ZLONM)
+ DEALLOCATE (ZYM)
+ DEALLOCATE (ZXM)
+ END IF
+!
+CASE(2) ! ALADIN REUNION
+!
+ CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
+ CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
+ INLO_GRIB(2:)=INLO_GRIB(1)
+ CALL GRIB_GET(KGRIB,'DiInMetres',ILENX)
+ CALL GRIB_GET(KGRIB,'DjInMetres',ILENY)
+ CALL GRIB_GET(KGRIB,'LaDInDegrees',ZALALAT0)
+ KNI = IINLA*INLO_GRIB(1)
+ ZILA1 = 0.
+ ZILO1 = 0.
+ ZILA2 = ZILA1 + (IINLA -1)*ILENY
+ ZILO2 = ZILO1 + (INLO_GRIB(1)-1)*ILENX
+ GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
+ PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
+ PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2.AND.&
+ PPARAM(7)==ILENX .AND. PPARAM(8)==ILENY.AND.&
+ PPARAM(9)==ZALALAT0)
+ IF(.NOT. GREADY) THEN
+ PPARAM(1)=INLO_GRIB(1)
+ PPARAM(2)=IINLA
+ PPARAM(3)=ZILA1
+ PPARAM(4)=ZILO1
+ PPARAM(5)=ZILA2
+ PPARAM(6)=ZILO2
+ PPARAM(7)=ILENX
+ PPARAM(8)=ILENY
+ PPARAM(9)=ZALALAT0
+ ZALALON0 = 0.
+ CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZALALATOR)
+ CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZALALONOR)
+ IF (ZALALONOR > 180.) ZALALONOR = ZALALONOR - 360.
+ ZALARPK = 0
+ ALLOCATE (ZXM(KNOLON,KNOLARG))
+ ALLOCATE (ZYM(KNOLON,KNOLARG))
+ ALLOCATE (ZLONM(KNOLON,KNOLARG))
+ ALLOCATE (ZLATM(KNOLON,KNOLARG))
+ JLOOP1=0
+ DO JLOOP2=1, KNOLARG
+ ZLONM(1:KNOLON,JLOOP2) = PLONOUT(1+JLOOP1:KNOLON+JLOOP1)
+ ZLATM(1:KNOLON,JLOOP2) = PLATOUT(1+JLOOP1:KNOLON+JLOOP1)
+ JLOOP1 = JLOOP1+KNOLON
+ END DO
+ CALL GRIB_GET(KGRIB,'earthIsOblate',IEARTH)
+ IF (IEARTH==0) THEN
+ CALL SM_LATLONTOXY_A (ZALALAT0,ZALALON0,ZALARPK,ZALALATOR,ZALALONOR, &
+ ZXM,ZYM,ZLATM,ZLONM,KNOLON,KNOLARG,6367470.)
+ ELSE
+ CALL SM_LATLONTOXY_A (ZALALAT0,ZALALON0,ZALARPK,ZALALATOR,ZALALONOR, &
+ ZXM,ZYM,ZLATM,ZLONM,KNOLON,KNOLARG)
+ END IF
+ JLOOP1=0
+ DO JLOOP2=1, KNOLARG
+ PLXOUT(1+JLOOP1:KNOLON+JLOOP1)=ZXM(1:KNOLON,JLOOP2)
+ PLYOUT(1+JLOOP1:KNOLON+JLOOP1)=ZYM(1:KNOLON,JLOOP2)
+ JLOOP1 = JLOOP1+KNOLON
+ ENDDO
+ DEALLOCATE (ZLATM)
+ DEALLOCATE (ZLONM)
+ DEALLOCATE (ZYM)
+ DEALLOCATE (ZXM)
+ END IF
+!
+CASE(3,4,7) ! ARPEGE
+!
+!print*,"=========COORDINATE CONVERSION CASE ARPEGE ============="
+! PROBLEME AVEC LES GRIB d'EPYGRAM
+! dans longitudeOfLastGridPointInDegrees on la la longitude du dernier point du
+! tableau (donc au pole sud)
+! dans les GRIB1 ont avait la valeur max du tableau des longitude (donc Ã
+! l'equateur)
+ CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZILA1)
+ CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZILO1)
+ CALL GRIB_GET(KGRIB,'latitudeOfLastGridPointInDegrees',ZILA2)
+ CALL GRIB_GET(KGRIB,'longitudeOfLastGridPointInDegrees',ZILO2)
+ CALL GRIB_GET(KGRIB,'latitudeOfStretchingPoleInDegrees',ZILASP)
+ CALL GRIB_GET(KGRIB,'longitudeOfStretchingPoleInDegrees',ZILOSP)
+ CALL GRIB_GET(KGRIB,'stretchingFactor',ZSTRECH)
+ CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
+!
+ KNI=0
+ CALL GRIB_IS_MISSING(KGRIB,'pl',IRET_GRIB)
+ IF (IRET_GRIB == 1) THEN ! regular
+ CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
+ INLO_GRIB(2:)=INLO_GRIB(1)
+ KNI=IINLA*INLO_GRIB(1)
+ GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
+ PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
+ PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2 .AND.&
+ PPARAM(7)==ZILASP .AND. PPARAM(8)==ZILOSP .AND.&
+ PPARAM(9)==ZSTRECH)
+ ELSE ! quasi-regular
+ CALL GRIB_GET(KGRIB,'pl',INLO_GRIB)
+ DO JLOOP1=1 ,IINLA
+ KNI = KNI + INLO_GRIB(JLOOP1)
+ ENDDO
+ ZILO2=360.-360./(MAXVAL(INLO_GRIB))
+ GREADY= (PPARAM(1)==INLO_GRIB(1) .AND.&
+ PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
+ PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2 .AND.&
+ PPARAM(7)==ZILASP .AND. PPARAM(8)==ZILOSP .AND.&
+ PPARAM(9)==ZSTRECH)
+ END IF
+!
+ IF (.NOT. GREADY) THEN
+ CALL ARPEGE_STRETCH_A(INO,ZILASP,ZILOSP, &
+ ZSTRECH,PLATOUT,PLONOUT,PLYOUT,PLXOUT)
+ PPARAM(1)=INLO_GRIB(1)
+ PPARAM(2)=IINLA
+ PPARAM(3)=ZILA1
+ PPARAM(4)=ZILO1
+ PPARAM(5)=ZILA2
+ PPARAM(6)=ZILO2
+ PPARAM(7)=ZILASP
+ PPARAM(8)=ZILOSP
+ PPARAM(9)=ZSTRECH
+ END IF
+!
+CASE(10) ! NCEP
+!
+ CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZILA1)
+ CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZILO1)
+ CALL GRIB_GET(KGRIB,'latitudeOfLastGridPointInDegrees',ZILA2)
+ CALL GRIB_GET(KGRIB,'longitudeOfLastGridPointInDegrees',ZILO2)
+ CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
+ CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
+ INLO_GRIB(2:)=INLO_GRIB(1)
+ KNI=IINLA*INLO_GRIB(1)
+ GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
+ PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
+ PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2)
+ PPARAM(1)=INLO_GRIB(1)
+ PPARAM(2)=IINLA
+ PPARAM(3)=ZILA1
+ PPARAM(4)=ZILO1
+ PPARAM(5)=ZILA2
+ PPARAM(6)=ZILO2
+ IF (.NOT. GREADY) THEN
+ PLXOUT=PLONOUT
+ PLYOUT=PLATOUT
+ ENDIF
+END SELECT
+!JUAN
+KINLO=INLO_GRIB
+!JUAN
+END SUBROUTINE COORDINATE_CONVERSION
+!
+! ###################################################################
+ SUBROUTINE ARPEGE_STRETCH_A(KN,PLAP,PLOP,PCOEF,PLAR,PLOR,PLAC,PLOC)
+! ###################################################################
+!!**** *ARPEGE_STRETCH_A* - Projection to Arpege stretched grid
+!!
+!! PURPOSE
+!! -------
+!!
+!! Projection from standard Lat,Lon grid to Arpege stretched grid
+!!
+!! METHOD
+!! ------
+!!
+!! The projection is defined in two steps :
+!! 1. A rotation to place the stretching pole at the north pole
+!! 2. The stretching
+!! This routine is a basic implementation of the informations founded in
+!! 'Note de travail Arpege nr.3'
+!! 'Transformation de coordonnees'
+!! J.F.Geleyn 1988
+!! This document describes a slightly different transformation in 3 steps. Only the
+!! two first steps are to be taken in account (at the time of writing this paper has
+!! not been updated).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! Module MODD_CST
+!! XPI
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! This routine is based on :
+!! 'Note de travail ARPEGE' number 3
+!! by J.F. GELEYN (may 1988)
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Bousquet
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 07/01/1999
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! -----------------------------
+!
+INTEGER, INTENT(IN) :: KN ! Number of points to convert
+REAL, INTENT(IN) :: PLAP ! Latitude of stretching pole
+REAL, INTENT(IN) :: PLOP ! Longitude of stretching pole
+REAL, INTENT(IN) :: PCOEF ! Stretching coefficient
+REAL, DIMENSION(KN), INTENT(IN) :: PLAR ! Lat. of points
+REAL, DIMENSION(KN), INTENT(IN) :: PLOR ! Lon. of points
+REAL, DIMENSION(KN), INTENT(OUT) :: PLAC ! Computed pseudo-lat. of points
+REAL, DIMENSION(KN), INTENT(OUT) :: PLOC ! Computed pseudo-lon. of points
+!
+!* 0.2. Declaration of local variables
+! -----------------------------------
+!
+REAL :: ZSINSTRETCHLA ! Sine of stretching point lat.
+REAL :: ZSINSTRETCHLO ! Sine of stretching point lon.
+REAL :: ZCOSSTRETCHLA ! Cosine of stretching point lat.
+REAL :: ZCOSSTRETCHLO ! Cosine of stretching point lon.
+REAL :: ZSINLA ! Sine of computed point latitude
+REAL :: ZSINLO ! Sine of computed point longitude
+REAL :: ZCOSLA ! Cosine of computed point latitude
+REAL :: ZCOSLO ! Cosine of computed point longitude
+REAL :: ZSINLAS ! Sine of point's pseudo-latitude
+REAL :: ZSINLOS ! Sine of point's pseudo-longitude
+REAL :: ZCOSLOS ! Cosine of point's pseudo-lon.
+REAL :: ZA,ZB,ZD ! Dummy variables used for
+REAL :: ZX,ZY ! computations
+!
+INTEGER :: JLOOP1 ! Dummy loop counter
+!
+!----------------------------------------------------------------------------
+!
+ZSINSTRETCHLA = SIN(PLAP*XPI/180.)
+ZCOSSTRETCHLA = COS(PLAP*XPI/180.)
+ZSINSTRETCHLO = SIN(PLOP*XPI/180.)
+ZCOSSTRETCHLO = COS(PLOP*XPI/180.)
+! L = longitude (0 = Greenwich, + toward east)
+! l = latitude (90 = N.P., -90 = S.P.)
+! p stands for stretching pole
+PLAC(:) = PLAR(:) * XPI / 180.
+PLOC(:) = PLOR(:) * XPI / 180.
+! A = 1 + c.c
+ZA = 1. + PCOEF*PCOEF
+! B = 1 - c.c
+ZB = 1. - PCOEF*PCOEF
+DO JLOOP1=1, KN
+ ZSINLA = SIN(PLAC(JLOOP1))
+ ZCOSLA = COS(PLAC(JLOOP1))
+ ZSINLO = SIN(PLOC(JLOOP1))
+ ZCOSLO = COS(PLOC(JLOOP1))
+ ! X = cos(Lp-L)
+ ZX = ZCOSLO*ZCOSSTRETCHLO + ZSINLO*ZSINSTRETCHLO
+ ! Y = sin(Lp-L)
+ ZY = ZSINSTRETCHLO*ZCOSLO - ZSINLO*ZCOSSTRETCHLO
+ ! D = (1+c.c) + (1-c.c)(sin lp.sin l + cos lp.cos l.cos(Lp-L))
+ ZD = ZA + ZB*(ZSINSTRETCHLA*ZSINLA+ZCOSSTRETCHLA*ZCOSLA*ZX)
+ ! (1-c.c)+(1+c.c)((sin lp.sin l + cos lp.cos l.cos(Lp-L))
+ ! sin lr = -------------------------------------------------------
+ ! D
+ ZSINLAS = (ZB + ZA*(ZSINSTRETCHLA*ZSINLA+ZCOSSTRETCHLA*ZCOSLA*ZX)) / ZD
+ ! D' = D * cos lr
+ ZD = ZD * (AMAX1(1e-6,SQRT(1.-ZSINLAS*ZSINLAS)))
+ ! 2.c.(cos lp.sin l - sin lp.cos l.cos(Lp-L))
+ ! cos Lr = -------------------------------------------
+ ! D'
+ ZCOSLOS = 2.*PCOEF*(ZCOSSTRETCHLA*ZSINLA-ZSINSTRETCHLA*ZCOSLA*ZX) / ZD
+ ! 2.c.cos l.cos(Lp-L)
+ ! sin Lr = -------------------
+ ! D'
+ ZSINLOS = 2.*PCOEF*(ZCOSLA*ZY) / ZD
+ ! saturations (corrects calculation errors)
+ ZSINLAS = MAX(ZSINLAS,-1.)
+ ZSINLAS = MIN(ZSINLAS, 1.)
+ ZCOSLOS = MAX(ZCOSLOS,-1.)
+ ZCOSLOS = MIN(ZCOSLOS, 1.)
+ ! back from sine & cosine
+ PLAC(JLOOP1) = ASIN(ZSINLAS)
+ IF (ZSINLOS>0) THEN
+ PLOC(JLOOP1) = ACOS(ZCOSLOS)
+ ELSE
+ PLOC(JLOOP1) = -ACOS(ZCOSLOS)
+ ENDIF
+ENDDO
+PLOC(:) = PLOC(:) * 180. / XPI
+PLAC(:) = PLAC(:) * 180. / XPI
+RETURN
+END SUBROUTINE ARPEGE_STRETCH_A
+!
+!
+END SUBROUTINE READ_ALL_DATA_GRIB_CASE
diff --git a/src/PHYEX/ext/read_desfmn.f90 b/src/PHYEX/ext/read_desfmn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..39e599098f7401789fea437b2d6539906d08f4f1
--- /dev/null
+++ b/src/PHYEX/ext/read_desfmn.f90
@@ -0,0 +1,890 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_READ_DESFM_n
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE READ_DESFM_n(KMI,TPDATAFILE,HCONF,OFLAT,OUSERV, &
+ OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
+ OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
+ ODEPOS_SLT,ODUST,ODEPOS_DST, OCHTRANS, &
+ OORILAM,ODEPOS_AER,OLG,OPASPOL,OFIRE, &
+#ifdef MNH_FOREFIRE
+ OFOREFIRE, &
+#endif
+ OLNOX_EXPLICIT, &
+ OCONDSAMP,OBLOWSNOW, &
+ KRIMX,KRIMY,KSV_USER, &
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC,HEQNSYS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
+CHARACTER (LEN=5), INTENT(OUT) :: HCONF ! configuration var. linked to FMfile
+LOGICAL, INTENT(OUT) :: OFLAT ! Logical for zero orography
+LOGICAL, INTENT(OUT) :: OUSERV ! use Rv mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERC ! use Rc mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERR ! use Rr mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERI ! use Ri mixing ratio
+LOGICAL, INTENT(OUT) :: OUSECI ! use Ci concentration of Ice cristals
+LOGICAL, INTENT(OUT) :: OUSERS ! use Rs mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERG ! use Rg mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERH ! use Rh mixing ratio
+LOGICAL, INTENT(OUT) :: OUSECHEM ! Chemical flag
+LOGICAL, INTENT(OUT) :: OUSECHAQ ! Aqueous Chemical flag
+LOGICAL, INTENT(OUT) :: OUSECHIC ! Ice phase Chemical flag
+LOGICAL, INTENT(OUT) :: OCH_PH ! pH flag
+LOGICAL, INTENT(OUT) :: OCH_CONV_LINOX ! LiNOX flag
+LOGICAL, INTENT(OUT) :: OLG ! lagrangian flag
+LOGICAL, INTENT(OUT) :: OSALT ! Sea Salt flag
+LOGICAL, INTENT(OUT) :: ODUST ! Dust flag
+LOGICAL, INTENT(OUT) :: OPASPOL ! Passive pollutant flag
+LOGICAL, INTENT(OUT) :: OFIRE ! Blaze flag
+#ifdef MNH_FOREFIRE
+LOGICAL, INTENT(OUT) :: OFOREFIRE! ForeFire flag
+#endif
+LOGICAL, INTENT(OUT) :: OLNOX_EXPLICIT ! explicit LNOx flag
+LOGICAL, INTENT(OUT) :: OCONDSAMP! Conditional sampling flag
+LOGICAL, INTENT(OUT) :: OBLOWSNOW ! Blowing snow flag
+LOGICAL, INTENT(OUT) :: OORILAM ! Orilam flag
+LOGICAL, INTENT(OUT) :: OCHTRANS ! Deep convection on scalar
+LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_DST ! Dust Wet Deposition flag
+LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_SLT ! Sea Salt Wet Deposition flag
+LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_AER ! Aerosols Wet Deposition flag
+INTEGER, INTENT(OUT) :: KRIMX, KRIMY ! number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, INTENT(OUT) :: KSV_USER ! number of additional scalar
+ ! variables in FMfile
+CHARACTER (LEN=4), INTENT(OUT) :: HTURB ! Kind of turbulence parameterization
+ ! used to produce the FMfile
+CHARACTER (LEN=4), INTENT(OUT) :: HTOM ! Kind of third order moment
+LOGICAL, INTENT(OUT) :: ORMC01 ! flag for RMC01 SBL computations
+CHARACTER (LEN=4), INTENT(OUT) :: HRAD ! Kind of radiation scheme
+CHARACTER (LEN=4), INTENT(OUT) :: HDCONV ! Kind of deep convection scheme
+CHARACTER (LEN=4), INTENT(OUT) :: HSCONV ! Kind of shallow convection scheme
+CHARACTER (LEN=4), INTENT(OUT) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(OUT) :: HELEC ! Kind of electrical scheme
+CHARACTER (LEN=*), INTENT(OUT) :: HEQNSYS! type of equations' system
+END SUBROUTINE READ_DESFM_n
+!
+END INTERFACE
+!
+END MODULE MODI_READ_DESFM_n
+! #########################################################################
+ SUBROUTINE READ_DESFM_n(KMI,TPDATAFILE,HCONF,OFLAT,OUSERV, &
+ OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
+ OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
+ ODEPOS_SLT,ODUST,ODEPOS_DST, OCHTRANS, &
+ OORILAM,ODEPOS_AER,OLG,OPASPOL,OFIRE, &
+#ifdef MNH_FOREFIRE
+ OFOREFIRE, &
+#endif
+ OLNOX_EXPLICIT, &
+ OCONDSAMP,OBLOWSNOW, &
+ KRIMX,KRIMY,KSV_USER, &
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC,HEQNSYS )
+! #########################################################################
+!
+!!**** *READ_DESFM_n * - routine to read the descriptor file DESFM
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to read the descriptor file called
+! DESFM.
+!
+!!
+!!** METHOD
+!! ------
+!! The descriptor file is read. Namelists (NAMXXXn) which contain
+!! informations linked to one nested model are at the beginning of the file.
+!! Namelists (NAMXXX) which contain variables common to all models
+!! are at the end of the file. When the model index is different from 1,
+!! the end of the file (namelists NAMXXX) is not read.
+!! Some attributes of the FMfile are saved in order to check coherence
+!! between initial file and the segment to perform (description given by
+!! EXSEG file), i.e. :
+!! - the configuration which has been used to produce the initial file
+!! (CCONF)
+!! - logical switch for flat configuration (zero orography) in initial file
+!! (LFLAT)
+!! - kind of moist variables in initial file (LUSERV,LUSERC,LUSERR,
+!! LUSERI,LUSERS,LUSERG,LUSERH)
+!! - number of additional scalar variables in initial file (NSV_USER)
+!! - kind of turbulence parameterization used to produce the initial
+!! file (CTURB)
+!! - kind of mixing length used to produce the initial
+!! file (CTURBLEN)
+!! - time step of each model stored in PTSTEP_OLD, to correct the initial
+!! field at t-dt in routine READ_FIELD in case of time step change
+!! - type of equation system in order to verify that the anelastic is the
+!! same for the initila file generation and the run
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODN_CONF : CCONF,LFLAT,CEQNSYS
+!!
+!! Module MODN_CONF1 : LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,
+!! LUSERS,LUSERG,LUSERH
+!!
+!! Module MODN_PARAM1 : CTURB,CRAD,CDCONV,CSCONV
+!!
+!! Module MODN_TURB$n : CTURBLEN
+!!
+!! Module MODN_DYN$n : NRIMX,NRIMY
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine READ_DESFM_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/06/94
+!! Modifications 17/10/94 (Stein) For LCORIO
+!! Modifications 26/10/94 (Stein) remove NAM_GET from the Namelists
+!! present in DESFM + change the namelist names
+!! Modifications 09/01/95 (Stein) add the turbulence scheme
+!! Modifications 09/01/95 (Stein) add the 1D switch
+!! Modifications 13/02/95 (Stein) save HTURBLEN
+!! Modifications 30/06/95 (Stein) add new namelists
+!! Modifications 18/08/95 (Lafore) time step change
+!! Modifications 15/09/95 (Pinty) add the radiations
+!! Modifications 06/02/96 (J.Vila) add the new scalar advection scheme
+!! Modifications 20/02/96 (Stein) add the LES namelist + cleaning
+!! Modifications 25/04/96 (Suhre) add NAM_BLANK
+!! Modifications 25/04/96 (Suhre) add NAM_FRC
+!! Modifications 25/04/96 (Suhre) add NAM_CH_MNHCn and NAM_CH_SOLVER
+!! Modifications 11/04/96 (Pinty) add the ice concentration
+!! Modifications 11/01/97 (Pinty) add the deep convection
+!! Modifications 22/07/96 (Lafore) gridnesting implementation
+!! Modifications 22/06/97 (Stein ) save the equations' system+ cleaning
+!! Modifications 09/07/97 (Masson) add NAM_PARAM_GROUND
+!! Modifications 25/08/97 (Masson) add HGROUND
+!! Modifications 25/10/97 (Stein ) new namelists
+!! Modification 04/06/00 (Pinty) add C2R2 scheme
+!! Modification 22/01/01 (Gazen) Add OUSECHEM and OLG
+!! Modification 15/10/01 (Mallet) allow namelists in different orders
+!! Modification 29/11/02 (Pinty) add C3R5, ICE2, ICE4, ELEC
+!! Modification 01/2004 (Masson) removes surface (externalization)
+!! Modification 01/2005 (Masson) removes 1D and 2D switches
+!! Modification 03/2005 (Tulet) add dust, aerosols
+!! Modification 03/2006 (O.Geoffroy) Add KHKO scheme
+!! Modification 04/2010 (M. Leriche) Add aqueous + ice chemistry
+!! Modification 07/2013 (Bosseur & Filippi) Adds Forefire
+!! Modification 01/2015 (C. Barthe) Add explicit LNOx
+!! Modification 2016 (B.VIE) LIMA
+!! Modification 11/2016 (Ph. Wautelet) Allocate/initialise some output/backup structures
+!! Modification 02/2018 (Q.Libois) ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Modification 07/2017 (V. Vionnet) Add blowing snow scheme
+!! Modification 02/2021 (F.Auguste) add IBM
+!! (T.Nagel) add turbulence recycling
+!! (E.Jezequel) add stations read from CSV file
+! A. Costes 12/2021: add Blaze fire model
+! P. Wautelet 27/04/2022: add namelist for profilers
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAMETERS
+!
+USE MODN_BACKUP
+USE MODN_BUDGET
+USE MODN_CONF
+USE MODN_DYN
+USE MODN_NESTING
+USE MODN_OUTPUT
+USE MODN_LES
+USE MODN_CONF_n
+USE MODN_DYN_n
+USE MODN_ADV_n
+USE MODN_PARAM_n
+USE MODN_PARAM_RAD_n
+USE MODN_PARAM_ECRAD_n
+USE MODN_PARAM_KAFR_n
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
+USE MODD_PARAM_ICE_n, ONLY : PARAM_ICEN_INIT
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
+USE MODN_LUNIT_n
+USE MODN_LBC_n
+USE MODN_NUDGING_n
+USE MODD_TURB_n, ONLY: TURBN_INIT, CTOM, LRMC01
+USE MODD_NEB_n, ONLY: NEBN_INIT
+USE MODN_FRC
+USE MODN_BLANK_n
+USE MODN_CH_SOLVER_n
+USE MODN_CH_MNHC_n
+USE MODN_PARAM_C2R2, ONLY : HPARAM_CCN_C2R2=>HPARAM_CCN,HINI_CCN_C2R2=>HINI_CCN, &
+ HTYPE_CCN_C2R2=>HTYPE_CCN,LRAIN_C2R2=>LRAIN, &
+ LSEDC_C2R2=>LSEDC,LACTIT_C2R2=>LACTIT,XCHEN_C2R2=>XCHEN, &
+ XKHEN_C2R2=>XKHEN,XMUHEN_C2R2=>XMUHEN, &
+ XBETAHEN_C2R2=>XBETAHEN,XCONC_CCN_C2R2=>XCONC_CCN, &
+ XR_MEAN_CCN_C2R2=>XR_MEAN_CCN,XLOGSIG_CCN_C2R2=>XLOGSIG_CCN, &
+ XFSOLUB_CCN_C2R2=>XFSOLUB_CCN,XACTEMP_CCN_C2R2=>XACTEMP_CCN, &
+ XALPHAC_C2R2=>XALPHAC,XNUC_C2R2=>XNUC,XALPHAR_C2R2=>XALPHAR, &
+ XNUR_C2R2=>XNUR,XAERDIFF_C2R2=>XAERDIFF, &
+ XAERHEIGHT_C2R2=>XAERHEIGHT,NAM_PARAM_C2R2
+USE MODN_PARAM_C1R3, ONLY : XALPHAI_C1R3=>XALPHAI,XNUI_C1R3=>XNUI,XALPHAS_C1R3=>XALPHAS, &
+ XNUS_C1R3=>XNUS,XALPHAG_C1R3=>XALPHAG,XNUG_C1R3=>XNUG, &
+ XFACTNUC_DEP_C1R3=>XFACTNUC_DEP, &
+ XFACTNUC_CON_C1R3=>XFACTNUC_CON,LSEDI_C1R3=>LSEDI, &
+ LHHONI_C1R3=>LHHONI,CPRISTINE_ICE_C1R3,CHEVRIMED_ICE_C1R3, &
+ NAM_PARAM_C1R3
+USE MODN_ELEC
+USE MODN_SERIES
+USE MODN_SERIES_n
+USE MODN_TURB_CLOUD
+USE MODN_CH_ORILAM
+USE MODN_DUST
+USE MODN_SALT
+USE MODN_PASPOL
+USE MODN_VISCOSITY
+USE MODN_DRAG_n
+#ifdef MNH_FOREFIRE
+USE MODN_FOREFIRE
+#endif
+USE MODN_CONDSAMP
+USE MODN_LATZ_EDFLX
+USE MODN_2D_FRC
+USE MODN_BLOWSNOW_n
+USE MODN_BLOWSNOW
+!
+! USE MODN_FLYERS
+!
+USE MODE_MSG
+USE MODE_POS
+USE MODN_RECYCL_PARAM_n
+USE MODN_IBM_PARAM_n
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
+!
+USE MODN_FIRE_n
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
+CHARACTER (LEN=5), INTENT(OUT) :: HCONF ! configuration var. linked to FMfile
+LOGICAL, INTENT(OUT) :: OFLAT ! Logical for zero orography
+LOGICAL, INTENT(OUT) :: OUSERV ! use Rv mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERC ! use Rc mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERR ! use Rr mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERI ! use Ri mixing ratio
+LOGICAL, INTENT(OUT) :: OUSECI ! use Ci concentration of Ice cristals
+LOGICAL, INTENT(OUT) :: OUSERS ! use Rs mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERG ! use Rg mixing ratio
+LOGICAL, INTENT(OUT) :: OUSERH ! use Rh mixing ratio
+LOGICAL, INTENT(OUT) :: OUSECHEM ! Chemical flag
+LOGICAL, INTENT(OUT) :: OUSECHAQ ! Aqueous Chemical flag
+LOGICAL, INTENT(OUT) :: OUSECHIC ! Ice phase Chemical flag
+LOGICAL, INTENT(OUT) :: OCH_PH ! pH flag
+LOGICAL, INTENT(OUT) :: OCH_CONV_LINOX ! LiNOX flag
+LOGICAL, INTENT(OUT) :: OLG ! lagrangian flag
+INTEGER, INTENT(OUT) :: KRIMX, KRIMY ! number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, INTENT(OUT) :: KSV_USER ! number of additional scalar
+ ! variables in FMfile
+CHARACTER (LEN=4), INTENT(OUT) :: HTURB ! Kind of turbulence parameterization
+ ! used to produce the FMfile
+CHARACTER (LEN=4), INTENT(OUT) :: HTOM ! Kind of third order moment
+LOGICAL, INTENT(OUT) :: ORMC01 ! flag for RMC01 SBL computations
+CHARACTER (LEN=4), INTENT(OUT) :: HRAD ! Kind of radiation scheme
+CHARACTER (LEN=4), INTENT(OUT) :: HDCONV ! Kind of deep convection scheme
+CHARACTER (LEN=4), INTENT(OUT) :: HSCONV ! Kind of shallow convection scheme
+CHARACTER (LEN=4), INTENT(OUT) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(OUT) :: HELEC ! Kind of electrical scheme
+CHARACTER (LEN=*), INTENT(OUT) :: HEQNSYS! type of equations' system
+LOGICAL, INTENT(OUT) :: OSALT ! Sea Salt flag
+LOGICAL, INTENT(OUT) :: OPASPOL ! Passive pollutant flag
+LOGICAL, INTENT(OUT) :: OFIRE ! Blaze flag
+#ifdef MNH_FOREFIRE
+LOGICAL, INTENT(OUT) :: OFOREFIRE ! ForeFire flag
+#endif
+LOGICAL, INTENT(OUT) :: OLNOX_EXPLICIT ! explicit LNOx flag
+LOGICAL, INTENT(OUT) :: OCONDSAMP! Conditional sampling flag
+LOGICAL, INTENT(OUT) :: OBLOWSNOW! Blowing snow flag
+LOGICAL, INTENT(OUT) :: ODUST ! Dust flag
+LOGICAL, INTENT(OUT) :: OORILAM ! Dust flag
+LOGICAL, INTENT(OUT) :: OCHTRANS ! Deep convection on scalar
+ ! variables flag
+LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_DST ! Dust Wet Deposition flag
+LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_SLT ! Sea Salt Wet Deposition flag
+LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_AER ! Aerosols Wet Deposition flag
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILUDES, & ! logical unit numbers of
+ ILUOUT ! DESFM file and output listing
+LOGICAL :: GFOUND ! Return code when searching namelist
+LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_DST ! Dust Moist flag
+LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_SLT ! Sea Salt Moist flag
+LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_AER ! Orilam Moist flag
+TYPE(TFILEDATA), POINTER :: TZDESFILE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. READ DESFM FILE
+! ---------------
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_DESFM_n','called for '//TRIM(TPDATAFILE%CNAME))
+!
+IF (.NOT.ASSOCIATED(TPDATAFILE%TDESFILE)) &
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_DESFM_n','TDESFILE not associated for '//TRIM(TPDATAFILE%CNAME))
+!
+TZDESFILE => TPDATAFILE%TDESFILE
+ILUDES = TZDESFILE%NLU
+ILUOUT = TLUOUT%NLU
+!
+CALL POSNAM( TZDESFILE, 'NAM_LUNITN', GFOUND )
+CALL INIT_NAM_LUNITN
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_LUNITn)
+ CALL UPDATE_NAM_LUNITN
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_CONFN', GFOUND )
+CALL INIT_NAM_CONFN
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_CONFn)
+ CALL UPDATE_NAM_CONFN
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_DYNN', GFOUND )
+CALL INIT_NAM_DYNN
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_DYNn)
+ CALL UPDATE_NAM_DYNN
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_ADVN', GFOUND )
+CALL INIT_NAM_ADVN
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_ADVn)
+ CALL UPDATE_NAM_ADVN
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_PARAMN', GFOUND )
+CALL INIT_NAM_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_PARAMn)
+ CALL UPDATE_NAM_PARAMn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_RADN', GFOUND )
+CALL INIT_NAM_PARAM_RADn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_PARAM_RADn)
+ CALL UPDATE_NAM_PARAM_RADn
+END IF
+#ifdef MNH_ECRAD
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_ECRADN', GFOUND )
+CALL INIT_NAM_PARAM_ECRADn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_PARAM_ECRADn)
+ CALL UPDATE_NAM_PARAM_ECRADn
+END IF
+#endif
+CALL POSNAM( TZDESFILE, 'NAM_PARAM_KAFRN', GFOUND )
+CALL INIT_NAM_PARAM_KAFRn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_PARAM_KAFRn)
+ CALL UPDATE_NAM_PARAM_KAFRn
+END IF
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TZDESFILE, 'NAM_LBCN', GFOUND )
+CALL INIT_NAM_LBCn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_LBCn)
+ CALL UPDATE_NAM_LBCn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_NUDGINGN', GFOUND )
+CALL INIT_NAM_NUDGINGn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_NUDGINGn)
+ CALL UPDATE_NAM_NUDGINGn
+END IF
+CALL TURBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL NEBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL PARAM_ICEN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TZDESFILE, 'NAM_CH_MNHCN', GFOUND )
+CALL INIT_NAM_CH_MNHCn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_CH_MNHCn)
+ CALL UPDATE_NAM_CH_MNHCn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_CH_SOLVERN', GFOUND )
+CALL INIT_NAM_CH_SOLVERn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_CH_SOLVERn)
+ CALL UPDATE_NAM_CH_SOLVERn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_DRAGN', GFOUND )
+CALL INIT_NAM_DRAGn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_DRAGn)
+ CALL UPDATE_NAM_DRAGn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_IBM_PARAMN', GFOUND )
+CALL INIT_NAM_IBM_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_IBM_PARAMn)
+ CALL UPDATE_NAM_IBM_PARAMn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_RECYCL_PARAMN', GFOUND )
+CALL INIT_NAM_RECYCL_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_RECYCL_PARAMn)
+ CALL UPDATE_NAM_RECYCL_PARAMn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_SERIESN', GFOUND )
+CALL INIT_NAM_SERIESn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_SERIESn)
+ CALL UPDATE_NAM_SERIESn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_BLOWSNOWN', GFOUND )
+CALL INIT_NAM_BLOWSNOWn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_BLOWSNOWn)
+ CALL UPDATE_NAM_BLOWSNOWn
+END IF
+CALL POSNAM( TZDESFILE, 'NAM_BLANKN', GFOUND )
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
+! Note: it is not useful to read the PROFILERS/STATIONS namelists in the .des files
+! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! CALL POSNAM( TZDESFILE, 'NAM_PROFILERN', GFOUND )
+! CALL INIT_NAM_PROFILERn
+! IF (GFOUND) THEN
+! READ(UNIT=ILUDES,NML=NAM_PROFILERN)
+! CALL UPDATE_NAM_PROFILERn
+! END IF
+! CALL POSNAM( TZDESFILE, 'NAM_STATIONN', GFOUND )
+! CALL INIT_NAM_STATIONn
+! IF (GFOUND) THEN
+! READ(UNIT=ILUDES,NML=NAM_STATIONn)
+! CALL UPDATE_NAM_STATIONn
+! END IF
+CALL POSNAM( TZDESFILE, 'NAM_FIREN', GFOUND )
+CALL INIT_NAM_FIREn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_FIREn)
+ CALL UPDATE_NAM_FIREn
+END IF
+!
+!
+IF (KMI == 1) THEN
+ CALL POSNAM( TZDESFILE, 'NAM_CONF', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONF)
+ CALL POSNAM( TZDESFILE, 'NAM_DYN', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DYN)
+ CALL POSNAM( TZDESFILE, 'NAM_NESTING', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_NESTING)
+ CALL POSNAM( TZDESFILE, 'NAM_BACKUP', GFOUND )
+ IF (GFOUND) THEN
+ IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
+ ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
+ XBAK_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
+ ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX)) !Allocate *OUT* variables to prevent
+ XOUT_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
+ ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX))
+ NBAK_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
+ ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX)) !problems if NAM_OUTPUT does not exist
+ NOUT_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(COUT_VAR)) THEN
+ ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
+ COUT_VAR(:,:) = ''
+ END IF
+ READ(UNIT=ILUDES,NML=NAM_BACKUP)
+ ELSE
+ CALL POSNAM( TZDESFILE, 'NAM_FMOUT', GFOUND )
+ IF (GFOUND) CALL PRINT_MSG(NVERB_FATAL,'IO','READ_DESFM_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
+ END IF
+ CALL POSNAM( TZDESFILE, 'NAM_OUTPUT', GFOUND )
+ IF (GFOUND) THEN
+ IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
+ ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) !Allocate *BAK* variables to prevent
+ XBAK_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
+ ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX))
+ XOUT_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
+ ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX)) !problems if NAM_BACKUP does not exist
+ NBAK_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
+ ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX))
+ NOUT_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(COUT_VAR)) THEN
+ ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
+ COUT_VAR(:,:) = ''
+ END IF
+ READ(UNIT=ILUDES,NML=NAM_OUTPUT)
+ END IF
+! Note: it is not useful to read the budget namelists in the .des files
+! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! CALL POSNAM( TZDESFILE, 'NAM_BUDGET', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BUDGET)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RU', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RU)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RV', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RV)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RW', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RW)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RTH', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTH)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RTKE', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTKE)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRV', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRV)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRC', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRC)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRR', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRR)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRI', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRI)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRS', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRS)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRG', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRG)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RRH', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRH)
+! CALL POSNAM( TZDESFILE, 'NAM_BU_RSV', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RSV)
+ CALL POSNAM( TZDESFILE, 'NAM_LES', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LES)
+ CALL POSNAM( TZDESFILE, 'NAM_PDF', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PDF)
+ CALL POSNAM( TZDESFILE, 'NAM_FRC', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FRC)
+ CALL POSNAM( TZDESFILE, 'NAM_PARAM_C2R2', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PARAM_C2R2)
+ CALL POSNAM( TZDESFILE, 'NAM_PARAM_C1R3', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PARAM_C1R3)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+ CALL POSNAM( TZDESFILE, 'NAM_ELEC', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_ELEC)
+ CALL POSNAM( TZDESFILE, 'NAM_SERIES', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SERIES)
+ CALL POSNAM( TZDESFILE, 'NAM_TURB_CLOUD', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_TURB_CLOUD)
+ CALL POSNAM( TZDESFILE, 'NAM_CH_ORILAM', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CH_ORILAM)
+ CALL POSNAM( TZDESFILE, 'NAM_DUST', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DUST)
+ CALL POSNAM( TZDESFILE, 'NAM_SALT', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SALT)
+ CALL POSNAM( TZDESFILE, 'NAM_PASPOL', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PASPOL)
+#ifdef MNH_FOREFIRE
+ CALL POSNAM( TZDESFILE, 'NAM_FOREFIRE', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FOREFIRE)
+#endif
+ CALL POSNAM( TZDESFILE, 'NAM_CONDSAMP', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONDSAMP)
+ CALL POSNAM( TZDESFILE, 'NAM_BLOWSNOW', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BLOWSNOW)
+ CALL POSNAM( TZDESFILE, 'NAM_2D_FRC', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_2D_FRC)
+ LTEMPDEPOS_DST(:) = LDEPOS_DST(:)
+ LTEMPDEPOS_SLT(:) = LDEPOS_SLT(:)
+ LTEMPDEPOS_AER(:) = LDEPOS_AER(:)
+ CALL POSNAM( TZDESFILE, 'NAM_LATZ_EDFLX', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LATZ_EDFLX)
+ CALL POSNAM( TZDESFILE, 'NAM_VISC', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_VISC)
+! Note: it is not useful to read the FLYERS/AIRCRAFTS/BALLOONS namelists in the .des files
+! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! CALL POSNAM( TZDESFILE, 'NAM_FLYERS', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FLYERS)
+! CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
+! CALL POSNAM(ILUSEG,'NAM_BALLOONS', GFOUND )
+! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. SAVE SOME FMFILE ATTRIBUTES
+! ---------------------------
+HCONF = CCONF
+OFLAT = LFLAT
+OUSERV = LUSERV
+OUSERC = LUSERC
+OUSERR = LUSERR
+OUSERI = LUSERI
+OUSECI = LUSECI
+OUSERS = LUSERS
+OUSERG = LUSERG
+OUSERH = LUSERH
+OUSECHEM = LUSECHEM
+OUSECHAQ = LUSECHAQ
+OUSECHIC = LUSECHIC
+OCH_PH = LCH_PH
+OCH_CONV_LINOX = LCH_CONV_LINOX
+ODUST = LDUST
+ODEPOS_DST(KMI) = LTEMPDEPOS_DST(KMI)
+ODEPOS_SLT(KMI) = LTEMPDEPOS_SLT(KMI)
+ODEPOS_AER(KMI) = LTEMPDEPOS_AER(KMI)
+OCHTRANS = LCHTRANS
+OSALT = LSALT
+OORILAM = LORILAM
+OLG = LLG
+OPASPOL = LPASPOL
+OFIRE = LBLAZE
+#ifdef MNH_FOREFIRE
+OFOREFIRE = LFOREFIRE
+#endif
+OLNOX_EXPLICIT = LLNOX_EXPLICIT
+OCONDSAMP= LCONDSAMP
+OBLOWSNOW= LBLOWSNOW
+! Initially atmosphere free of blowing snow particles
+IF(KMI>1) OBLOWSNOW=.FALSE.
+KRIMX = NRIMX
+KRIMY = NRIMY
+KSV_USER = NSV_USER
+HTURB = CTURB
+HTOM = CTOM
+ORMC01 = LRMC01
+HRAD = CRAD
+HDCONV = CDCONV
+HSCONV = CSCONV
+HCLOUD = CCLOUD
+HELEC = CELEC
+HEQNSYS = CEQNSYS
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. WRITE DESFM ON OUTPUT LISTING
+! ------------------------------
+!
+IF (NVERB >= 10) THEN
+ WRITE(UNIT=ILUOUT,FMT="(/,'DESCRIPTOR OF INITIAL FILE FOR MODEL ',I2)") KMI
+ WRITE(UNIT=ILUOUT,FMT="( '------------------------------------ ' )")
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** LOGICAL UNITSn **********')")
+ WRITE(UNIT=ILUOUT,NML=NAM_LUNITn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** CONFIGURATIONn **********')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CONFn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** DYNAMICn ****************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_DYNn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** ADVECTIONn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_ADVn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** PARAMETERIZATIONSn ******')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAMn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** RADIATIONSn *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_RADn)
+!
+#ifdef MNH_ECRAD
+ WRITE(UNIT=ILUOUT,FMT="('********** ECRAD RADIATIONSn *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_ECRADn)
+#endif
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** DEEP CONVECTIONn ********')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_KAFRn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('*** MASS FLUX SHALLOW CONVECTION ***')")
+ CALL PARAM_MFSHALLN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** LBCn ********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_LBCn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** TURBn *******************')")
+ CALL TURBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** NEBn *******************')")
+ CALL NEBN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** DRAGn *******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_DRAGn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** IBM FORCING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** RECYLING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** NUDGINGn ****************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL MONITORn *******')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CH_MNHCn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL SOLVER *********')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CH_SOLVERn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLOWSNOWn ***************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOWn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLANKn ******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
+!
+! Profilers/stations namelists not read anymore in READ_DESFM_n
+! WRITE(UNIT=ILUOUT,FMT="('********** PROFILERn *****************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_PROFILERn)
+!
+! WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ ICE SCHEME ***********************')")
+ CALL PARAM_ICEN_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLAZE *******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_FIREn)
+!
+ IF (KMI==1) THEN
+ WRITE(UNIT=ILUOUT,FMT="(/,'PART OF INITIAL FILE COMMON TO ALL THE MODELS')")
+ WRITE(UNIT=ILUOUT,FMT="( '---------------------------------------------')")
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ CONFIGURATION ********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CONF)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ DYNAMIC **************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_DYN)
+!
+! Budget namelists not read anymore in READ_DESFM_n
+! WRITE(UNIT=ILUOUT,FMT="('************ BUDGET ***************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BUDGET)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ U BUDGET *************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RU)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ V BUDGET *************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RV)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ W BUDGET *************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RW)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ TH BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RTH)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ TKE BUDGET ***********************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RTKE)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RV BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRV)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RC BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRC)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RR BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRR)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RI BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRI)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RS BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRS)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RG BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRG)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RH BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRH)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ SVx BUDGET ***********************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RSV)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ LES ******************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_LES)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ PDF ******************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PDF)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ FORCING **************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_FRC)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ ORILAM SCHEME ********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CH_ORILAM)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ SALT SCHEME **********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_SALT)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ DUST SCHEME **********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_DUST)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ PASSIVE POLLUTANT ***************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PASPOL)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ VISCOSITY ***************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_VISC)
+!
+#ifdef MNH_FOREFIRE
+ WRITE(UNIT=ILUOUT,FMT="('************ FOREFIRE ***************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_FOREFIRE)
+!
+#endif
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ CONDITIONAL SAMPLING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CONDSAMP)
+ !
+ WRITE(UNIT=ILUOUT,FMT="('********** BLOWING SNOW SCHEME******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOW)
+!
+ IF( CCLOUD == 'C2R2' ) THEN
+ WRITE(UNIT=ILUOUT,FMT="('************ C2R2 SCHEME **********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
+ END IF
+!
+ IF( CCLOUD == 'KHKO' ) THEN !modif
+ WRITE(UNIT=ILUOUT,FMT="('************ KHKO SCHEME **********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
+ END IF
+!
+ IF( CCLOUD == 'C3R5' ) THEN
+ WRITE(UNIT=ILUOUT,FMT="('************ C3R5 SCHEME **********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C1R3)
+ END IF
+!
+ IF( CCLOUD == 'LIMA' ) THEN
+ WRITE(UNIT=ILUOUT,FMT="('************ LIMA SCHEME **********************')")
+ CALL PARAM_LIMA_INIT(CPROGRAM, TZDESFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ END IF
+!
+ IF (CELEC /= 'NONE') THEN
+ WRITE(UNIT=ILUOUT,FMT="('************ ELEC SCHEME **********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_ELEC)
+ END IF
+!
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_DESFM_n
diff --git a/src/PHYEX/ext/read_exsegn.f90 b/src/PHYEX/ext/read_exsegn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1aa20763f3e5f7718a35250692619d1555dc8b76
--- /dev/null
+++ b/src/PHYEX/ext/read_exsegn.f90
@@ -0,0 +1,3040 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_READ_EXSEG_n
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, &
+ OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
+ OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
+ ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
+ OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
+#ifdef MNH_FOREFIRE
+ OFOREFIRE, &
+#endif
+ OLNOX_EXPLICIT, &
+ OCONDSAMP,OBLOWSNOW, &
+ KRIMX,KRIMY, KSV_USER, &
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
+ HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
+! The following variables are read by READ_DESFM in DESFM descriptor :
+CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography
+LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, &
+ OUSERG,OUSERH ! kind of moist variables in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
+#ifdef MNH_FOREFIRE
+LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
+#endif
+LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE
+
+LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE
+INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar
+ ! variables in FMfile
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+ ! used to produce FMFILE
+CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment
+LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme
+CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
+CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
+REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
+!
+END SUBROUTINE READ_EXSEG_n
+!
+END INTERFACE
+!
+END MODULE MODI_READ_EXSEG_n
+!
+!
+! #########################################################################
+ SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, &
+ OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
+ OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
+ ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
+ OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
+#ifdef MNH_FOREFIRE
+ OFOREFIRE, &
+#endif
+ OLNOX_EXPLICIT, &
+ OCONDSAMP, OBLOWSNOW, &
+ KRIMX,KRIMY, KSV_USER, &
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
+ HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
+! #########################################################################
+!
+!!**** *READ_EXSEG_n * - routine to read the descriptor file EXSEG
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to read the descriptor file called
+! EXSEG and to control the coherence with FMfile data .
+!
+!!
+!!** METHOD
+!! ------
+!! The descriptor file is read. Namelists (NAMXXXn) which contain
+!! variables linked to one nested model are at the beginning of the file.
+!! Namelists (NAMXXX) which contain variables common to all models
+!! are at the end of the file. When the model index is different from 1,
+!! the end of the file (namelists NAMXXX) is not read.
+!!
+!! Coherence between the initial file (description read in DESFM file)
+!! and the segment to perform (description read in EXSEG file)
+!! is checked for segment achievement configurations
+!! or postprocessing configuration. The get indicators are set according
+!! to the following check :
+!!
+!! - segment achievement and preinit configurations :
+!!
+!! * if there is no turbulence kinetic energy in initial
+!! file (HTURB='NONE'), and the segment to perform requires a turbulence
+!! parameterization (CTURB /= 'NONE'), the get indicators for turbulence
+!! kinetic energy variables are set to 'INIT'; i.e. these variables will be
+!! set equal to zero by READ_FIELD according to the get indicators.
+!! * The same procedure is applied to the dissipation of TKE.
+!! * if there is no moist variables RRn in initial file (OUSERn=.FALSE.)
+!! and the segment to perform requires moist variables RRn
+!! (LUSERn=.TRUE.), the get indicators for moist variables RRn are set
+!! equal to 'INIT'; i.e. these variables will be set equal to zero by
+!! READ_FIELD according to the get indicators.
+!! * if there are KSV_USER additional scalar variables in initial file and the
+!! segment to perform needs more than KSV_USER additional variables, the get
+!! indicators for these (NSV_USER-KSV_USER) additional scalar variables are set
+!! equal to 'INIT'; i.e. these variables will be set equal to zero by
+!! READ_FIELD according to the get indicators. If the segment to perform
+!! needs less additional scalar variables than there are in initial file,
+!! the get indicators for these (KSV_USER - NSV_USER) additional scalar variables are
+!! set equal to 'SKIP'.
+!! * warning messages are printed if the fields in initial file are the
+!! same at time t and t-dt (HCONF='START') and a leap-frog advance
+!! at first time step will be used for the segment to perform
+!! (CCONF='RESTA'); It is likewise when HCONF='RESTA' and CCONF='START'.
+!! * A warning message is printed if the orography in initial file is zero
+!! (OFLAT=.TRUE.) and the segment to perform considers no-zero orography
+!! (LFLAT=.FALSE.). It is likewise for LFLAT=.TRUE. and OFLAT=.FALSE..
+!! If the segment to perform requires zero orography (LFLAT=.TRUE.), the
+!! orography (XZS) will not read in initial file but set equal to zero
+!! by SET_GRID.
+!! * check of the depths of the Lateral Damping Layer in x and y
+!! direction is performed
+!! * If some coupling files are specified, LSTEADYLS is set to T
+!! * If no coupling files are specified, LSTEADYLS is set to F
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODN_CONF : CCONF,LTHINSHELL,LFLAT,NMODEL,NVERB
+!!
+!! Module MODN_DYN : LCORIO, LZDIFFU
+!!
+!! Module MODN_NESTING : NDAD(m),NDTRATIO(m),XWAY(m)
+!!
+!! Module MODN_BUDGET : CBUTYPE,XBULEN
+!!
+!! Module MODN_CONF1 : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH,CSEG
+!!
+!! Module MODN_DYN1 : XTSTEP,CPRESOPT,NITR,XRELAX
+!!
+!! Module MODD_ADV1 : CMET_ADV_SCHEME,CSV_ADV_SCHEME,CUVW_ADV_SCHEME,NLITER
+!!
+!! Module MODN_PARAM1 : CTURB,CRAD,CDCONV,CSCONV
+!!
+!! Module MODN_LUNIT1 :
+!! Module MODN_LBC1 : CLBCX,CLBCY,NLBLX,NLBLY,XCPHASE,XPOND
+!!
+!! Module MODN_TURB_n : CTURBLEN,CTURBDIM
+!!
+!! Module MODD_GET1:
+!! CGETTKEM,CGETTKET,
+!! CGETRVM,CGETRCM,CGETRRM,CGETRIM,CGETRSM,CGETRGM,CGETRHM
+!! CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETRST,CGETRGT,CGETRHT,CGETSVM
+!! CGETSVT,CGETSIGS,CGETSRCM,CGETSRCT
+!! NCPL_NBR,NCPL_TIMES,NCPL_CUR
+!! Module MODN_LES : contains declaration of the control parameters
+!! for Large Eddy Simulations' storages
+!! for the forcing
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine READ_EXSEG_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/06/94
+!! Modification 26/10/94 (Stein) remove NAM_GET from the Namelists
+!! present in DESFM + change the namelist names
+!! Modification 22/11/94 (Stein) add GET indicator for phi
+!! Modification 21/12/94 (Stein) add GET indicator for LS fields
+!! Modification 06/01/95 (Stein) bug in the test for Scalar Var.
+!! Modifications 09/01/95 (Stein) add the turbulence scheme
+!! Modifications 09/01/95 (Stein) add the 1D switch
+!! Modifications 10/03/95 (Mallet) add coherence in coupling case
+!! Modifications 16/03/95 (Stein) remove R from the historical variables
+!! Modifications 01/03/95 (Hereil) add the budget namelists
+!! Modifications 16/06/95 (Stein) coherence control for the
+!! microphysical scheme + remove the wrong messge for RESTA conf
+!! Modifications 30/06/95 (Stein) conditionnal reading of the fields
+!! used by the moist turbulence scheme
+!! Modifications 12/09/95 (Pinty) add the radiation scheme
+!! Modification 06/02/96 (J.Vila) implement scalar advection schemes
+!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE
+!! Modifications 02/05/96 (Stein Jabouille) change the Z0SEA activation
+!! Modifications 24/05/96 (Stein) change the SRC SIGS control
+!! Modifications 08/09/96 (Masson) the coupling file names are reset to
+!! default value " " before reading in EXSEG1.nam
+!! to avoid extra non-existant coupling files
+!!
+!! Modifications 25/04/95 (K.Suhre)add namelist NAM_BLANK
+!! add read for LFORCING
+!! 25/04/95 (K.Suhre)add namelist NAM_FRC
+!! and switch checking
+!! 06/08/96 (K.Suhre)add namelist NAM_CH_MNHCn
+!! and NAM_CH_SOLVER
+!! Modifications 10/10/96 (Stein) change SRC into SRCM and SRCT
+!! Modifications 11/04/96 (Pinty) add the rain-ice microphysical scheme
+!! Modifications 11/01/97 (Pinty) add the deep convection scheme
+!! Modifications 22/05/97 (Lafore) gridnesting implementation
+!! Modifications 22/06/97 (Stein) add the absolute pressure + cleaning
+!! Modifications 25/08/97 (Masson) add tests on surface schemes
+!! 22/10/97 (Stein) remove the RIMX /= 0 control
+!! + new namelist + cleaning
+!! Modifications 17/04/98 (Masson) add tests on character variables
+!! Modification 15/03/99 (Masson) add tests on PROGRAM
+!! Modification 04/01/00 (Masson) removes TSZ0 case
+!! Modification 04/06/00 (Pinty) add C2R2 scheme
+!! 11/12/00 (Tomasini) add CSEA_FLUX to MODD_PARAMn
+!! delete the test on SST_FRC only in 1D
+!! Modification 22/01/01 (Gazen) change NSV,KSV to NSV_USER,KSV_USER and add
+!! NSV_* variables initialization
+!! Modification 15/10/01 (Mallet) allow namelists in different orders
+!! Modification 18/03/02 (Solmon) new radiation scheme test
+!! Modification 29/11/02 (JP Pinty) add C3R5, ICE2, ICE4, ELEC
+!! Modification 06/11/02 (Masson) new LES BL height diagnostic
+!! Modification 06/11/02 (Jabouille) remove LTHINSHELL LFORCING test
+!! Modification 01/12/03 (Gazen) change Chemical scheme interface
+!! Modification 01/2004 (Masson) removes surface (externalization)
+!! Modification 01/2005 (Masson) removes 1D and 2D switches
+!! Modification 04/2005 (Tulet) add dust, orilam
+!! Modification 03/2006 (O.Geoffroy) Add KHKO scheme
+!! Modification 04/2006 (Maric) include 4th order advection scheme
+!! Modification 05/2006 (Masson) add nudging
+!! Modification 05/2006 Remove KEPS
+!! Modification 04/2006 (Maric) include PPM advection scheme
+!! Modification 04/2006 (J.Escobar) Bug dollarn add CALL UPDATE_NAM_CONFN
+!! Modifications 01/2007 (Malardel,Pergaud) add the MF shallow
+!! convection scheme MODN_PARAM_MFSHALL_n
+!! Modification 09/2009 (J.Escobar) add more info on relaxation problems
+!! Modification 09/2011 (J.Escobar) re-add 'ZRESI' choose
+!! Modification 12/2011 (C.Lac) Adaptation to FIT temporal scheme
+!! Modification 12/2012 (S.Bielli) add NAM_NCOUT for netcdf output (removed 08/07/2016)
+!! Modification 02/2012 (Pialat/Tulet) add ForeFire
+!! Modification 02/2012 (T.Lunet) add of new Runge-Kutta methods
+!! Modification 01/2015 (C. Barthe) add explicit LNOx
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Leriche 18/12/2015 : bug chimie glace dans prep_real_case
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 02/2016 (M.Leriche) treat gas and aq. chemicals separately
+!! P.Wautelet 08/07/2016 : removed MNH_NCWRIT define
+!! Modification 10/2016 (C.LAC) Add OSPLIT_WENO + Add droplet
+!! deposition + Add max values
+!! Modification 11/2016 (Ph. Wautelet) Allocate/initialise some output/backup structures
+!! Modification 03/2017 (JP Chaboureau) Fix the initialization of
+!! LUSERx-type variables for LIMA
+!! M.Leriche 06/2017 for spawn and prep_real avoid abort if wet dep for
+!! aerosol and no cloud scheme defined
+!! Q.Libois 02/2018 ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Modification 07/2017 (V. Vionnet) add blowing snow scheme
+!! Modification 01/2019 (Q. Rodier) define XCEDIS depending on BL89 or RM17 mixing length
+!! Modification 01/2019 (P. Wautelet) bugs correction: incorrect writes
+!! Modification 01/2019 (R. Honnert) remove SURF in CMF_UPDRAFT
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions
+! F.Auguste 02/2021: add IBM
+! T.Nagel 02/2021: add turbulence recycling
+! E.Jezequel 02/2021: add stations read from CSV file
+! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
+! R. Honnert 23/04/2021: add HM21 mixing length and delete HRIO and BOUT from CMF_UPDRAFT
+! S. Riette 11/05/2021 HighLow cloud
+! A. Costes 12/2021: add Blaze fire model
+! R. Schoetter 12/2021: multi-level coupling between MesoNH and SURFEX
+! P. Wautelet 27/04/2022: add namelist for profilers
+! P. Wautelet 24/06/2022: remove check on CSTORAGE_TYPE for restart of ForeFire variables
+! P. Wautelet 13/07/2022: add namelist for flyers and balloons
+! P. Wautelet 19/08/2022: add namelist for aircrafts
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_AIRCRAFT_BALLOON, ONLY: NAIRCRAFTS, NBALLOONS
+USE MODD_BLOWSNOW
+USE MODD_BUDGET
+USE MODD_CH_AEROSOL
+USE MODD_CH_M9_n, ONLY : NEQ
+USE MODD_CONDSAMP
+USE MODD_CONF
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_CONFZ
+! USE MODD_DRAG_n
+USE MODD_DUST
+USE MODD_DYN
+USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA, LHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_GET_n
+USE MODD_GR_FIELD_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV,NSV_USER_n=>NSV_USER
+USE MODD_PARAMETERS
+USE MODD_PASPOL
+USE MODD_SALT
+USE MODD_VAR_ll, ONLY: NPROC
+USE MODD_VISCOSITY
+
+USE MODE_MSG
+USE MODE_POS
+
+USE MODI_INI_NSV
+USE MODI_TEST_NAM_VAR
+
+USE MODN_2D_FRC
+USE MODN_ADV_n ! The final filling of these modules for the model n is
+USE MODN_AIRCRAFTS, ONLY: AIRCRAFTS_NML_ALLOCATE, NAM_AIRCRAFTS
+USE MODN_BACKUP
+USE MODN_BALLOONS, ONLY: BALLOONS_NML_ALLOCATE, NAM_BALLOONS
+USE MODN_BLANK_n
+USE MODN_BLOWSNOW
+USE MODN_BLOWSNOW_n
+USE MODN_BUDGET
+USE MODN_CH_MNHC_n
+USE MODN_CH_ORILAM
+USE MODN_CH_SOLVER_n
+USE MODN_CONDSAMP
+USE MODN_CONF
+USE MODN_CONF_n
+USE MODN_CONFZ
+USE MODN_DRAGBLDG_n
+USE MODN_COUPLING_LEVELS_n
+USE MODN_DRAG_n
+USE MODN_DRAGTREE_n
+USE MODN_DUST
+USE MODN_DYN
+USE MODN_DYN_n ! to avoid the duplication of this routine for each model.
+USE MODN_ELEC
+USE MODN_EOL
+USE MODN_EOL_ADNR
+USE MODN_EOL_ALM
+USE MODN_FIRE_n
+USE MODN_FLYERS
+#ifdef MNH_FOREFIRE
+USE MODN_FOREFIRE
+#endif
+USE MODN_FRC
+USE MODN_IBM_PARAM_n
+USE MODN_LATZ_EDFLX
+USE MODN_LBC_n ! routine is used for each nested model. This has been done
+USE MODN_LES
+USE MODN_LUNIT_n
+USE MODN_MEAN
+USE MODN_NESTING
+USE MODN_NUDGING_n
+USE MODN_OUTPUT
+USE MODN_PARAM_C1R3, ONLY : NAM_PARAM_C1R3, CPRISTINE_ICE_C1R3, &
+ CHEVRIMED_ICE_C1R3
+USE MODN_PARAM_C2R2, ONLY : EPARAM_CCN=>HPARAM_CCN, EINI_CCN=>HINI_CCN, &
+ WNUC=>XNUC, WALPHAC=>XALPHAC, NAM_PARAM_C2R2
+USE MODN_PARAM_ECRAD_n
+USE MODD_PARAM_ICE_n, ONLY : PARAM_ICEN_INIT, PARAM_ICEN, CSUBG_AUCV_RC, CSUBG_AUCV_RI
+USE MODN_PARAM_KAFR_n
+USE MODD_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,PARAM_LIMA_INIT,NMOD_CCN,LSCAV, &
+ CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, NMOD_IFN, NMOD_IMM, &
+ LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, &
+ LPTSPLIT, LSPRO, LADJ, LKHKO, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
+USE MODN_PARAM_n ! realized in subroutine ini_model n
+USE MODN_PARAM_RAD_n
+USE MODN_PASPOL
+USE MODN_PROFILER_n, LDIAG_SURFRAD_PROF => LDIAG_SURFRAD
+USE MODN_RECYCL_PARAM_n
+USE MODN_SALT
+USE MODN_SERIES
+USE MODN_SERIES_n
+USE MODN_STATION_n, LDIAG_SURFRAD_STAT => LDIAG_SURFRAD
+USE MODD_TURB_n, ONLY: TURBN_INIT, CTOM, CTURBDIM, LRMC01, LHARAT, &
+ LCLOUDMODIFLM, CTURBLEN_CLOUD, XCEI_MIN, XCEI_MAX
+USE MODD_NEB_n, ONLY: NEBN_INIT, LSIGMAS, LSUBG_COND, CCONDENS, LSTATNW
+USE MODN_VISCOSITY
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
+! The following variables are read by READ_DESFM in DESFM descriptor :
+CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile
+LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography
+LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, &
+ OUSERG,OUSERH ! kind of moist variables in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in
+ ! FMfile
+LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust Deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE
+LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
+#ifdef MNH_FOREFIRE
+LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
+#endif
+LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE
+LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE
+
+LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE
+INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the
+ ! horizontal relaxation for the outermost verticals
+INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar
+ ! variables in FMfile
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+ ! used to produce FMFILE
+CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment
+LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme
+CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
+CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
+REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
+!
+!* 0.2 declarations of local variables
+!
+CHARACTER(LEN=3) :: YMODEL
+INTEGER :: ILUSEG,ILUOUT ! logical unit numbers of EXSEG file and outputlisting
+INTEGER :: JS,JCI,JI,JSV ! Loop indexes
+LOGICAL :: GRELAX
+LOGICAL :: GFOUND ! Return code when searching namelist
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. READ EXSEG FILE
+! ---------------
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_EXSEG_n','called for '//TRIM(TPEXSEGFILE%CNAME))
+!
+ILUSEG = TPEXSEGFILE%NLU
+ILUOUT = TLUOUT%NLU
+!
+CALL INIT_NAM_LUNITN
+CCPLFILE(:)=" "
+CALL INIT_NAM_CONFN
+CALL INIT_NAM_DYNN
+CALL INIT_NAM_ADVN
+CALL INIT_NAM_DRAGTREEN
+CALL INIT_NAM_DRAGBLDGN
+CALL INIT_NAM_COUPLING_LEVELSN
+CALL INIT_NAM_PARAMN
+CALL INIT_NAM_PARAM_RADN
+#ifdef MNH_ECRAD
+CALL INIT_NAM_PARAM_ECRADN
+#endif
+CALL INIT_NAM_PARAM_KAFRN
+CALL INIT_NAM_LBCN
+CALL INIT_NAM_NUDGINGN
+CALL INIT_NAM_BLANKN
+CALL INIT_NAM_DRAGN
+CALL INIT_NAM_IBM_PARAMN
+CALL INIT_NAM_RECYCL_PARAMN
+CALL INIT_NAM_CH_MNHCN
+CALL INIT_NAM_CH_SOLVERN
+CALL INIT_NAM_SERIESN
+CALL INIT_NAM_BLOWSNOWN
+CALL INIT_NAM_PROFILERn
+CALL INIT_NAM_STATIONn
+CALL INIT_NAM_FIREn
+!
+WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
+CALL POSNAM( TPEXSEGFILE, 'NAM_LUNITN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LUNITn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CONFN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DYNN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYNn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_ADVN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ADVn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAMN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAMn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_RADN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_RADn)
+#ifdef MNH_ECRAD
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_ECRADN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn)
+#endif
+CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_KAFRN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TPEXSEGFILE, 'NAM_LBCN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LBCn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_NUDGINGN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NUDGINGn)
+CALL TURBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL NEBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL PARAM_ICEN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_IBM_PARAMN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_RECYCL_PARAMN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CH_MNHCN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_CH_SOLVERN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_SERIESN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_BLANKN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANKn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_BLOWSNOWN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGTREEN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_DRAGBLDGN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
+CALL POSNAM( TPEXSEGFILE,'NAM_COUPLING_LEVELSN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_COUPLING_LEVELSn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL_ADNR', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
+CALL POSNAM( TPEXSEGFILE, 'NAM_EOL_ALM', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
+CALL POSNAM( TPEXSEGFILE, 'NAM_PROFILERN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PROFILERn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_STATIONN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
+CALL POSNAM( TPEXSEGFILE, 'NAM_FIREN', GFOUND )
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FIREn)
+!
+IF (KMI == 1) THEN
+ WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONF', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONF)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONFZ', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_DYN', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYN)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_NESTING', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NESTING)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BACKUP', GFOUND )
+ IF (GFOUND) THEN
+ !Should have been allocated before in READ_DESFM_n
+ IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
+ ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
+ XBAK_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
+ ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX)) !Allocate *OUT* variables to prevent
+ XOUT_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
+ ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX))
+ NBAK_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
+ ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX)) !problems if NAM_OUTPUT does not exist
+ NOUT_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(COUT_VAR)) THEN
+ ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
+ COUT_VAR(:,:) = ''
+ END IF
+ READ(UNIT=ILUSEG,NML=NAM_BACKUP)
+ ELSE
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FMOUT', GFOUND )
+ IF (GFOUND) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_EXSEG_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
+ ELSE
+ IF (CPROGRAM=='MESONH') CALL PRINT_MSG(NVERB_ERROR,'IO','READ_EXSEG_n','namelist NAM_BACKUP not found')
+ END IF
+ END IF
+ CALL POSNAM( TPEXSEGFILE, 'NAM_OUTPUT', GFOUND )
+ IF (GFOUND) THEN
+ !Should have been allocated before in READ_DESFM_n
+ IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
+ ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) !Allocate *BAK* variables to prevent
+ XBAK_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
+ ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX))
+ XOUT_TIME(:,:) = XNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
+ ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX)) !problems if NAM_BACKUP does not exist
+ NBAK_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
+ ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX))
+ NOUT_STEP(:,:) = NNEGUNDEF
+ END IF
+ IF (.NOT.ALLOCATED(COUT_VAR)) THEN
+ ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
+ COUT_VAR(:,:) = ''
+ END IF
+ READ(UNIT=ILUSEG,NML=NAM_OUTPUT)
+ END IF
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BUDGET', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BUDGET)
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RU', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RU ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RU was already allocated' )
+ DEALLOCATE( CBULIST_RU )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(NBULISTMAXLINES) )
+ CBULIST_RU(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RU)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RV', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RV was already allocated' )
+ DEALLOCATE( CBULIST_RV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(NBULISTMAXLINES) )
+ CBULIST_RV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RW', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RW ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RW was already allocated' )
+ DEALLOCATE( CBULIST_RW )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(NBULISTMAXLINES) )
+ CBULIST_RW(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RW)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RTH', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RTH ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTH was already allocated' )
+ DEALLOCATE( CBULIST_RTH )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(NBULISTMAXLINES) )
+ CBULIST_RTH(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RTH)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RTKE', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RTKE ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTKE was already allocated' )
+ DEALLOCATE( CBULIST_RTKE )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(NBULISTMAXLINES) )
+ CBULIST_RTKE(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RTKE)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRV', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRV was already allocated' )
+ DEALLOCATE( CBULIST_RRV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(NBULISTMAXLINES) )
+ CBULIST_RRV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRC', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRC ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRC was already allocated' )
+ DEALLOCATE( CBULIST_RRC )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(NBULISTMAXLINES) )
+ CBULIST_RRC(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRC)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRR', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRR ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRR was already allocated' )
+ DEALLOCATE( CBULIST_RRR )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(NBULISTMAXLINES) )
+ CBULIST_RRR(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRR)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRI', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRI ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRI was already allocated' )
+ DEALLOCATE( CBULIST_RRI )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(NBULISTMAXLINES) )
+ CBULIST_RRI(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRI)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRS', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRS ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRS was already allocated' )
+ DEALLOCATE( CBULIST_RRS )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(NBULISTMAXLINES) )
+ CBULIST_RRS(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRS)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRG', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRG ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRG was already allocated' )
+ DEALLOCATE( CBULIST_RRG )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(NBULISTMAXLINES) )
+ CBULIST_RRG(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRG)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RRH', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRH ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRH was already allocated' )
+ DEALLOCATE( CBULIST_RRH )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(NBULISTMAXLINES) )
+ CBULIST_RRH(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRH)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BU_RSV', GFOUND )
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RSV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RSV was already allocated' )
+ DEALLOCATE( CBULIST_RSV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(NBULISTMAXLINES) )
+ CBULIST_RSV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RSV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
+ END IF
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_LES', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LES)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_MEAN', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_MEAN)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PDF', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PDF)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FRC', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FRC)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_C2R2', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PARAM_C1R3', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_ELEC', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ELEC)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_SERIES', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIES)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CH_ORILAM', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_DUST', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DUST)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_SALT', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SALT)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_PASPOL', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PASPOL)
+#ifdef MNH_FOREFIRE
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FOREFIRE', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FOREFIRE)
+#endif
+ CALL POSNAM( TPEXSEGFILE, 'NAM_CONDSAMP', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_2D_FRC', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_LATZ_EDFLX', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BLOWSNOW', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
+ CALL POSNAM( TPEXSEGFILE, 'NAM_VISC', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_VISC)
+
+ CALL POSNAM( TPEXSEGFILE, 'NAM_FLYERS', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FLYERS)
+
+ IF ( NAIRCRAFTS > 0 ) THEN
+ CALL AIRCRAFTS_NML_ALLOCATE( NAIRCRAFTS )
+ CALL POSNAM( TPEXSEGFILE, 'NAM_AIRCRAFTS', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
+ END IF
+
+ IF ( NBALLOONS > 0 ) THEN
+ CALL BALLOONS_NML_ALLOCATE( NBALLOONS )
+ CALL POSNAM( TPEXSEGFILE, 'NAM_BALLOONS', GFOUND )
+ IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+CALL TEST_NAM_VAR(ILUOUT,'CPRESOPT',CPRESOPT,'RICHA','CGRAD','CRESI','ZRESI')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CUVW_ADV_SCHEME',CUVW_ADV_SCHEME, &
+ 'CEN4TH','CEN2ND','WENO_K' )
+CALL TEST_NAM_VAR(ILUOUT,'CMET_ADV_SCHEME',CMET_ADV_SCHEME, &
+ &'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CSV_ADV_SCHEME',CSV_ADV_SCHEME, &
+ &'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CTEMP_SCHEME',CTEMP_SCHEME, &
+ &'RK11','RK21','RK33','RKC4','RK53','RK4B','RK62','RK65','NP32','SP32','LEFR')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CTURB',CTURB,'NONE','TKEL')
+CALL TEST_NAM_VAR(ILUOUT,'CRAD',CRAD,'NONE','FIXE','ECMW',&
+#ifdef MNH_ECRAD
+ 'ECRA',&
+#endif
+ 'TOPA')
+CALL TEST_NAM_VAR(ILUOUT,'CCLOUD',CCLOUD,'NONE','REVE','KESS', &
+ & 'ICE3','ICE4','C2R2','C3R5','KHKO','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'CDCONV',CDCONV,'NONE','KAFR')
+CALL TEST_NAM_VAR(ILUOUT,'CSCONV',CSCONV,'NONE','KAFR','EDKF')
+CALL TEST_NAM_VAR(ILUOUT,'CELEC',CELEC,'NONE','ELE3','ELE4')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CAER',CAER,'TANR','TEGE','SURF','NONE')
+CALL TEST_NAM_VAR(ILUOUT,'CAOP',CAOP,'CLIM','EXPL')
+CALL TEST_NAM_VAR(ILUOUT,'CLW',CLW,'RRTM','MORC')
+CALL TEST_NAM_VAR(ILUOUT,'CEFRADL',CEFRADL,'PRES','OCLN','MART','C2R2','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'CEFRADI',CEFRADI,'FX40','LIOU','SURI','C3R5','LIMA')
+CALL TEST_NAM_VAR(ILUOUT,'COPWLW',COPWLW,'SAVI','SMSH','LILI','MALA')
+CALL TEST_NAM_VAR(ILUOUT,'COPILW',COPILW,'FULI','EBCU','SMSH','FU98')
+CALL TEST_NAM_VAR(ILUOUT,'COPWSW',COPWSW,'SLIN','FOUQ','MALA')
+CALL TEST_NAM_VAR(ILUOUT,'COPISW',COPISW,'FULI','EBCU','FU96')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CLBCX(1)',CLBCX(1),'CYCL','WALL','OPEN')
+CALL TEST_NAM_VAR(ILUOUT,'CLBCX(2)',CLBCX(2),'CYCL','WALL','OPEN')
+CALL TEST_NAM_VAR(ILUOUT,'CLBCY(1)',CLBCY(1),'CYCL','WALL','OPEN')
+CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN')
+!
+CALL TURBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+CALL NEBN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+!
+CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
+ 'SPLIT ','CENTER ','LAGGED ')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CCONF',CCONF,'START','RESTA')
+CALL TEST_NAM_VAR(ILUOUT,'CEQNSYS',CEQNSYS,'LHE','DUR','MAE')
+CALL TEST_NAM_VAR(ILUOUT,'CSPLIT',CSPLIT,'BSPLITTING','XSPLITTING','YSPLITTING')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CBUTYPE',CBUTYPE,'NONE','CART','MASK')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CRELAX_HEIGHT_TYPE',CRELAX_HEIGHT_TYPE,'FIXE','THGR')
+!
+CALL TEST_NAM_VAR(ILUOUT,'CLES_NORM_TYPE',CLES_NORM_TYPE,'NONE','CONV','EKMA','MOBU')
+CALL TEST_NAM_VAR(ILUOUT,'CBL_HEIGHT_DEF',CBL_HEIGHT_DEF,'TKE','KE','WTV','FRI','DTH')
+CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN_CLOUD',CTURBLEN_CLOUD,'NONE','DEAR','DELT','BL89')
+!
+! The test on the mass flux scheme for shallow convection
+!
+CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+!
+! The test on the CSOLVER name is made elsewhere
+!
+CALL PARAM_ICEN_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+IF( CCLOUD == 'C3R5' ) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_C1R3',CPRISTINE_ICE_C1R3, &
+ 'PLAT','COLU','BURO')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_C1R3',CHEVRIMED_ICE_C1R3, &
+ 'GRAU','HAIL')
+END IF
+!
+IF( CCLOUD == 'LIMA' ) THEN
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPEXSEGFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
+END IF
+! Blaze
+CALL UPDATE_NAM_FIREn
+IF (LBLAZE) THEN
+ ! Blaze is only allowed on finer model(s)
+ DO JI = 1, NMODEL
+ IF ( JI /= KMI .AND. NDAD(JI) == KMI ) THEN
+ WRITE( YMODEL, '( I3 )' ) JI
+ CMNHMSG(1) = 'Blaze fire model only allowed on finer model'
+ CMNHMSG(2) = '=> disabled on model ' // YMODEL
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'READ_EXSEG_n' )
+ LBLAZE = .FALSE.
+ END IF
+ END DO
+ CALL TEST_NAM_VAR(ILUOUT,'CPROPAG_MODEL',CPROPAG_MODEL,'SANTONI2011')
+ CALL TEST_NAM_VAR(ILUOUT,'CHEAT_FLUX_MODEL',CHEAT_FLUX_MODEL,'CST','EXP','EXS')
+ CALL TEST_NAM_VAR(ILUOUT,'CLATENT_FLUX_MODEL',CLATENT_FLUX_MODEL,'CST','EXP')
+ CALL TEST_NAM_VAR(ILUOUT,'CFIRE_CPL_MODE',CFIRE_CPL_MODE,'2WAYCPL','FIR2ATM','ATM2FIR')
+ CALL TEST_NAM_VAR(ILUOUT,'CWINDFILTER',CWINDFILTER,'EWAM','WLIM')
+END IF
+!
+IF(LBLOWSNOW) THEN
+ CALL TEST_NAM_VAR(ILUOUT,'CSNOWSEDIM',CSNOWSEDIM,'NONE','MITC','CARR','TABC')
+ IF (XALPHA_SNOW .NE. 3 .AND. CSNOWSEDIM=='TABC') THEN
+ WRITE(ILUOUT,*) '*****************************************'
+ WRITE(ILUOUT,*) '* XALPHA_SNW must be set to 3 when '
+ WRITE(ILUOUT,*) '* CSNOWSEDIM = TABC '
+ WRITE(ILUOUT,*) '* Update the look-up table in BLOWSNOW_SEDIM_LKT1D '
+ WRITE(ILUOUT,*) '* to use TABC with a different value of XEMIALPHA_SNW'
+ WRITE(ILUOUT,*) '*****************************************'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+END IF
+! Consistency checks between phyex modules
+IF ((CSUBG_AUCV_RC == 'ADJU' .OR. CSUBG_AUCV_RI == 'ADJU') .AND. CCONDENS /= 'GAUS') THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'READ_EXSEGN', &
+ &"CSUBG_AUCV_RC and/or CSUBG_AUCV_RI cannot be 'ADJU' if CCONDENS is not 'GAUS'")
+ENDIF
+IF (.NOT. LHARAT .AND. LSTATNW) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'READ_EXSEGN', &
+ &'LSTATNW only tested in combination with HARATU and EDMFm!')
+ENDIF
+!
+!-------------------------------------------------------------------------------!
+!* 2. FIRST INITIALIZATIONS
+! ---------------------
+!
+!* 2.1 Time step in gridnesting case
+!
+IF (KMI /= 1 .AND. NDAD(KMI) /= KMI) THEN
+ XTSTEP = PTSTEP_ALL(NDAD(KMI)) / NDTRATIO(KMI)
+END IF
+PTSTEP_ALL(KMI) = XTSTEP
+!
+!* 2.2 Fill the global configuration module
+!
+! Check coherence between the microphysical scheme and water species and
+!initialize the logicals LUSERn
+!
+SELECT CASE ( CCLOUD )
+ CASE ( 'NONE' )
+ IF (.NOT. ( (.NOT. LUSERC) .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) .AND. CPROGRAM=='MESONH' ) THEN
+!
+ LUSERC=.FALSE.
+ LUSERR=.FALSE.; LUSERI=.FALSE.
+ LUSERS=.FALSE.; LUSERG=.FALSE.
+ LUSERH=.FALSE.
+!
+ END IF
+!
+ IF (CSUBG_AUCV_RC == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE SUBGRID AUTOCONVERSION SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT MICROPHYSICS'
+ WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"'
+!
+ CSUBG_AUCV_RC = 'NONE'
+!
+ END IF
+!
+ CASE ( 'REVE' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) &
+ .AND. (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A REVERSIBLE MICROPHYSICAL " ,&
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR AND CLOUD WATER ",/, &
+ &" LUSERV AND LUSERC ARE TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE.
+ LUSERR=.FALSE.; LUSERI=.FALSE.
+ LUSERS=.FALSE.; LUSERG=.FALSE.
+ LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV_RC == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A REVERSIBLE MICROPHYSICAL SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT YOU DO NOT HAVE RAIN in the "REVE" SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV_RC IS PUT TO "NONE"'
+!
+ CSUBG_AUCV_RC = 'NONE'
+!
+ END IF
+!
+ CASE ( 'KESS' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A KESSLER MICROPHYSICAL " , &
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, &
+ &" LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE.
+ LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV_RC == 'SIGM') THEN
+!
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A KESSLER MICROPHYSICAL SCHEME '
+ WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME USING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SIGMA_RC.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET CSUBG_AUCV_RC TO "CLFR" or "NONE" OR CCLOUD TO "ICE3"'
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ CASE ( 'ICE3' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI &
+ .AND. LUSERS .AND. LUSERG .AND. (.NOT. LUSERH)) &
+ .AND. CPROGRAM=='MESONH' ) THEN
+ !
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice3 SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES AND GRAUPELN.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG ARE SET TO TRUE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH TO FALSE'
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+!
+ IF (CSUBG_AUCV_RC == 'SIGM' .AND. .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV_RC is SET to NONE'
+ CSUBG_AUCV_RC='NONE'
+ END IF
+!
+ IF (CSUBG_AUCV_RC == 'CLFR' .AND. CSCONV /= 'EDKF') THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WITH THE CONVECTIVE CLOUD FRACTION WITHOUT EDKF'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV_RC is SET to NONE'
+ CSUBG_AUCV_RC='NONE'
+ END IF
+!
+ CASE ( 'ICE4' )
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI &
+ .AND. LUSERS .AND. LUSERG .AND. LUSERH) &
+ .AND. CPROGRAM=='MESONH' ) THEN
+ !
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice4 SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES, GRAUPELN AND HAILSTONES.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH ARE SET TO TRUE'
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE. ; LUSERH=.TRUE.
+ END IF
+!
+ IF (CSUBG_AUCV_RC /= 'NONE' .AND. .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV_RC is SET to NONE'
+ CSUBG_AUCV_RC='NONE'
+ END IF
+!
+ CASE ( 'C2R2','C3R5', 'KHKO' )
+ IF (( EPARAM_CCN == 'XXX') .OR. (EINI_CCN == 'XXX')) THEN
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
+ &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_C2R2", &
+ &" YOU HAVE TO FILL HPARAM_CCN and HINI_CCN ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ IF (HCLOUD == 'NONE') THEN
+ CGETCLOUD = 'SKIP'
+ ELSE IF (HCLOUD == 'REVE' ) THEN
+ CGETCLOUD = 'INI1'
+ ELSE IF (HCLOUD == 'KESS' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE IF (HCLOUD == 'ICE3' ) THEN
+ IF (CCLOUD == 'C3R5') THEN
+ CGETCLOUD = 'INI2'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE WARM MICROPHYSICAL ", &
+ &" SCHEME BUT YOU WERE USING THE ICE3 SCHEME PREVIOUSLY.",/, &
+ &" AS THIS IS A LITTLE BIT STUPID IT IS NOT AUTHORIZED !!!")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ ELSE
+ CGETCLOUD = 'READ' ! This is automatically done
+ END IF
+!
+ IF ((CCLOUD == 'C2R2' ).OR. (CCLOUD == 'KHKO' )) THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. &
+ (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C2R2 MICROPHYSICAL ", &
+ &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, &
+ &"LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")')
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE.
+ LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+ ELSE IF (CCLOUD == 'C3R5') THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. &
+ LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C3R5 MICROPHYS. SCHEME.",&
+ &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, &
+ &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+ ELSE IF (CCLOUD == 'LIMA') THEN
+ IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. &
+ LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) &
+ ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LIMA MICROPHYS. SCHEME.",&
+ &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, &
+ &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
+!
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSECI=.TRUE.
+ LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH=.FALSE.
+ END IF
+ END IF
+!
+ IF (LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE SIMPLE MIXED PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYS. SCHEME AND THE SUBGRID COND. SCHEME.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LSUBG_COND TO FALSE OR CCLOUD TO "REVE", "KESS"'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( CEFRADL /= 'C2R2') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ IF ( CCLOUD == 'C3R5' .AND. CEFRADI /= 'C3R5') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADI=C3R5 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADI=C3R5 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ IF ( WALPHAC /= 3.0 .OR. WNUC /= 2.0) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS WITH KHKO SCHEME. '
+ END IF
+!
+ IF ( CEFRADL /= 'C2R2') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
+ END IF
+!
+ CASE ( 'LIMA')
+ IF (HCLOUD == 'NONE') THEN
+ CGETCLOUD = 'SKIP'
+ ELSE IF (HCLOUD == 'REVE' ) THEN
+ CGETCLOUD = 'INI1'
+ ELSE IF (HCLOUD == 'KESS' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE IF (HCLOUD == 'ICE3' ) THEN
+ CGETCLOUD = 'INI2'
+ ELSE
+ CGETCLOUD = 'READ' ! This is automatically done
+ END IF
+!
+ IF (NMOM_C.GE.1) THEN
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.FALSE.; LUSERS=.FALSE. ; LUSERG=.FALSE.; LUSERH=.FALSE.
+ END IF
+!
+ IF (NMOM_I.GE.1) THEN
+ LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
+ LUSERI=.TRUE. ; LUSERS=.TRUE. ; LUSERG=.TRUE.
+ LUSERH= NMOM_H.GE.1
+ END IF
+ !
+ IF (LSPRO) LADJ=.FALSE.
+ IF (.NOT.LPTSPLIT) THEN
+ IF (NMOM_C==1) NMOM_C=2
+ IF (NMOM_R==1) NMOM_R=2
+ IF (NMOM_I==1) NMOM_I=2
+ IF (NMOM_S==2 .OR. NMOM_G==2 .OR. NMOM_H==2) THEN
+ NMOM_S=2
+ NMOM_G=2
+ IF (NMOM_H.GE.1) NMOM_H=2
+ END IF
+ END IF
+!
+ IF (LSUBG_COND .AND. (.NOT. LPTSPLIT)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LPTSPLIT=T with CCLOUD=LIMA'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LPTSPLIT=T with LIMA and LSUBG_COND=T')
+ END IF
+!
+ IF (LSUBG_COND .AND. (.NOT. LADJ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LADJ=T with CCLOUD=LIMA'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LADJ=T with LIMA and LSUBG_COND=T')
+ END IF
+!
+ IF ( LKHKO .AND. (XALPHAC /= 3.0 .OR. XNUC /= 2.0) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS. '
+ END IF
+!
+ IF ( CEFRADL /= 'LIMA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=LIMA FOR RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=LIMA '
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME "LIMA"'
+ END IF
+!
+END SELECT
+!
+LUSERV_G(KMI) = LUSERV
+LUSERC_G(KMI) = LUSERC
+LUSERR_G(KMI) = LUSERR
+LUSERI_G(KMI) = LUSERI
+LUSERS_G(KMI) = LUSERS
+LUSERG_G(KMI) = LUSERG
+LUSERH_G(KMI) = LUSERH
+LUSETKE(KMI) = (CTURB /= 'NONE')
+!
+!-------------------------------------------------------------------------------
+!
+!* 2.3 Chemical and NSV_* variables initializations
+!
+CALL UPDATE_NAM_IBM_PARAMN
+CALL UPDATE_NAM_RECYCL_PARAMN
+CALL UPDATE_NAM_PARAMN
+CALL UPDATE_NAM_DYNN
+CALL UPDATE_NAM_CONFN
+!
+IF (LORILAM .AND. .NOT. LUSECHEM) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CANNOT USE ORILAM AEROSOL SCHEME WITHOUT '
+ WRITE(ILUOUT,FMT=*) 'CHEMICAL GASEOUS CHEMISTRY '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LUSECHEM IS SET TO TRUE '
+ LUSECHEM=.TRUE.
+END IF
+!
+IF (LUSECHAQ.AND.(.NOT.LUSECHEM)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHEM TO TRUE IF YOU WANT REALLY USE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHAQ TO FALSE IF YOU DO NOT WANT USE IT'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+IF (LUSECHAQ.AND.(.NOT.LUSERC).AND.CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT CLOUD MICROPHYSICS IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHAQ IS SET TO FALSE'
+ LUSECHAQ = .FALSE.
+END IF
+IF (LUSECHAQ.AND.CCLOUD(1:3) == 'ICE'.AND. .NOT. LUSECHIC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WITH MIXED PHASE CLOUD MICROPHYSICS'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHIC TO TRUE IF YOU WANT TO ACTIVATE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'ICE PHASE CHEMICAL SPECIES'
+ IF (LCH_RET_ICE) THEN
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE TRUE MEANS ALL SOLUBLE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'GASES ARE RETAINED IN ICE PHASE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'WHEN SUPERCOOLED WATER FREEZES'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE FALSE MEANS ALL SOLUBLE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'GASES GO BACK TO THE GAS PHASE WHEN'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SUPERCOOLED WATER FREEZES'
+ ENDIF
+ENDIF
+IF (LUSECHIC.AND. .NOT. CCLOUD(1:3) == 'ICE'.AND.CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT MIXED PHASE CLOUD MICROPHYSICS IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHIC IS SET TO FALSE'
+ LUSECHIC= .FALSE.
+ENDIF
+IF (LCH_PH.AND. (.NOT. LUSECHAQ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'DIAGNOSTIC PH COMPUTATION IS ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT TO ACTIVATE IT'
+ WRITE(UNIT=ILUOUT,FMT=*) 'LCH_PH IS SET TO FALSE'
+ LCH_PH= .FALSE.
+ENDIF
+IF (LUSECHIC.AND.(.NOT.LUSECHAQ)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT REALLY USE CLOUD CHEMISTRY'
+ WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHIC TO FALSE IF YOU DO NOT WANT USE IT'
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+IF ((LUSECHIC).AND.(LCH_RET_ICE)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE RETENTION OF SOLUBLE GASES IN ICE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE ICE PHASE CHEMISTRY IS ACTIVATED'
+ WRITE(UNIT=ILUOUT,FMT=*) 'FLAG LCH_RET_ICE IS ONLY USES WHEN LUSECHIC IS SET'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE IE NO CHEMICAL SPECIES IN ICE'
+ENDIF
+!
+CALL UPDATE_NAM_CH_MNHCN
+CALL INI_NSV(KMI)
+!
+! From this point, all NSV* variables contain valid values for model KMI
+!
+DO JSV = 1,NSV
+ LUSESV(JSV,KMI) = .TRUE.
+END DO
+!
+IF ( CAOP=='EXPL' .AND. .NOT.LDUST .AND. .NOT.LORILAM &
+ .AND. .NOT.LSALT .AND. .NOT.(CCLOUD=='LIMA') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) ' YOU WANT TO USE EXPLICIT AEROSOL OPTICAL '
+ WRITE(UNIT=ILUOUT,FMT=*) 'PROPERTIES BUT YOU DONT HAVE DUST OR '
+ WRITE(UNIT=ILUOUT,FMT=*) 'AEROSOL OR SALT THEREFORE CAOP=CLIM'
+ CAOP='CLIM'
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 3. CHECK COHERENCE BETWEEN EXSEG VARIABLES AND FMFILE ATTRIBUTES
+! -------------------------------------------------------------
+!
+!
+!* 3.1 Turbulence variable
+!
+IF ((CTURB /= 'NONE').AND.(HTURB == 'NONE')) THEN
+ CGETTKET ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE TURBULENCE KINETIC ENERGY TKE'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'TKE WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (CTURB /= 'NONE') THEN
+ CGETTKET ='READ'
+ IF ((CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETTKET='INIT'
+ ELSE
+ CGETTKET ='SKIP'
+ END IF
+END IF
+!
+!
+IF ((CTOM == 'TM06').AND.(HTOM /= 'TM06')) THEN
+ CGETBL_DEPTH ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE BL DEPTH FOR THIRD ORDER MOMENTS'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (CTOM == 'TM06') THEN
+ CGETBL_DEPTH ='READ'
+ ELSE
+ CGETBL_DEPTH ='SKIP'
+ END IF
+END IF
+!
+IF (LRMC01 .AND. .NOT. ORMC01) THEN
+ CGETSBL_DEPTH ='INIT'
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE SBL DEPTH FOR RMC01'
+ WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
+ WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO'
+ELSE
+ IF (LRMC01) THEN
+ CGETSBL_DEPTH ='READ'
+ ELSE
+ CGETSBL_DEPTH ='SKIP'
+ END IF
+END IF
+!
+!
+!* 3.2 Moist variables
+!
+IF (LUSERV.AND. (.NOT.OUSERV)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE VAPOR VARIABLE Rv WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & "Rv WILL BE INITIALIZED TO ZERO")')
+ CGETRVT='INIT'
+ELSE
+ IF (LUSERV) THEN
+ CGETRVT='READ'
+ ELSE
+ CGETRVT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERC.AND. (.NOT.OUSERC)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE CLOUD VARIABLE Rc WHEREAS IT ", &
+ & " IS NOT IN INITIAL FMFILE",/, &
+ & "Rc WILL BE INITIALIZED TO ZERO")')
+ CGETRCT='INIT'
+ELSE
+ IF (LUSERC) THEN
+ CGETRCT='READ'
+! IF(CCONF=='START') CGETRCT='INIT'
+ ELSE
+ CGETRCT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERR.AND. (.NOT.OUSERR)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE RAIN VARIABLE Rr WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Rr WILL BE INITIALIZED TO ZERO")')
+
+ CGETRRT='INIT'
+ELSE
+ IF (LUSERR) THEN
+ CGETRRT='READ'
+! IF( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRRT='INIT'
+ ELSE
+ CGETRRT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERI.AND. (.NOT.OUSERI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE VARIABLE Ri WHEREAS IT ", &
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Ri WILL BE INITIALIZED TO ZERO")')
+ CGETRIT='INIT'
+ELSE
+ IF (LUSERI) THEN
+ CGETRIT='READ'
+! IF(CCONF=='START') CGETRIT='INIT'
+ ELSE
+ CGETRIT='SKIP'
+ END IF
+END IF
+!
+IF (LUSECI.AND. (.NOT.OUSECI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE CONC. VARIABLE Ci WHEREAS IT ",&
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Ci WILL BE INITIALIZED TO ZERO")')
+ CGETCIT='INIT'
+ELSE
+ IF (LUSECI) THEN
+ CGETCIT='READ'
+ ELSE
+ CGETCIT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERS.AND. (.NOT.OUSERS)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SNOW VARIABLE Rs WHEREAS IT ",&
+ & "IS NOT IN INITIAL FMFILE",/, &
+ & " Rs WILL BE INITIALIZED TO ZERO")')
+ CGETRST='INIT'
+ELSE
+ IF (LUSERS) THEN
+ CGETRST='READ'
+! IF ( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRST='INIT'
+ ELSE
+ CGETRST='SKIP'
+ END IF
+END IF
+!
+IF (LUSERG.AND. (.NOT.OUSERG)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE GRAUPEL VARIABLE Rg WHEREAS ",&
+ & " IT IS NOTIN INITIAL FMFILE",/, &
+ & "Rg WILL BE INITIALIZED TO ZERO")')
+ CGETRGT='INIT'
+ELSE
+ IF (LUSERG) THEN
+ CGETRGT='READ'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRGT='INIT'
+ ELSE
+ CGETRGT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERH.AND. (.NOT.OUSERH)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE HAIL VARIABLE Rh WHEREAS",&
+ & "IT IS NOT IN INITIAL FMFILE",/, &
+ & " Rh WILL BE INITIALIZED TO ZERO")')
+ CGETRHT='INIT'
+ELSE
+ IF (LUSERH) THEN
+ CGETRHT='READ'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRHT='INIT'
+ ELSE
+ CGETRHT='SKIP'
+ END IF
+END IF
+!
+IF (LUSERC.AND. (.NOT.OUSERC)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD FRACTION WILL BE INITIALIZED ACCORDING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0'
+ CGETCLDFR = 'INIT'
+ELSE
+ IF ( LUSERC ) THEN
+ CGETCLDFR = 'READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETCLDFR='INIT'
+ ELSE
+ CGETCLDFR = 'SKIP'
+ END IF
+END IF
+!
+IF (LUSERI.AND. (.NOT.OUSERI)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE ICE CLOUD FRACTION WILL BE INITIALIZED ACCORDING'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0'
+ CGETICEFR = 'INIT'
+ELSE
+ IF ( LUSERI ) THEN
+ CGETICEFR = 'READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETICEFR='INIT'
+ ELSE
+ CGETICEFR = 'SKIP'
+ END IF
+END IF
+!
+!
+!* 3.3 Moist turbulence
+!
+IF ( LUSERC .AND. CTURB /= 'NONE' ) THEN
+ IF ( .NOT. (OUSERC .AND. HTURB /= 'NONE') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MOIST TURBULENCE WHEREAS IT ",/, &
+ & " WAS NOT THE CASE FOR THE INITIAL FMFILE GENERATION",/, &
+ & "SRC AND SIGS ARE INITIALIZED TO 0")')
+ CGETSRCT ='INIT'
+ CGETSIGS ='INIT'
+ ELSE
+ CGETSRCT ='READ'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETSRCT ='INIT'
+ CGETSIGS ='READ'
+ END IF
+ELSE
+ CGETSRCT ='SKIP'
+ CGETSIGS ='SKIP'
+END IF
+!
+IF(LCLOUDMODIFLM .AND. CTURBLEN_CLOUD/='NONE') THEN
+ IF (CTURB=='NONE' .OR. .NOT.LUSERC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO COMPUTE A MIXING LENGTH FOR CLOUD=", &
+ & ", WHEREAS YOU DO NOT SPECIFY A TURBULENCE SCHEME OR ", &
+ & "USE OF RC,",/," CTURBLEN_CLOUD IS SET TO NONE")') &
+ CTURBLEN_CLOUD
+ CTURBLEN_CLOUD='NONE'
+ END IF
+ IF( XCEI_MIN > XCEI_MAX ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("PROBLEM OF CEI LIMITS FOR CLOUD MIXING ",/, &
+ & "LENGTH COMPUTATION: XCEI_MIN=",E9.3,", XCEI_MAX=",E9.3)')&
+ XCEI_MIN,XCEI_MAX
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+IF ( LSIGMAS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SIGMA_S FROM TURBULENCE SCHEME",/, &
+ & " IN ICE SUBGRID CONDENSATION, SO YOUR SIGMA_S"/, &
+ & " MIGHT BE SMALL ABOVE PBL DEPENDING ON LENGTH SCALE")')
+END IF
+!
+IF (LSUBG_COND .AND. CTURB=='NONE' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID CONDENSATION'
+ WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT TURBULENCE '
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: LSUBG_COND is SET to FALSE'
+ LSUBG_COND=.FALSE.
+END IF
+!
+IF (L1D .AND. CTURB/='NONE' .AND. CTURBDIM == '3DIM') THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE 3D TURBULENCE IN 1D CONFIGURATION '
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE: CTURBDIM IS SET TO 1DIM'
+ CTURBDIM = '1DIM'
+END IF
+!
+!* 3.4 Additional scalar variables
+!
+IF (NSV_USER == KSV_USER) THEN
+ DO JS = 1,KSV_USER ! to read all the variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize them
+! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
+ END DO
+ELSEIF (NSV_USER > KSV_USER) THEN
+ IF (KSV_USER == 0) THEN
+ CGETSVT(1:NSV_USER)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MORE ADDITIONAL SCALAR " ,&
+ &" VARIABLES THAN THERE ARE IN INITIAL FMFILE",/, &
+ & "THE SUPPLEMENTARY VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ DO JS = 1,KSV_USER ! to read all the variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize them
+! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
+ END DO
+ DO JS = KSV_USER+1, NSV_USER ! to initialize to zero supplementary
+ CGETSVT(JS)='INIT' ! initial file)
+ END DO
+ END IF
+ELSE
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE LESS ADDITIONAL SCALAR " ,&
+ &" VARIABLES THAN THERE ARE IN INITIAL FMFILE")')
+ DO JS = 1,NSV_USER ! to read the first NSV_USER variables in initial file
+ CGETSVT(JS)='READ' ! and to initialize with these values
+! IF(CCONF=='START') CGETSVT(JS)='INIT'
+ END DO
+ DO JS = NSV_USER + 1, KSV_USER ! to skip the last (KSV_USER-NSV_USER) variables
+ CGETSVT(JS)='SKIP'
+ END DO
+END IF
+!
+! C2R2 and KHKO SV case
+!
+IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
+ IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
+ CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C2R2 &
+ & (or KHKO) SCHEME IN INITIAL FMFILE",/,&
+ & "THE C2R2 (or KHKO) VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
+ END IF
+END IF
+!
+! C3R5 SV case
+!
+IF (CCLOUD == 'C3R5') THEN
+ IF (HCLOUD == 'C3R5') THEN
+ CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C3R5 &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE C1R3 VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
+ END IF
+END IF
+!
+! LIMA SV case
+!
+IF (CCLOUD == 'LIMA') THEN
+ IF (HCLOUD == 'LIMA') THEN
+ CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LIMA &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE LIMA VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='INIT'
+ END IF
+END IF
+!
+! Electrical SV case
+!
+IF (CELEC /= 'NONE') THEN
+ IF (HELEC /= 'NONE') THEN
+ CGETSVT(NSV_ELECBEG:NSV_ELECEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR ELECTRICAL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE ELECTRICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
+ END IF
+END IF
+!
+! (explicit) LINOx SV case
+!
+IF (CELEC /= 'NONE' .AND. LLNOX_EXPLICIT) THEN
+ IF (HELEC /= 'NONE' .AND. OLNOX_EXPLICIT) THEN
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
+ & IN INITIAL FMFILE",/,&
+ & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
+ END IF
+END IF
+!
+! Chemical SV case (excluding aqueous chemical species)
+!
+IF (LUSECHEM) THEN
+ IF (OUSECHEM) THEN
+ CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='READ'
+ IF(CCONF=='START' .AND. LCH_INIT_FIELD ) CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT'
+ END IF
+END IF
+! add aqueous chemical species
+IF (LUSECHAQ) THEN
+ IF (OUSECHAQ) THEN
+ CGETSVT(NSV_CHACBEG:NSV_CHACEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SCHEME IN AQUEOUS PHASE IN INITIAL FMFILE",/,&
+ & "THE AQUEOUS PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT'
+ END IF
+END IF
+! add ice phase chemical species
+IF (LUSECHIC) THEN
+ IF (OUSECHIC) THEN
+ CGETSVT(NSV_CHICBEG:NSV_CHICEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
+ &SPECIES IN ICE PHASE IN INITIAL FMFILE",/,&
+ & "THE ICE PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
+ END IF
+END IF
+! pH values = diagnostics
+IF (LCH_PH .AND. .NOT. OCH_PH) THEN
+ CGETPHC ='INIT' !will be initialized to XCH_PHINIT
+ IF (LUSERR) THEN
+ CGETPHR = 'INIT' !idem
+ ELSE
+ CGETPHR = 'SKIP'
+ ENDIF
+ELSE
+ IF (LCH_PH) THEN
+ CGETPHC ='READ'
+ IF (LUSERR) THEN
+ CGETPHR = 'READ'
+ ELSE
+ CGETPHR = 'SKIP'
+ ENDIF
+ ELSE
+ CGETPHC ='SKIP'
+ CGETPHR ='SKIP'
+ END IF
+END IF
+!
+! Dust case
+!
+IF (LDUST) THEN
+ IF (ODUST) THEN
+ CGETSVT(NSV_DSTBEG:NSV_DSTEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR DUST &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
+ END IF
+ IF (LDEPOS_DST(KMI)) THEN
+
+ !UPG *PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF DUST IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG *PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_DST(KMI) ) THEN
+ CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD DUST &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
+ END IF
+ END IF
+
+ IF(NMODE_DST.GT.3 .OR. NMODE_DST.LT.1) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("DUST MODES MUST BE BETWEEN 1 and 3 ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+! Sea Salt case
+!
+IF (LSALT) THEN
+ IF (OSALT) THEN
+ CGETSVT(NSV_SLTBEG:NSV_SLTEND)='READ'
+ CGETZWS='READ'
+! IF(CCONF=='START') CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR SALT &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
+ CGETZWS='INIT'
+ END IF
+ IF (LDEPOS_SLT(KMI)) THEN
+
+ !UPG*PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF SEA SALT AEROSOLS IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG*PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_SLT(KMI) ) THEN
+ CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD SEA SALT &
+ & SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST SEA SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
+ END IF
+ END IF
+ IF(NMODE_SLT.GT.8 .OR. NMODE_SLT.LT.1) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 8 ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+! Orilam SV case
+!
+IF (LORILAM) THEN
+ IF (OORILAM) THEN
+ CGETSVT(NSV_AERBEG:NSV_AEREND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR AEROSOL &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE AEROSOLS VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
+ END IF
+ IF (LDEPOS_AER(KMI)) THEN
+
+ !UPG*PT
+ IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
+ .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
+ !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
+ (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF ORILAM AEROSOLS IS ONLY CODED FOR THE",/,&
+ & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
+ !UPG*PT
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+
+ IF (ODEPOS_AER(KMI) ) THEN
+ CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and IN CLOUD &
+ & AEROSOL SCHEME IN INITIAL FMFILE",/,&
+ & "THE MOIST AEROSOL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
+ END IF
+ END IF
+END IF
+!
+! Lagrangian variables
+!
+IF (LINIT_LG .AND. .NOT.(LLG)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("IT IS INCOHERENT TO HAVE LINIT_LG=.T. AND LLG=.F.",/,&
+ & "IF YOU WANT LAGRANGIAN TRACERS CHANGE LLG TO .T. ")')
+ENDIF
+IF (LLG) THEN
+ IF (OLG .AND. .NOT.(LINIT_LG .AND. CPROGRAM=='MESONH')) THEN
+ CGETSVT(NSV_LGBEG:NSV_LGEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
+ ELSE
+ IF(.NOT.(LINIT_LG) .AND. CPROGRAM=='MESONH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO LAGRANGIAN VARIABLES IN INITIAL FMFILE",/,&
+ & "THE LAGRANGIAN VARIABLES HAVE BEEN REINITIALIZED")')
+ LINIT_LG=.TRUE.
+ ENDIF
+ CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
+ END IF
+END IF
+!
+!
+! LINOx SV case
+!
+IF (.NOT.LUSECHEM .AND. LCH_CONV_LINOX) THEN
+ IF (.NOT.OUSECHEM .AND. OCH_CONV_LINOX) THEN
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
+ &IN INITIAL FMFILE",/,&
+ & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
+ END IF
+END IF
+!
+! Passive pollutant case
+!
+IF (LPASPOL) THEN
+ IF (OPASPOL) THEN
+ CGETSVT(NSV_PPBEG:NSV_PPEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
+ END IF
+END IF
+!
+#ifdef MNH_FOREFIRE
+! ForeFire
+!
+IF (LFOREFIRE) THEN
+ IF (OFOREFIRE) THEN
+ CGETSVT(NSV_FFBEG:NSV_FFEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO FOREFIRE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_FFBEG:NSV_FFEND)='INIT'
+ END IF
+END IF
+#endif
+! Blaze smoke
+!
+IF (LBLAZE) THEN
+ IF (OFIRE) THEN
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO BLAZE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_FIREBEG:NSV_FIREEND)='INIT'
+ END IF
+END IF
+!
+! Conditional sampling case
+!
+IF (LCONDSAMP) THEN
+ IF (OCONDSAMP) THEN
+ CGETSVT(NSV_CSBEG:NSV_CSEND)='READ'
+! IF(CCONF=='START') CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
+ & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
+ CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
+ END IF
+END IF
+!
+! Blowing snow scheme
+!
+IF (LBLOWSNOW) THEN
+ IF (OBLOWSNOW) THEN
+ CGETSVT(NSV_SNWBEG:NSV_SNWEND)='READ'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR BLOWING SNOW &
+ &SCHEME IN INITIAL FMFILE",/,&
+ & "THE BLOWING SNOW VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
+ CGETSVT(NSV_SNWBEG:NSV_SNWEND)='INIT'
+ END IF
+END IF
+!
+!
+!
+!* 3.5 Check coherence between the radiation control parameters
+!
+IF( CRAD == 'ECMW' .AND. CPROGRAM=='MESONH' ) THEN
+ IF(CLW == 'RRTM' .AND. COPILW == 'SMSH') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'the SMSH parametrisation of LW optical properties for cloud ice'
+ WRITE(UNIT=ILUOUT,FMT=*) '(COPILW) can not be used with RRTM radiation scheme'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+ IF(CLW == 'MORC' .AND. COPWLW == 'LILI') THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'the LILI parametrisation of LW optical properties for cloud water'
+ WRITE(UNIT=ILUOUT,FMT=*) '(COPWLW) can not be used with MORC radiation scheme'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ ENDIF
+ IF( .NOT. LSUBG_COND) THEN
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE SUBGRID CONDENSATION'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90'
+ ELSE IF (CLW == 'MORC') THEN
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE MORCRETTE LW SCHEME'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90'
+ ELSE
+ WRITE(UNIT=ILUOUT,FMT=9000) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=6 IN ini_radconf.f90'
+ ENDIF
+!
+ IF( LCLEAR_SKY .AND. XDTRAD_CLONLY /= XDTRAD) THEN
+ ! Check the validity of the LCLEAR_SKY approximation
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE CLEAR-SKY APPROXIMATION'
+ WRITE(UNIT=ILUOUT,FMT=*) '(i.e. AVERAGE THE WHOLE CLOUDFREE VERTICALS BUT KEEP'
+ WRITE(UNIT=ILUOUT,FMT=*) 'ALL THE CLOUDY VERTICALS) AND'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD-ONLY APPROXIMATION (i.e. YOU CALL MORE OFTEN THE'
+ WRITE(UNIT=ILUOUT,FMT=*) 'RADIATIONS FOR THE CLOUDY VERTICALS THAN FOR CLOUDFREE ONES).'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE, SO CHOOSE BETWEEN :'
+ WRITE(UNIT=ILUOUT,FMT=*) 'XDTRAD_CLONLY = XDTRAD and LCLEAR_SKY = FALSE'
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF( XDTRAD_CLONLY > XDTRAD ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("BAD USE OF THE CLOUD-ONLY APPROXIMATION " ,&
+ &" XDTRAD SHOULD BE LARGER THAN XDTRAD_CLONLY ")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF(( XDTRAD < XTSTEP ).OR. ( XDTRAD_CLONLY < XTSTEP )) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("THE RADIATION CALL XDTRAD OR XDTRAD_CLONLY " ,&
+ &" IS MORE FREQUENT THAN THE TIME STEP SO ADJUST XDTRAD OR XDTRAD_CLONLY ")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END IF
+!
+IF ( CRAD /= 'NONE' .AND. CPROGRAM=='MESONH' ) THEN
+ CGETRAD='READ'
+ IF( HRAD == 'NONE' .AND. CCONF=='RESTA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU ARE PERFORMING A RESTART. FOR THIS SEGMENT, YOU ARE USING A RADIATION'
+ WRITE(UNIT=ILUOUT,FMT=*) 'SCHEME AND NO RADIATION SCHEME WAS USED FOR THE PREVIOUS SEGMENT.'
+ CGETRAD='INIT'
+ END IF
+ IF(CCONF=='START') THEN
+ CGETRAD='INIT'
+ END IF
+ IF(CCONF=='RESTA' .AND. (.NOT. LAERO_FT) .AND. (.NOT. LORILAM) &
+ .AND. (.NOT. LSALT) .AND. (.NOT. LDUST)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) '!!! WARNING !!! FOR REPRODUCTIBILITY BETWEEN START and START+RESTART,'
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LAERO_FT=T WITH CAER=TEGE IF CCONF=RESTA IN ALL SEGMENTS'
+ WRITE(UNIT=ILUOUT,FMT=*) 'TO UPDATE THE OZONE AND AEROSOLS CLIMATOLOGY USED BY THE RADIATION CODE;'
+ END IF
+END IF
+!
+! 3.6 check the initialization of the deep convection scheme
+!
+IF ( (CDCONV /= 'KAFR') .AND. &
+ (CSCONV /= 'KAFR') .AND. LCHTRANS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT IT CAN ONLY",&
+ &"BE USED FOR THE KAIN FRITSCH SCHEME ")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+SELECT CASE ( CDCONV )
+ CASE( 'KAFR' )
+ IF (.NOT. ( LUSERV ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH DEEP CONV. ",&
+ &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")')
+ LUSERV=.TRUE.
+ ELSE IF (.NOT. ( LUSERI ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",&
+ &" THE CLOUD WATER ")')
+ ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",&
+ &" WILL BE ADDED TO THE WATER VAPOR FIELD ")')
+ END IF
+ IF ( LCHTRANS .AND. NSV == 0 ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",&
+ &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")')
+ LCHTRANS=.FALSE.
+ END IF
+END SELECT
+!
+IF ( CDCONV == 'KAFR' .AND. LCHTRANS .AND. NSV > 0 ) THEN
+ IF( OCHTRANS ) THEN
+ CGETSVCONV='READ'
+ ELSE
+ CGETSVCONV='INIT'
+ END IF
+END IF
+!
+SELECT CASE ( CSCONV )
+ CASE( 'KAFR' )
+ IF (.NOT. ( LUSERV ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH SHALLOW CONV. ",&
+ &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")')
+ LUSERV=.TRUE.
+ ELSE IF (.NOT. ( LUSERI ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",&
+ &" THE CLOUD WATER ")')
+ ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
+ &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",&
+ &" WILL BE ADDED TO THE WATER VAPOR FIELD ")')
+ END IF
+ IF ( LCHTRANS .AND. NSV == 0 ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
+ &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",&
+ &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")')
+ LCHTRANS=.FALSE.
+ END IF
+ CASE( 'EDKF' )
+ IF (CTURB == 'NONE' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE EDKF ", &
+ &"SHALLOW CONVECTION WITHOUT TURBULENCE SCHEME : ", &
+ &"IT IS NOT POSSIBLE")')
+!
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+END SELECT
+!
+!
+CGETCONV = 'SKIP'
+!
+IF ( (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) .AND. CPROGRAM=='MESONH') THEN
+ CGETCONV = 'READ'
+ IF( HDCONV == 'NONE' .AND. CCONF=='RESTA') THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT='(" YOU ARE PERFORMING A RESTART. FOR THIS ",&
+ &" SEGMENT, YOU ARE USING A DEEP CONVECTION SCHEME AND NO DEEP ",&
+ &" CONVECTION SCHEME WAS USED FOR THE PREVIOUS SEGMENT. ")')
+!
+ CGETCONV = 'INIT'
+ END IF
+ IF(CCONF=='START') THEN
+ CGETCONV = 'INIT'
+ END IF
+END IF
+!
+!* 3.7 configuration and model version
+!
+IF (KMI == 1) THEN
+!
+ IF (L1D.AND.(CLBCX(1)/='CYCL'.AND.CLBCX(2)/='CYCL' &
+ .AND.CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 1D MODEL VERSION WITH NON-CYCL",&
+ & "CLBCX OR CLBCY VALUES")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ IF (L2D.AND.(CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2D MODEL VERSION WITH NON-CYCL",&
+ & " CLBCY VALUES")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ !
+ IF ( (.NOT. LCARTESIAN) .AND. ( LCORIO) .AND. (.NOT. LGEOST_UV_FRC) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("BE CAREFUL YOU COULD HAVE SPURIOUS MOTIONS " ,&
+ & " NEAR THE LBC AS LCORIO=T and LGEOST_UV_FRC=F")')
+ END IF
+ !
+ IF ((.NOT.LFLAT).AND.OFLAT) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'ZERO OROGRAPHY IN INITIAL FILE'
+ WRITE(UNIT=ILUOUT,FMT=*) '***** ALL TERMS HAVE BEEN NEVERTHELESS COMPUTED WITHOUT SIMPLIFICATION*****'
+ WRITE(UNIT=ILUOUT,FMT=*) 'THIS SHOULD LEAD TO ERRORS IN THE PRESSURE COMPUTATION'
+ END IF
+ IF (LFLAT.AND.(.NOT.OFLAT)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='(" OROGRAPHY IS NOT EQUAL TO ZERO ", &
+ & "IN INITIAL FILE" ,/, &
+ & "******* OROGRAPHY HAS BEEN SET TO ZERO *********",/, &
+ & "ACCORDING TO ZERO OROGRAPHY, SIMPLIFICATIONS HAVE ", &
+ & "BEEN MADE IN COMPUTATIONS")')
+ END IF
+END IF
+!
+!* 3.8 System of equations
+!
+IF ( HEQNSYS /= CEQNSYS ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU HAVE CHANGED THE SYSTEM OF EQUATIONS'
+ WRITE(ILUOUT,FMT=*) 'THE ANELASTIC CONSTRAINT IS PERHAPS CHANGED :'
+ WRITE(ILUOUT,FMT=*) 'FOR THE INITIAL FILE YOU HAVE USED ',HEQNSYS
+ WRITE(ILUOUT,FMT=*) 'FOR THE RUN YOU PLAN TO USE ',CEQNSYS
+ WRITE(ILUOUT,FMT=*) 'THIS CAN LEAD TO A NUMERICAL EXPLOSION IN THE FIRST TIME STEPS'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+! 3.9 Numerical schemes
+!
+IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. &
+ (CTEMP_SCHEME /= 'LEFR') .AND. (CTEMP_SCHEME /= 'RKC4') ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("CEN4TH SCHEME HAS TO BE USED WITH ",&
+ &"CTEMP_SCHEME = LEFR of RKC4 ONLY")')
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ( (CUVW_ADV_SCHEME == 'WENO_K') .AND. LNUMDIFU ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE NUMERICAL DIFFUSION ",&
+ &"WITH WENO SCHEME ALREADY DIFFUSIVE")')
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 4. CHECK COHERENCE BETWEEN EXSEG VARIABLES
+! ---------------------------------------
+!
+!* 4.1 coherence between coupling variables in EXSEG file
+!
+IF (KMI == 1) THEN
+ NCPL_NBR = 0
+ DO JCI = 1,JPCPLFILEMAX
+ IF (LEN_TRIM(CCPLFILE(JCI)) /= 0) THEN ! Finds the number
+ NCPL_NBR = NCPL_NBR + 1 ! of coupling files
+ ENDIF
+ IF (JCI/=JPCPLFILEMAX) THEN ! Deplaces the coupling files
+ IF ((LEN_TRIM(CCPLFILE(JCI)) == 0) .AND. &! names if one missing
+ (LEN_TRIM(CCPLFILE(JCI+1)) /= 0)) THEN
+ DO JI=JCI,JPCPLFILEMAX-1
+ CCPLFILE(JI)=CCPLFILE(JI+1)
+ END DO
+ CCPLFILE(JPCPLFILEMAX)=' '
+ END IF
+ END IF
+ END DO
+!
+ IF (NCPL_NBR /= 0) THEN
+ LSTEADYLS = .FALSE.
+ ELSE
+ LSTEADYLS = .TRUE.
+ ENDIF
+END IF
+!
+!* 4.3 check consistency in forcing switches
+!
+IF ( LFORCING ) THEN
+ IF ( LRELAX_THRV_FRC .AND. ( LTEND_THRV_FRC .OR. LGEOST_TH_FRC ) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CHOSE A TEMPERATURE AND HUMIDITY RELAXATION'
+ WRITE(ILUOUT,FMT=*) 'TOGETHER WITH TENDENCY OR GEOSTROPHIC FORCING'
+ WRITE(ILUOUT,FMT=*) &
+ 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND'
+ WRITE(ILUOUT,FMT=*) 'LGEOST_TH_FRC'
+ END IF
+!
+ IF ( LRELAX_UV_FRC .AND. LRELAX_UVMEAN_FRC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU MUST CHOOSE BETWEEN A RELAXATION APPLIED TO'
+ WRITE(ILUOUT,FMT=*) 'THE 3D FULL WIND FIELD (LRELAX_UV_FRC) OR'
+ WRITE(ILUOUT,FMT=*) 'THE HORIZONTAL MEAN WIND (LRELAX_UVMEAN_FRC)'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( (LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) .AND. LGEOST_UV_FRC ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU MUST NOT USE A WIND RELAXATION'
+ WRITE(ILUOUT,FMT=*) 'TOGETHER WITH A GEOSTROPHIC FORCING'
+ WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LRELAX_UVMEAN_FRC, LGEOST_UV_FRC'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( CRELAX_HEIGHT_TYPE.NE."FIXE" .AND. CRELAX_HEIGHT_TYPE.NE."THGR" ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'CRELAX_HEIGHT_TYPE MUST BE EITHER "FIXE" OR "THGR"'
+ WRITE(ILUOUT,FMT=*) 'BUT IT IS "', CRELAX_HEIGHT_TYPE, '"'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( .NOT.LCORIO .AND. LGEOST_UV_FRC ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU CANNOT HAVE A GEOSTROPHIC FORCING WITHOUT'
+ WRITE(ILUOUT,FMT=*) 'ACTIVATING LCORIOLIS OPTION'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( LPGROUND_FRC ) THEN
+ WRITE(ILUOUT,FMT=*) 'SURFACE PRESSURE FORCING NOT YET IMPLEMENTED'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+END IF
+!
+IF (LTRANS .AND. .NOT. LFLAT ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU ASK FOR A CONSTANT SPEED DOMAIN TRANSLATION '
+ WRITE(ILUOUT,FMT=*) 'BUT NOT IN THE FLAT TERRAIN CASE:'
+ WRITE(ILUOUT,FMT=*) 'THIS IS NOT ALLOWED ACTUALLY'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+!* 4.4 Check the coherence between the LUSERn and LHORELAX
+!
+IF (.NOT. LUSERV .AND. LHORELAX_RV) THEN
+ LHORELAX_RV=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RV FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE'
+END IF
+!
+IF (.NOT. LUSERC .AND. LHORELAX_RC) THEN
+ LHORELAX_RC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RC FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE'
+END IF
+!
+IF (.NOT. LUSERR .AND. LHORELAX_RR) THEN
+ LHORELAX_RR=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RR FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE'
+END IF
+!
+IF (.NOT. LUSERI .AND. LHORELAX_RI) THEN
+ LHORELAX_RI=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RI FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE'
+END IF
+!
+IF (.NOT. LUSERS .AND. LHORELAX_RS) THEN
+ LHORELAX_RS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RS FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE'
+END IF
+!
+IF (.NOT. LUSERG .AND. LHORELAX_RG) THEN
+ LHORELAX_RG=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RG FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE'
+END IF
+!
+IF (.NOT. LUSERH .AND. LHORELAX_RH) THEN
+ LHORELAX_RH=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RH FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE'
+END IF
+!
+IF (CTURB=='NONE' .AND. LHORELAX_TKE) THEN
+ LHORELAX_TKE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX TKE FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE'
+END IF
+!
+!
+IF (CCLOUD/='C2R2' .AND. CCLOUD/='KHKO' .AND. LHORELAX_SVC2R2) THEN
+ LHORELAX_SVC2R2=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C2R2 or KHKO FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC2R2=FALSE'
+END IF
+!
+IF (CCLOUD/='C3R5' .AND. LHORELAX_SVC1R3) THEN
+ LHORELAX_SVC1R3=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C3R5 FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC1R3=FALSE'
+END IF
+!
+IF (CCLOUD/='LIMA' .AND. LHORELAX_SVLIMA) THEN
+ LHORELAX_SVLIMA=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX LIMA FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVLIMA=FALSE'
+END IF
+!
+IF (CELEC(1:3) /= 'ELE' .AND. LHORELAX_SVELEC) THEN
+ LHORELAX_SVELEC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ELEC FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVELEC=FALSE'
+END IF
+!
+IF (.NOT. LUSECHEM .AND. LHORELAX_SVCHEM) THEN
+ LHORELAX_SVCHEM=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CHEM FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHEM=FALSE'
+END IF
+!
+IF (.NOT. LUSECHIC .AND. LHORELAX_SVCHIC) THEN
+ LHORELAX_SVCHIC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ICE CHEM FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHIC=FALSE'
+END IF
+!
+IF (.NOT. LORILAM .AND. LHORELAX_SVAER) THEN
+ LHORELAX_SVAER=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX AEROSOL FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVAER=FALSE'
+END IF
+
+IF (.NOT. LDUST .AND. LHORELAX_SVDST) THEN
+ LHORELAX_SVDST=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX DUST FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVDST=FALSE'
+END IF
+
+IF (.NOT. LSALT .AND. LHORELAX_SVSLT) THEN
+ LHORELAX_SVSLT=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SEA SALT FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSLT=FALSE'
+END IF
+
+IF (.NOT. LPASPOL .AND. LHORELAX_SVPP) THEN
+ LHORELAX_SVPP=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX PASSIVE POLLUTANT FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVPP=FALSE'
+END IF
+#ifdef MNH_FOREFIRE
+IF (.NOT. LFOREFIRE .AND. LHORELAX_SVFF) THEN
+ LHORELAX_SVFF=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX FOREFIRE FLUXES BUT THEY DO NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFF=FALSE'
+END IF
+#endif
+IF (.NOT. LBLAZE .AND. LHORELAX_SVFIRE) THEN
+ LHORELAX_SVFIRE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLAZE FLUXES BUT THEY DO NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFIRE=FALSE'
+END IF
+IF (.NOT. LCONDSAMP .AND. LHORELAX_SVCS) THEN
+ LHORELAX_SVCS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CONDITIONAL SAMPLING FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCS=FALSE'
+END IF
+
+IF (.NOT. LBLOWSNOW .AND. LHORELAX_SVSNW) THEN
+ LHORELAX_SVSNW=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLOWING SNOW FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSNW=FALSE'
+END IF
+
+IF (ANY(LHORELAX_SV(NSV+1:))) THEN
+ LHORELAX_SV(NSV+1:)=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SV(NSV+1:) FIELD BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(NSV+1:)=FALSE'
+END IF
+!
+!* 4.5 check the number of points for the horizontal relaxation
+!
+IF ( NRIMX > KRIMX .AND. .NOT.LHORELAX_SVELEC ) THEN
+ NRIMX = KRIMX
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS '
+ WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE '
+ WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:'
+ WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMX =',NRIMX
+END IF
+!
+IF ( L2D .AND. KRIMY>0 ) THEN
+ NRIMY = 0
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A 2D MODEL THEREFORE NRIMY=0 '
+END IF
+!
+IF ( NRIMY > KRIMY .AND. .NOT.LHORELAX_SVELEC ) THEN
+ NRIMY = KRIMY
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS '
+ WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE '
+ WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:'
+ WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMY =',NRIMY
+END IF
+!
+IF ( (.NOT. LHORELAX_UVWTH) .AND. (.NOT.(ANY(LHORELAX_SV))) .AND. &
+ (.NOT. LHORELAX_SVC2R2).AND. (.NOT. LHORELAX_SVC1R3) .AND. &
+ (.NOT. LHORELAX_SVLIMA).AND. &
+ (.NOT. LHORELAX_SVELEC).AND. (.NOT. LHORELAX_SVCHEM) .AND. &
+ (.NOT. LHORELAX_SVLG) .AND. (.NOT. LHORELAX_SVPP) .AND. &
+ (.NOT. LHORELAX_SVCS) .AND. (.NOT. LHORELAX_SVFIRE) .AND. &
+#ifdef MNH_FOREFIRE
+ (.NOT. LHORELAX_SVFF) .AND. &
+#endif
+ (.NOT. LHORELAX_RV) .AND. (.NOT. LHORELAX_RC) .AND. &
+ (.NOT. LHORELAX_RR) .AND. (.NOT. LHORELAX_RI) .AND. &
+ (.NOT. LHORELAX_RS) .AND. (.NOT. LHORELAX_RG) .AND. &
+ (.NOT. LHORELAX_RH) .AND. (.NOT. LHORELAX_TKE) .AND. &
+ (.NOT. LHORELAX_SVCHIC).AND. &
+ (NRIMX /= 0 .OR. NRIMY /= 0)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE NRIMX=NRIMY=0 '
+ NRIMX=0
+ NRIMY=0
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (NRIMX==0 .OR. (NRIMY==0 .AND. .NOT.(L2D) ))) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'BUT NRIMX OR NRIMY=0 CHANGE YOUR VALUES '
+ WRITE(ILUOUT,FMT=*) "LHORELAX_UVWTH=",LHORELAX_UVWTH
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVC2R2=",LHORELAX_SVC2R2
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVC1R3=",LHORELAX_SVC1R3
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVLIMA=",LHORELAX_SVLIMA
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVELEC=",LHORELAX_SVELEC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHEM=",LHORELAX_SVCHEM
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHIC=",LHORELAX_SVCHIC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVLG=",LHORELAX_SVLG
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVPP=",LHORELAX_SVPP
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVFIRE=",LHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVFF=",LHORELAX_SVFF
+#endif
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SVCS=",LHORELAX_SVCS
+ WRITE(ILUOUT,FMT=*) "LHORELAX_SV=",LHORELAX_SV
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RV=",LHORELAX_RV
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RC=",LHORELAX_RC
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RR=",LHORELAX_RR
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RI=",LHORELAX_RI
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RG=",LHORELAX_RG
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RS=",LHORELAX_RS
+ WRITE(ILUOUT,FMT=*) "LHORELAX_RH=",LHORELAX_RH
+ WRITE(ILUOUT,FMT=*) "LHORELAX_TKE=", LHORELAX_TKE
+ WRITE(ILUOUT,FMT=*) "NRIMX=",NRIMX
+ WRITE(ILUOUT,FMT=*) "NRIMY=",NRIMY
+ WRITE(ILUOUT,FMT=*) "L2D=",L2D
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (KMI /=1)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'FOR A NESTED MODEL BUT THE COUPLING IS ALREADY DONE'
+ WRITE(ILUOUT,FMT=*) 'BY THE GRID NESTING. CHANGE LHORELAX TO FALSE'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (CLBCX(1)=='CYCL'.OR.CLBCX(2)=='CYCL' &
+ .OR.CLBCY(1)=='CYCL'.OR.CLBCY(2)=='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'FOR CYCLIC CLBCX OR CLBCY VALUES'
+ WRITE(ILUOUT,FMT=*) 'CHANGE LHORELAX TO FALSE'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERV) .AND. LUSERV .AND. LHORELAX_RV
+ELSE
+ GRELAX = .NOT.(LUSERV_G(NDAD(KMI))) .AND. LUSERV_G(KMI).AND. LHORELAX_RV
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RV=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RV FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERC) .AND. LUSERC .AND. LHORELAX_RC
+ELSE
+ GRELAX = .NOT.(LUSERC_G(NDAD(KMI))) .AND. LUSERC_G(KMI).AND. LHORELAX_RC
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RC=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RC FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERR) .AND. LUSERR .AND. LHORELAX_RR
+ELSE
+ GRELAX = .NOT.(LUSERR_G(NDAD(KMI))) .AND. LUSERR_G(KMI).AND. LHORELAX_RR
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RR=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RR FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERI) .AND. LUSERI .AND. LHORELAX_RI
+ELSE
+ GRELAX = .NOT.(LUSERI_G(NDAD(KMI))) .AND. LUSERI_G(KMI).AND. LHORELAX_RI
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RI=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RI FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERG) .AND. LUSERG .AND. LHORELAX_RG
+ELSE
+ GRELAX = .NOT.(LUSERG_G(NDAD(KMI))) .AND. LUSERG_G(KMI).AND. LHORELAX_RG
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RG=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RG FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERH) .AND. LUSERH .AND. LHORELAX_RH
+ELSE
+ GRELAX = .NOT.(LUSERH_G(NDAD(KMI))) .AND. LUSERH_G(KMI).AND. LHORELAX_RH
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RH=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RH FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = .NOT.(OUSERS) .AND. LUSERS .AND. LHORELAX_RS
+ELSE
+ GRELAX = .NOT.(LUSERS_G(NDAD(KMI))) .AND. LUSERS_G(KMI).AND. LHORELAX_RS
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_RS=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RS FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE'
+END IF
+!
+IF (KMI==1) THEN
+ GRELAX = HTURB=='NONE' .AND. LUSETKE(1).AND. LHORELAX_TKE
+ELSE
+ GRELAX = .NOT.(LUSETKE(NDAD(KMI))) .AND. LUSETKE(KMI) .AND. LHORELAX_TKE
+END IF
+!
+IF ( GRELAX ) THEN
+ LHORELAX_TKE=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE TKE FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE'
+END IF
+!
+!
+DO JSV = 1,NSV_USER
+!
+ IF (KMI==1) THEN
+ GRELAX = KSV_USER<JSV .AND. LUSESV(JSV,1).AND. LHORELAX_SV(JSV)
+ ELSE
+ GRELAX = .NOT.(LUSESV(JSV,NDAD(KMI))) .AND. LUSESV(JSV,KMI) .AND. LHORELAX_SV(JSV)
+ END IF
+ !
+ IF ( GRELAX ) THEN
+ LHORELAX_SV(JSV)=.FALSE.
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE ',JSV,' SV FIELD'
+ WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
+ WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(',JSV,')=FALSE'
+ END IF
+END DO
+!
+!* 4.6 consistency in LES diagnostics choices
+!
+IF (CLES_NORM_TYPE=='EKMA' .AND. .NOT. LCORIO) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE EKMAN NORMALIZATION'
+ WRITE(ILUOUT,FMT=*) 'BUT CORIOLIS FORCE IS NOT USED (LCORIO=.FALSE.)'
+ WRITE(ILUOUT,FMT=*) 'THEN, NO NORMALIZATION IS PERFORMED'
+ CLES_NORM_TYPE='NONE'
+END IF
+!
+!* 4.7 Check the coherence with LNUMDIFF
+!
+IF (L1D .AND. (LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE HORIZONTAL DIFFUSION '
+ WRITE(ILUOUT,FMT=*) 'BUT YOU ARE IN A COLUMN MODEL (L1D=.TRUE.).'
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFU and LNUMDIFTH and LNUMDIFSV'
+ WRITE(ILUOUT,FMT=*) 'ARE SET TO FALSE'
+ LNUMDIFU=.FALSE.
+ LNUMDIFTH=.FALSE.
+ LNUMDIFSV=.FALSE.
+END IF
+!
+IF (.NOT. LNUMDIFTH .AND. LZDIFFU) THEN
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE HORIZONTAL DIFFUSION (LNUMDIFTH=F)'
+ WRITE(ILUOUT,FMT=*) 'BUT YOU WANT TO USE Z-NUMERICAL DIFFUSION '
+ WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFTH IS SET TO TRUE'
+ LNUMDIFTH=.TRUE.
+END IF
+!
+!* 4.8 Other
+!
+IF (XTNUDGING < 4.*XTSTEP) THEN
+ XTNUDGING = 4.*XTSTEP
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("TIME SCALE FOR NUDGING CAN NOT BE SMALLER THAN", &
+ & " FOUR TIMES THE TIME STEP")')
+ WRITE(ILUOUT,FMT=*) 'XTNUDGING is SET TO ',XTNUDGING
+END IF
+!
+!
+IF (XWAY(KMI) == 3. ) THEN
+ XWAY(KMI) = 2.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("XWAY=3 DOES NOT EXIST ANYMORE; ", &
+ & " IT IS REPLACED BY XWAY=2 ")')
+END IF
+!
+IF ( (KMI == 1) .AND. XWAY(KMI) /= 0. ) THEN
+ XWAY(KMI) = 0.
+ WRITE(UNIT=ILUOUT,FMT=9002) KMI
+ WRITE(UNIT=ILUOUT,FMT='("XWAY MUST BE EQUAL TO 0 FOR DAD MODEL")')
+END IF
+!
+!JUANZ ZRESI solver need BSPLITTING
+IF ( CPRESOPT == 'ZRESI' .AND. CSPLIT /= 'BSPLITTING' ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(UNIT=ILUOUT,FMT='("Paralleliez in Z solver CPRESOPT=ZRESI need also CSPLIT=BSPLITTING ")')
+ WRITE(ILUOUT,FMT=*) ' ERROR you have to set also CSPLIT=BSPLITTING '
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
+IF ( LEN_TRIM(HINIFILEPGD)>0 ) THEN
+ IF ( CINIFILEPGD/=HINIFILEPGD ) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(ILUOUT,FMT=*) ' ERROR : in EXSEG1.nam, in NAM_LUNITn you have CINIFILEPGD= ',CINIFILEPGD
+ WRITE(ILUOUT,FMT=*) ' whereas in .des you have CINIFILEPGD= ',HINIFILEPGD
+ WRITE(ILUOUT,FMT=*) ' Please check your Namelist '
+ WRITE(ILUOUT,FMT=*) ' For example, you may have specified the un-nested PGD file instead of the nested PGD file '
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*) '###############'
+ WRITE(ILUOUT,FMT=*) ' MESONH ABORTS'
+ WRITE(ILUOUT,FMT=*) '###############'
+ WRITE(ILUOUT,FMT=*)
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+ELSE
+ CINIFILEPGD = ''
+!* note that after a spawning, there is no value for CINIFILEPGD in the .des file,
+! so the checking cannot be made if the user starts a simulation directly from
+! a spawned file (without the prep_real_case stage)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 5. WE DO NOT FORGET TO UPDATE ALL DOLLARN NAMELIST VARIABLES
+! ---------------------------------------------------------
+!
+CALL UPDATE_NAM_LUNITN
+CALL UPDATE_NAM_CONFN
+CALL UPDATE_NAM_DRAGTREEN
+CALL UPDATE_NAM_DRAGBLDGN
+CALL UPDATE_NAM_COUPLING_LEVELSN
+CALL UPDATE_NAM_DYNN
+CALL UPDATE_NAM_ADVN
+CALL UPDATE_NAM_PARAMN
+CALL UPDATE_NAM_PARAM_RADN
+#ifdef MNH_ECRAD
+CALL UPDATE_NAM_PARAM_ECRADN
+#endif
+CALL UPDATE_NAM_PARAM_KAFRN
+CALL UPDATE_NAM_LBCN
+CALL UPDATE_NAM_NUDGINGN
+CALL UPDATE_NAM_BLANKN
+CALL UPDATE_NAM_CH_MNHCN
+CALL UPDATE_NAM_CH_SOLVERN
+CALL UPDATE_NAM_SERIESN
+CALL UPDATE_NAM_BLOWSNOWN
+CALL UPDATE_NAM_PROFILERn
+CALL UPDATE_NAM_STATIONn
+CALL UPDATE_NAM_FIREn
+!-------------------------------------------------------------------------------
+WRITE(UNIT=ILUOUT,FMT='(/)')
+!-------------------------------------------------------------------------------
+!
+!* 6. FORMATS
+! -------
+!
+9000 FORMAT(/,'NOTE IN READ_EXSEG FOR MODEL ', I2, ' : ',/, &
+ '--------------------------------')
+9001 FORMAT(/,'CAUTION ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '----------------------------------------' )
+9002 FORMAT(/,'WARNING IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '----------------------------------' )
+9003 FORMAT(/,'FATAL ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
+ '--------------------------------------' )
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_EXSEG_n
diff --git a/src/PHYEX/ext/read_field.f90 b/src/PHYEX/ext/read_field.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d86c67557c62c692ede13db25b29122ca62055f1
--- /dev/null
+++ b/src/PHYEX/ext/read_field.f90
@@ -0,0 +1,1700 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_READ_FIELD
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, &
+ HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, &
+ HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR,HGETICEFR, &
+ HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
+ HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
+ KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
+ KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
+ PUM,PVM,PWM,PDUM,PDVM,PDWM, &
+ PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, &
+ PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, &
+ PSIGS,PSRCT,PCLDFR,PICEFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, PLSZWSM, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
+ PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
+ PTENDUFRC,PTENDVFRC, &
+ KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
+ KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
+ PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
+ PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS, &
+ PLSPHI,PBMAP,PFMASE,PFMAWC,PFMWINDU,PFMWINDV,PFMWINDW,PFMHWS )
+!
+USE MODD_IO, ONLY : TFILEDATA
+USE MODD_TIME ! for type DATE_TIME
+!
+!
+INTEGER, INTENT(IN) :: KOCEMI !Ocan model index
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
+INTEGER, INTENT(IN) :: KIU, KJU, KKU
+ ! array sizes in x, y and z directions
+!
+CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
+ HGETRVT,HGETRCT,HGETRRT, &
+ HGETRIT,HGETRST,HGETRGT,HGETRHT, &
+ HGETCIT,HGETSRCT, HGETZWS, &
+ HGETSIGS, HGETCLDFR, HGETICEFR, &
+ HGETBL_DEPTH, HGETSBL_DEPTH, &
+ HGETPHC, HGETPHR
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
+!
+! GET indicators to know wether a given variable should or not be read in the
+! FM file at time t-deltat and t
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
+CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! advection scheme for wind
+!
+! sizes of the West-east total LB area
+INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
+INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
+INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV
+! sizes of the North-south total LB area
+INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
+INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
+INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDUM,PDVM,PDWM ! Difference on U,V,W
+ ! between t+dt and t-dt
+REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHVMF ! MassFlux buoyancy flux
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKEMS ! tke adv source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar
+ ! variables at t
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux
+ ! <s'Rc'> at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t
+REAL, INTENT(OUT) :: PDRYMASST ! Md(t)
+REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the
+ ! Subgrid Condensation
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PICEFR ! cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHC ! pH value in cloud water
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwater
+! Larger Scale fields
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM,PLSVM,PLSWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM ! Mass
+! LB fields
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM ! significant height of sea waves
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+! Forcing fields
+INTEGER, INTENT(IN) :: KFRC ! number of forcing
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs.
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
+REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
+INTEGER, INTENT(IN) :: KADVFRC ! number of forcing
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTADVFRC ! date of forcing profs.
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC, PDRVFRC
+INTEGER, INTENT(IN) :: KRELFRC ! number of forcing
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs.
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M ! Eddy fluxes
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF,PIBM_XMUT
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS
+!
+! Fire Model fields
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI ! Fire Model Level Set function Phi [-]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBMAP ! Fire Model Burning map [s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMASE ! Fire Model Available Sensible Energy [J/m2]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMAWC ! Fire Model Available Water Content [kg/m2]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDU ! Fire Model filtered u wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDV ! Fire Model filtered v wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDW ! Fire Model filtered w wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMHWS ! Fire Model filtered horizontal wind speed [m/s]
+!
+END SUBROUTINE READ_FIELD
+!
+END INTERFACE
+!
+END MODULE MODI_READ_FIELD
+!
+! ########################################################################
+ SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, &
+ HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, &
+ HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR,HGETICEFR, &
+ HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
+ HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
+ KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
+ KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
+ PUM,PVM,PWM,PDUM,PDVM,PDWM, &
+ PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, &
+ PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, &
+ PSIGS,PSRCT,PCLDFR,PICEFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
+ KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
+ PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
+ PTENDUFRC,PTENDVFRC, &
+ KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
+ KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
+ PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
+ PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS, &
+ PLSPHI,PBMAP,PFMASE,PFMAWC,PFMWINDU,PFMWINDV,PFMWINDW,PFMHWS )
+! ########################################################################
+!
+!!**** *READ_FIELD* - routine to read prognostic and surface fields
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize prognostic and
+! surface fields by reading their value in initial file or by setting
+! them to a fixed value.
+!
+!!** METHOD
+!! ------
+!! According to the get indicators, the prognostics fields are :
+!! - initialized by reading their value in the LFIFM file
+!! if the corresponding indicators are equal to 'READ'
+!! - initialized to zero if the corresponding indicators
+!! are equal to 'INIT'
+!! - not initialized if their corresponding indicators
+!! are equal to 'SKIP'
+!!
+!! In case of time step change, all fields at t-dt are (linearly)
+!! interpolated to get a consistant initial state before the segment
+!! integration
+!!
+!! EXTERNAL
+!! --------
+!! FMREAD : to read data in LFIFM file
+!! INI_LS : to initialize larger scale fields
+!! INI_LB : to initialize "2D" surfacic LB fields
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CONF : NVERB,CCONF,CPROGRAM
+!!
+!! Module MODD_CTURB : XTKEMIN
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine READ_FIELD)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/06/94
+!! modification 22/11/94 add the pressure function (J.Stein)
+!! modification 22/11/94 add the LS fields (J.Stein)
+!! modification 06/01/95 add Md(t) (J.P.Lafore)
+!! 26/03/95 add EPS var (J. Cuxart)
+!! 30/06/95 add var related to the Subgrid condensation
+!! (J.Stein)
+!! 18/08/95 time step change case (J.P.Lafore)
+!! 01/03/96 add the cloud fraction (J. Stein)
+!! modification 13/12/95 add fmread of the forcing variables
+!! (M.Georgelin)
+!! modification 13/02/96 external control of the forcing (J.-P. Pinty)
+!! 11/04/96 add the ice concentration (J.-P. Pinty)
+!! 27/01/97 read ISVR 3D fields of SV (J.-P. Pinty)
+!! 26/02/97 "surfacic" LS fieds introduction (J.P.Lafore)
+!! (V MASSON) 03/03/97 positivity control for time step change
+!! 10/04/97 proper treatment of minima for LS-fields (J.P.Lafore)
+!! J. Stein 22/06/97 use the absolute pressure
+!! J. Stein 22/10/97 cleaning + add the LB fields for u,v,w,theta,Rv
+!! P. Bechtold 22/01/98 add SST and surface pressure forcing
+!! V. Ducrocq 14/08/98 //, remove KIINF,KJINF,KISUP,KJSUP,
+!! and introduce INI_LS and INI_LB
+!! J. Stein 22/01/99 add the reading of STORAGE_TYPE to improve
+!! the START case when the file contains 2
+!! instants MT
+!! D. Gazen 22/01/01 use MODD_NSV to handle NSV floating indices
+!! for the current model
+!! V. Masson 01/2004 removes surface (externalization)
+!! J.-P. Pinty 06/05/04 treat NSV_* for C1R3 and ELEC
+!! 05/06 Remove EPS
+!! M. Leriche 04/10 add pH in cloud water and rainwater
+!! M. Leriche 07/10 treat NSV_* for ice phase chemical species
+!! C.Lac 11/11 Suppress all the t-Dt fields
+!! M.Tomasini,
+!! P. Peyrille 06/12 2D west african monsoon : add reading of ADV forcing and addy fluxes
+!! C.Lac 03/13 add prognostic supersaturation for C2R2/KHKO
+!! Bosseur & Filippi 07/13 Adds Forefire
+!! M. Leriche 11/14 correct bug in pH initialization
+!! C.Lac 12/14 correction for reproducibility START/RESTA
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! M. Leriche 02/16 treat gas and aq. chemicals separately
+!! C.Lac 10/16 CEN4TH with RKC4 + Correction on RK loop
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! V. Vionnet 07/17: add blowing snow scheme
+! P. Wautelet 01/2019: corrected intent of PDUM,PDVM,PDWM (OUT->INOUT)
+! P. Wautelet 13/02/2019: removed PPABSM and PTSTEP dummy arguments (bugfix: PPABSM was intent(OUT))
+! S. Bielli 02/2019: Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
+! M. Leriche 10/06/2019: in restart case read all immersion modes for LIMA
+! B. Vie 06/2020: Add prognostic supersaturation for LIMA
+! F. Auguste 02/2021: add fields necessary for IBM
+! T. Nagel 02/2021: add fields necessary for turbulence recycling
+! JL. Redelsperger 03/2021: add necessary variables for Ocean LES case
+! A. Costes 12/2021: add Blaze fire model
+! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_2D_FRC, ONLY: L2D_ADV_FRC, L2D_REL_FRC
+USE MODD_ADV_n, ONLY: CTEMP_SCHEME, LSPLIT_CFL
+USE MODD_BLOWSNOW_n, ONLY: XSNWCANO
+USE MODD_CONF, ONLY: CCONF, CPROGRAM, L1D, LFORCING, NVERB
+USE MODD_CONF_n, ONLY: IDX_RVT, IDX_RCT, IDX_RRT, IDX_RIT, IDX_RST, IDX_RGT, IDX_RHT
+USE MODD_CST, ONLY: XALPW, XBETAW, XCPD, XGAMW, XMD, XMV, XP00, XRD
+USE MODD_TURB_n, ONLY: XTKEMIN
+USE MODD_DYN_n, ONLY: LOCEAN
+use modd_field, only: tfieldmetadata, tfieldlist, NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, &
+ TYPEDATE, TYPEREAL, TYPELOG, TYPEINT
+USE MODD_FIELD_n, only: XZWS_DEFAULT
+USE MODD_FIRE_n, ONLY: CWINDFILTER, LBLAZE, LRESTA_ASE, LRESTA_AWC, LRESTA_EWAM, LRESTA_WLIM, LWINDFILTER
+USE MODD_IBM_PARAM_n, ONLY: LIBM
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LATZ_EDFLX, ONLY: LTH_FLX, LUV_FLX
+USE MODD_LUNIT_N, ONLY: TLUOUT
+USE MODD_NSV, ONLY: NSV, NSV_C2R2BEG, NSV_C2R2END, NSV_CSBEG, NSV_CSEND, &
+#ifdef MNH_FOREFIRE
+ NSV_FFBEG, NSV_FFEND, &
+#endif
+ NSV_PPBEG, NSV_PPEND, NSV_SNW, NSV_USER, TSVLIST
+USE MODD_OCEANH, ONLY: NFRCLT, NINFRT, XSSOLA_T, XSSUFL_T, XSSTFL_T, XSSVFL_T
+USE MODD_PARAM_C2R2, ONLY: LSUPSAT
+USE MODD_PARAMETERS, ONLY: XUNDEF
+USE MODD_PARAM_n, ONLY: CSCONV
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCLE, LRECYCLN, LRECYCLS, LRECYCLW, NR_COUNT
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_TIME, ONLY: DATE_TIME
+!
+use mode_field, only: Find_field_id_from_mnhname
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_MSG
+USE MODE_TOOLS, ONLY: UPCASE
+!
+USE MODI_INI_LB
+USE MODI_INI_LS
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KOCEMI !Ocan model index
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
+INTEGER, INTENT(IN) :: KIU, KJU, KKU
+ ! array sizes in x, y and z directions
+!
+CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
+ HGETRVT,HGETRCT,HGETRRT, &
+ HGETRIT,HGETRST,HGETRGT,HGETRHT, &
+ HGETCIT,HGETSRCT, HGETZWS, &
+ HGETSIGS, HGETCLDFR, HGETICEFR, &
+ HGETBL_DEPTH, HGETSBL_DEPTH, &
+ HGETPHC, HGETPHR
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
+!
+! GET indicators to know wether a given variable should or not be read in the
+! FM file at time t-deltat and t
+!
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
+CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! advection scheme for wind
+!
+! sizes of the West-east total LB area
+INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
+INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
+INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV
+! sizes of the North-south total LB area
+INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
+INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
+INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM,PDVM,PDWM ! Difference on U,V,W
+ ! between t+dt and t-dt
+REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHVMF ! MassFlux buoyancy flux
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKEMS ! tke adv source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar
+ ! variables at t
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux
+ ! <s'Rc'> at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t
+REAL, INTENT(OUT) :: PDRYMASST ! Md(t)
+REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the
+ ! Subgrid Condensation
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PICEFR ! cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHC ! pH value in cloud water
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwater
+!
+!
+! Larger Scale fields
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM ! significant height of sea waves
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM,PLSVM,PLSWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir.
+!
+!
+! Forcing fields
+INTEGER, INTENT(IN) :: KFRC ! number of forcing
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs.
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
+REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
+INTEGER, INTENT(IN) :: KADVFRC ! number of forcing
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTADVFRC ! date of forcing profs.
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC, PDRVFRC
+INTEGER, INTENT(IN) :: KRELFRC ! number of forcing
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs.
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M ! Eddy fluxes
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF ! LSF for IBM
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_XMUT ! Turbulent viscosity
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW ! Velocity average at West boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN ! Velocity average at North boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE ! Velocity average at East boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS ! Velocity average at South boundary
+! Fire Model fields
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI ! Fire Model Level Set function Phi [-]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBMAP ! Fire Model Burning map [s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMASE ! Fire Model Available Sensible Energy [J/m2]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMAWC ! Fire Model Available Water Content [kg/m2]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDU ! Fire Model filtered u wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDV ! Fire Model filtered v wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDW ! Fire Model filtered v wind [m/s]
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMHWS ! Fire Model filtered horizontal wind speed [m/s]
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IID
+INTEGER :: ILUOUT ! Unit number for prints
+INTEGER :: IRESP
+INTEGER :: ISV ! total number of scalar variables
+INTEGER :: JSV ! Loop index for additional scalar variables
+INTEGER :: JKLOOP,JRR ! Loop indexes
+INTEGER :: IIUP,IJUP ! size of working window arrays
+INTEGER :: JT ! loop index
+LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb)
+LOGICAL :: ZLRECYCL ! switch if turbulence recycling is activated
+LOGICAL :: GOLDFILEFORMAT
+CHARACTER(LEN=3) :: YFRC ! To mark the different forcing dates
+CHARACTER(LEN=3) :: YNUM3
+CHARACTER(LEN=15) :: YVAL
+REAL, DIMENSION(KIU,KJU,KKU) :: ZWORK ! to compute supersaturation
+TYPE(TFIELDMETADATA) :: TZFIELD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATION
+! ---------------
+!
+GLSOURCE=.FALSE.
+ZWORK = 0.0
+!
+!If TPINIFILE file was written with a MesoNH version < 5.6, some variables had different names or were not available
+GOLDFILEFORMAT = ( TPINIFILE%NMNHVERSION(1) < 5 &
+ .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 6 ) )
+!-------------------------------------------------------------------------------
+!
+!* 2. READ PROGNOSTIC VARIABLES
+! -------------------------
+!
+!* 2.1 Time t:
+!
+IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('UT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'UM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUT)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('VT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'VM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVT)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'WM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWT)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'THM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTHT)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'PABSM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PPABST)
+ELSE
+ CALL IO_Field_read(TPINIFILE,'UT',PUT)
+ CALL IO_Field_read(TPINIFILE,'VT',PVT)
+ CALL IO_Field_read(TPINIFILE,'WT',PWT)
+ CALL IO_Field_read(TPINIFILE,'THT',PTHT)
+ CALL IO_Field_read(TPINIFILE,'PABST',PPABST)
+ENDIF
+!
+SELECT CASE(HGETTKET)
+ CASE('READ')
+ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('TKET',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'TKEM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTKET)
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'TKET',PTKET)
+ END IF
+ IF ( ( (TPINIFILE%NMNHVERSION(1)==5 .AND. TPINIFILE%NMNHVERSION(2)>0) .OR. TPINIFILE%NMNHVERSION(1)>5 ) &
+ .AND. (CCONF == 'RESTA') .AND. LSPLIT_CFL) THEN
+ CALL IO_Field_read(TPINIFILE,'TKEMS',PRTKEMS)
+ END IF
+ CASE('INIT')
+ PTKET(:,:,:) = XTKEMIN
+ PRTKEMS(:,:,:) = 0.
+END SELECT
+!
+SELECT CASE(HGETZWS)
+ CASE('READ')
+ CALL IO_Field_read(TPINIFILE,'ZWS',PZWS,IRESP)
+ !If the field ZWS is not in the file, set its value to XZWS_DEFAULT
+ !ZWS is present in files since MesoNH 5.4.2
+ IF ( IRESP/=0 ) THEN
+ WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
+ CALL PRINT_MSG(NVERB_WARNING,'IO','READ_FIELD','ZWS not found in file: using default value: '//TRIM(YVAL)//' m')
+ PZWS(:,:) = XZWS_DEFAULT
+ END IF
+
+ CASE('INIT')
+ PZWS(:,:)=0.
+END SELECT
+!
+SELECT CASE(HGETRVT) ! vapor
+ CASE('READ')
+ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RVT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'RVM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RVT))
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'RVT',PRT(:,:,:,IDX_RVT))
+ END IF
+ CASE('INIT')
+ PRT(:,:,:,IDX_RVT) = 0.
+END SELECT
+!
+SELECT CASE(HGETRCT) ! cloud
+ CASE('READ')
+ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RCT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'RCM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RCT))
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'RCT',PRT(:,:,:,IDX_RCT))
+ END IF
+ CASE('INIT')
+ PRT(:,:,:,IDX_RCT) = 0.
+END SELECT
+!
+SELECT CASE(HGETRRT) ! rain
+ CASE('READ')
+ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RRT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'RRM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RRT))
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'RRT',PRT(:,:,:,IDX_RRT))
+ END IF
+ CASE('INIT')
+ PRT(:,:,:,IDX_RRT) = 0.
+END SELECT
+!
+SELECT CASE(HGETRIT) ! cloud ice
+ CASE('READ')
+ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RIT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'RIM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RIT))
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'RIT',PRT(:,:,:,IDX_RIT))
+ END IF
+ CASE('INIT')
+ PRT(:,:,:,IDX_RIT) = 0.
+END SELECT
+!
+SELECT CASE(HGETRST) ! snow
+ CASE('READ')
+ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RST',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'RSM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RST))
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'RST',PRT(:,:,:,IDX_RST))
+ END IF
+ CASE('INIT')
+ PRT(:,:,:,IDX_RST) = 0.
+END SELECT
+!
+SELECT CASE(HGETRGT) ! graupel
+ CASE('READ')
+ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RGT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'RGM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RGT))
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'RGT',PRT(:,:,:,IDX_RGT))
+ END IF
+ CASE('INIT')
+ PRT(:,:,:,IDX_RGT) = 0.
+END SELECT
+!
+SELECT CASE(HGETRHT) ! hail
+ CASE('READ')
+ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RHT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'RHM'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RHT))
+ ELSE
+ CALL IO_Field_read(TPINIFILE,'RHT',PRT(:,:,:,IDX_RHT))
+ END IF
+ CASE('INIT')
+ PRT(:,:,:,IDX_RHT) = 0.
+END SELECT
+!
+SELECT CASE(HGETCIT) ! ice concentration
+ CASE('READ')
+ IF (SIZE(PCIT) /= 0 ) CALL IO_Field_read(TPINIFILE,'CIT',PCIT)
+ CASE('INIT')
+ PCIT(:,:,:)=0.
+END SELECT
+!
+IF (LIBM .AND. CPROGRAM=='MESONH') THEN
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'LSFP', &
+ CLONGNAME = 'LSFP', &
+ CSTDNAME = '', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_LSF)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'XMUT', &
+ CLONGNAME = 'XMUT', &
+ CSTDNAME = '', &
+ CUNITS = 'm2 s-1', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_XMUT)
+ !
+ENDIF
+!
+TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'RECYCLING', &
+ CLONGNAME = 'RECYCLING', &
+ CSTDNAME = '', &
+ CUNITS = '', &
+ CDIR = '--', &
+ CCOMMENT = '', &
+ NGRID = 1, &
+ NTYPE = TYPELOG, &
+ NDIMS = 0, &
+ LTIMEDEP = .FALSE. )
+CALL IO_Field_read(TPINIFILE,TZFIELD,ZLRECYCL,IRESP)
+!If field not found (file from older version of MesoNH) => set ZLRECYCL to false
+IF ( IRESP /= 0 ) ZLRECYCL = .FALSE.
+
+IF (ZLRECYCL) THEN
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'RCOUNT', &
+ CLONGNAME = 'RCOUNT', &
+ CSTDNAME = '', &
+ CUNITS = '', &
+ CDIR = '--', &
+ NGRID = 1, &
+ NTYPE = TYPEINT, &
+ NDIMS = 0, &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'Incremental counter for averaging purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,NR_COUNT)
+ !
+ IF (NR_COUNT .NE. 0) THEN
+ IF (LRECYCLW) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'URECYCLW', &
+ CLONGNAME = 'URECYCLW', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'UMEAN-WEST side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANW)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VRECYCLW', &
+ CLONGNAME = 'VRECYCLW', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'VMEAN-WEST side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANW)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'WRECYCLW', &
+ CLONGNAME = 'WRECYCLW', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'WMEAN-WEST side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANW)
+ !
+ ENDIF
+ IF (LRECYCLN) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'URECYCLN', &
+ CLONGNAME = 'URECYCLN', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'UMEAN-NORTH side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANN)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VRECYCLN', &
+ CLONGNAME = 'VRECYCLN', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'VMEAN-NORTH side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANN)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'WRECYCLN', &
+ CLONGNAME = 'WRECYCLN', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'WMEAN-NORTH side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANN)
+ !
+ ENDIF
+ IF (LRECYCLE) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'URECYCLE', &
+ CLONGNAME = 'URECYCLE', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'UMEAN-EAST side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANE)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VRECYCLE', &
+ CLONGNAME = 'VRECYCLE', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'VMEAN-EAST side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANE)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'WRECYCLE', &
+ CLONGNAME = 'WRECYCLE', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'WMEAN-EAST side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANE)
+ !
+ ENDIF
+ IF (LRECYCLS) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'URECYCLS', &
+ CLONGNAME = 'URECYCLS', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'UMEAN-SOUTH side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANS)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VRECYCLS', &
+ CLONGNAME = 'VRECYCLS', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'VMEAN-SOUTH side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANS)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'WRECYCLS', &
+ CLONGNAME = 'WRECYCLS', &
+ CSTDNAME = '', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE., &
+ CCOMMENT = 'WMEAN-SOUTH side plan for recycling purpose' )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANS)
+ ENDIF
+ ENDIF
+ENDIF
+
+! Blaze fire model
+IF (LBLAZE .AND. CCONF=='RESTA') THEN
+ ! Blaze is not compliant with MNHVERSION(1)<5
+ ! Blaze begins with MNH 5.3.1
+ CALL IO_Field_read(TPINIFILE,'FMPHI',PLSPHI,IRESP)
+ IF (IRESP /= 0) PLSPHI(:,:,:) = 0.
+ CALL IO_Field_read(TPINIFILE,'FMBMAP',PBMAP,IRESP)
+ IF (IRESP /= 0) PBMAP(:,:,:) = -1.
+ CALL IO_Field_read(TPINIFILE,'FMASE',PFMASE,IRESP)
+ IF(IRESP == 0) THEN
+ ! flag for the use of restart value for ASE initialization
+ LRESTA_ASE = .TRUE.
+ ELSE
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMASE set to 0' )
+ PFMASE(:,:,:) = 0.
+ END IF
+ CALL IO_Field_read(TPINIFILE,'FMAWC',PFMAWC,IRESP)
+ ! flag for the use of restart value for AWC initialization
+ IF(IRESP == 0) THEN
+ LRESTA_AWC = .TRUE.
+ ELSE
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMAWC set to 0' )
+ PFMAWC(:,:,:) = 0.
+ END IF
+ ! read wind on fire grid if present
+ IF (LWINDFILTER) THEN
+ ! read in file only if wind filtering is required
+ SELECT CASE(CWINDFILTER)
+ CASE('EWAM')
+ ! read u
+ CALL IO_Field_read(TPINIFILE,'FMWINDU',PFMWINDU,IRESP)
+ ! flag for EWAM filtered u wind
+ IF(IRESP == 0) THEN
+ LRESTA_EWAM = .TRUE.
+ ELSE
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMWINDU set to 0' )
+ PFMWINDU(:,:,:) = 0.
+ END IF
+ ! read v
+ CALL IO_Field_read(TPINIFILE,'FMWINDV',PFMWINDV,IRESP)
+ ! flag for EWAM filtered v wind
+ IF(IRESP == 0 .AND. LRESTA_EWAM) THEN
+ ! u and v fields found
+ LRESTA_EWAM = .TRUE.
+ ELSE
+ ! u or v fields NOT found
+ LRESTA_EWAM = .FALSE.
+ END IF
+ IF (IRESP /= 0) THEN
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMWINDV set to 0' )
+ PFMWINDV(:,:,:) = 0.
+ END IF
+ ! read w
+ CALL IO_Field_read(TPINIFILE,'FMWINDW',PFMWINDW,IRESP)
+ ! flag for EWAM filtered w wind
+ IF(IRESP == 0 .AND. LRESTA_EWAM) THEN
+ ! u and v and w fields found
+ LRESTA_EWAM = .TRUE.
+ ELSE
+ ! u or v or w fields NOT found
+ LRESTA_EWAM = .FALSE.
+ END IF
+ IF (IRESP /= 0) THEN
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMWINDW set to 0' )
+ PFMWINDW(:,:,:) = 0.
+ END IF
+
+ CASE('WLIM')
+ CALL IO_Field_read(TPINIFILE,'FMHWS',PFMHWS,IRESP)
+ ! flag for WLIM filtered horizontal wind speed
+ IF(IRESP == 0) THEN
+ LRESTA_WLIM = .TRUE.
+ ELSE
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMHWS set to 0' )
+ PFMHWS(:,:,:) = 0.
+ END IF
+ END SELECT
+ END IF
+END IF
+!
+! Scalar Variables Reading : Users, C2R2, C1R3, LIMA, ELEC, Chemical SV
+!
+ISV= SIZE(PSVT,4)
+!
+DO JSV = 1, NSV ! initialize according to the get indicators
+ SELECT CASE( HGETSVT(JSV) )
+ CASE ('READ')
+ TZFIELD = TSVLIST(JSV)
+
+ IF ( GOLDFILEFORMAT ) THEN
+ IF ( ( JSV >= 1 .AND. JSV <= NSV_USER ) .OR. &
+ ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) .OR. &
+#ifdef MNH_FOREFIRE
+ ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) .OR. &
+#endif
+ ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) ) THEN
+ !Some variables were written with an other name in MesoNH < 5.6
+ WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ ELSE
+ !Scalar variables were written with a T suffix in older versions
+ TZFIELD%CMNHNAME = TRIM( TZFIELD%CMNHNAME ) // 'T'
+ TZFIELD%CLONGNAME = TRIM( TZFIELD%CLONGNAME ) // 'T'
+ END IF
+ END IF
+
+ CALL IO_Field_read( TPINIFILE, TZFIELD, PSVT(:,:,:,JSV), IRESP )
+
+ IF ( IRESP /= 0 ) THEN
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PSVT set to 0 for ' // TRIM( TZFIELD%CMNHNAME ) )
+ PSVT(:,:,:,JSV) = 0.
+ END IF
+
+ CASE ('INIT')
+ PSVT(:,:,:,JSV) = 0.
+
+ IF ( JSV == NSV_C2R2END ) THEN
+ IF ( LSUPSAT .AND. (HGETRVT == 'READ') ) THEN
+ ZWORK(:,:,:) = (PPABST(:,:,:)/XP00 )**(XRD/XCPD)
+ ZWORK(:,:,:) = PTHT(:,:,:)*ZWORK(:,:,:)
+ ZWORK(:,:,:) = EXP(XALPW-XBETAW/ZWORK(:,:,:)-XGAMW*LOG(ZWORK(:,:,:)))
+ !rvsat
+ ZWORK(:,:,:) = (XMV / XMD)*ZWORK(:,:,:)/(PPABST(:,:,:)-ZWORK(:,:,:))
+ ZWORK(:,:,:) = PRT(:,:,:,IDX_RVT)/ZWORK(:,:,:)
+ PSVT(:,:,:,NSV_C2R2END ) = ZWORK(:,:,:)
+ END IF
+ END IF
+
+ END SELECT
+END DO
+
+DO JSV = NSV_PPBEG, NSV_PPEND
+ SELECT CASE( HGETSVT(JSV) )
+ CASE ('READ')
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ATC' // YNUM3, &
+ CSTDNAME = '', &
+ CLONGNAME = 'ATC' // YNUM3, &
+ CCOMMENT = 'X_Y_Z_ATC' // YNUM3, &
+ CUNITS = 'm-3', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ CALL IO_Field_read( TPINIFILE, TZFIELD, PATC(:,:,:,JSV-NSV_PPBEG+1), IRESP )
+
+ IF ( IRESP /= 0 ) THEN
+ PATC(:,:,:,JSV-NSV_PPBEG+1) = 0.
+ ENDIF
+
+ CASE ('INIT')
+ PATC(:,:,:,JSV-NSV_PPBEG+1) = 0.
+
+ END SELECT
+END DO
+
+IF ( NSV_SNW >= 1 ) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for SNOWCANO_M', &
+ CUNITS = 'kg kg-1', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ DO JSV = 1, NSV_SNW
+ SELECT CASE(HGETSVT(JSV))
+ CASE ('READ')
+ WRITE(TZFIELD%CMNHNAME,'(A10,I3.3)')'SNOWCANO_M',JSV
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A6,A8,I3.3)') 'X_Y_Z_','SNOWCANO',JSV
+ CALL IO_Field_read( TPINIFILE, TZFIELD, XSNWCANO(:,:,JSV) )
+ CASE ('INIT')
+ XSNWCANO(:,:,JSV) = 0.
+ END SELECT
+ END DO
+END IF
+!
+IF (CCONF == 'RESTA') THEN
+ IF (CTEMP_SCHEME/='LEFR') THEN
+ CALL IO_Field_read(TPINIFILE,'US_PRES',PRUS_PRES)
+ CALL IO_Field_read(TPINIFILE,'VS_PRES',PRVS_PRES)
+ CALL IO_Field_read(TPINIFILE,'WS_PRES',PRWS_PRES)
+ END IF
+ IF (LSPLIT_CFL) THEN
+ CALL IO_Field_read(TPINIFILE,'THS_CLD',PRTHS_CLD)
+ DO JRR = 1, SIZE(PRT,4)
+ SELECT CASE(JRR)
+ CASE (1)
+ CALL IO_Field_read(TPINIFILE,'RVS_CLD',PRRS_CLD(:,:,:,JRR))
+ CASE (2)
+ CALL IO_Field_read(TPINIFILE,'RCS_CLD',PRRS_CLD(:,:,:,JRR))
+ CASE (3)
+ CALL IO_Field_read(TPINIFILE,'RRS_CLD',PRRS_CLD(:,:,:,JRR))
+ CASE (4)
+ CALL IO_Field_read(TPINIFILE,'RIS_CLD',PRRS_CLD(:,:,:,JRR))
+ CASE (5)
+ CALL IO_Field_read(TPINIFILE,'RSS_CLD',PRRS_CLD(:,:,:,JRR))
+ CASE (6)
+ CALL IO_Field_read(TPINIFILE,'RGS_CLD',PRRS_CLD(:,:,:,JRR))
+ CASE (7)
+ CALL IO_Field_read(TPINIFILE,'RHS_CLD',PRRS_CLD(:,:,:,JRR))
+ CASE DEFAULT
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_FIELD','PRT is too big')
+ END SELECT
+ END DO
+ DO JSV = NSV_C2R2BEG,NSV_C2R2END
+ IF (JSV == NSV_C2R2BEG ) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'RSVS_CLD1', &
+ CSTDNAME = '', &
+ CLONGNAME = 'RSVS_CLD1', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_RHS_CLD', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV))
+ END IF
+ IF (JSV == NSV_C2R2BEG ) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'RSVS_CLD2', &
+ CSTDNAME = '', &
+ CLONGNAME = 'RSVS_CLD2', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_RHS_CLD', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV))
+ END IF
+ END DO
+ END IF
+END IF
+!
+!* 2.1 Time t-dt:
+!
+IF (CPROGRAM=='MESONH' .AND. HUVW_ADV_SCHEME(1:3)=='CEN' .AND. &
+ HTEMP_SCHEME == 'LEFR' ) THEN
+ IF (CCONF=='RESTA') THEN
+ CALL IO_Field_read(TPINIFILE,'UM', PUM)
+ CALL IO_Field_read(TPINIFILE,'VM', PVM)
+ CALL IO_Field_read(TPINIFILE,'WM', PWM)
+ CALL IO_Field_read(TPINIFILE,'DUM',PDUM)
+ CALL IO_Field_read(TPINIFILE,'DVM',PDVM)
+ CALL IO_Field_read(TPINIFILE,'DWM',PDWM)
+ ELSE
+ PUM = PUT
+ PVM = PVT
+ PWM = PWT
+ END IF
+END IF
+!
+!* 2.2a 3D LS fields
+!
+!
+CALL INI_LS(TPINIFILE,HGETRVT,GLSOURCE,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM)
+!
+!
+!* 2.2b 2D "surfacic" LB fields
+!
+!
+CALL INI_LB(TPINIFILE,GLSOURCE,ISV, &
+ KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
+ KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
+ KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
+ HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETRST, &
+ HGETRGT,HGETRHT,HGETSVT, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM )
+!
+!
+!* 2.3 Some special variables:
+!
+CALL IO_Field_read(TPINIFILE,'DRYMASST',PDRYMASST) ! dry mass
+IF (CCONF=='RESTA') THEN
+ CALL IO_Field_read(TPINIFILE,'DRYMASSS',PDRYMASSS,IRESP) ! dry mass tendency
+
+ ! DRYMASSS was not written in backup files before MesoNH 5.5.1
+ IF ( IRESP /= 0 ) THEN
+ CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PDRYMASSS set to 0 for ' // TRIM( TZFIELD%CMNHNAME ) )
+ PDRYMASSS = 0.
+ END IF
+ELSE
+ PDRYMASSS=XUNDEF ! should not be used
+END IF
+!
+SELECT CASE(HGETSRCT) ! turbulent flux SRC at time t
+ CASE('READ')
+ CALL IO_Field_read(TPINIFILE,'SRCT',PSRCT)
+ CASE('INIT')
+ PSRCT(:,:,:)=0.
+END SELECT
+!
+SELECT CASE(HGETSIGS) ! subgrid condensation
+ CASE('READ')
+ CALL IO_Field_read(TPINIFILE,'SIGS',PSIGS)
+ CASE('INIT')
+ PSIGS(:,:,:)=0.
+END SELECT
+!
+SELECT CASE(HGETPHC) ! pH in cloud water
+ CASE('READ')
+ CALL IO_Field_read(TPINIFILE,'PHC',PPHC)
+ CASE('INIT')
+ PPHC(:,:,:)=0.
+END SELECT
+!
+SELECT CASE(HGETPHR) ! pH in rainwater
+ CASE('READ')
+ CALL IO_Field_read(TPINIFILE,'PHR',PPHR)
+ CASE('INIT')
+ PPHR(:,:,:)=0.
+END SELECT
+!
+IRESP=0
+IF(HGETCLDFR=='READ') THEN ! cloud fraction
+ CALL IO_Field_read(TPINIFILE,'CLDFR',PCLDFR,IRESP)
+ENDIF
+IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN
+ IF(SIZE(PRT,4) > 3) THEN
+ WHERE(PRT(:,:,:,2)+PRT(:,:,:,4) > 1.E-30)
+ PCLDFR(:,:,:) = 1.
+ ELSEWHERE
+ PCLDFR(:,:,:) = 0.
+ ENDWHERE
+ ELSE
+ WHERE(PRT(:,:,:,2) > 1.E-30)
+ PCLDFR(:,:,:) = 1.
+ ELSEWHERE
+ PCLDFR(:,:,:) = 0.
+ ENDWHERE
+ ENDIF
+ENDIF
+!
+IRESP=0
+IF(HGETICEFR=='READ') THEN ! cloud fraction
+ CALL IO_Field_read(TPINIFILE,'ICEFR',PICEFR,IRESP)
+ENDIF
+IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN
+ IF(SIZE(PRT,4) > 3) THEN
+ WHERE(PRT(:,:,:,4) > 1.E-30)
+ PICEFR(:,:,:) = 1.
+ ELSEWHERE
+ PICEFR(:,:,:) = 0.
+ ENDWHERE
+ ELSE
+ PICEFR(:,:,:) = 0.
+ ENDIF
+ENDIF
+!
+!* boundary layer depth
+!
+IF (HGETBL_DEPTH=='READ') THEN
+ CALL IO_Field_read(TPINIFILE,'BL_DEPTH',PBL_DEPTH)
+ELSE
+ PBL_DEPTH(:,:)=XUNDEF
+END IF
+!
+!* surface boundary layer depth
+!
+IF (HGETSBL_DEPTH=='READ') THEN
+ CALL IO_Field_read(TPINIFILE,'SBL_DEPTH',PSBL_DEPTH)
+ELSE
+ PSBL_DEPTH(:,:)=0.
+END IF
+!
+!* Contribution from MAss Flux parameterizations to vert. flux of buoyancy
+!
+SELECT CASE(HGETTKET)
+ CASE('READ')
+ IF (CSCONV=='EDKF') THEN
+ CALL IO_Field_read(TPINIFILE,'WTHVMF',PWTHVMF)
+ ELSE
+ PWTHVMF(:,:,:)=0
+ ENDIF
+ CASE('INIT')
+ PWTHVMF(:,:,:)=0.
+END SELECT
+!-------------------------------------------------------------------------------
+!
+!* 2.4 READ FORCING VARIABLES
+! ----------------------
+!
+! READ FIELD ONLY FOR MODEL1 (identical for all model in GN)
+IF (LOCEAN .AND. (.NOT.LCOUPLES) .AND. (KOCEMI==1)) THEN
+!
+ CALL IO_Field_read(TPINIFILE,'NFRCLT',NFRCLT)
+ CALL IO_Field_read(TPINIFILE,'NINFRT',NINFRT)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SSUFL_T', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SSUFL', &
+ CUNITS = 'kg m-1 s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'sfc stress along U to force ocean LES', &
+ NGRID = 0, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ ALLOCATE(XSSUFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSUFL_T(:))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SSVFL_T', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SSVFL', &
+ CUNITS = 'kg m-1 s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'sfc stress along V to force ocean LES', &
+ NGRID = 0, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ ALLOCATE(XSSVFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSVFL_T(:))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SSTFL_T', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SSTFL', &
+ CUNITS = 'kg m3 K m s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'sfc total heat flux to force ocean LES', &
+ NGRID = 0, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ ALLOCATE(XSSTFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSTFL_T(:))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SSOLA_T', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SSOLA', &
+ CUNITS = 'kg m3 K m s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'sfc solar flux to force ocean LES', &
+ NGRID = 0, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ ALLOCATE(XSSOLA_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSOLA_T(:))
+!
+END IF ! ocean sfc forcing end
+
+!
+IF ( LFORCING ) THEN
+ DO JT=1,KFRC
+!
+ WRITE (YFRC,'(I3.3)') JT
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'DTFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'DTFRC'//YFRC, &
+ CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S', &
+ CDIR = '--', &
+ CCOMMENT = 'Date of forcing profile '//YFRC, &
+ NGRID = 0, &
+ NTYPE = TYPEDATE, &
+ NDIMS = 0, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTFRC(JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'UFRC'//YFRC, &
+ CUNITS = 'm s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Zonal component of horizontal forcing wind', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'VFRC'//YFRC, &
+ CUNITS = 'm s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Meridian component of horizontal forcing wind', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'WFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'WFRC'//YFRC, &
+ CUNITS = 'm s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Vertical forcing wind', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'THFRC'//YFRC, &
+ CUNITS = 'K', &
+ CDIR = '--', &
+ CCOMMENT = 'Forcing potential temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTHFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'RVFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'RVFRC'//YFRC, &
+ CUNITS = 'kg kg-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Forcing vapor mixing ratio', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRVFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TENDTHFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TENDTHFRC'//YFRC, &
+ CUNITS = 'K s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale potential temperature tendency for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDTHFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TENDRVFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TENDRVFRC'//YFRC, &
+ CUNITS = 'kg kg-1 s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale vapor mixing ratio tendency for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDRVFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'GXTHFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'GXTHFRC'//YFRC, &
+ CUNITS = 'K m-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale potential temperature gradient for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PGXTHFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'GYTHFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'GYTHFRC'//YFRC, &
+ CUNITS = 'K m-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale potential temperature gradient for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PGYTHFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'PGROUNDFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'PGROUNDFRC'//YFRC, &
+ CUNITS = 'Pa', &
+ CDIR = '--', &
+ CCOMMENT = 'Forcing ground pressure', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 0, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PPGROUNDFRC(JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TENDUFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TENDUFRC'//YFRC, &
+ CUNITS = 'm s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale U tendency for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDUFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TENDVFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TENDVFRC'//YFRC, &
+ CUNITS = 'm s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale V tendency for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDVFRC(:,JT))
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+IF (L2D_ADV_FRC) THEN
+
+ DO JT=1,KADVFRC
+ WRITE (YFRC,'(I3.3)') JT
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'DTADV'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'DTADV'//YFRC, &
+ CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S', &
+ CDIR = '--', &
+ CCOMMENT = 'Date and time of the advecting forcing '//YFRC, &
+ NGRID = 0, &
+ NTYPE = TYPEDATE, &
+ NDIMS = 0, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTADVFRC(JT))
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TH_ADV'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TH_ADV'//YFRC, &
+ CUNITS = 'K s-1', &
+ CDIR = '--', &
+ CCOMMENT = '', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDTHFRC(:,:,:,JT))
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'Q_ADV'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'Q_ADV'//YFRC, &
+ CUNITS = 'kg kg-1 s-1', &
+ CDIR = '--', &
+ CCOMMENT = '', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDRVFRC(:,:,:,JT))
+ ENDDO
+ENDIF
+!
+IF (L2D_REL_FRC) THEN
+
+ DO JT=1,KRELFRC
+ WRITE (YFRC,'(I3.3)') JT
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'DTREL'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'DTREL'//YFRC, &
+ CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S', &
+ CDIR = '--', &
+ CCOMMENT = 'Date and time of the relaxation forcing '//YFRC, &
+ NGRID = 0, &
+ NTYPE = TYPEDATE, &
+ NDIMS = 0, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTRELFRC(JT))
+ !
+ ! Relaxation
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TH_REL'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TH_REL'//YFRC, &
+ CUNITS = 'K', &
+ CDIR = '--', &
+ CCOMMENT = '', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTHREL(:,:,:,JT))
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'Q_REL'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'Q_REL'//YFRC, &
+ CUNITS = 'kg kg-1', &
+ CDIR = '--', &
+ CCOMMENT = '', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRVREL(:,:,:,JT))
+ ENDDO
+ENDIF
+!
+IF (LUV_FLX) THEN
+ IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN
+ CALL IO_Field_read(TPINIFILE,'VU_FLX',PVU_FLUX_M)
+ ELSE IF (CCONF == 'START') THEN
+ PVU_FLUX_M(:,:,:)=0.
+ END IF
+ENDIF
+!
+IF (LTH_FLX) THEN
+ IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN
+ CALL IO_Field_read(TPINIFILE,'VT_FLX',PVTH_FLUX_M)
+ CALL IO_Field_read(TPINIFILE,'WT_FLX',PWTH_FLUX_M)
+ ELSE IF (CCONF == 'START') THEN
+ PWTH_FLUX_M(:,:,:)=0.
+ PVTH_FLUX_M(:,:,:)=0.
+ END IF
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. PRINT ON OUTPUT-LISTING
+! ----------------------
+!
+IF (NVERB >= 10 .AND. .NOT. L1D) THEN
+ IIUP = SIZE(PUT,1)
+ IJUP = SIZE(PVT,2)
+ ILUOUT= TLUOUT%NLU
+!
+ WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PUT values:'
+ WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
+ DO JKLOOP=1,KKU
+ WRITE(ILUOUT,FMT=*) PUT(1,1,JKLOOP),PUT(IIUP/2,IJUP/2,JKLOOP), &
+ PUT(IIUP,KJU,JKLOOP),JKLOOP
+ END DO
+!
+ WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PVT values:'
+ WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
+ DO JKLOOP=1,KKU
+ WRITE(ILUOUT,FMT=*) PVT(1,1,JKLOOP),PVT(IIUP/2,IJUP/2,JKLOOP), &
+ PVT(IIUP,IJUP,JKLOOP),JKLOOP
+ END DO
+!
+ WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PWT values:'
+ WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
+ DO JKLOOP=1,KKU
+ WRITE(ILUOUT,FMT=*) PWT(1,1,JKLOOP),PWT(IIUP/2,IJUP/2,JKLOOP), &
+ PWT(IIUP,IJUP,JKLOOP),JKLOOP
+ END DO
+!
+ WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTHT values:'
+ WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
+ DO JKLOOP=1,KKU
+ WRITE(ILUOUT,FMT=*) PTHT(1,1,JKLOOP),PTHT(IIUP/2,IJUP/2,JKLOOP), &
+ PTHT(IIUP,IJUP,JKLOOP),JKLOOP
+ END DO
+!
+ IF(SIZE(PTKET,1) /=0) THEN
+ WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTKET values:'
+ WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
+ DO JKLOOP=1,KKU
+ WRITE(ILUOUT,FMT=*) PTKET(1,1,JKLOOP),PTKET(IIUP/2,IJUP/2,JKLOOP), &
+ PTKET(IIUP,IJUP,JKLOOP),JKLOOP
+ END DO
+ END IF
+!
+ IF (SIZE(PRT,4) /= 0) THEN
+ WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PRT values:'
+ DO JRR = 1, SIZE(PRT,4)
+ WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
+ WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
+ DO JKLOOP=1,KKU
+ WRITE(ILUOUT,FMT=*) PRT(1,1,JKLOOP,JRR),PRT(IIUP/2,IJUP/2,JKLOOP,JRR), &
+ PRT(IIUP,IJUP,JKLOOP,JRR),JKLOOP
+ END DO
+ END DO
+!
+ END IF
+!
+ IF (SIZE(PSVT,4) /= 0) THEN
+ WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PSVT values:'
+ DO JRR = 1, SIZE(PSVT,4)
+ WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
+ WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
+ DO JKLOOP=1,KKU
+ WRITE(ILUOUT,FMT=*) PSVT(1,1,JKLOOP,JRR),PSVT(IIUP/2,IJUP/2,JKLOOP,JRR), &
+ PSVT(IIUP,IJUP,JKLOOP,JRR),JKLOOP
+ END DO
+ END DO
+!
+ END IF
+END IF
+!-------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE READ_FIELD
diff --git a/src/PHYEX/ext/read_precip_field.f90 b/src/PHYEX/ext/read_precip_field.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1267beea757dd57efdedb88d79264cefd58a738c
--- /dev/null
+++ b/src/PHYEX/ext/read_precip_field.f90
@@ -0,0 +1,299 @@
+!MNH_LIC Copyright 1996-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_READ_PRECIP_FIELD
+! #############################
+!
+!
+!
+INTERFACE
+!
+ SUBROUTINE READ_PRECIP_FIELD(TPINIFILE,HPROGRAM,HCONF, &
+ HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
+ PINPRC,PACPRC,PINDEP,PACDEP,PINPRR,PINPRR3D,PEVAP3D, &
+ PACPRR,PINPRS,PACPRS,PINPRG,PACPRG,PINPRH,PACPRH )
+!
+USE MODD_IO, ONLY : TFILEDATA
+!
+!* 0.1 declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+CHARACTER (LEN=*), INTENT(IN) :: HPROGRAM !
+CHARACTER (LEN=*), INTENT(IN) :: HCONF !
+!
+CHARACTER (LEN=*), INTENT(IN) :: HGETRCT, HGETRRT, HGETRST, HGETRGT, HGETRHT
+ ! Get indicator RCT,RRT,RST,RGT,RHT
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Droplet instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRC ! Droplet accumulated precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Droplet instant deposition
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACDEP ! Droplet accumulated dep
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain precipitation flux 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evaporation flux 3D
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRR ! Rain accumulated precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRS ! Snow accumulated precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRG ! Graupel accumulated precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRH ! Hail accumulated precip
+!
+END SUBROUTINE READ_PRECIP_FIELD
+!
+END INTERFACE
+!
+END MODULE MODI_READ_PRECIP_FIELD
+!
+! ##############################################################################
+ SUBROUTINE READ_PRECIP_FIELD(TPINIFILE,HPROGRAM,HCONF, &
+ HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
+ PINPRC,PACPRC,PINDEP,PACDEP,PINPRR,PINPRR3D,PEVAP3D, &
+ PACPRR,PINPRS,PACPRS,PINPRG,PACPRG,PINPRH,PACPRH )
+! ##############################################################################
+!
+!!**** *READ_PRECIP_FIELD* - routine to read precipitation surface fields
+!!
+!! PURPOSE
+!! -------
+! Initialize precipitation fields by reading their value in an initial
+! MNH file.
+!
+!!** METHOD
+!! ------
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FMREAD : to read data in LFIFM file
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine READ_PRECIP_FIELD)
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/06/96
+!! (J. Viviand) 04/02/97 convert precipitation rates in m/s
+!! (V. Ducrocq) 14/08/98 // remove KIINF,KJINF,KISUP,KJSUP
+!! (JP Pinty) 29/11/02 add C3R5, ICE2, ICE4
+!! (C.Lac) 04/03/13 add YGETxxx for FIT scheme
+!! 10/2016 (C.Lac) Add droplet deposition
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+
+use modd_field, only: tfieldmetadata, tfieldlist
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAM_ICE_n, ONLY: LDEPOSC
+USE MODD_PARAM_C2R2, ONLY: LDEPOC
+USE MODD_PARAM_LIMA, ONLY: MDEPOC=>LDEPOC
+!
+use mode_field, only: Find_field_id_from_mnhname
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+CHARACTER (LEN=*), INTENT(IN) :: HPROGRAM !
+CHARACTER (LEN=*), INTENT(IN) :: HCONF !
+!
+CHARACTER (LEN=*), INTENT(IN) :: HGETRCT, HGETRRT, HGETRST, HGETRGT, HGETRHT
+ ! Get indicator RCT,RRT,RST,RGT,RHT
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Droplet instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRC ! Droplet accumulated precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Droplet instant deposition
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACDEP ! Droplet accumulated dep
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain precipitation flux 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evaporation flux 3D
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRR ! Rain accumulated precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRS ! Snow accumulated precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRG ! Graupel accumulated precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRH ! Hail accumulated precip
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PINPRR,1),SIZE(PINPRR,2)) :: Z2D ! 2D array to read data
+REAL, DIMENSION(SIZE(PINPRR3D,1),SIZE(PINPRR3D,2),SIZE(PINPRR3D,3)) :: Z3D ! 3D array to read data
+ ! in initial file
+INTEGER :: IID
+INTEGER :: IRESP
+CHARACTER(LEN=4) :: YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT
+TYPE(TFIELDMETADATA) :: TZFIELD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.. INITIALIZATION
+! ----------------
+!
+IF ((HPROGRAM == 'MESONH') .AND. (HCONF == 'START')) THEN
+ YGETRCT = 'INIT'
+ YGETRRT = 'INIT'
+ YGETRST = 'INIT'
+ YGETRGT = 'INIT'
+ YGETRHT = 'INIT'
+ELSE
+ YGETRCT = HGETRCT
+ YGETRRT = HGETRRT
+ YGETRST = HGETRST
+ YGETRGT = HGETRGT
+ YGETRHT = HGETRHT
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 2.. READ PROGNOSTIC VARIABLES
+! -------------------------
+!
+IF (SIZE(PINPRC) /= 0 ) THEN
+ SELECT CASE(YGETRCT)
+ CASE ('READ')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PINPRC(:,:)=Z2D(:,:)/(1000.*3600.)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PACPRC(:,:)=Z2D(:,:)/(1000.)
+ CASE ('INIT')
+ PINPRC(:,:) = 0.0
+ PACPRC(:,:) = 0.0
+ END SELECT
+END IF
+!
+IF (SIZE(PINDEP) /= 0 ) THEN
+ SELECT CASE(YGETRCT)
+ CASE ('READ')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PINDEP(:,:)=Z2D(:,:)/(1000.*3600.)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PACDEP(:,:)=Z2D(:,:)/(1000.)
+ CASE ('INIT')
+ PINDEP(:,:) = 0.0
+ PACDEP(:,:) = 0.0
+ END SELECT
+END IF
+!
+IF (SIZE(PINPRR) /= 0 ) THEN
+ SELECT CASE(YGETRRT)
+ CASE ('READ')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PINPRR(:,:)=Z2D(:,:)/(1000.*3600.)
+ !
+ CALL IO_Field_read(TPINIFILE,'INPRR3D',Z3D,IRESP)
+ IF (IRESP == 0) PINPRR3D(:,:,:)=Z3D(:,:,:)
+ !
+ CALL IO_Field_read(TPINIFILE,'EVAP3D',Z3D,IRESP)
+ IF (IRESP == 0) PEVAP3D(:,:,:)=Z3D(:,:,:)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PACPRR(:,:)=Z2D(:,:)/(1000.)
+ CASE ('INIT')
+ PINPRR(:,:) = 0.0
+ PINPRR3D(:,:,:) = 0.0
+ PEVAP3D(:,:,:) = 0.0
+ PACPRR(:,:) = 0.0
+ END SELECT
+END IF
+!
+IF (SIZE(PINPRS) /= 0 ) THEN
+ SELECT CASE(YGETRST)
+ CASE ('READ')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PINPRS(:,:)=Z2D(:,:)/(1000.*3600.)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PACPRS(:,:)=Z2D(:,:)/(1000.)
+ CASE ('INIT')
+ PINPRS(:,:) = 0.0
+ PACPRS(:,:) = 0.0
+ END SELECT
+END IF
+!
+IF (SIZE(PINPRG) /= 0 ) THEN
+ SELECT CASE(YGETRGT)
+ CASE ('READ')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PINPRG(:,:)=Z2D(:,:)/(1000.*3600.)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PACPRG(:,:)=Z2D(:,:)/(1000.)
+ CASE ('INIT')
+ PINPRG(:,:) = 0.0
+ PACPRG(:,:) = 0.0
+ END SELECT
+END IF
+!
+IF (SIZE(PINPRH) /= 0 ) THEN
+ SELECT CASE(YGETRHT)
+ CASE ('READ')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PINPRH(:,:)=Z2D(:,:)/(1000.*3600.)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
+ IF (IRESP == 0) PACPRH(:,:)=Z2D(:,:)/(1000.)
+ CASE ('INIT')
+ PINPRH(:,:) = 0.0
+ PACPRH(:,:) = 0.0
+ END SELECT
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_PRECIP_FIELD
diff --git a/src/PHYEX/ext/resolved_cloud.f90 b/src/PHYEX/ext/resolved_cloud.f90
new file mode 100644
index 0000000000000000000000000000000000000000..aec42c0535e375182860e9e1ff46049510d13234
--- /dev/null
+++ b/src/PHYEX/ext/resolved_cloud.f90
@@ -0,0 +1,1107 @@
+!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_n, ONLY: NEBN, CCONDENS, CLAMBDA3
+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_n, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, LRED, PARAM_ICEN
+USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XRTMIN, RAIN_ICE_DESCRN
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: TURBN
+!
+USE MODE_ll
+USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
+use mode_sources_neg_correct, only: Sources_neg_correct
+!
+USE MODI_C2R2_ADJUST
+USE MODI_FAST_TERMS
+USE MODI_GET_HALO
+USE MODI_ICE_ADJUST
+USE MODI_KHKO_NOTADJUST
+USE MODI_LIMA
+USE MODI_LIMA_ADJUST
+USE MODI_LIMA_ADJUST_SPLIT
+USE MODI_LIMA_COLD
+USE MODI_LIMA_MIXED
+USE MODI_LIMA_NOTADJUST
+USE MODI_LIMA_WARM
+USE MODI_RAIN_C2R2_KHKO
+USE MODI_RAIN_ICE
+USE MODI_RAIN_ICE_OLD
+USE MODI_SHUMAN
+USE MODI_SLOW_TERMS
+USE MODI_AER2LIMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integrations for rain sedimendation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integrations for ice sedimendation
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+ ! concentration at time t
+LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for ICE3
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation through temp.
+ ! evolution in C2R2 and KHKO
+LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
+ ! cloud crystal sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
+ ! raindrop formation
+LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
+ ! by slow warm microphysical
+ ! processes
+LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
+LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
+ ! hail to graupel
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JRR,JSV ! Loop index for the moist and scalar variables
+INTEGER :: IIB ! Define the physical domain
+INTEGER :: IIE !
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+INTEGER :: IKU
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: JK,JI,JL
+!
+!
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDZZ
+real, dimension(:,:,:), allocatable :: ZEXN
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ
+ ! model layer height
+! REAL :: ZMASSTOT ! total mass for one water category
+! ! including the negative values
+! REAL :: ZMASSPOS ! total mass for one water category
+! ! after removing the negative values
+! REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
+!
+INTEGER :: ISVBEG ! first scalar index for microphysics
+INTEGER :: ISVEND ! last scalar index for microphysics
+!UPG*PT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
+!UPG*PT
+
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
+!
+INTEGER :: JMOD, JMOD_IFN
+LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
+LOGICAL :: LMFCONV ! =SIZE(PMFCONV)!=0
+! BVIE work array waiting for PINPRI
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZICEFR
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZPRCFR
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZTM
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSIGQSAT2D
+TYPE(DIMPHYEX_t) :: YLDIMPHYEX
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDUM
+ZSIGQSAT2D(:,:) = PSIGQSAT
+!
+!------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+IKU=SIZE(PZZ,3)
+!
+CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3))
+!
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+GSOUTH = LSOUTH_ll()
+GNORTH = LNORTH_ll()
+!
+LMFCONV=(SIZE(PMFCONV)/=0)
+!
+IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN
+ ISVBEG = NSV_C2R2BEG
+ ISVEND = NSV_C2R2END
+ELSE IF (HCLOUD == 'C3R5') THEN
+ ISVBEG = NSV_C2R2BEG
+ ISVEND = NSV_C1R3END
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ISVBEG = NSV_LIMA_BEG
+ IF (.NOT. LDUST .AND. .NOT. LSALT .AND. .NOT. LORILAM) THEN
+ ISVEND = NSV_LIMA_END
+ ELSE
+ IF (LORILAM) THEN
+ ISVEND = NSV_AEREND
+ END IF
+ IF (LDUST) THEN
+ ISVEND = NSV_DSTEND
+ END IF
+ IF (LSALT) THEN
+ ISVEND = NSV_SLTEND
+ END IF
+ END IF
+ELSE
+ ISVBEG = 0
+ ISVEND = 0
+END IF
+!
+!
+!
+!* 1. From ORILAM to LIMA:
+!
+IF (HCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN
+! ORILAM : tendance s --> variable instant t
+ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV))
+ DO JSV = 1, NSV
+ ZSVT(:,:,:,JSV) = PSVS(:,:,:,JSV) * PTSTEP / PRHODJ(:,:,:)
+ END DO
+
+CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,1),&
+ PPABST(IIB:IIE,IJB:IJE,IKB:IKE),&
+ PTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
+
+! LIMA : variable instant t --> tendance s
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+1) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE+2) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+2) * &
+ PRHODJ(:,:,:) / PTSTEP
+
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE) * &
+ PRHODJ(:,:,:) / PTSTEP
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE+1) * &
+ PRHODJ(:,:,:) / PTSTEP
+
+DEALLOCATE(ZSVT)
+END IF
+
+!UPG*PT
+!
+!
+!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
+! ---------------------------------------
+!
+PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
+DO JRR = 1,KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
+END DO
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
+ ENDDO
+ENDIF
+!
+! complete the lateral boundaries to avoid possible problems
+!
+DO JI=1,JPHEXT
+ PTHS(JI,:,:) = PTHS(IIB,:,:)
+ PTHS(IIE+JI,:,:) = PTHS(IIE,:,:)
+ PTHS(:,JI,:) = PTHS(:,IJB,:)
+ PTHS(:,IJE+JI,:) = PTHS(:,IJE,:)
+!
+ PRS(JI,:,:,:) = PRS(IIB,:,:,:)
+ PRS(IIE+JI,:,:,:) = PRS(IIE,:,:,:)
+ PRS(:,JI,:,:) = PRS(:,IJB,:,:)
+ PRS(:,IJE+JI,:,:) = PRS(:,IJE,:,:)
+END DO
+!
+! complete the physical boundaries to avoid some computations
+!
+IF(GWEST .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0
+IF(GEAST .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0
+IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0
+IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+DO JI=1,JPHEXT
+ PSVS(JI, :, :, ISVBEG:ISVEND) = PSVS(IIB, :, :, ISVBEG:ISVEND)
+ PSVS(IIE+JI, :, :, ISVBEG:ISVEND) = PSVS(IIE, :, :, ISVBEG:ISVEND)
+ PSVS(:, JI, :, ISVBEG:ISVEND) = PSVS(:, IJB, :, ISVBEG:ISVEND)
+ PSVS(:, IJE+JI, :, ISVBEG:ISVEND) = PSVS(:, IJE, :, ISVBEG:ISVEND)
+END DO
+ !
+! complete the physical boundaries to avoid some computations
+!
+ IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0
+ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0
+ENDIF
+!
+! complete the vertical boundaries
+!
+PTHS(:,:,IKB-1) = PTHS(:,:,IKB)
+PTHS(:,:,IKE+1) = PTHS(:,:,IKE)
+!
+PRS(:,:,IKB-1,:) = PRS(:,:,IKB,:)
+PRS(:,:,IKE+1,:) = PRS(:,:,IKE,:)
+!
+PRT(:,:,IKB-1,:) = PRT(:,:,IKB,:)
+PRT(:,:,IKE+1,:) = PRT(:,:,IKE,:)
+!
+IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' &
+ .OR. HCLOUD == 'LIMA') THEN
+ PSVS(:,:,IKB-1,ISVBEG:ISVEND) = PSVS(:,:,IKB,ISVBEG:ISVEND)
+ PSVS(:,:,IKE+1,ISVBEG:ISVEND) = PSVS(:,:,IKE,ISVBEG:ISVEND)
+ PSVT(:,:,IKB-1,ISVBEG:ISVEND) = PSVT(:,:,IKB,ISVBEG:ISVEND)
+ PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND)
+ENDIF
+!
+!
+!* 3. REMOVE NEGATIVE VALUES
+! ----------------------
+!
+!* 3.1 Non local correction for precipitating species (Rood 87)
+!
+! IF ( HCLOUD == 'KESS' &
+! .OR. HCLOUD == 'ICE3' .OR. HCLOUD == 'ICE4' &
+! .OR. HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' &
+! .OR. HCLOUD == 'KHKO' .OR. HCLOUD == 'LIMA' ) THEN
+! !
+! DO JRR = 3,KRR
+! SELECT CASE (JRR)
+! CASE(3,5,6,7) ! rain, snow, graupel and hail
+!
+! IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll) < 0.0 ) THEN
+! !
+! ! compute the total water mass computation
+! !
+! ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
+! !
+! ! remove the negative values
+! !
+! PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
+! !
+! ! compute the new total mass
+! !
+! ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
+! !
+! ! correct again in such a way to conserve the total mass
+! !
+! ZRATIO = ZMASSTOT / ZMASSPOS
+! PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
+! !
+! END IF
+! END SELECT
+! END DO
+! END IF
+!
+!* 3.2 Adjustement for liquid and solid cloud
+!
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+!
+!* 3.4 Limitations of Na and Nc to the CCN max number concentration
+!
+! Commented by O.Thouron 03/2013
+!IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') &
+! .AND.(XCONC_CCN > 0)) THEN
+! IF ((HACTCCN /= 'ABRK')) THEN
+! ZSVT(:,:,:,1) = MIN( ZSVT(:,:,:,1),XCONC_CCN )
+! ZSVT(:,:,:,2) = MIN( ZSVT(:,:,:,2),XCONC_CCN )
+! ZSVS(:,:,:,1) = MIN( ZSVS(:,:,:,1),XCONC_CCN )
+! ZSVS(:,:,:,2) = MIN( ZSVS(:,:,:,2),XCONC_CCN )
+! END IF
+!END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HCLOUD )
+ CASE ('REVE')
+!
+!* 4. REVERSIBLE MICROPHYSICAL SCHEME
+! -------------------------------
+!
+ CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PCF_MF,PRC_MF, &
+ PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
+!
+ CASE ('KESS')
+!
+!* 5. KESSLER MICROPHYSICAL SCHEME
+! ----------------------------
+!
+!
+!* 5.1 Compute the explicit microphysical sources
+!
+ CALL SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, &
+ PZZ, PRHODJ, PRHODREF, PCLDFR, &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), PPABST, &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PINPRR, PINPRR3D, PEVAP3D )
+!
+!* 5.2 Perform the saturation adjustment
+!
+ CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PCF_MF,PRC_MF, &
+ PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3), &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
+!
+!
+ CASE ('C2R2','KHKO')
+!
+!* 7. 2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO
+! ---------------------------------------
+!
+!
+!* 7.1 Compute the explicit microphysical sources
+!
+!
+ CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PTHM, PRCM, PPABSTT, &
+ PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
+ PSVT(:,:,:,NSV_C2R2BEG), PSVT(:,:,:,NSV_C2R2BEG+1), &
+ PSVT(:,:,:,NSV_C2R2BEG+2), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG+2), &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D , &
+ PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN, &
+ PINDEP, PSUPSAT, PNACT )
+!
+!
+!* 7.2 Perform the saturation adjustment
+!
+ IF (LSUPSAT) THEN
+ CALL KHKO_NOTADJUST (KRR, KTCOUNT,TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PZZ, &
+ PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), &
+ PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+3), PCLDFR, PSRCS, PNPRO, PSSPRO )
+!
+ ELSE
+ CALL C2R2_ADJUST ( KRR,TPFILE, HRAD, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PCNUCS=PSVS(:,:,:,NSV_C2R2BEG), &
+ PCCS=PSVS(:,:,:,NSV_C2R2BEG+1), &
+ PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) )
+!
+ END IF
+!
+ CASE ('ICE3')
+!
+!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
+! -----------------------------------------------------
+!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+ ZEXN(:,:,:)= (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
+!
+!* 9.1 Compute the explicit microphysical sources
+!
+!
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF(LRED .AND. LADJ_BEFORE) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
+ PARAM_ICEN, TBUCONF, KRR, &
+ 'ADJU', &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV,PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ ENDIF
+ IF (LRED) THEN
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, &
+ RAIN_ICE_DESCRN, TBUCONF, &
+ PTSTEP, KRR, ZEXN, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC,PINPRR, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS,SIZE(TBUDGETS), &
+ PSEA,PTOWN, PFPR=ZFPR )
+ ELSE
+ CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
+ KSPLITR, PTSTEP, KRR, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
+ PSEA, PTOWN, PFPR=ZFPR)
+ END IF
+
+!
+!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
+!
+!
+ IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
+ PARAM_ICEN, TBUCONF, KRR, &
+ 'DEPI', &
+ 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_PARAMN, NEBN, TURBN, &
+ PARAM_ICEN, TBUCONF, KRR, &
+ 'ADJU', &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV,PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ ENDIF
+ IF (LRED) THEN
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, &
+ RAIN_ICE_DESCRN, TBUCONF, &
+ PTSTEP, KRR, ZEXN, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC, PINPRR, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS,SIZE(TBUDGETS), &
+ PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
+ ELSE
+ CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
+ KSPLITR, PTSTEP, KRR, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
+ PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR)
+ END IF
+
+
+!
+!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
+!
+ IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
+ PARAM_ICEN, TBUCONF, KRR, &
+ 'DEPI', &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, &
+ OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ END IF
+
+ deallocate( zexn )
+!
+!
+!* 12. 2-MOMENT MIXED-PHASE MICROPHYSICAL SCHEME LIMA
+! --------------------------------------------------------------
+!
+!
+!* 12.1 Compute the explicit microphysical sources
+!
+ CASE ('LIMA')
+ !
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF (LPTSPLIT) THEN
+ CALL LIMA (YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ PTSTEP, &
+ PRHODREF, PEXNREF, ZDZZ, &
+ PRHODJ, PPABST, &
+ NMOD_CCN, NMOD_IFN, NMOD_IMM, &
+ PDTHRAD, PTHT, PRT, &
+ PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, &
+ PEVAP3D, PCLDFR, PICEFR, PRAINFR, ZFPR )
+ ELSE
+
+ IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PW_ACT, PPABST, &
+ PDTHRAD, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
+!
+ IF (NMOM_I.GE.1) CALL LIMA_COLD(CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRS, PINPRG, PINPRH )
+!
+ IF (OWARM .AND. NMOM_I.GE.1) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END) )
+ ENDIF
+!
+!* 12.2 Perform the saturation adjustment
+!
+ IF (LSPRO) THEN
+ CALL LIMA_NOTADJUST (KMI, TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PCLDFR, PICEFR, PRAINFR, PSRCS )
+ ELSE IF (LPTSPLIT) THEN
+ CALL LIMA_ADJUST_SPLIT(YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ KRR, KMI, CCONDENS, CLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PPABSTT, ZZZ,&
+ PDTHRAD, PW_ACT, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF )
+ ELSE
+ CALL LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABST, PPABSTT, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR, PICEFR, PRAINFR )
+ ENDIF
+!
+END SELECT
+!
+IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
+! TODO: code a generic routine to update vertical lower and upper levels to 0, a
+! specific value or to IKB or IKE and apply it to every output prognostic variable of physics
+ PCIT(:,:,1) = 0.
+ PCIT(:,:,IKE+1) = 0.
+
+ PINPRC3D=ZFPR(:,:,:,2) / CST%XRHOLW
+ PINPRR3D=ZFPR(:,:,:,3) / CST%XRHOLW
+ PINPRS3D=ZFPR(:,:,:,5) / CST%XRHOLW
+ PINPRG3D=ZFPR(:,:,:,6) / CST%XRHOLW
+ IF(KRR==7) PINPRH3D=ZFPR(:,:,:,7) / CST%XRHOLW
+ WHERE (PRT(:,:,:,2) > 1.E-04 )
+ PSPEEDC=ZFPR(:,:,:,2) / (PRT(:,:,:,2) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,3) > 1.E-04 )
+ PSPEEDR=ZFPR(:,:,:,3) / (PRT(:,:,:,3) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,5) > 1.E-04 )
+ PSPEEDS=ZFPR(:,:,:,5) / (PRT(:,:,:,5) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,6) > 1.E-04 )
+ PSPEEDG=ZFPR(:,:,:,6) / (PRT(:,:,:,6) * PRHODREF(:,:,:))
+ ENDWHERE
+ IF(KRR==7) THEN
+ WHERE (PRT(:,:,:,7) > 1.E-04 )
+ PSPEEDH=ZFPR(:,:,:,7) / (PRT(:,:,:,7) * PRHODREF(:,:,:))
+ ENDWHERE
+ ENDIF
+ENDIF
+
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+
+!-------------------------------------------------------------------------------
+!
+!
+!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES
+! ---------------------------------------
+!
+PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
+!
+DO JRR = 1,KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
+END DO
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
+ ENDDO
+ENDIF
+
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RESOLVED_CLOUD
diff --git a/src/PHYEX/ext/series_cloud_elec.f90 b/src/PHYEX/ext/series_cloud_elec.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c740922db924e0a69472a670046a154571f3977e
--- /dev/null
+++ b/src/PHYEX/ext/series_cloud_elec.f90
@@ -0,0 +1,618 @@
+!MNH_LIC Copyright 2010-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_SERIES_CLOUD_ELEC
+! #############################
+!
+INTERFACE
+ SUBROUTINE SERIES_CLOUD_ELEC (KTCOUNT, PTSTEP, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PRT, PRS, PSVT, &
+ PTHT, PWT, PPABST, PCIT, &
+ TPFILE_SERIES_CLOUD_ELEC, &
+ PINPRR )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+!
+REAL, INTENT(IN) :: PTSTEP ! Double time step except for cold start
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variable at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! Vertical velocity at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! ab. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice number
+ ! concentration at time t
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE_SERIES_CLOUD_ELEC
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+!
+END SUBROUTINE SERIES_CLOUD_ELEC
+END INTERFACE
+END MODULE MODI_SERIES_CLOUD_ELEC
+!
+!
+! ###############################################################
+ SUBROUTINE SERIES_CLOUD_ELEC (KTCOUNT, PTSTEP, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PRT, PRS, PSVT, &
+ PTHT, PWT, PPABST, PCIT, &
+ TPFILE_SERIES_CLOUD_ELEC, &
+ PINPRR )
+! ###############################################################
+!
+!!**** * -
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! C. Bovalo * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original : Avril 2010
+!! Modifications:
+!! C. Barthe * LACy * Dec. 2010 add some parameters
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
+!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
+!-------------------------------------------------------------------------------
+!
+! 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF, ONLY: CEXP
+USE MODD_CST
+USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_PARAM
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
+USE MODD_PARAMETERS
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_PARAM_n
+USE MODD_REF
+
+USE MODI_MOMG
+USE MODI_RADAR_RAIN_ICE
+
+USE MODE_ELEC_ll
+USE MODE_ll
+use mode_tools, only: Countjv
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+!
+REAL, INTENT(IN) :: PTSTEP ! Double time step except for cold start
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variable at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! Vertical velocity at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! ab. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice number
+ ! concentration at time t
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE_SERIES_CLOUD_ELEC
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: II, IJ, IK
+INTEGER :: IIB,IIE ! Indices for the first and last inner mass point along x
+INTEGER :: IJB,IJE ! Indices for the first and last inner mass point along y
+INTEGER :: IKB,IKE ! Indices for the first and last inner mass point along z
+INTEGER :: JCOUNT_STOP
+INTEGER :: ICOUNT ! counter for iwp computation
+INTEGER :: IPROC ! my proc number
+INTEGER :: IPROC_MAX ! proc that contains max value
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: ILU ! unit number for IO
+!
+INTEGER, SAVE :: JCOUNT
+!
+INTEGER, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: IFLAG
+!
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZMASS_SP ! Precipitation snow mass (kg)
+REAL :: ZMASS_GP ! Precipitation graupel mass (kg)
+REAL :: ZFLUX_I ! Ice crystal mass flux (kg m/s)
+REAL :: ZFLUX_SP ! Precipitation snow mass flux (kg m/s)
+REAL :: ZFLUX_SNP ! Non precipitation snow mass flux (kg m/s)
+REAL :: ZFLUX_G ! Graupel mass flux (kg m/s)
+REAL :: ZCLD_TOP_REF ! Cloud top height (m) from radar refl.
+REAL :: ZCLD_TOP_MR ! Cloud top height (m) from mixing ratio
+REAL :: ZICE_MASS ! Ice mass (kg)
+!
+REAL, SAVE :: ZMASS_C ! Cloud water mass (kg)
+REAL, SAVE :: ZMASS_R ! Rain water mass (kg)
+REAL, SAVE :: ZMASS_I ! Ice crystal mass (kg)
+REAL, SAVE :: ZMASS_S ! Snow mass (kg)
+REAL, SAVE :: ZMASS_G ! Graupel mass (kg)
+REAL, SAVE :: ZMASS_ICE_P ! Precipitation ice mass (kg)
+REAL, SAVE :: ZFLUX_PROD ! Ice mass flux product (kg^2 m^2/s^2)
+REAL, SAVE :: ZFLUX_PRECIP ! Precipitation ice mass flux (kg m/s)
+REAL, SAVE :: ZFLUX_NPRECIP ! Non-precipitation ice mass flux (kg m/s)
+REAL, SAVE :: ZVOL_UP5 ! Updraft volume for W > 5 m/s (m^3)
+REAL, SAVE :: ZVOL_UP10 ! Updraft volume for W > 10 m/s (m^3)
+REAL, SAVE :: ZWMAX ! Maximum vertical velocity (m/s)
+REAL, SAVE :: ZVOL_G ! Graupel volume (m^3)
+REAL, SAVE :: ZIWP ! Ice water path (kg/m^2)
+REAL, SAVE :: ZCTH_MR ! Cloud top height / m.r. > 1.e-4 kg/kg (m)
+REAL, SAVE :: ZCTH_REF ! Cloud top height / Z > 20 dBZ (m)
+REAL, SAVE :: ZCLD_VOL ! Cloud volume (m^3)
+REAL, SAVE :: ZDBZMAX ! Max radar reflectivity (dBZ)
+REAL, SAVE :: ZINPRR ! Rain instant precip. (mm/H)
+REAL, SAVE :: ZMAX_INPRR ! Maximum rain instant. precip. (mm/H)
+!
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
+! XRTMIN = Minimum value for the mixing ratio
+! ZRTMIN = Minimum value for the source (tendency)
+!
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
+ ZTCT ! Temperature in Degrees Celsius
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
+ ZWORK31, ZWORK32, ZWORK33, ZWORK34
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCLOUD
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLAMBDAS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLAMBDAG
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVTS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVTG
+!
+LOGICAL, SAVE :: GFIRSTCALL = .TRUE.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS AND SOME PARAMETERS
+! -------------------------------------------
+!
+JCOUNT_STOP = INT(NTSAVE_SERIES/PTSTEP)
+!
+!* 1.1 beginning and end indexes of the physical subdomain
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PZZ,3) - JPVEXT
+!
+!
+!* 1.2 compute some parameters
+!
+! temperature : K -> C
+ZTCT(:,:,:) = (PTHT(:,:,:) * (PPABST(:,:,:) / XP00)**(XRD/XCPD)) - XTT
+!
+! total mixing ratio
+ALLOCATE(ZCLOUD(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ZCLOUD(:,:,:) = 0.
+ZCLOUD(IIB:IIE,IJB:IJE,IKB:IKE) = PRT(IIB:IIE,IJB:IJE,IKB:IKE,2) + &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,3) + &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,4) + &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,5) + &
+ PRT(IIB:IIE,IJB:IJE,IKB:IKE,6)
+!
+!
+!* 1.3 compute the terminal fall speed
+!
+! the mean terminal fall speed is computed following:
+! V_mean = Int(v(D) n(D) dD) / Int(n(D) dD)
+!
+ALLOCATE(ZLAMBDAS(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
+ALLOCATE(ZLAMBDAG(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
+ALLOCATE(ZVTS(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
+ALLOCATE(ZVTG(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
+!
+ZLAMBDAS(:,:,:) = 0.
+ZLAMBDAG(:,:,:) = 0.
+ZVTS(:,:,:) = 0.
+ZVTG(:,:,:) = 0.
+!
+! Surface reference air density
+ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+!
+! for snow
+WHERE (PRT(:,:,:,5) .GT. 1.E-12)
+ ZLAMBDAS(:,:,:) = MIN(XLBDAS_MAX, &
+ XLBS * (PRHODREF(:,:,:) * &
+ MAX(PRT(:,:,:,5), XRTMIN(5)))**XLBEXS)
+ ZVTS(:,:,:) = XCS * MOMG(XALPHAS, XNUS, XBS+XDS) * ZLAMBDAS(:,:,:)**(-XDS) * &
+ (ZRHO00 / PRHODREF(:,:,:))**XCEXVT / MOMG(XALPHAS, XNUS, XBS)
+ELSEWHERE
+ ZLAMBDAS(:,:,:) = 0.
+ ZVTS(:,:,:) = 0.
+END WHERE
+!
+! for graupel
+WHERE(PRT(:,:,:,6) .GT. 1.E-12)
+ ZLAMBDAG(:,:,:) = XLBG * (PRHODREF(:,:,:) * &
+ MAX(PRT(:,:,:,6), XRTMIN(6)))**XLBEXG
+ ZVTG(:,:,:) = XCG * MOMG(XALPHAG, XNUG, XBG+XDG) * ZLAMBDAG(:,:,:)**(-XDG) * &
+ (ZRHO00 / PRHODREF(:,:,:))**XCEXVT / MOMG(XALPHAG, XNUG, XBG)
+ELSEWHERE
+ ZLAMBDAG(:,:,:) = 0.
+ ZVTG(:,:,:) = 0.
+END WHERE
+!
+DEALLOCATE(ZLAMBDAS)
+DEALLOCATE(ZLAMBDAG)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. INITIALIZE THE VARIABLES
+! ------------------------
+!
+IF (GFIRSTCALL) THEN
+ GFIRSTCALL = .FALSE.
+!
+ JCOUNT = 0
+ ZMASS_C = 0.
+ ZMASS_R = 0.
+ ZMASS_I = 0.
+ ZMASS_S = 0.
+ ZMASS_G = 0.
+ ZMASS_ICE_P = 0.
+ ZFLUX_PROD = 0.
+ ZFLUX_PRECIP = 0.
+ ZFLUX_NPRECIP = 0.
+ ZVOL_UP5 = 0.
+ ZVOL_UP10 = 0.
+ ZVOL_G = 0.
+ ZWMAX = 0.
+ ZDBZMAX = 0.
+ ZCTH_REF = 0.
+ ZCTH_MR = 0.
+ ZCLD_VOL = 0.
+ ZINPRR = 0.
+ ZMAX_INPRR = 0.
+END IF
+!
+ZICE_MASS = 0.
+ZMASS_SP = 0.
+ZMASS_GP = 0.
+ZFLUX_I = 0.
+ZFLUX_SP = 0.
+ZFLUX_SNP = 0.
+ZFLUX_G = 0.
+ZCLD_TOP_REF = 0.
+ZCLD_TOP_MR = 0.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTE THE DYNAMICAL AND MICROPHYSICAL PARAMETERS
+! --------------------------------------------------
+!
+JCOUNT = JCOUNT + 1
+!
+!* 3.1 compute the maximum vertical velocity
+!
+ZWMAX = ZWMAX + MAXVAL(PWT(IIB:IIE,IJB:IJE,IKB:IKE))
+!
+!
+!* 3.2 compute the maximum radar reflectivity
+!
+CALL RADAR_RAIN_ICE (PRT, PCIT, PRHODREF, ZTCT, &
+ ZWORK31, ZWORK32, ZWORK33, ZWORK34)
+!
+ZDBZMAX = ZDBZMAX + MAXVAL(ZWORK31(IIB:IIE,IJB:IJE,IKB:IKE))
+!
+!
+!* 3.3 compute the mass of the different microphysical species
+!
+ZMASS_C = ZMASS_C + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,2) * &
+ PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
+!
+ZMASS_R = ZMASS_R + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,3) * &
+ PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
+!
+ZMASS_I = ZMASS_I + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,4) * &
+ PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
+!
+ZMASS_S = ZMASS_S + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,5) * &
+ PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
+!
+ZMASS_G = ZMASS_G + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,6) * &
+ PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
+!
+!
+!* 3.4 compute the ice mass fluxes
+!
+!* 3.4.1 non-precipitation ice mass flux
+!
+IFLAG(:,:) = 0
+ICOUNT = 0
+!
+DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKB, IKE
+!
+!* 3.4.1 non-precipitation ice crystal mass flux
+!
+ IF (ZTCT(II,IJ,IK) .LT. 0. .AND. PWT(II,IJ,IK) .GT. 0.) THEN
+ ZFLUX_I = ZFLUX_I + &
+ PWT(II,IJ,IK) * PRT(II,IJ,IK,4) * PRHODJ(II,IJ,IK)
+ END IF
+!
+!* 3.4.2 non-precipitation snow mass flux
+!
+ IF (ZTCT(II,IJ,IK) .LT. 0. .AND. PWT(II,IJ,IK) .GT. ZVTS(II,IJ,IK)) THEN
+ ZFLUX_SNP = ZFLUX_SNP + &
+ (PWT(II,IJ,IK) - ZVTS(II,IJ,IK)) * PRT(II,IJ,IK,5) * &
+ PRHODJ(II,IJ,IK)
+ END IF
+!
+!* 3.4.3 precipitation snow mass flux
+!
+ IF (ZTCT(II,IJ,IK) .LT. 0. .AND. PWT(II,IJ,IK) .LT. ZVTS(II,IJ,IK)) THEN
+ ZMASS_SP = ZMASS_SP + PRT(II,IJ,IK,5) * PRHODJ(II,IJ,IK)
+ ZFLUX_SP = ZFLUX_SP + &
+ (PWT(II,IJ,IK) - ZVTS(II,IJ,IK)) * PRT(II,IJ,IK,5) * &
+ PRHODJ(II,IJ,IK)
+ END IF
+!
+!* 3.4.4 precipitation graupel mass flux
+!
+ IF (ZTCT(II,IJ,IK) .LT. 0. .AND. PWT(II,IJ,IK) .LT. ZVTG(II,IJ,IK)) THEN
+ ZMASS_GP = ZMASS_GP + PRT(II,IJ,IK,6) * PRHODJ(II,IJ,IK)
+ ZFLUX_G = ZFLUX_G + &
+ (PWT(II,IJ,IK) - ZVTG(II,IJ,IK)) * PRT(II,IJ,IK,6) * &
+ PRHODJ(II,IJ,IK)
+ END IF
+!
+!
+!* 3.5 compute the updraft volume
+!
+! Updraft volume for W > 5 m/s
+ IF (ZTCT(II,IJ,IK) .LT. -5. .AND. PWT(II,IJ,IK) .GT. 5.) THEN
+ ZVOL_UP5 = ZVOL_UP5 + XDXHATM * XDYHATM * &
+ (PZZ(II,IJ,IK+1) - PZZ(II,IJ,IK-1)) / 2.
+ END IF
+!
+! Updraft volume for W > 10 m/s
+ IF (ZTCT(II,IJ,IK) .LT. -5. .AND. PWT(II,IJ,IK) .GT. 10.) THEN
+ ZVOL_UP10 = ZVOL_UP10 + XDXHATM * XDYHATM * &
+ (PZZ(II,IJ,IK+1) - PZZ(II,IJ,IK-1)) / 2.
+ END IF
+!
+!
+!* 3.6 total ice mass
+!
+ IF (ZTCT(II,IJ,IK) .LT. -10. .AND. ZWORK31(II,IJ,IK) .GT. 18.) THEN
+ ZICE_MASS = ZICE_MASS + (PRT(II,IJ,IK,4) + PRT(II,IJ,IK,5) + PRT(II,IJ,IK,6)) * &
+ PRHODJ(II,IJ,IK)
+ IFLAG(II,IJ) = IFLAG(II,IJ) + 1
+ END IF
+ END DO ! end loop ik
+!
+ IF (IFLAG(II,IJ) .GE. 1) THEN
+ ICOUNT = ICOUNT + 1
+ END IF
+ END DO ! end loop ij
+END DO ! end loop ii
+!
+DEALLOCATE(ZVTS)
+DEALLOCATE(ZVTG)
+!
+!
+!* 3.7 precipitation and non precipitation ice mass flux product
+!
+IF (ZFLUX_G .LT. 0. .AND. ZFLUX_I .GT. 0.) THEN
+ ZFLUX_PROD = ZFLUX_PROD - (ZFLUX_I + ZFLUX_SNP) * (ZFLUX_G + ZFLUX_SP)
+END IF
+!
+! precipitation ice mass flux
+IF ((ZFLUX_G+ZFLUX_SP) .LT. 0.) THEN
+ ZFLUX_PRECIP = ZFLUX_PRECIP - (ZFLUX_G + ZFLUX_SP)
+END IF
+!
+! non-precipitation ice mass flux
+IF ((ZFLUX_I+ZFLUX_SNP) .GT. 0.) THEN
+ ZFLUX_NPRECIP = ZFLUX_NPRECIP + (ZFLUX_I + ZFLUX_SNP)
+END IF
+!
+!
+!* 3.8 compute the precipitation ice mass
+!
+IF ((ZMASS_GP .GT. 0.) .OR. (ZMASS_SP .GT. 0.)) THEN
+ ZMASS_ICE_P = ZMASS_ICE_P + ZMASS_GP + ZMASS_SP
+END IF
+!
+!
+!* 3.9 compute the ice water path
+!
+CALL SUM_ELEC_ll(ZICE_MASS)
+CALL SUM_ELEC_ll(ICOUNT)
+!
+IF (ICOUNT .GT. 0) THEN
+ ZIWP = ZIWP + ZICE_MASS / (REAL(ICOUNT) * XDXHATM * XDYHATM)
+END IF
+!
+!
+!* 3.10 compute the cloud top height
+!
+DO II = IIB, IIE
+ DO IJ = IJB, IJE
+ DO IK = IKB, IKE
+! maximum height of the 20 dBZ echo
+ IF (ZWORK31(II,IJ,IK) .GT. 20. .AND. PZZ(II,IJ,IK) .GT. ZCLD_TOP_REF) THEN
+ ZCLD_TOP_REF = PZZ(II,IJ,IK)
+ END IF
+!
+! maximum height with mixing ratio > 1.e-4
+ IF (ZCLOUD(II,IJ,IK) .GT. 1.E-4 .AND. PZZ(II,IJ,IK) .GT. ZCLD_TOP_REF) THEN
+ ZCLD_TOP_MR = PZZ(II,IJ,IK)
+ END IF
+!
+!
+!* 3.11 compute the cloud volume
+!
+ IF (ZCLOUD(II,IJ,IK) .GT. 1.E-4) THEN
+ ZCLD_VOL = ZCLD_VOL + XDXHATM * XDYHATM * &
+ (PZZ(II,IJ,IK+1) - PZZ(II,IJ,IK-1)) / 2.
+ END IF
+!
+ END DO
+ END DO
+END DO
+!
+DEALLOCATE(ZCLOUD)
+!
+ZCTH_MR = ZCTH_MR + ZCLD_TOP_MR
+ZCTH_REF = ZCTH_REF + ZCLD_TOP_REF
+!
+!
+!* 3.12 compute the instantaneous precipitation rate
+!
+ZMAX_INPRR = ZMAX_INPRR + MAXVAL(PINPRR(IIB:IIE,IJB:IJE))
+ZINPRR = ZINPRR + SUM(PINPRR(IIB:IIE,IJB:IJE))
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. FROM LOCAL TO GLOBAL VARIABLES
+! ------------------------------
+!
+CALL MAX_ELEC_ll (ZCTH_REF, IPROC_MAX)
+CALL MAX_ELEC_ll (ZCTH_MR, IPROC_MAX)
+CALL MAX_ELEC_ll (ZDBZMAX, IPROC_MAX)
+CALL MAX_ELEC_ll (ZMAX_INPRR,IPROC_MAX)
+CALL MAX_ELEC_ll (ZWMAX, IPROC_MAX)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. SAVE THE DATA IN AN ASCII FILE
+! ------------------------------
+!
+CALL MYPROC_ELEC_ll(IPROC)
+!
+IF (JCOUNT == JCOUNT_STOP) THEN
+!
+ ZINPRR = ZINPRR * 3.6E6 ! m/s --> mm/H
+ ZMAX_INPRR = ZMAX_INPRR * 3.6E6 ! m/s --> mm/H
+!
+ CALL REDUCESUM_ll (ZVOL_UP5, IINFO_ll)
+ CALL REDUCESUM_ll (ZVOL_UP10, IINFO_ll)
+ CALL REDUCESUM_ll (ZMASS_C, IINFO_ll)
+ CALL REDUCESUM_ll (ZMASS_R, IINFO_ll)
+ CALL REDUCESUM_ll (ZMASS_I, IINFO_ll)
+ CALL REDUCESUM_ll (ZMASS_S, IINFO_ll)
+ CALL REDUCESUM_ll (ZMASS_G, IINFO_ll)
+ CALL REDUCESUM_ll (ZMASS_ICE_P, IINFO_ll)
+ CALL REDUCESUM_ll (ZFLUX_PROD, IINFO_ll)
+ CALL REDUCESUM_ll (ZFLUX_PRECIP, IINFO_ll)
+ CALL REDUCESUM_ll (ZFLUX_NPRECIP, IINFO_ll)
+ CALL REDUCESUM_ll (ZCLD_VOL, IINFO_ll)
+ CALL REDUCESUM_ll (ZINPRR, IINFO_ll)
+!
+ IF (IPROC == 0) THEN
+ ILU = TPFILE_SERIES_CLOUD_ELEC%NLU
+ WRITE (ILU, FMT='(I6,19(E12.4))') &
+ INT(KTCOUNT*PTSTEP), & ! time
+ ZCTH_REF/REAL(JCOUNT), & ! cloud top height from Z
+ ZCTH_MR/REAL(JCOUNT), & ! cloud top height from m.r.
+ ZDBZMAX/REAL(JCOUNT), & ! maximum radar reflectivity
+ ZWMAX/REAL(JCOUNT), & ! maximum vertical velocity
+ ZVOL_UP5/REAL(JCOUNT), & ! updraft volume for W > 5 m/s
+ ZVOL_UP10/REAL(JCOUNT), & ! updraft volume for W > 10 m/s
+ ZMASS_C/REAL(JCOUNT), & ! cloud droplets mass
+ ZMASS_R/REAL(JCOUNT), & ! rain mass
+ ZMASS_I/REAL(JCOUNT), & ! ice crystal mass
+ ZMASS_S/REAL(JCOUNT), & ! snow mass
+ ZMASS_G/REAL(JCOUNT), & ! graupel mass
+ ZMASS_ICE_P/REAL(JCOUNT), & ! precipitation ice mass
+ ZFLUX_PROD/REAL(JCOUNT), & ! ice mass flux product
+ ZFLUX_PRECIP/REAL(JCOUNT), & ! precipitation ice mass flux
+ ZFLUX_NPRECIP/REAL(JCOUNT), & ! non-precipitation ice mass flux
+ ZIWP/REAL(JCOUNT), & ! ice water path
+ ZCLD_VOL/REAL(JCOUNT), & ! cloud volume
+ ZINPRR/REAL(JCOUNT), & ! Rain instant precip
+ ZMAX_INPRR/REAL(JCOUNT) ! maximum rain instant. precip.
+ FLUSH(UNIT=ILU)
+ END IF
+!
+ JCOUNT = 0
+ ZMASS_C = 0.
+ ZMASS_R = 0.
+ ZMASS_I = 0.
+ ZMASS_S = 0.
+ ZMASS_G = 0.
+ ZMASS_ICE_P = 0.
+ ZFLUX_PROD = 0.
+ ZFLUX_PRECIP = 0.
+ ZFLUX_NPRECIP = 0.
+ ZVOL_UP5 = 0.
+ ZVOL_UP10 = 0.
+ ZWMAX = 0.
+ ZDBZMAX = 0.
+ ZCTH_REF = 0.
+ ZCTH_MR = 0.
+ ZIWP = 0.
+ ZCLD_VOL = 0.
+ ZINPRR = 0.
+ ZMAX_INPRR = 0.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+!
+!-------------------------------------------------------------------------------
+! ##############################################
+ FUNCTION MOMG0D(PALPHA, PNU, PP) RESULT(PMOMG)
+! ##############################################
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, INTENT(IN) :: PP
+REAL :: PMOMG
+!
+!
+PMOMG = GAMMA(PNU+PP/PALPHA) / GAMMA(PNU)
+!
+END FUNCTION MOMG0D
+!
+!-------------------------------------------------------------------------------
+
+!
+END SUBROUTINE SERIES_CLOUD_ELEC
diff --git a/src/PHYEX/ext/set_conc_ice_c1r3.f90 b/src/PHYEX/ext/set_conc_ice_c1r3.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0dfe34119bcd614b71adf0c7c6e3e9d8a8e006b4
--- /dev/null
+++ b/src/PHYEX/ext/set_conc_ice_c1r3.f90
@@ -0,0 +1,129 @@
+!MNH_LIC Copyright 2001-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_SET_CONC_ICE_C1R3
+! #############################
+!
+INTERFACE
+!
+ SUBROUTINE SET_CONC_ICE_C1R3 (PRHODREF,PRT,PSVT)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! microphys. concentrations
+!
+!
+END SUBROUTINE SET_CONC_ICE_C1R3
+!
+END INTERFACE
+!
+END MODULE MODI_SET_CONC_ICE_C1R3
+!
+! ##########################################################
+ SUBROUTINE SET_CONC_ICE_C1R3 (PRHODREF,PRT,PSVT)
+! ##########################################################
+!
+!!**** *SET_CONC_ICE_C1R3 * - initialize the ice crystal
+!! concentration for a RESTArt simulation of the C1R3 scheme
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the pristine ice crystal
+!! concentrations when the cloud ice mixing ratios are only available.
+!! This routine is used to initialize the small ice crystal concentrations
+!! using the r_i of a previous ICE3 run but also to compute the LB tendencies
+!! in ONE_WAY$n in case of grid-nesting when the optional argument PTIME is
+!! set (a C3R5 run embedded in a ICE3 run).
+!!
+!!** METHOD
+!! ------
+!! The method uses the contact nucleation formulation of Meyers as a rough
+!! estimate (a function of the temperature). A limiting value of XCONCI_MAX
+!! is also assumed in the case of very cold temperatures
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_ICE_C1R3_DESCR, ONLY : XRTMIN, XCTMIN
+!! Module MODD_ICE_C1R3_PARAM, ONLY : XCONCI_INI
+!! Module MODD_CONF, ONLY : NVERB
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine SET_CONC_ICE_C1R3 )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/04/01
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XRHOLI
+USE MODD_CONF, ONLY : NVERB
+USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN, XCTMIN
+USE MODD_ICE_C1R3_PARAM, ONLY : XCONCI_MAX, XNUC_CON, XEXTT_CON, XEX_CON
+USE MODD_LUNIT_n, ONLY : TLUOUT
+USE MODD_RAIN_ICE_DESCR_n, ONLY : XAI, XBI
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! microphys. concentrations
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! Logical unit number of output-listing
+!
+!
+!-------------------------------------------------------------------------------
+!* 1. RETRIEVE LOGICAL UNIT NUMBER
+! ----------------------------
+!
+ILUOUT = TLUOUT%NLU
+!
+!* 2. INITIALIZATION
+! --------------
+!
+! Assume the ice crystal concentration according to the
+! contact nucleation formulation of Meyers et al. (1992)
+!
+WHERE ( PRT(:,:,:,4) > XRTMIN(4) )
+ PSVT(:,:,:,4) = MIN( PRHODREF(:,:,:) / &
+ ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
+ XCONCI_MAX )
+ PSVT(:,:,:,5) = 0.0
+END WHERE
+WHERE ( PRT(:,:,:,4) <= XRTMIN(4) )
+ PRT(:,:,:,4) = 0.0
+ PSVT(:,:,:,4) = 0.0
+ PSVT(:,:,:,5) = 0.0
+END WHERE
+IF( NVERB >= 5 ) THEN
+ WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The cloud ice concentration has "
+ WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised to a value of 1 per liter"
+END IF
+!
+END SUBROUTINE SET_CONC_ICE_C1R3
diff --git a/src/PHYEX/ext/set_msk.f90 b/src/PHYEX/ext/set_msk.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ba4da88bfda2972c8bff2174907cb9e2d884710a
--- /dev/null
+++ b/src/PHYEX/ext/set_msk.f90
@@ -0,0 +1,286 @@
+!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.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_SET_MSK
+!####################
+!
+INTERFACE
+!
+SUBROUTINE SET_MSK(PRT,PRHODREF,OBU_MSK)
+!
+REAL , DIMENSION (:,:,:,:),INTENT(IN) :: PRT
+REAL , DIMENSION (:,:,:),INTENT(IN) :: PRHODREF
+LOGICAL , DIMENSION (:,:,:),INTENT(OUT) :: OBU_MSK
+!
+END SUBROUTINE SET_MSK
+!
+END INTERFACE
+!
+END MODULE MODI_SET_MSK
+!
+! ######spl
+ SUBROUTINE SET_MSK(PRT,PRHODREF,OBU_MSK)
+! ###############################
+!
+!!****SET_MSK** -routine to define the mask based on SET_MASK
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to test the occurence or not of the
+! different criteria, used to compute the budgets. It also updates the
+! number of occurence of the different criteria.
+!
+!!** METHOD
+!! ------
+!! According to each criterion associated to one zone, the mask is
+!! set to TRUE at each point where the criterion is confirmed, at each
+!! time step of the model.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of MESO-NH documentation (routine BUDGET)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J. Nicolau * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/02/95
+!! T.Montmerle 15/07/96 Computation of masks for convective and stratiform parts
+!! Biju Thomas 29/03/99 Identified nonprecipitating convective cells and only
+!! precipitating anvils as stratiform part
+!! O. Caumont 09/04/08 Use in RADAR_SIMULATOR
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_FIELD_n
+USE MODD_RAIN_ICE_PARAM_n , ONLY : XFSEDR,XEXSEDR
+USE MODD_RAIN_ICE_DESCR_n , ONLY : XCEXVT
+USE MODD_CST , ONLY : XRHOLW
+USE MODD_PARAMETERS
+USE MODD_CONF
+USE MODE_ll
+USE MODD_LUNIT, ONLY : TLUOUT0
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of arguments :
+!
+REAL , DIMENSION (:,:,:,:),INTENT(IN) :: PRT
+REAL , DIMENSION (:,:,:),INTENT(IN) :: PRHODREF
+LOGICAL , DIMENSION (:,:,:),INTENT(OUT) :: OBU_MSK
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Lower bounds and Upper bounds
+INTEGER :: IIE,IJE ! of the physical sub-domain
+INTEGER :: IKB,IKE ! in x, y and z directions
+INTEGER :: IIU,IJU!,IKU
+!
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZMASK ! signature de l'insertion
+ ! dans un masque (0 ou 1.)
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZCONVECT ! signature du domaine convectif
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZSURFPP ! precipitation au sol
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZMAXWATER ! teneur maximale en eau
+ ! recensee sur la verticale
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZMIMX,ZMIPX ! I,I+1 and I,I-1 precipitation sums
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZMEANX_MY,ZMEANX_PY ! J,J+1 and J,J-1 precipitation sums
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZMEANX, ZMEANXY
+REAL :: ZAVER_PR,ZREPSILON,ZTOTWATER,ZREPSILON1
+REAL :: ZCRS,ZCEXRS,ZCEXVT,ZREPSILON2,ZREPSILON3
+INTEGER :: I,J,JILOOP,JJLOOP,JKLOOP
+INTEGER :: ILUOUT0
+INTEGER :: IRESP
+INTEGER :: IBUIL,IBUJL,IBUIH,IBUJH
+!INTEGER :: IBUSIL,IBUSJL,IBUSIH,IBUSJH
+!INTEGER :: IINFO_ll ! return code of parallel routine
+!TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+!-------------------------------------------------------------------------------
+!
+ILUOUT0 = TLUOUT0%NLU
+!
+!* 1. COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
+! ---------------------------------------
+!
+IKB = 1 + JPVEXT
+IKE = SIZE(PRT,3) - JPVEXT
+IIU = SIZE(PRT,1)
+IJU = SIZE(PRT,2)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+! ----------------------
+ALLOCATE( ZMASK(IIU,IJU,4) )
+ALLOCATE( ZSURFPP(IIU,IJU) )
+ALLOCATE(ZMIMX(IIU,IJU),ZMIPX(IIU,IJU),ZMEANX(IIU,IJU))
+ALLOCATE(ZMEANX_MY(IIU,IJU),ZMEANX_PY(IIU,IJU),ZMEANXY(IIU,IJU))
+ALLOCATE( ZCONVECT(IIU,IJU) )
+ALLOCATE( ZMAXWATER(IIU,IJU) )
+!
+!* 2. DEFINITION OF THE MASK
+! ----------------------
+! initialization to FALSE on the extended subdomain
+OBU_MSK(:,:,:)=.FALSE.
+ZMASK(:,:,:)=0.
+ZSURFPP(:,:)=0.
+ZCONVECT(:,:)=0.
+ZMAXWATER(:,:)=0.
+ZREPSILON=5.E-6
+ZREPSILON1=5.E-4
+ZREPSILON2=5.0
+ZREPSILON3=5.E-6
+ZAVER_PR=0.
+
+!**********************************************************************
+! CAUTION: Definition of parameters
+! depends on the model configuration WARM or COLD
+! -----------------------------------------------
+
+!**********************************************************************
+!partie a activer pour le cas chaud, en activant USE MODD_CLOUDPAR et en
+!desactivant USE MODD_RAIN_ICE_PARAM et USE MODD_RAIN_ICE_DESCR qui servent
+!au cas froid. En activant tout, XCEXVT est defini deux fois, donc une fois
+!de trop.
+!**********************************************************************
+!IF (CCLOUD == 'REVE' .OR. CCLOUD == 'KESS' .OR. CCLOUD == 'KES2') THEN
+! ZCRS=XCRS
+! ZCEXRS=XCEXRS
+! ZCEXVT=XCEXVT
+!ELSE IF (CCLOUD == 'ICE3') THEN
+!**********************************************************************
+
+ ZCRS=XFSEDR
+ ZCEXRS=XEXSEDR
+ ZCEXVT=XCEXVT
+!END IF
+
+! Total solid and liquid water (qr+qc+qs+qi+qg) (= cloudy area)
+! -------------------------------------------------------------
+
+DO JKLOOP=IKB,IKE
+ DO JJLOOP=IJB,IJE
+ DO JILOOP=IIB,IIE
+ ZTOTWATER = PRT(JILOOP,JJLOOP,JKLOOP,2) &
+ +PRT(JILOOP,JJLOOP,JKLOOP,3) &
+ +PRT(JILOOP,JJLOOP,JKLOOP,4) &
+ +PRT(JILOOP,JJLOOP,JKLOOP,5) &
+ +PRT(JILOOP,JJLOOP,JKLOOP,6)
+ ZMAXWATER(JILOOP,JJLOOP)=MAX(ZMAXWATER(JILOOP,JJLOOP),ZTOTWATER)
+ END DO
+ END DO
+END DO
+
+! Computation of ground precipitation
+! -----------------------------------
+
+! Precipitation (mm/h)
+ZSURFPP(IIB:IIE,IJB:IJE)=ZCRS*PRT(IIB:IIE,IJB:IJE,IKB,3)**ZCEXRS &
+ *PRHODREF(IIB:IIE,IJB:IJE,IKB)**(ZCEXRS-ZCEXVT)*3.6E6/XRHOLW
+
+! Lateral Boundaries for Precipitation
+! (cyclic case in Y-direction, OPEN in X-direction)
+ ZSURFPP(1,IJB:IJE)=ZSURFPP(IIB,IJB:IJE)
+ ZSURFPP(IIU,IJB:IJE)=ZSURFPP(IIE,IJB:IJE)
+ ZSURFPP(1:IIU,1)=ZSURFPP(1:IIU,IJB)
+ ZSURFPP(1:IIU,IJU)=ZSURFPP(1:IIU,IJE)
+
+!
+! Predefinition of the Convective region criteria
+! ------------------------------------------------
+ZMIPX(:,:)=0.
+ZMIMX(:,:)=0.
+ZMEANX(:,:)=0.
+!
+ZMIPX(1:IIU-1,:)=ZSURFPP(1:IIU-1,:)+ZSURFPP(2:IIU,:)
+ZMIMX(2:IIU,:)=ZSURFPP(2:IIU,:)+ZSURFPP(1:IIU-1,:)
+
+DO J=IJB+1,IJE-1
+ DO I=3,IIE-1
+ ZAVER_PR=(SUM(ZSURFPP(I-2:I+2,J-2:J+2))-ZSURFPP(I,J))/24.
+
+! threshold at 4 mm/h
+ IF(ZSURFPP(I,J) >= MAX(4.,2.*ZAVER_PR) &
+ .AND.(ZMAXWATER(I,J) >= ZREPSILON)) ZCONVECT(I-1:I+1,J-1:J+1)=1.
+ IF(ZSURFPP(I,J) >= 20.) ZCONVECT(I,J)=1.
+ IF(ZMAXWATER(I,J) >= ZREPSILON)THEN
+ DO JKLOOP=2,IKE
+ IF(PRT(I,J,JKLOOP,2) >= ZREPSILON1) ZCONVECT(I,J)=1.
+ IF(XWT(I,J,JKLOOP) >= ZREPSILON2) ZCONVECT(I,J)=1.
+ END DO
+ END IF
+ END DO
+END DO
+
+!------------------------------------------
+!* MASK Definition
+!------------------------------------------
+IBUIL=IIB+1
+IBUIH = IIE-1
+IBUJL = IJB+1
+IBUJH = IJE-1
+DO JILOOP=IBUIL,IBUIH
+ DO JJLOOP=IBUJL,IBUJH
+!------------------------------------------
+!* Zone 1: Convective Zone
+!------------------------------------------
+ ZMASK(JILOOP,JJLOOP,1)=ZCONVECT(JILOOP,JJLOOP)
+!------------------------------------------
+!* Zone 2: Stratiforme Zone
+!------------------------------------------
+ IF (ZMAXWATER(JILOOP,JJLOOP) >= 10.*ZREPSILON.AND.ZMASK(JILOOP,JJLOOP,1)/=1.) THEN
+ DO JKLOOP=IKB,IKE
+ IF(PRT(JILOOP,JJLOOP,JKLOOP,3) >= ZREPSILON3) ZMASK(JILOOP,JJLOOP,2)=1.
+ END DO
+ END IF
+!------------------------------------------
+!* Zone 3: Clear air Zone
+!------------------------------------------
+ IF (ZMASK(JILOOP,JJLOOP,1)/=1. .AND. ZMASK(JILOOP,JJLOOP,2)/=1.) ZMASK(JILOOP,JJLOOP,3)=1.
+!------------------------------------------
+!* Zone 4: Total Domain
+!------------------------------------------
+ ZMASK(JILOOP,JJLOOP,4)=1.
+
+ END DO
+END DO
+!
+!-----------------------------------------------------------------------
+!
+
+OBU_MSK(IIB:IIE,IJB:IJE,:)=ZMASK(IIB:IIE,IJB:IJE,:)>0.8
+
+
+!
+!* 2. INCREASE IN SURFACE ARRAY
+! -------------------------
+!
+DEALLOCATE( ZMASK )
+DEALLOCATE( ZCONVECT )
+DEALLOCATE( ZSURFPP )
+DEALLOCATE( ZMAXWATER )
+DEALLOCATE(ZMIMX,ZMIPX,ZMEANX)
+DEALLOCATE(ZMEANX_MY,ZMEANX_PY,ZMEANXY)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE SET_MSK
diff --git a/src/PHYEX/ext/set_rsou.f90 b/src/PHYEX/ext/set_rsou.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6c2ea6b2f9203cc2eca4d01697a0975155c40f95
--- /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_n, ONLY: NEBN
+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,NEBN,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..1f76d9759fc4562c5ae5835d9bb994c750ea5f3a
--- /dev/null
+++ b/src/PHYEX/ext/shallow_mf_pack.f90
@@ -0,0 +1,381 @@
+!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, &
+ TPFILE,PTIME_LES, &
+ 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.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+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, &
+ TPFILE,PTIME_LES, &
+ 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_n, ONLY: NEBN
+USE MODD_TURB_n, ONLY: TURBN
+USE MODD_CTURB, ONLY: CSTURB
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN, LMF_FLX
+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: tfieldmetadata, TYPEREAL
+USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
+USE MODD_PARAMETERS
+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.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+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(TFIELDMETADATA) :: 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, NEBN, PARAM_MFSHALLN, TURBN, CSTURB,&
+ KRR,KRRL,KRRI,ISV, &
+ LNOMIXLG,NSV_LGBEG,NSV_LGEND, &
+ 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 ( LMF_FLX .AND. tpfile%lopened ) THEN
+ ! stores the conservative potential temperature vertical flux
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MF_THW_FLX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MF_THW_FLX', &
+ CUNITS = 'K m s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MF_THW_FLX', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZTHMF)
+ !
+ ! stores the conservative mixing ratio vertical flux
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MF_RCONSW_FLX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MF_RCONSW_FLX', &
+ CUNITS = 'K m s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MF_RCONSW_FLX', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZRMF)
+ !
+ ! stores the theta_v vertical flux
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MF_THVW_FLX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MF_THVW_FLX', &
+ CUNITS = 'K m s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MF_THVW_FLX', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,PFLXZTHVMF)
+ !
+ IF (PARAM_MFSHALLN%LMIXUV) THEN
+ ! stores the U momentum vertical flux
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MF_UW_FLX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MF_UW_FLX', &
+ CUNITS = 'm2 s-2', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MF_UW_FLX', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZUMF)
+ !
+ ! stores the V momentum vertical flux
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MF_VW_FLX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MF_VW_FLX', &
+ CUNITS = 'm2 s-2', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MF_VW_FLX', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ 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/spawn_model2.f90 b/src/PHYEX/ext/spawn_model2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3511cd27f32930b19e51dac080c7feeb5469d991
--- /dev/null
+++ b/src/PHYEX/ext/spawn_model2.f90
@@ -0,0 +1,1696 @@
+!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_SPAWN_MODEL2
+!########################
+!
+INTERFACE
+!
+ SUBROUTINE SPAWN_MODEL2 (KRR,KSV_USER,HTURB,HSURF,HCLOUD, &
+ HCHEM_INPUT_FILE,HSPAFILE,HSPANBR, &
+ HSONFILE,HINIFILE,HINIFILEPGD,OSPAWN_SURF )
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV_USER ! Number of Users Scalar Variables
+CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HSURF ! Kind of surface parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
+ ! model 2 physical domain
+CHARACTER (LEN=*), INTENT(IN) :: HSPAFILE ! possible name of the output FM-file
+CHARACTER (LEN=*), INTENT(IN) :: HSPANBR ! NumBeR associated to the SPAwned file
+CHARACTER (LEN=*), INTENT(IN) :: HSONFILE ! name of the input FM-file SON
+CHARACTER (LEN=80), INTENT(IN) :: HCHEM_INPUT_FILE
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Input file
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! Input pgd file
+LOGICAL, INTENT(IN) :: OSPAWN_SURF ! flag to spawn surface fields
+!
+END SUBROUTINE SPAWN_MODEL2
+!
+END INTERFACE
+!
+END MODULE MODI_SPAWN_MODEL2
+! ######spl
+ SUBROUTINE SPAWN_MODEL2 (KRR,KSV_USER,HTURB,HSURF,HCLOUD, &
+ HCHEM_INPUT_FILE,HSPAFILE,HSPANBR, &
+ HSONFILE,HINIFILE,HINIFILEPGD,OSPAWN_SURF )
+! #######################################################################
+!
+!!**** *SPAWN_MODEL2 * - subroutine to prepare by horizontal interpolation and
+!! write an initial FM-file spawned from an other FM-file.
+!!
+!! PURPOSE
+!! -------
+!!
+!! Initializes by horizontal interpolation, the model 2 in a sub-domain of
+!! model 1, possibly overwrites model 2 information by model SON1,
+!! and writes the resulting fields in a FM-file.
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! In this routine, only the model 2 variables are known through the
+!! MODD_... calls.
+!!
+!! The directives to perform the preparation of the initial FM
+!! file are stored in EXSPA.nam file.
+!!
+!! The following SPAWN_MODEL2 routine :
+!!
+!! - sets default values of DESFM files
+!! - reads the namelists part of EXSPA file which gives the
+!! directives concerning the spawning to perform
+!! - controls the domain size of model 2 and initializes its
+!! configuration for parameterizations and LBC
+!! - allocates memory for arrays
+!! - computes the interpolation coefficients needed to spawn model 2
+!! 2 types of interpolations are used:
+!! 1. Clark and Farley (JAS 1984) on 9 points
+!! 2. Bikhardt on 16 points
+!! - initializes fields
+!! - reads SON1 fields and overwrites on common domain
+!! - writes the DESFM file (variables written have been initialized
+!! by reading the DESFM file concerning the model 1)
+!! - writes the LFIFM file.
+!!
+!! Finally some control prints are performed on the output listing.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! 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_REF : to compute rhoJ
+!! TOTAL_DMASS : to compute the total mass of dry air
+!! ANEL_BALANCE2 : to apply an anelastic correction in the case of changing
+!! resolution between the two models
+!! IO_File_open : to open a FM-file (DESFM + LFIFM)
+!! WRITE_DESFM : to write the DESFM file
+!! WRITE_LFIFM : to write the LFIFM file
+!! IO_File_close : to close a FM-file (DESFM + LFIFM)
+!! INI_BIKHARDT2 : initializes Bikhardt coefficients
+!!
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_PARAMETERS : contains parameters
+!! Module MODD_CONF : contains configuration variables for all models
+!! Module MODD_CTURB :
+!! XTKEMIN : mimimum value for the TKE
+!! Module MODD_GRID : contains grid variables for all models
+!! Module USE MODD_DYN : contains configuration for the dynamics
+!! Module MODD_REF : contains reference state variables for
+!! all models
+!!
+!! Module MODD_DIM2 : contains dimensions
+!! Module MODD_CONF2 : contains configuration variables
+!! Module MODD_GRID2 : contains grid variables
+!! Module MODD_TIME2 : contains time variables and uses MODD_TIME
+!! Module MODD_REF2 : contains reference state variables
+!! Module MODD_FIELD2 : contains prognostic variables
+!! Module MODD_LSFIELD2 : contains Larger Scale fields
+!! Module MODD_GR_FIELD2 : contains surface fields
+!! Module MODD_DYN2 : contains dynamic control variables for model 2
+!! Module MODD_LBC2 : contains lbc control variables for model 2
+!! Module MODD_PARAM2 : contains configuration for physical parameterizations
+!!
+!! REFERENCE
+!! ---------
+!!
+!! PROGRAM SPAWN_MODEL2 (Book2 of the documentation)
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!! J.P. Lafore * METEO-FRANCE *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 11/01/95
+!! Modification 27/04/95 (I.Mallet) remove R from the historical variables
+!! Modification 16/04/96 (Lafore) Different resolution ratio case introduction
+!! Modification 24/04/96 (Lafore & Masson) Initialization of LUSERWs
+!! Modification 24/04/96 (Masson) Correction of positivity on Rw and TKE
+!! Modification 25/04/96 (Masson) Copies of internal zs on external points
+!! Modification 02/05/96 (Stein Jabouille) initialize CCONF
+!! Modification 31/05/96 (Lafore) Cumputing time analysis
+!! Modification 10/06/96 (Masson) Call to anel_balance in all cases
+!! Modification 10/06/96 (Masson) Bikhardt and Clark_and_Farley coefficients
+!! incorporated in modules
+!! Modification 12/06/96 (Masson) default values of NJMAX and KDYRATIO
+!! if 2D version of the model
+!! Modification 13/06/96 (Masson) choice of the name of the spawned file
+!! Modification 30/07/96 (Lafore) MY_NAME and DAD_NAME writing for nesting
+!! Modification 25/09/96 (Masson) grid optionnaly given by a fm file
+!! and number of points given relatively
+!! to model 1
+!! Modification 10/10/96 (Masson) L1D and L2D verifications
+!! Modification 12/11/96 (Masson) allocations of XSRCM and XSRCT
+!! Modification 19/11/96 (Masson) add deep convection
+!! Modification 26/11/96 (Lafore) spawning configuration writing on the FM-file
+!! Modification 26/11/96 (Lafore) replacing of TOTAL_DMASS by REAL_DMASS
+!! Modification 27/02/97 (Lafore) "surfacic" LS fields
+!! Modification 10/04/97 (Lafore) proper treatment of minima
+!! Modification 09/07/97 (Masson) absolute pressure and directional z0
+!! Modification 10/07/97 (Masson) routines SPAWN_PRESSURE2 and DRY_MASS
+!! Modification 17/07/97 (Masson) vertical interpolations and EPS
+!! Modification 29/07/97 (Masson) split mode_lfifm_pgd
+!! Modification 10/08/97 (Lafore) initialization of LUSERV
+!! Modification 14/09/97 (Masson) use of relative humidity
+!! Modification 08/12/97 (Masson) deallocation of model 1 variables
+!! Modification 24/12/97 (Masson) directional z0 parameters and orographies
+!! Modification 20/07/98 (Stein ) add the LB fields
+!! Modification 15/03/99 (Masson) cover types
+!! Modification 15/07/99 (Jabouille) shift domain initialization in INI_SIZE_SPAWN
+!! Modification 04/01/00 (Masson) removes TSZ0 option
+!! Modification 29/11/02 (Pinty) add C3R5, ICE2, ICE4
+!! Modification 07/07/05 (D.Barbary) spawn with 2 input files (father+son1)
+!! Modification 20/05/06 Remove EPS, Clark and Farley interpolation
+!! Replace DRY_MASS by TOTAL_DMASS
+!! Modification 06/12 (M.Tomasini) Interpolation of the advective forcing (ADVFRC)
+!! and of the turbulent fluxes (EDDY_FLUX)
+!! Modification 07/13 (Bosseur & Filippi) Adds Forefire
+!! 24/04/2014 (J.escobar) bypass CRAY internal compiler error on IIJ computation
+!! Modification 06/2014 (C.Lac) Initialization of physical param of
+!! model2 before the call to ini_nsv
+!! Modification 05/02/2015 (M.Moge) parallelization of SPAWNING
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar 02/05/2016 : test ZZS_MAX in //
+!! P.Wautelet 08/07/2016 : removed MNH_NCWRIT define
+!! J.Escobar 12/07/2016 : add test on NRIMY & change the one on NRIMX with >=
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 10/2016 (C.Lac) Add droplet deposition
+!! 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
+! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 22/02/2019: replace Hollerith edit descriptor (deleted from Fortran 95 standard)
+! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 24/03/2021: bugfix: allocate XLSRVM, XINPAP and XACPAP to zero size when not needed
+!! 03/2021 (JL Redelsperger) Ocean model case
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS ! Declarative modules
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_GRID
+USE MODD_REF
+USE MODD_DYN
+USE MODD_NESTING
+USE MODD_SPAWN
+USE MODD_NSV
+USE MODD_PASPOL
+!
+USE MODD_DIM_n
+USE MODD_DYN_n
+USE MODD_CONF_n
+USE MODD_LBC_n
+USE MODD_GRID_n
+USE MODD_TIME_n
+USE MODD_REF_n
+USE MODD_FIELD_n
+USE MODD_LSFIELD_n
+USE MODD_DUMMY_GR_FIELD_n
+USE MODD_PRECIP_n
+USE MODD_ELEC_n
+USE MODD_LUNIT_n
+USE MODD_PARAM_n
+USE MODD_TURB_n
+USE MODD_METRICS_n
+USE MODD_CH_MNHC_n
+USE MODD_PASPOL_n
+!$20140515
+USE MODD_VAR_ll, ONLY : NPROC
+USE MODD_IO, ONLY: TFILEDATA,TFILE_DUMMY,TFILE_SURFEX
+use modd_precision, only: MNHREAL_MPI
+!
+USE MODE_GRIDCART ! Executive modules
+USE MODE_GRIDPROJ
+USE MODE_ll
+USE MODE_MSG
+!
+USE MODI_READ_HGRID
+USE MODI_SPAWN_GRID2
+USE MODI_SPAWN_FIELD2
+USE MODI_SPAWN_SURF
+USE MODI_VER_INTERP_FIELD
+USE MODI_SPAWN_PRESSURE2
+USE MODI_SPAWN_SURF2_RAIN
+USE MODI_SET_REF
+USE MODI_TOTAL_DMASS
+USE MODI_ANEL_BALANCE_n
+USE MODI_WRITE_DESFM_n
+USE MODI_WRITE_LFIFM_n
+USE MODI_METRICS
+USE MODI_INI_BIKHARDT_n
+USE MODI_DEALLOCATE_MODEL1
+USE MODI_BOUNDARIES
+USE MODI_INI_NSV
+!$20140710
+USE MODI_UPDATE_METRICS
+!
+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
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+!
+USE MODE_THERMO
+!
+USE MODI_SECOND_MNH
+!
+! Modules for EDDY_FLUX
+USE MODD_LATZ_EDFLX
+USE MODD_DEF_EDDY_FLUX_n
+USE MODD_DEF_EDDYUV_FLUX_n
+USE MODD_ADVFRC_n
+USE MODD_RELFRC_n
+USE MODD_2D_FRC
+!
+!USE MODE_LB_ll, ONLY : SET_LB_FIELD_ll
+USE MODI_GET_SIZEX_LB
+USE MODI_GET_SIZEY_LB
+!
+USE MODD_LIMA_PRECIP_SCAVENGING_n
+USE MODD_PARAM_LIMA, ONLY : MDEPOC=>LDEPOC, LSCAV
+USE MODD_PARAM_ICE_n, ONLY : LDEPOSC
+USE MODD_PARAM_C2R2, ONLY : LDEPOC
+USE MODD_PASPOL, ONLY : LPASPOL
+!
+USE MODD_MPIF
+USE MODD_VAR_ll
+use modd_precision, only: LFIINT
+!
+IMPLICIT NONE
+!
+!* 0.1.1 Declarations of global variables not declared in the modules :
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ ! Jacobian
+!
+!
+!* 0.1.2 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV_USER ! Number of Users Scalar Variables
+CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HSURF ! Kind of surface parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
+CHARACTER (LEN=*), INTENT(IN) :: HSPAFILE ! possible name of the output FM-file
+CHARACTER (LEN=*), INTENT(IN) :: HSPANBR ! NumBeR associated to the SPAwned file
+CHARACTER (LEN=*), INTENT(IN) :: HSONFILE ! name of the input FM-file SON
+CHARACTER (LEN=80), INTENT(IN) :: HCHEM_INPUT_FILE
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Input file
+CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! Input pgd file
+LOGICAL, INTENT(IN) :: OSPAWN_SURF ! flag to spawn surface fields
+!
+!* 0.1.3 Declarations of local variables :
+!
+!
+INTEGER :: ILUOUT ! Logical unit number for the output listing
+INTEGER(KIND=LFIINT) :: INPRAR ! Number of articles predicted in the LFIFM file
+!
+!
+INTEGER :: IIU ! Upper dimension in x direction
+INTEGER :: IJU ! Upper dimension in y direction
+INTEGER :: IKU ! Upper dimension in z direction
+INTEGER :: IIB ! indice I Beginning in x direction
+INTEGER :: IJB ! indice J Beginning in y direction
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IIE ! indice I End in x direction
+INTEGER :: IJE ! indice J End in y direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: JLOOP,JKLOOP ! Loop indexes
+INTEGER :: JSV ! loop index for scalar variables
+INTEGER :: JRR ! loop index for moist variables
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS_LS ! large scale interpolated zs
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZSMT_LS ! large scale interpolated smooth zs
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZZ_LS ! large scale interpolated z
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHVT ! virtual potential temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZHUT ! relative humidity
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSUMRT ! sum of water ratios
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHOD ! dry density
+!
+REAL :: ZTIME1,ZTIME2,ZSTART,ZEND,ZTOT,ZALL,ZPERCALL ! for computing time analysis
+REAL :: ZGRID2, ZSURF2, ZFIELD2, ZVER, &
+ ZPRESSURE2, ZANEL, ZWRITE, ZMISC
+REAL :: ZPERCGRID2,ZPERCSURF2,ZPERCFIELD2, ZPERCVER, &
+ ZPERCPRESSURE2, ZPERCANEL, ZPERCWRITE,ZPERCMISC
+!
+INTEGER, DIMENSION(2) :: IIJ
+INTEGER :: IK4000
+INTEGER :: IMI ! Old Model index
+!
+! Spawning variables for the SON 1 (input one)
+INTEGER :: IIMAXSON,IJMAXSON ! physical dimensions
+INTEGER :: IIUSON,IJUSON ! upper dimensions
+INTEGER :: IXSIZESON,IYSIZESON ! sizes according to model1 grid
+INTEGER :: IDXRATIOSON,IDYRATIOSON ! x and y-resolution ratios
+INTEGER :: IXORSON,IYORSON ! horizontal position
+INTEGER :: IXENDSON,IYENDSON !in x and y directions
+! Common indexes for the SON 2 (output one, model2)
+INTEGER :: IIB2 ! indice I Beginning in x direction
+INTEGER :: IJB2 ! indice J Beginning in y direction
+INTEGER :: IIE2 ! indice I End in x direction
+INTEGER :: IJE2 ! indice J End in y direction
+! Common indexes for the SON 1 (input one)
+INTEGER :: IIB1 ! indice I Beginning in x direction
+INTEGER :: IJB1 ! indice J Beginning in y direction
+INTEGER :: IIE1 ! indice I End in x direction
+INTEGER :: IJE1 ! indice J End in y direction
+! Logical for no common domain between the 2 sons or no input son
+LOGICAL :: GNOSON = .TRUE.
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D ! working array
+CHARACTER(LEN=28) :: YDAD_SON
+!$
+INTEGER :: IINFO_ll
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
+INTEGER :: NXOR_TMP, NYOR_TMP, NXEND_TMP, NYEND_TMP
+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
+!
+CHARACTER(LEN=4) :: YLBTYPE
+!
+INTEGER,DIMENSION(:,:),ALLOCATABLE :: IJCOUNT
+!
+REAL :: ZZS_MAX, ZZS_MAX_ll
+!
+TYPE(TFILEDATA),POINTER :: TZFILE => NULL()
+TYPE(TFILEDATA),POINTER :: TZSONFILE => NULL()
+!-------------------------------------------------------------------------------
+!
+! Save model index and switch to model 2 variables
+IMI = GET_CURRENT_MODEL_INDEX()
+CALL GOTO_MODEL(2)
+CSTORAGE_TYPE='TT'
+!
+ILUOUT=TLUOUT%NLU
+!
+!* 1. INITIALIZATIONS :
+! ---------------
+!
+!* 1.1 time analysis :
+! -------------
+!
+ZTIME1 = 0
+ZTIME2 = 0
+ZSTART = 0
+ZEND = 0
+ZGRID2 = 0
+ZSURF2 = 0
+ZFIELD2= 0
+ZANEL = 0
+ZWRITE = 0
+ZPERCGRID2 = 0
+ZPERCSURF2 = 0
+ZPERCFIELD2= 0
+ZPERCANEL = 0
+ZPERCWRITE = 0
+!
+CALL SECOND_MNH(ZSTART)
+!
+ZTIME1 = ZSTART
+!
+!* 1.2 deallocates not used model 1 variables :
+! --------------------------------------
+!
+CALL DEALLOCATE_MODEL1(1)
+CALL DEALLOCATE_MODEL1(2)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. PROLOGUE:
+! --------
+!
+!* 3.1 Compute dimensions of model 2 and other indices
+!
+NIMAX_ll = NXSIZE * NDXRATIO
+NJMAX_ll = NYSIZE * NDYRATIO
+!
+IF (NIMAX_ll==1 .AND. NJMAX_ll==1) THEN
+ L1D=.TRUE.
+ L2D=.FALSE.
+ELSE IF (NJMAX_ll==1) THEN
+ L1D=.FALSE.
+ L2D=.TRUE.
+ELSE
+ L1D=.FALSE.
+ L2D=.FALSE.
+END IF
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+NIMAX = IIE-IIB+1
+NJMAX = IJE-IJB+1
+!$
+IKU = SIZE(XTHVREFZ,1)
+NKMAX = IKU - 2*JPVEXT ! initialization of NKMAX (MODD_DIM2)
+!
+IKB = 1 + JPVEXT
+IKE = IKU - JPVEXT
+!
+!
+!* 3.2 Position of model 2 domain relative to model 1 and controls
+!
+!$20140506 the condition on NXSIZE*NXRATIO ==IIE-IIB+1 only works for monoproc
+!$then cancel it
+!IF ( (NXSIZE*NDXRATIO) /= (IIE-IIB+1) ) THEN
+! WRITE(ILUOUT,*) 'SPAWN_MODEL2: MODEL 2 DOMAIN X-SIZE INCOHERENT WITH THE', &
+! ' MODEL1 MESH ',' IIB = ',IIB,' IIE = ', IIE ,'NDXRATIO = ',NDXRATIO
+! !callabortstop
+! CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','')
+!END IF
+!$
+!$20140506 the condition on NXSIZE*NXRATIO ==IIE-IIB+1 only works for monoproc
+!$then cancel it
+!IF ( (NYSIZE*NDYRATIO) /= (IJE-IJB+1) ) THEN
+! WRITE(ILUOUT,*) 'SPAWN_MODEL2: MODEL 2 DOMAIN Y-SIZE INCOHERENT WITH THE', &
+! ' MODEL1 MESH ',' IJB = ',IJB,' IJE = ', IJE ,'NDYRATIO = ',NDYRATIO
+! !callabortstop
+! CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','')
+!END IF
+!$
+!
+!* 3.3 Treatement of a SON 1 model (input)
+!
+IF (LEN_TRIM(HSONFILE) /= 0 ) THEN
+!
+! 3.3.1 Opening the son input file and reading the grid
+!
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: spawning with a SON input file :',TRIM(HSONFILE)
+ CALL IO_File_add2list(TZSONFILE,TRIM(HSONFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TZSONFILE)
+ CALL IO_Field_read(TZSONFILE,'DAD_NAME',YDAD_SON)
+ CALL IO_Field_read(TZSONFILE,'IMAX', IIMAXSON)
+ CALL IO_Field_read(TZSONFILE,'JMAX', IJMAXSON)
+ CALL IO_Field_read(TZSONFILE,'XOR', IXORSON)
+ CALL IO_Field_read(TZSONFILE,'YOR', IYORSON)
+ CALL IO_Field_read(TZSONFILE,'DXRATIO', IDXRATIOSON)
+ CALL IO_Field_read(TZSONFILE,'DYRATIO', IDYRATIOSON)
+ !
+ IF (ADJUSTL(ADJUSTR(YDAD_SON)).NE.ADJUSTL(ADJUSTR(CMY_NAME(1)))) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: DAD of SON file is different from the one of model2'
+ WRITE(ILUOUT,*) ' DAD of SON = ',TRIM(YDAD_SON),' DAD of model2 = ',TRIM(CMY_NAME(1))
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','DAD of SON file is different from the one of model2')
+ END IF
+ IF ( IDXRATIOSON /= NDXRATIO ) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: RATIOX of input SON file is different from the one of model2' ,&
+ ' RATIOX SON = ',IDXRATIOSON,' RATIOX model2 = ',NDXRATIO
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','RATIOX of input SON file is different from the one of model2')
+ END IF
+ IF ( IDYRATIOSON /= NDYRATIO ) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: RATIOY of input SON file is different from the one of model2' ,&
+ ' RATIOY SON = ',IDYRATIOSON,' RATIOY model2 = ',NDYRATIO
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','RATIOY of input SON file is different from the one of model2')
+ END IF
+ !
+ IIUSON=IIMAXSON+2*JPHEXT
+ IJUSON=IJMAXSON+2*JPHEXT
+!
+! 3.3.2 Correspondance of indexes between the input SON and model2
+!
+ IXSIZESON = IIMAXSON/IDXRATIOSON
+ IYSIZESON = IJMAXSON/IDYRATIOSON
+ IXENDSON = IXORSON+IXSIZESON
+ IYENDSON = IYORSON+IYSIZESON
+! Is a common domain between the input SON and the output son (model2)?
+ IF( ( MIN(NXEND-1,IXENDSON)-MAX(NXOR,IXORSON) > 0 ) .OR. &
+ ( MIN(NYEND-1,IYENDSON)-MAX(NYOR,IYORSON) > 0 ) ) THEN
+ GNOSON=.FALSE.
+ ! Common domain for the model2 (output son) indexes
+ IIB2 = (MAX(NXOR,IXORSON)-NXOR)*NDXRATIO+1+JPHEXT
+ IJB2 = (MAX(NYOR,IYORSON)-NYOR)*NDYRATIO+1+JPHEXT
+ IIE2 = (MIN(NXEND-1,IXENDSON)-NXOR)*NDXRATIO+JPHEXT
+ IJE2 = (MIN(NYEND-1,IYENDSON)-NYOR)*NDYRATIO+JPHEXT
+ ! Common domain for the SON 1 (input one) indexes
+ IIB1 = (MAX(NXOR,IXORSON)-IXORSON)*NDXRATIO+1+JPHEXT
+ IJB1 = (MAX(NYOR,IYORSON)-IYORSON)*NDYRATIO+1+JPHEXT
+ IIE1 = (MIN(NXEND-1,IXENDSON)-IXORSON)*NDXRATIO+JPHEXT
+ IJE1 = (MIN(NYEND-1,IYENDSON)-IYORSON)*NDYRATIO+JPHEXT
+ !
+ WRITE(ILUOUT,*) ' common domain in the SON grid (IB,IE=', &
+ 1+JPHEXT,'-',IIMAXSON+JPHEXT,' ; JB,JE=', &
+ 1+JPHEXT,'-',IJMAXSON+JPHEXT,'):'
+ WRITE(ILUOUT,*) 'I=',IIB1,'->',IIE1,' ; J=',IJB1,'->',IJE1
+ WRITE(ILUOUT,*) ' common domain in the model2 grid (IB,IE=', &
+ 1+JPHEXT,'-',NXSIZE*NDXRATIO+JPHEXT,' ; JB,JE=', &
+ 1+JPHEXT,'-',NYSIZE*NDYRATIO+JPHEXT,'):'
+ WRITE(ILUOUT,*) 'I=',IIB2,'->',IIE2,' ; J=',IJB2,'->',IJE2
+ ELSE
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: no common domain between input SON and model2:'
+ WRITE(ILUOUT,*) ' the input SON fields are not taken into account, spawned fields are computed from model1'
+ END IF
+END IF
+!
+!* 3.4 Initialization of model 2 configuration
+!
+NRR = KRR ! for MODD_CONF2
+NSV_USER = KSV_USER
+IF (NSV_CHEM>0) THEN
+ LUSECHEM=.TRUE.
+ IF (NSV_CHAC>0) THEN
+ LUSECHAQ=.TRUE.
+ ENDIF
+ IF (NSV_CHIC>0) THEN
+ LUSECHIC=.TRUE.
+ ENDIF
+ CCHEM_INPUT_FILE = HCHEM_INPUT_FILE
+END IF
+!
+CTURB = HTURB ! for MODD_PARAM2
+CRAD = 'NONE' ! radiation will have to be restarted
+CSURF = HSURF ! for surface call
+CCLOUD = HCLOUD
+CDCONV = 'NONE' ! deep convection will have to be restarted
+CSCONV = 'NONE' ! shallow convection will have to be restarted
+!
+! cas LIMA
+!
+!IF (HCLOUD=='LIMA') THEN
+! CCLOUD='LIMA'
+! NMOD_CCN=3
+! LSCAV=.FALSE.
+! LAERO_MASS=.FALSE.
+! NMOD_IFN=2
+! NMOD_IMM=1
+! LHHONI=.FALSE.
+!ENDIF
+!
+CALL INI_NSV(2) ! NSV* are set equal for model 2 and model 1.
+ ! NSV is set to the total number of SV for model 2
+!
+IF (NRR==0) THEN
+ LUSERV=.FALSE. ! as the default is .T.
+ELSE
+ IDX_RVT = 1
+END IF
+IF (NRR>1) THEN
+ LUSERC=.TRUE.
+ IDX_RCT = 2
+END IF
+IF (NRR>2) THEN
+ LUSERR=.TRUE.
+ IDX_RRT = 2
+END IF
+IF (NRR>3) THEN
+ LUSERI=.TRUE.
+ IDX_RIT = 2
+END IF
+IF (NRR>4) THEN
+ LUSERS=.TRUE.
+ IDX_RST = 2
+END IF
+IF (NRR>5) THEN
+ LUSERG=.TRUE.
+ IDX_RGT = 2
+END IF
+IF (NRR>6) THEN
+ LUSERH=.TRUE.
+ IDX_RHT = 2
+END IF
+!
+!
+!
+!* 3.5 model 2 configuration in MODD_NESTING to be written
+!* on the FM-file to allow nesting or coupling
+!
+CCPLFILE(:) = ' '
+LSTEADYLS=.TRUE.
+!
+NDXRATIO_ALL(:) = 0
+NDYRATIO_ALL(:) = 0
+NDXRATIO_ALL(2) = NDXRATIO
+NDYRATIO_ALL(2) = NDYRATIO
+NXOR_ALL(2) = NXOR
+NYOR_ALL(2) = NYOR
+NXEND_ALL(2) = NXEND
+NYEND_ALL(2) = NYEND
+!
+!* 3.6 size of the RIM area for lbc
+!
+NRIMX=MIN(JPRIMMAX,IIU/2-1)
+IF ( .NOT. L2D ) THEN
+ NRIMY=MIN(JPRIMMAX,IJU/2-1)
+ELSE
+ NRIMY=0
+END IF
+IF (NRIMX >= IIU/2-1) THEN ! Error ! this case is not supported - it should be, but there is a bug
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPAWN_MODEL2', 'The size of the LBX zone is too big for the size of the subdomains. '// &
+ 'Try with less processes, a smaller LBX size or a bigger grid in X.' )
+ENDIF
+IF ( ( .NOT. L2D ) .AND. (NRIMY >= IJU/2-1) ) THEN ! Error ! this case is not supported - it should be, but there is a bug
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPAWN_MODEL2', 'The size of the LBY zone is too big for the size of the subdomains. '// &
+ 'Try with less processes, a smaller LBY size or a bigger grid in Y.' )
+ENDIF
+!
+LHORELAX_UVWTH=.TRUE.
+LHORELAX_RV=LUSERV
+LHORELAX_RC=LUSERC
+LHORELAX_RR=LUSERR
+LHORELAX_RI=LUSERI
+LHORELAX_RS=LUSERS
+LHORELAX_RG=LUSERG
+LHORELAX_RH=LUSERH
+!
+IF (CTURB/='NONE') LHORELAX_TKE =.TRUE.
+LHORELAX_SV(:)=.FALSE.
+DO JSV=1,NSV
+ LHORELAX_SV(JSV)=.TRUE.
+END DO
+IF (NSV_CHEM > 0) LHORELAX_SVCHEM = .TRUE.
+IF (NSV_CHIC > 0) LHORELAX_SVCHIC = .TRUE.
+IF (NSV_C2R2 > 0) LHORELAX_SVC2R2 = .TRUE.
+IF (NSV_C1R3 > 0) LHORELAX_SVC1R3 = .TRUE.
+IF (NSV_ELEC > 0) LHORELAX_SVELEC = .TRUE.
+IF (NSV_AER > 0) LHORELAX_SVAER = .TRUE.
+IF (NSV_DST > 0) LHORELAX_SVDST = .TRUE.
+IF (NSV_SLT > 0) LHORELAX_SVSLT = .TRUE.
+IF (NSV_PP > 0) LHORELAX_SVPP = .TRUE.
+#ifdef MNH_FOREFIRE
+IF (NSV_FF > 0) LHORELAX_SVFF = .TRUE.
+#endif
+IF (NSV_CS > 0) LHORELAX_SVCS = .TRUE.
+LHORELAX_SVLG = .FALSE.
+IF (NSV_LIMA > 0) LHORELAX_SVLIMA = .TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. ALLOCATE MEMORY FOR ARRAYS :
+! -----------------------------
+!
+!* 4.1 Global variables absent from the modules :
+!
+ALLOCATE(ZJ(IIU,IJU,IKU))
+!
+!* 4.2 Prognostic (and diagnostic) variables (module MODD_FIELD2) :
+!
+ALLOCATE(XZWS(IIU,IJU)); XZWS(:,:) = XZWS_DEFAULT
+ALLOCATE(XLSZWSM(IIU,IJU))
+ALLOCATE(XUT(IIU,IJU,IKU))
+ALLOCATE(XVT(IIU,IJU,IKU))
+ALLOCATE(XWT(IIU,IJU,IKU))
+ALLOCATE(XTHT(IIU,IJU,IKU))
+IF (CTURB/='NONE') THEN
+ ALLOCATE(XTKET(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XTKET(0,0,0))
+END IF
+ALLOCATE(XPABST(IIU,IJU,IKU))
+ALLOCATE(XRT(IIU,IJU,IKU,NRR))
+ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
+!
+IF (CTURB /= 'NONE' .AND. NRR>1) THEN
+ ALLOCATE(XSRCT(IIU,IJU,IKU))
+ ALLOCATE(XSIGS(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XSRCT(0,0,0))
+ ALLOCATE(XSIGS(0,0,0))
+END IF
+!
+!
+!* 4.4 Grid variables (module MODD_GRID2 and MODD_METRICS2):
+!
+ALLOCATE(XXHAT(IIU),XYHAT(IJU),XZHAT(IKU))
+ALLOCATE(XXHATM(IIU),XYHATM(IJU),XZHATM(IKU))
+ALLOCATE(XZTOP)
+ALLOCATE(XMAP(IIU,IJU))
+ALLOCATE(XLAT(IIU,IJU))
+ALLOCATE(XLON(IIU,IJU))
+ALLOCATE(XDXHAT(IIU),XDYHAT(IJU))
+ALLOCATE(XZS(IIU,IJU))
+ALLOCATE(XZSMT(IIU,IJU))
+ALLOCATE(XZZ(IIU,IJU,IKU))
+!
+ALLOCATE(XDXX(IIU,IJU,IKU))
+ALLOCATE(XDYY(IIU,IJU,IKU))
+ALLOCATE(XDZX(IIU,IJU,IKU))
+ALLOCATE(XDZY(IIU,IJU,IKU))
+ALLOCATE(XDZZ(IIU,IJU,IKU))
+!
+ALLOCATE(ZZS_LS(IIU,IJU))
+ALLOCATE(ZZSMT_LS(IIU,IJU))
+ALLOCATE(ZZZ_LS(IIU,IJU,IKU))
+!
+!* 4.5 Reference state variables (module MODD_REF2):
+!
+ALLOCATE(XRHODREF(IIU,IJU,IKU),XTHVREF(IIU,IJU,IKU),XRVREF(IIU,IJU,IKU))
+ALLOCATE(XRHODJ(IIU,IJU,IKU),XEXNREF(IIU,IJU,IKU))
+!
+!* 4.6 Larger Scale fields (module MODD_LSFIELD2):
+!
+ ! LS fields for vertical relaxation and diffusion
+ALLOCATE(XLSUM(IIU,IJU,IKU))
+ALLOCATE(XLSVM(IIU,IJU,IKU))
+ALLOCATE(XLSWM(IIU,IJU,IKU))
+ALLOCATE(XLSTHM(IIU,IJU,IKU))
+IF ( NRR >= 1) THEN
+ ALLOCATE(XLSRVM(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XLSRVM(0,0,0))
+ENDIF
+ ! LB fields for lbc coupling
+!
+!get the size of the local portion of the LB zone in X and Y direction
+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)
+!on fait des choses inutiles avec GET_SIZEX_LB, on pourrait utiliser seulement GET_LOCAL_LB_SIZE_X_ll
+!ILOCLBSIZEX = GET_LOCAL_LB_SIZE_X_ll( NRIMX )
+!ILOCLBSIZEY = GET_LOCAL_LB_SIZE_Y_ll( NRIMY )
+!
+ ALLOCATE(XLBXUM(IISIZEXFU,IJU,IKU))
+!! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,IJU,IKU))
+!
+IF ( .NOT. L2D ) THEN
+ ALLOCATE(XLBYUM(IIU,IJSIZEYF,IKU))
+!! ALLOCATE(XLBYUM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ELSE
+ ALLOCATE(XLBYUM(0,0,0))
+END IF
+!
+ALLOCATE(XLBXVM(IISIZEXF,IJU,IKU))
+!! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,IJU,IKU))
+!
+IF ( .NOT. L2D ) THEN
+ IF ( NRIMY == 0 ) THEN
+ ALLOCATE(XLBYVM(IIU,IJSIZEY4,IKU))
+ ELSE
+ ALLOCATE(XLBYVM(IIU,IJSIZEYFV,IKU))
+!! ALLOCATE(XLBYVM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ END IF
+ELSE
+ ALLOCATE(XLBYVM(0,0,0))
+END IF
+!
+ALLOCATE(XLBXWM(IISIZEXF,IJU,IKU))
+!! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,IJU,IKU))
+!
+IF ( .NOT. L2D ) THEN
+ ALLOCATE(XLBYWM(IIU,IJSIZEYF,IKU))
+!! ALLOCATE(XLBYWM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ELSE
+ ALLOCATE(XLBYWM(0,0,0))
+END IF
+!
+ALLOCATE(XLBXTHM(IISIZEXF,IJU,IKU))
+!!ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,IJU,IKU))
+!
+IF ( .NOT. L2D ) THEN
+ ALLOCATE(XLBYTHM(IIU,IJSIZEYF,IKU))
+!! ALLOCATE(XLBYTHM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ELSE
+ ALLOCATE(XLBYTHM(0,0,0))
+END IF
+!
+IF (CTURB /= 'NONE') THEN
+ ALLOCATE(XLBXTKEM(IISIZEXF,IJU,IKU))
+!! ALLOCATE(XLBXTKEM(2*NRIMX+2*JPHEXT,IJU,IKU))
+ELSE
+ ALLOCATE(XLBXTKEM(0,0,0))
+END IF
+!
+IF (CTURB /= 'NONE' .AND. (.NOT. L2D)) THEN
+ ALLOCATE(XLBYTKEM(IIU,IJSIZEYF,IKU))
+!! ALLOCATE(XLBYTKEM(IIU,2*NRIMY+2*JPHEXT,IKU))
+ELSE
+ ALLOCATE(XLBYTKEM(0,0,0))
+END IF
+!
+ALLOCATE(XLBXRM(IISIZEXF,IJU,IKU,NRR))
+!!ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,IJU,IKU,NRR))
+!
+IF (.NOT. L2D ) THEN
+ ALLOCATE(XLBYRM(IIU,IJSIZEYF,IKU,NRR))
+!! ALLOCATE(XLBYRM(IIU,2*NRIMY+2*JPHEXT,IKU,NRR))
+ELSE
+ ALLOCATE(XLBYRM(0,0,0,0))
+END IF
+!
+ALLOCATE(XLBXSVM(IISIZEXF,IJU,IKU,NSV))
+!!ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,IJU,IKU,NSV))
+!
+IF (.NOT. L2D ) THEN
+ ALLOCATE(XLBYSVM(IIU,IJSIZEYF,IKU,NSV))
+!! ALLOCATE(XLBYSVM(IIU,2*NRIMY+2*JPHEXT,IKU,NSV))
+ELSE
+ ALLOCATE(XLBYSVM(0,0,0,0))
+END IF
+!
+NSIZELBX_ll=2*NRIMX+2*JPHEXT
+NSIZELBXU_ll=2*NRIMX+2*JPHEXT
+NSIZELBY_ll=2*NRIMY+2*JPHEXT
+NSIZELBYV_ll=2*NRIMY+2*JPHEXT
+NSIZELBXR_ll=2*NRIMX+2*JPHEXT
+NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
+NSIZELBXTKE_ll=2*NRIMX+2*JPHEXT
+NSIZELBYTKE_ll=2*NRIMY+2*JPHEXT
+NSIZELBYR_ll=2*NRIMY+2*JPHEXT
+NSIZELBYSV_ll=2*NRIMY+2*JPHEXT
+!
+!
+! 4.8 precipitation variables ! same allocations than in ini_micron
+!
+IF (CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE') THEN
+ ALLOCATE(XINPRR(IIU,IJU))
+ ALLOCATE(XINPRR3D(IIU,IJU,IKU))
+ ALLOCATE(XEVAP3D(IIU,IJU,IKU))
+ ALLOCATE(XACPRR(IIU,IJU))
+ELSE
+ ALLOCATE(XINPRR(0,0))
+ ALLOCATE(XINPRR3D(0,0,0))
+ ALLOCATE(XEVAP3D(0,0,0))
+ ALLOCATE(XACPRR(0,0))
+END IF
+!
+IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C2R2' &
+ .OR. CCLOUD == 'KHKO' .OR. CCLOUD == 'LIMA') THEN
+ ALLOCATE(XINPRC(IIU,IJU))
+ ALLOCATE(XACPRC(IIU,IJU))
+ELSE
+ ALLOCATE(XINPRC(0,0))
+ ALLOCATE(XACPRC(0,0))
+END IF
+!
+IF (( CCLOUD(1:3) == 'ICE' .AND.LDEPOSC) .OR. &
+ ((CCLOUD=='C2R2' .OR. CCLOUD=='KHKO').AND.LDEPOC) .OR. &
+ ( CCLOUD=='LIMA' .AND.MDEPOC)) THEN
+ ALLOCATE(XINDEP(IIU,IJU))
+ ALLOCATE(XACDEP(IIU,IJU))
+ELSE
+ ALLOCATE(XINDEP(0,0))
+ ALLOCATE(XACDEP(0,0))
+END IF
+!
+IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5'.OR. CCLOUD == 'LIMA') THEN
+ ALLOCATE(XINPRS(IIU,IJU))
+ ALLOCATE(XACPRS(IIU,IJU))
+ELSE
+ ALLOCATE(XINPRS(0,0))
+ ALLOCATE(XACPRS(0,0))
+END IF
+!
+IF (CCLOUD == 'C3R5' .OR. CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4'.OR. CCLOUD == 'LIMA' ) THEN
+ ALLOCATE(XINPRG(IIU,IJU))
+ ALLOCATE(XACPRG(IIU,IJU))
+ELSE
+ ALLOCATE(XINPRG(0,0))
+ ALLOCATE(XACPRG(0,0))
+END IF
+!
+IF (CCLOUD == 'ICE4'.OR. CCLOUD == 'LIMA') THEN
+ ALLOCATE(XINPRH(IIU,IJU))
+ ALLOCATE(XACPRH(IIU,IJU))
+ELSE
+ ALLOCATE(XINPRH(0,0))
+ ALLOCATE(XACPRH(0,0))
+END IF
+!
+IF ( CCLOUD=='LIMA' .AND. LSCAV ) THEN
+ ALLOCATE(XINPAP(IIU,IJU))
+ ALLOCATE(XACPAP(IIU,IJU))
+ XINPAP(:,:)=0.0
+ XACPAP(:,:)=0.0
+ELSE
+ ALLOCATE(XINPAP(0,0))
+ ALLOCATE(XACPAP(0,0))
+END IF
+!
+! 4.8bis electric variables
+!
+IF (CELEC /= 'NONE' ) THEN
+ ALLOCATE(XNI_SDRYG(IIU,IJU,IKU))
+ ALLOCATE(XNI_IDRYG(IIU,IJU,IKU))
+ ALLOCATE(XNI_IAGGS(IIU,IJU,IKU))
+ ALLOCATE(XEFIELDU(IIU,IJU,IKU))
+ ALLOCATE(XEFIELDV(IIU,IJU,IKU))
+ ALLOCATE(XEFIELDW(IIU,IJU,IKU))
+ ALLOCATE(XESOURCEFW(IIU,IJU,IKU))
+ ALLOCATE(XIND_RATE(IIU,IJU,IKU))
+ ALLOCATE(XIONSOURCEFW(IIU,IJU,IKU))
+ ALLOCATE(XEW(IIU,IJU,IKU))
+ ALLOCATE(XCION_POS_FW(IIU,IJU,IKU))
+ ALLOCATE(XCION_NEG_FW(IIU,IJU,IKU))
+ ALLOCATE(XMOBIL_POS(IIU,IJU,IKU))
+ ALLOCATE(XMOBIL_NEG(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XNI_SDRYG(0,0,0))
+ ALLOCATE(XNI_IDRYG(0,0,0))
+ ALLOCATE(XNI_IAGGS(0,0,0))
+ ALLOCATE(XEFIELDU(0,0,0))
+ ALLOCATE(XEFIELDV(0,0,0))
+ ALLOCATE(XEFIELDW(0,0,0))
+ ALLOCATE(XESOURCEFW(0,0,0))
+ ALLOCATE(XIND_RATE(0,0,0))
+ ALLOCATE(XIONSOURCEFW(0,0,0))
+ ALLOCATE(XEW(0,0,0))
+ ALLOCATE(XCION_POS_FW(0,0,0))
+ ALLOCATE(XCION_NEG_FW(0,0,0))
+ ALLOCATE(XMOBIL_POS(0,0,0))
+ ALLOCATE(XMOBIL_NEG(0,0,0))
+END IF
+!
+!
+!
+! 4.9 Passive pollutant variable
+!
+IF (LPASPOL) THEN
+ ALLOCATE( XATC(IIU,IJU,IKU,NSV_PP) )
+ ELSE
+ ALLOCATE( XATC(0,0,0,0))
+END IF
+!
+! 4.10 Advective forcing variable for 2D (Modif MT)
+!
+!
+IF (L2D_ADV_FRC) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: L2D_ADV_FRC IS SET TO ',L2D_ADV_FRC,' SO ADVECTIVE FORCING WILL BE SPAWN: NADVFRC=',NADVFRC
+ ALLOCATE(TDTADVFRC(NADVFRC))
+ ALLOCATE(XDTHFRC(IIU,IJU,IKU,NADVFRC))
+ ALLOCATE(XDRVFRC(IIU,IJU,IKU,NADVFRC))
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: ALLOCATION OF ADV FORCING VARIABLES MADE'
+ELSE
+ ALLOCATE(TDTADVFRC(0))
+ ALLOCATE(XDTHFRC(0,0,0,0))
+ ALLOCATE(XDRVFRC(0,0,0,0))
+END IF
+IF (L2D_REL_FRC) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: L2D_REL_FRC IS SET TO ',L2D_REL_FRC,' SO RELAXATION FORCING WILL BE SPAWN: NRELFRC=',NRELFRC
+ ALLOCATE(TDTRELFRC(NRELFRC))
+ ALLOCATE(XTHREL(IIU,IJU,IKU,NRELFRC))
+ ALLOCATE(XRVREL(IIU,IJU,IKU,NRELFRC))
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: ALLOCATION OF REL FORCING VARIABLES MADE'
+ELSE
+ ALLOCATE(TDTRELFRC(0))
+ ALLOCATE(XTHREL(0,0,0,0))
+ ALLOCATE(XRVREL(0,0,0,0))
+END IF
+!
+! 4.11 Turbulent fluxes for 2D (Modif MT)
+!
+!
+IF (LUV_FLX) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: XUV_FLX1 IS SET TO ',XUV_FLX1,' SO XVU_FLUX WILL BE SPAWN'
+ ALLOCATE(XVU_FLUX_M(IIU,IJU,IKU))
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: ALLOCATION OF XVU_FLUX_M MADE'
+ELSE
+ ALLOCATE(XVU_FLUX_M(0,0,0))
+END IF
+!
+IF (LTH_FLX) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: XTH_FLX IS SET TO ',XTH_FLX,' SO XVTH_FLUX and XWTH_FLUX WILL BE SPAWN'
+ ALLOCATE(XVTH_FLUX_M(IIU,IJU,IKU))
+ ALLOCATE(XWTH_FLUX_M(IIU,IJU,IKU))
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: ALLOCATION OF XVTH_FLUX_M and XWTH_FLUX_M MADE'
+ELSE
+ ALLOCATE(XVTH_FLUX_M(0,0,0))
+ ALLOCATE(XWTH_FLUX_M(0,0,0))
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. INITIALIZE ALL THE MODEL VARIABLES
+! ----------------------------------
+!
+!* 5.1 Bikhardt interpolation coefficients computation :
+!
+CALL INI_BIKHARDT_n(NDXRATIO,NDYRATIO,2)
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZMISC = ZTIME2 - ZTIME1
+!
+!* 5.2 Spatial and Temporal grid (for MODD_GRID2 and MODD_TIME2) :
+!
+CALL SECOND_MNH(ZTIME1)
+!
+IF(NPROC.GT.1)THEN
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GET_FEEDBACK_COORD_ll(NXOR_TMP,NYOR_TMP,NXEND_TMP,NYEND_TMP,IINFO_ll) !phys domain
+ELSE
+ NXOR_TMP = NXOR
+ NYOR_TMP = NYOR
+ NXEND_TMP= NXEND
+ NYEND_TMP = NYEND
+ENDIF
+XZS=0.
+CALL SPAWN_GRID2( NXOR, NYOR, NXEND, NYEND, NDXRATIO, NDYRATIO, &
+ XLONORI, XLATORI, XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, XZHATM, &
+ XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll, &
+ XHAT_BOUND, XHATM_BOUND, &
+ XZTOP, LSLEVE, XLEN1, XLEN2, &
+ XZS, XZSMT, ZZS_LS, ZZSMT_LS, TDTMOD, TDTCUR )
+!
+CALL MPPDB_CHECK2D(ZZS_LS,"SPAWN_MOD2:ZZS_LS",PRECISION)
+CALL MPPDB_CHECK2D(ZZSMT_LS,"SPAWN_MOD2:ZZSMT_LS",PRECISION)
+CALL MPPDB_CHECK2D(XZS,"SPAWN_MOD2:XZS",PRECISION)
+CALL MPPDB_CHECK2D(XZSMT,"SPAWN_MOD2:XZSMT",PRECISION)
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZGRID2 = ZTIME2 - ZTIME1
+!
+!* 5.3 Calculation of the grid
+!
+ZTIME1 = ZTIME2
+!
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,ZZS_LS,LSLEVE,XLEN1,XLEN2,ZZSMT_LS,XDXHAT,XDYHAT,ZZZ_LS,ZJ)
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS ,LSLEVE,XLEN1,XLEN2,XZSMT ,XDXHAT,XDYHAT,XZZ ,ZJ)
+ELSE
+ CALL SM_GRIDPROJ( XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, ZZS_LS, &
+ LSLEVE, XLEN1, XLEN2, ZZSMT_LS, XLATORI, XLONORI, &
+ XMAP, XLAT, XLON, XDXHAT, XDYHAT, ZZZ_LS, ZJ )
+ CALL SM_GRIDPROJ( XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, XZS, &
+ LSLEVE, XLEN1, XLEN2, XZSMT, XLATORI, XLONORI, &
+ XMAP, XLAT, XLON, XDXHAT, XDYHAT, XZZ, ZJ )
+END IF
+!
+!* 5.4 Compute the metric coefficients
+!
+CALL ADD3DFIELD_ll( TZFIELDS_ll, XZZ, 'SPAWN_MODEL2::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,"spawnmod2-beforeupdate_metrics:XDXX",PRECISION)
+CALL MPPDB_CHECK3D(XDYY,"spawnmod2-beforeupdate_metrics:XDYY",PRECISION)
+CALL MPPDB_CHECK3D(XDZX,"spawnmod2-beforeupdate_metrics:XDZX",PRECISION)
+CALL MPPDB_CHECK3D(XDZY,"spawnmod2-beforeupdate_metrics:XDZY",PRECISION)
+!
+CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+CALL MPPDB_CHECK3D(XDXX,"spawnmod2-aftrupdate_metrics:XDXX",PRECISION)
+CALL MPPDB_CHECK3D(XDYY,"spawnmod2-aftrupdate_metrics:XDYY",PRECISION)
+CALL MPPDB_CHECK3D(XDZX,"spawnmod2-aftrupdate_metrics:XDZX",PRECISION)
+CALL MPPDB_CHECK3D(XDZY,"spawnmod2-aftrupdate_metrics:XDZY",PRECISION)
+!$
+!
+!* 5.5 3D Reference state variables :
+!
+CALL SET_REF( 0, TFILE_DUMMY, &
+ XZZ, XZHATM, ZJ, XDXX, XDYY, CLBCX, CLBCY, &
+ XREFMASS, XMASS_O_PHI0, XLINMASS, &
+ XRHODREF, XTHVREF, XRVREF, XEXNREF, XRHODJ )
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZMISC = ZMISC + ZTIME2 - ZTIME1
+!
+!* 5.6 Prognostic variables and Larger scale fields :
+!
+ZTIME1 = ZTIME2
+!
+!* horizontal interpolation
+!
+ALLOCATE(ZTHVT(IIU,IJU,IKU))
+ALLOCATE(ZHUT(IIU,IJU,IKU))
+!
+MPPDB_CHECK_LB = .TRUE.
+IF (GNOSON) THEN
+ CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
+ XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XZWS,XATC, &
+ XSRCT,XSIGS, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
+ XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
+ XVU_FLUX_M,XVTH_FLUX_M,XWTH_FLUX_M )
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 after SPAWN_FIELD2:XUT",PRECISION)
+ELSE
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 before SPAWN_FIELD2:XUT",PRECISION)
+ CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
+ XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XZWS,XATC, &
+ XSRCT,XSIGS, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
+ XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
+ XVU_FLUX_M, XVTH_FLUX_M,XWTH_FLUX_M, &
+ TZSONFILE,IIUSON,IJUSON, &
+ IIB2,IJB2,IIE2,IJE2, &
+ IIB1,IJB1,IIE1,IJE1 )
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 after SPAWN_FIELD2:XUT",PRECISION)
+END IF
+!
+CALL MPPDB_CHECK3D(XUT,"SPAWN_MOD2aftFIELD2:XUT",PRECISION)
+CALL MPPDB_CHECK3D(XVT,"SPAWN_MOD2aftFIELD2:XVT",PRECISION)
+!$
+!* correction of positivity
+!
+IF (SIZE(XLSRVM,1)>0) XLSRVM = MAX(0.,XLSRVM)
+IF (SIZE(XRT,1)>0) XRT = MAX(0.,XRT)
+IF (SIZE(ZHUT,1)>0) ZHUT = MIN(MAX(ZHUT,0.),100.)
+IF (SIZE(XTKET,1)>0) XTKET = MAX(XTKEMIN,XTKET)
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZFIELD2 = ZTIME2 - ZTIME1
+!
+ZTIME1 = ZTIME2
+!
+!* vertical interpolation
+!
+ZZS_MAX = ABS( MAXVAL(XZS(:,:)))
+CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MNHREAL_MPI, MPI_MAX, &
+ NMNH_COMM_WORLD,IINFO_ll)
+IF ( (ZZS_MAX_ll>0.) .AND. (NDXRATIO/=1 .OR. NDYRATIO/=1) ) THEN
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 before VER_INTERP_FIELD:XUT",PRECISION)
+ CALL VER_INTERP_FIELD (CTURB,NRR,NSV,ZZZ_LS,XZZ, &
+ XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT, &
+ XSRCT,XSIGS, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM )
+ !
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_M2aftVERINTER:XUT",PRECISION)
+ CALL MPPDB_CHECK3D(XVT,"SPAWN_M2aftVERINTER:XVT",PRECISION)
+ CALL MPPDB_CHECK3D(XWT,"SPAWN_M2aftVERINTER:XWT",PRECISION)
+ CALL MPPDB_CHECK3D(ZHUT,"SPAWN_M2aftVERINTER:ZHUT",PRECISION)
+ CALL MPPDB_CHECK3D(XTKET,"SPAWN_M2aftVERINTER:XTKET",PRECISION)
+ CALL MPPDB_CHECK3D(XSRCT,"SPAWN_M2aftVERINTER:XSRCT",PRECISION)
+ENDIF
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZVER = ZTIME2 - ZTIME1
+!
+!* 5.7 Absolute pressure :
+!
+ZTIME1 = ZTIME2
+!
+CALL SPAWN_PRESSURE2(NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
+ ZZZ_LS,XZZ,ZTHVT,XPABST )
+!
+IF (.NOT.GNOSON) THEN
+ ALLOCATE(ZWORK3D(IIUSON,IJUSON,IKU))
+ CALL IO_Field_read(TZSONFILE,'PABST',ZWORK3D)
+ XPABST(IIB2:IIE2,IJB2:IJE2,:) = ZWORK3D(IIB1:IIE1,IJB1:IJE1,:)
+ DEALLOCATE(ZWORK3D)
+END IF
+!
+IF (NVERB>=2) THEN
+ IK4000 = COUNT(XZHAT(:)<4000.)
+ IIJ = MAXLOC( SUM(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3), &
+ MASK=COUNT(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE) &
+ >=MAXVAL(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01,DIM=3 ) &
+ >=1 ) &
+ + JPHEXT
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) 'humidity (I=',IIJ(1),';J=',IIJ(2),')'
+ DO JK=IKB,IKE
+ WRITE(ILUOUT,'(F6.2," %")') ZHUT(IIJ(1),IIJ(2),JK)
+ END DO
+END IF
+!* 5.8 Retrieve model thermodynamical variables :
+!
+ALLOCATE(ZSUMRT(IIU,IJU,IKU))
+ZSUMRT(:,:,:) = 0.
+IF (NRR==0) THEN
+ XTHT(:,:,:) = ZTHVT(:,:,:)
+ELSE
+ IF (NDXRATIO/=1 .OR. NDYRATIO/=1) THEN
+ XRT(:,:,:,1) = SM_PMR_HU(XPABST(:,:,:), &
+ ZTHVT(:,:,:)*(XPABST(:,:,:)/XP00)**(XRD/XCPD), &
+ ZHUT(:,:,:),XRT(:,:,:,:),KITERMAX=100 )
+ END IF
+ !
+ DO JRR=1,NRR
+ ZSUMRT(:,:,:) = ZSUMRT(:,:,:) + XRT(:,:,:,JRR)
+ END DO
+ XTHT(:,:,:) = ZTHVT(:,:,:)/(1.+XRV/XRD*XRT(:,:,:,1))*(1.+ZSUMRT(:,:,:))
+ CALL MPPDB_CHECK3D(XTHT,"SPAWN_MOD2:XTHT",PRECISION)
+END IF
+!
+DEALLOCATE (ZHUT)
+!
+CALL SECOND_MNH(ZTIME2)
+ZPRESSURE2=ZTIME2-ZTIME1
+!
+!* 5.9 Large Scale field for lbc treatment:
+!
+!
+!* 5.9.1 West-East LB zones
+!
+!
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< spawn_model2.f90
+ MPPDB_CHECK_LB = .TRUE.
+ CALL MPPDB_CHECK3D(XUT,"SPAWN_MOD2 before lbc treatment:XUT",PRECISION)
+ CALL MPPDB_CHECK3D(XVT,"SPAWN_MOD2 before lbc treatment:XVT",PRECISION)
+ MPPDB_CHECK_LB = .FALSE.
+ YLBTYPE = 'LBU'
+ CALL SET_LB_FIELD_ll( YLBTYPE, XUT, XLBXUM, XLBYUM, IIB, IJB, IIE, IJE, 1, 0, 0, 0 )
+ ! copy XUT(IIB:IIB+NRIMX,:,:) instead of XUT(IIB-1:IIB-1+NRIMX,:,:) in XLBXUM
+ CALL SET_LB_FIELD_ll( YLBTYPE, XVT, XLBXVM, XLBYVM, IIB, IJB, IIE, IJE, 0, 0, 1, 0 )
+ ! copy XVT(:,IJB:IJB+NRIMY,:) instead of XVT(:,IJB-1:IJB-1+NRIMY,:) in XLBYVM
+ CALL SET_LB_FIELD_ll( YLBTYPE, XWT, XLBXWM, XLBYWM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ CALL SET_LB_FIELD_ll( YLBTYPE, XTHT, XLBXTHM, XLBYTHM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ IF (HTURB /= 'NONE') THEN
+ CALL SET_LB_FIELD_ll( YLBTYPE, XTKET, XLBXTKEM, XLBYTKEM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ ENDIF
+ IF (NRR >= 1) THEN
+ DO JRR =1,NRR
+ CALL SET_LB_FIELD_ll( YLBTYPE, XRT(:,:,:,JRR), XLBXRM(:,:,:,JRR), XLBYRM(:,:,:,JRR), IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ END DO
+ END IF
+ IF (NSV /= 0) THEN
+ DO JSV = 1, NSV
+ CALL SET_LB_FIELD_ll( YLBTYPE, XSVT(:,:,:,JSV), XLBXSVM(:,:,:,JSV), XLBYSVM(:,:,:,JSV), IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
+ END DO
+!!$=======
+!!$!
+!!$XLBXUM(1:NRIMX+JPHEXT,:,:) = XUT(2:NRIMX+JPHEXT+1,:,:)
+!!$XLBXUM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XUT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$IF( .NOT. L2D ) THEN
+!!$ XLBYUM(:,1:NRIMY+JPHEXT,:) = XUT(:,1:NRIMY+JPHEXT,:)
+!!$ XLBYUM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XUT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$END IF
+!!$!
+!!$!* 5.9.2 V variable
+!!$!
+!!$!
+!!$XLBXVM(1:NRIMX+JPHEXT,:,:) = XVT(1:NRIMX+JPHEXT,:,:)
+!!$XLBXVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XVT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$IF( .NOT. L2D ) THEN
+!!$ XLBYVM(:,1:NRIMY+JPHEXT,:) = XVT(:,2:NRIMY+JPHEXT+1,:)
+!!$ XLBYVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XVT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$END IF
+!!$!
+!!$!* 5.9.3 W variable
+!!$!
+!!$!
+!!$XLBXWM(1:NRIMX+JPHEXT,:,:) = XWT(1:NRIMX+JPHEXT,:,:)
+!!$XLBXWM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XWT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$IF( .NOT. L2D ) THEN
+!!$ XLBYWM(:,1:NRIMY+JPHEXT,:) = XWT(:,1:NRIMY+JPHEXT,:)
+!!$ XLBYWM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XWT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$END IF
+!!$!
+!!$!* 5.9.4 TH variable
+!!$!
+!!$!
+!!$XLBXTHM(1:NRIMX+JPHEXT,:,:) = XTHT(1:NRIMX+JPHEXT,:,:)
+!!$XLBXTHM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTHT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$IF( .NOT. L2D ) THEN
+!!$ XLBYTHM(:,1:NRIMY+JPHEXT,:) = XTHT(:,1:NRIMY+JPHEXT,:)
+!!$ XLBYTHM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTHT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$END IF
+!!$!
+!!$!* 5.9.5 TKE variable
+!!$!
+!!$!
+!!$IF (HTURB /= 'NONE') THEN
+!!$ XLBXTKEM(1:NRIMX+JPHEXT,:,:) = XTKET(1:NRIMX+JPHEXT,:,:)
+!!$ XLBXTKEM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTKET(IIE+1-NRIMX:IIE+JPHEXT,:,:)
+!!$ IF( .NOT. L2D ) THEN
+!!$ XLBYTKEM(:,1:NRIMY+JPHEXT,:) = XTKET(:,1:NRIMY+JPHEXT,:)
+!!$ XLBYTKEM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTKET(:,IJE+1-NRIMY:IJE+JPHEXT,:)
+!!$>>>>>>> 1.3.2.4.2.2.2.6.2.3.2.6.2.1
+ END IF
+!
+! <<<<<<< spawn_model2.f90
+ CALL MPPDB_CHECKLB(XLBXUM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN",PRECISION,'LBXU',NRIMX)
+ CALL MPPDB_CHECKLB(XLBXVM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBXVM",PRECISION,'LBXU',NRIMX)
+ CALL MPPDB_CHECKLB(XLBXWM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBXWM",PRECISION,'LBXU',NRIMX)
+ CALL MPPDB_CHECKLB(XLBYUM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYUM",PRECISION,'LBYV',NRIMY)
+ CALL MPPDB_CHECKLB(XLBYVM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYVM",PRECISION,'LBYV',NRIMY)
+ CALL MPPDB_CHECKLB(XLBYWM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYWM",PRECISION,'LBYV',NRIMY)
+!!$=======
+!!$!* 5.9.6 moist variables
+!!$!
+!!$IF (NRR >= 1) THEN
+!!$ DO JRR =1,NRR
+!!$ XLBXRM(1:NRIMX+JPHEXT,:,:,JRR) = XRT(1:NRIMX+JPHEXT,:,:,JRR)
+!!$ XLBXRM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JRR) = XRT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JRR)
+!!$ IF( .NOT. L2D ) THEN
+!!$ XLBYRM(:,1:NRIMY+JPHEXT,:,JRR) = XRT(:,1:NRIMY+JPHEXT,:,JRR)
+!!$ XLBYRM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JRR) = XRT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JRR)
+!!$ END IF
+!!$ END DO
+!!$END IF
+!!$!
+!!$!* 5.9.7 scalar variables
+!!$!
+!!$IF (NSV /= 0) THEN
+!!$ DO JSV = 1, NSV
+!!$ XLBXSVM(1:NRIMX+JPHEXT,:,:,JSV) = XSVT(1:NRIMX+JPHEXT,:,:,JSV)
+!!$ XLBXSVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JSV) = XSVT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JSV)
+!!$ IF( .NOT. L2D ) THEN
+!!$ XLBYSVM(:,1:NRIMY+JPHEXT,:,JSV) = XSVT(:,1:NRIMY+JPHEXT,:,JSV)
+!!$ XLBYSVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JSV) = XSVT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JSV)
+!!$ END IF
+!!$ END DO
+!!$ENDIF
+!!$>>>>>>> 1.3.2.4.2.2.2.6.2.3.2.6.2.1
+!
+!* 5.10 Surface precipitation computation
+!
+IF (SIZE(XINPRR) /= 0 ) THEN
+ IF (GNOSON) &
+ CALL SPAWN_SURF2_RAIN (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
+ XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
+ XACPRR,XINPRS,XACPRS,XINPRG,XACPRG,&
+ XINPRH,XACPRH )
+ IF (.NOT.GNOSON) &
+ CALL SPAWN_SURF2_RAIN (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
+ XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
+ XACPRR,XINPRS,XACPRS,XINPRG,XACPRG,XINPRH,XACPRH, &
+ TZSONFILE,IIUSON,IJUSON, &
+ IIB2,IJB2,IIE2,IJE2, &
+ IIB1,IJB1,IIE1,IJE1 )
+ENDIF
+!
+!* 5.11 Total mass of dry air Md computation :
+!
+ZTIME1 = ZTIME2
+!
+ALLOCATE(ZRHOD(IIU,IJU,IKU))
+!
+IF (LOCEAN) THEN
+ ZRHOD(:,:,:)=XRH00OCEAN*(1.-XALPHAOC*(ZTHVT(:,:,:)-XTH00OCEAN)+XBETAOC*(XRT(:,:,:,1)-XSA00OCEAN))
+ELSE
+ ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
+ /(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
+ENDIF
+!$20140709
+ CALL MPPDB_CHECK3D(ZRHOD,"SPAWN_MOD2:ZRHOD",PRECISION)
+ CALL MPPDB_CHECK3D(XPABST,"SPAWN_MOD2:XPABST",PRECISION)
+ CALL MPPDB_CHECK3D(ZSUMRT,"SPAWN_MOD2:ZSUMRT",PRECISION)
+!$20140710 until here all ok after UPHALO(XZZ)
+!
+CALL TOTAL_DMASS(ZJ,ZRHOD,XDRYMASST)
+!
+DEALLOCATE (ZRHOD)
+DEALLOCATE (ZSUMRT,ZTHVT)
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZMISC = ZMISC + ZTIME2 - ZTIME1
+!
+!* 5.12 Deallocation of model 1 variables :
+!
+ZTIME1 = ZTIME2
+!
+CALL DEALLOCATE_MODEL1(3)
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZMISC = ZMISC + ZTIME2 - ZTIME1
+!
+!* 5.13 Anelastic correction :
+!
+CALL SECOND_MNH(ZTIME1)
+!
+IF (.NOT. L1D) THEN
+ CALL ANEL_BALANCE_n
+ 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 )
+END IF
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZANEL = ZTIME2 - ZTIME1
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. WRITE THE FMFILE
+! ----------------
+!
+CALL SECOND_MNH(ZTIME1)
+!
+INPRAR = 22 + 2*(4+NRR+NSV) ! 22 = number of grid variables + reference state
+ ! variables +dimension variables
+ ! 2*(4+NRR+NSV) = number of prognostic variables
+ ! at time t and t-dt
+IF ( ( LEN_TRIM(HSPAFILE) /= 0 ) .AND. ( ADJUSTL(HSPAFILE) /= ADJUSTL(CINIFILE) ) ) THEN
+ CMY_NAME(2)=HSPAFILE
+ELSE
+ CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spa'//ADJUSTL(HSPANBR))
+ IF (.NOT.GNOSON) &
+ CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spr'//ADJUSTL(HSPANBR))
+END IF
+!
+CALL IO_File_add2list(TZFILE,CMY_NAME(2),'MNH','WRITE',KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
+!
+CALL IO_File_open(TZFILE)
+!
+CALL WRITE_DESFM_n(2,TZFILE)
+!
+IF (LBAL_ONLY) THEN ! same relation with its DAD for model2 and for model1
+ NDXRATIO_ALL(2) = NDXRATIO_ALL(1)
+ NDYRATIO_ALL(2) = NDYRATIO_ALL(1)
+ NXOR_ALL(2) = NXOR_ALL(1)
+ NYOR_ALL(2) = NYOR_ALL(1)
+ NXEND_ALL(2) = NXEND_ALL(1)
+ NYEND_ALL(2) = NYEND_ALL(1)
+ CDAD_NAME(2) = CDAD_NAME(1)
+ IF (CDADSPAFILE == '' ) THEN
+ IF (NDXRATIO_ALL(1) == 1 .AND. NDYRATIO_ALL(1) == 1 &
+ .AND. NXOR_ALL(1) == 1 .AND. NYOR_ALL(1) == 1 ) THEN
+ ! for spawning with ratio=1
+ ! if the DAD of model 1 is itself, the DAD of model 2 also.
+ CDAD_NAME(2)=CMY_NAME(2)
+ ENDIF
+ ENDIF
+ ! case of model with DAD
+ IF (CDADSPAFILE /='') CDAD_NAME(2)=CDADSPAFILE
+ELSE
+ CDAD_NAME(2)=CMY_NAME(1) ! model 1 becomes the DAD of model 2 (spawned one)
+ENDIF
+!
+CALL IO_Header_write(TZFILE,HDAD_NAME=CDAD_NAME(2))
+CALL WRITE_LFIFM_n(TZFILE,CDAD_NAME(2))
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZWRITE = ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. Surface variables :
+!
+ZTIME1 = ZTIME2
+!
+TFILE_SURFEX => TZFILE
+CALL SPAWN_SURF(HINIFILE,HINIFILEPGD,TZFILE,OSPAWN_SURF)
+NULLIFY(TFILE_SURFEX)
+!
+CALL SECOND_MNH(ZTIME2)
+!
+ZSURF2 = ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. CLOSES THE FMFILE
+! -----------------
+!
+CALL IO_File_close(TZFILE)
+IF (ASSOCIATED(TZSONFILE)) THEN
+ CALL IO_File_close(TZSONFILE)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. PRINTS ON OUTPUT-LISTING
+! ------------------------
+!
+WRITE(ILUOUT,FMT=9900) XZHAT(1)
+!
+DO JLOOP = 2,IKU
+ WRITE(ILUOUT,FMT=9901) JLOOP,XZHAT(JLOOP),XZHAT(JLOOP)-XZHAT(JLOOP-1)
+END DO
+!
+IF (NVERB >= 5) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERV,LUSERC=',LUSERV,LUSERC
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERR,LUSERI,LUSERS=',LUSERR,LUSERI,LUSERS
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERG,LUSERH,NSV=',LUSERG,LUSERH,NSV
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: NRR=',NRR
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: NVERB=',NVERB
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: XLON0,XLAT0,XBETA=',XLON0,XLAT0,XBETA
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: LCARTESIAN=',LCARTESIAN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: LOCEAN,LCOUPLES=',LOCEAN,LCOUPLES
+ IF(LCARTESIAN) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: No map projection used.'
+ ELSE
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: XRPK,XLONORI,XLATORI=',XRPK,XLONORI,XLATORI
+ IF (ABS(XRPK) == 1.) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Polar stereo used.'
+ ELSE IF (XRPK == 0.) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Mercator used.'
+ ELSE
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Lambert used, cone factor=',XRPK
+ END IF
+ END IF
+END IF
+!
+IF (NVERB >= 10) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: IIB, IJB, IKB=',IIB,IJB,IKB
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: IIU, IJU, IKU=',IIU,IJU,IKU
+END IF
+!
+IF(NVERB >= 10) THEN !Value control
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XZS values:'
+ WRITE(ILUOUT,*) XZS(1,IJU),XZS((IIU-1)/2,IJU),XZS(IIU,IJU)
+ WRITE(ILUOUT,*) XZS(1,(IJU-1)/2),XZS((IIU-1)/2,(IJU-1)/2),XZS(IIU,(IJU-1)/2)
+ WRITE(ILUOUT,*) XZS(1,1) ,XZS((IIU-1)/2,1) ,XZS(IIU,1)
+END IF
+!
+IF(NVERB >= 10) THEN !Value control
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XUT values:'
+ WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
+ &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
+ DO JKLOOP=1,IKU
+ WRITE(ILUOUT,*) 'JK = ',JKLOOP
+ WRITE(ILUOUT,*) XUT(1,IJU/2,JKLOOP),XUT(IIU/2,1,JKLOOP), &
+ XUT(IIU/2,IJU/2,JKLOOP),XUT(IIU/2,IJU,JKLOOP), &
+ XUT(IIU,IJU/2,JKLOOP)
+ END DO
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XVT values:'
+ WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
+ &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
+ DO JKLOOP=1,IKU
+ WRITE(ILUOUT,*) 'JK = ',JKLOOP
+ WRITE(ILUOUT,*) XVT(1,IJU/2,JKLOOP),XVT(IIU/2,1,JKLOOP), &
+ XVT(IIU/2,IJU/2,JKLOOP),XVT(IIU/2,IJU,JKLOOP), &
+ XVT(IIU,IJU/2,JKLOOP)
+ END DO
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XWT values:'
+ WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
+ &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
+ DO JKLOOP=1,IKU
+ WRITE(ILUOUT,*) 'JK = ',JKLOOP
+ WRITE(ILUOUT,*) XWT(1,IJU/2,JKLOOP),XWT(IIU/2,1,JKLOOP), &
+ XWT(IIU/2,IJU/2,JKLOOP),XWT(IIU/2,IJU,JKLOOP), &
+ XWT(IIU,IJU/2,JKLOOP)
+ END DO
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XTHT values:'
+ WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
+ &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
+ DO JKLOOP=1,IKU
+ WRITE(ILUOUT,*) 'JK = ',JKLOOP
+ WRITE(ILUOUT,*) XTHT(1,IJU/2,JKLOOP),XTHT(IIU/2,1,JKLOOP), &
+ XTHT(IIU/2,IJU/2,JKLOOP),XTHT(IIU/2,IJU,JKLOOP), &
+ XTHT(IIU,IJU/2,JKLOOP)
+ END DO
+ IF(NRR >= 1) THEN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XRT values:'
+ WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
+ &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
+ DO JKLOOP=1,IKU
+ WRITE(ILUOUT,*) 'JK = ',JKLOOP
+ WRITE(ILUOUT,*) XRT(1,IJU/2,JKLOOP,1),XRT(IIU/2,1,JKLOOP,1), &
+ XRT(IIU/2,IJU/2,JKLOOP,1),XRT(IIU/2,IJU,JKLOOP,1), &
+ XRT(IIU,IJU/2,JKLOOP,1)
+ END DO
+ END IF
+ !
+ IF (LUV_FLX) THEN
+ WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XVU_FLUX(IIU/2,2,:)=',XVU_FLUX_M(IIU/2,2,:)
+ END IF
+ !
+ IF (LTH_FLX) THEN
+ WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XVTH_FLUX(IIU/2,2,:)=',XVTH_FLUX_M(IIU/2,2,:)
+ WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XWTH_FLUX(IIU/2,2,:)=',XWTH_FLUX_M(IIU/2,2,:)
+ END IF
+ !
+END IF
+!
+WRITE(ILUOUT,*) 'SPAWN_MODEL2: SPAWN_MODEL2 ENDS CORRECTLY.'
+!
+CALL SECOND_MNH (ZEND)
+!
+ZTOT = ZEND - ZSTART ! for computing time analysis
+!
+ZALL = ZGRID2 + ZSURF2 + ZMISC + ZFIELD2 + ZVER + ZPRESSURE2 + ZANEL + ZWRITE
+!
+ZPERCALL = 100.*ZALL/ZTOT
+!
+ZPERCGRID2 = 100.*ZGRID2/ZTOT
+ZPERCSURF2 = 100.*ZSURF2/ZTOT
+ZPERCMISC = 100.*ZMISC/ZTOT
+ZPERCFIELD2 = 100.*ZFIELD2/ZTOT
+ZPERCVER = 100.*ZVER/ZTOT
+ZPERCPRESSURE2 = 100.*ZPRESSURE2/ZTOT
+ZPERCANEL = 100.*ZANEL/ZTOT
+ZPERCWRITE = 100.*ZWRITE/ZTOT
+!
+WRITE(ILUOUT,*)
+WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
+WRITE(ILUOUT,*) '| |'
+WRITE(ILUOUT,*) '| COMPUTING TIME ANALYSIS in SPAWN_MODEL2 |'
+WRITE(ILUOUT,*) '| |'
+WRITE(ILUOUT,*) '|------------------------------------------------------------|'
+WRITE(ILUOUT,*) '| | | |'
+WRITE(ILUOUT,*) '| ROUTINE NAME | CPU-TIME | PERCENTAGE % |'
+WRITE(ILUOUT,*) '| | | |'
+WRITE(ILUOUT,*) '|---------------------|-------------------|------------------|'
+WRITE(ILUOUT,*) '| | | |'
+WRITE(UNIT=ILUOUT,FMT=1) ZGRID2 ,ZPERCGRID2
+WRITE(UNIT=ILUOUT,FMT=3) ZFIELD2,ZPERCFIELD2
+WRITE(UNIT=ILUOUT,FMT=8) ZVER,ZPERCVER
+WRITE(UNIT=ILUOUT,FMT=7) ZPRESSURE2,ZPERCPRESSURE2
+WRITE(UNIT=ILUOUT,FMT=2) ZSURF2 ,ZPERCSURF2
+WRITE(UNIT=ILUOUT,FMT=4) ZANEL ,ZPERCANEL
+WRITE(UNIT=ILUOUT,FMT=5) ZWRITE ,ZPERCWRITE
+WRITE(UNIT=ILUOUT,FMT=9) ZMISC ,ZPERCMISC
+WRITE(UNIT=ILUOUT,FMT=6) ZTOT ,ZPERCALL
+WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
+!
+! FORMATS
+! -------
+!
+1 FORMAT(' | SPAWN_GRID2 | ',F8.3,' | ',F8.3,' |')
+3 FORMAT(' | SPAWN_FIELD2 | ',F8.3,' | ',F8.3,' |')
+8 FORMAT(' | VER_INTERP_FIELD | ',F8.3,' | ',F8.3,' |')
+7 FORMAT(' | SPAWN_PRESSURE2 | ',F8.3,' | ',F8.3,' |')
+2 FORMAT(' | SPAWN_SURF2 | ',F8.3,' | ',F8.3,' |')
+4 FORMAT(' | ANEL_BALANCE2 | ',F8.3,' | ',F8.3,' |')
+5 FORMAT(' | WRITE | ',F8.3,' | ',F8.3,' |')
+9 FORMAT(' | MISCELLANEOUS | ',F8.3,' | ',F8.3,' |')
+6 FORMAT(' | SPAWN_MODEL2 | ',F8.3,' | ',F8.3,' |')
+!
+!
+CALL IO_File_close(TLUOUT)
+!
+9900 FORMAT(' K = 001 ZHAT = ',E14.7)
+9901 FORMAT(' K = ',I3.3,' ZHAT = ',E14.7,' DZ = ' ,E14.7)
+!
+!-------------------------------------------------------------------------------
+!
+!
+! Switch back to model index of calling routine
+CALL GOTO_MODEL(IMI)
+!
+END SUBROUTINE SPAWN_MODEL2
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/to_elec_fieldn.f90 b/src/PHYEX/ext/to_elec_fieldn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a6822298d897cb7c93e22205048645c57db9da56
--- /dev/null
+++ b/src/PHYEX/ext/to_elec_fieldn.f90
@@ -0,0 +1,184 @@
+!MNH_LIC Copyright 2002-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_TO_ELEC_FIELD_n
+! ###########################
+!
+INTERFACE
+ SUBROUTINE TO_ELEC_FIELD_n(PRT, PSVT, PRHODJ, KTCOUNT, KRR, &
+ PEFIELDU, PEFIELDV, PEFIELDW, PPHIT)
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! counter value of the
+ ! model temporal loop
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variables with
+ ! electric charge density
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! 3 components
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! of the
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDW ! electric field
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PPHIT ! Electrostatic potential
+
+END SUBROUTINE TO_ELEC_FIELD_n
+END INTERFACE
+END MODULE MODI_TO_ELEC_FIELD_n
+!
+! ###############################################################
+ SUBROUTINE TO_ELEC_FIELD_n(PRT, PSVT, PRHODJ, KTCOUNT, KRR, &
+ PEFIELDU, PEFIELDV, PEFIELDW, PPHIT)
+! ###############################################################
+!
+!
+!!**** * - compute the electric field
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute...
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe, G. Molinie, J.-P. Pinty *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 2002
+!! C. Barthe 06/11/09 update to version 4.8.1
+!! M. Chong 26/01/10 Add Small ions
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_REF_n, ONLY : XRHODREF
+USE MODD_PARAMETERS, ONLY : JPVEXT
+USE MODD_RAIN_ICE_DESCR_n, ONLY : XRTMIN
+USE MODD_ELEC_DESCR, ONLY : XRELAX_ELEC, XECHARGE
+USE MODD_ELEC_n, ONLY : XESOURCEFW
+!
+USE MODI_ELEC_FIELD_n
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! counter value of the
+ ! model temporal loop
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variables with
+ ! electric charge density
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! 3 components
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! of the
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDW ! electric field
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PPHIT ! Electrostatic potential
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW ! work array
+!
+INTEGER :: IIB ! Define
+INTEGER :: IIE ! the
+INTEGER :: IJB ! physical
+INTEGER :: IJE ! domain
+INTEGER :: IKB !
+INTEGER :: IKE !
+INTEGER :: IIU, IJU, IKU
+INTEGER :: II
+INTEGER :: IINFO_ll
+!
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+NULLIFY(TZFIELDS_ll)
+!
+! Compute loop bounds
+!
+CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+!
+IKB = 1 + JPVEXT
+IKU = SIZE(XESOURCEFW,3)
+IKE = IKU - JPVEXT
+!
+! allocations
+!
+ALLOCATE(ZW(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)))
+ZW(:,:,:) = 0.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. TRANSFORM PSVT from C/kg INTO C/m3 and SUM
+! ----------------------------------
+!
+DO II = 1, KRR+1
+ ZW(:,:,:) = ZW(:,:,:) + PSVT(:,:,:,II) * XRHODREF(:,:,:)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. BOUNDARY CONDITIONS
+! -------------------
+!
+ZW(:,:,1:IKB-1) = 0.0 ! Setup to neutralize the computation on the
+ ! first ligne of the tridiagonal system starting
+ ! at IKB-1
+ZW(:,:,IKE:IKE+JPVEXT) = XESOURCEFW(:,:,IKE:IKE+JPVEXT)
+!
+CALL ADD3DFIELD_ll( TZFIELDS_ll, ZW, 'TO_ELEC_FIELD_n::ZW' )
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZFIELDS_ll)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. COMPUTE THE ELECTRIC FIELD
+! --------------------------
+!
+IF (PRESENT(PPHIT)) THEN
+ CALL ELEC_FIELD_n (ZW, KTCOUNT, XRELAX_ELEC, PRHODJ, &
+ PEFIELDU, PEFIELDV, PEFIELDW, PPHIT)
+ELSE
+ CALL ELEC_FIELD_n (ZW, KTCOUNT, XRELAX_ELEC, PRHODJ, &
+ PEFIELDU, PEFIELDV, PEFIELDW)
+ENDIF
+!
+DEALLOCATE(ZW)
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TO_ELEC_FIELD_n
+
diff --git a/src/PHYEX/ext/two_wayn.f90 b/src/PHYEX/ext/two_wayn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b2299ee4ac537dace171013da289b8b8f0fc0b5b
--- /dev/null
+++ b/src/PHYEX/ext/two_wayn.f90
@@ -0,0 +1,1309 @@
+!MNH_LIC Copyright 1997-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_TWO_WAY_n
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE TWO_WAY_n (KRR,KSV,PRHODJ,KMI,PTSTEP, &
+ PUM ,PVM, PWM, PTHM, PRM, PSVM, &
+ PRUS,PRVS,PRWS,PRTHS,PRRS,PRSVS, &
+ PINPRC,PINPRR,PINPRS,PINPRG,PINPRH,PPRCONV,PPRSCONV, &
+ PDIRFLASWD,PSCAFLASWD,PDIRSRFSWD,OMASKkids )
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, INTENT(IN) :: PTSTEP ! Timestep duration
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! Variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM, PSVM
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS, PRSVS ! terms
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC,PINPRR,PINPRS,PINPRG,PINPRH, &
+ PPRCONV,PPRSCONV ! precipitating variables
+LOGICAL, DIMENSION(:,:), INTENT(INOUT) :: OMASKkids ! true where kids exist
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDIRFLASWD,PSCAFLASWD ! Long wave radiation
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDIRSRFSWD ! Long wave radiation
+!
+END SUBROUTINE TWO_WAY_n
+!
+END INTERFACE
+!
+END MODULE MODI_TWO_WAY_n
+! #######################################################################
+ SUBROUTINE TWO_WAY_n (KRR,KSV,PRHODJ,KMI,PTSTEP, &
+ PUM ,PVM, PWM, PTHM, PRM, PSVM, &
+ PRUS,PRVS,PRWS,PRTHS,PRRS,PRSVS, &
+ PINPRC,PINPRR,PINPRS,PINPRG,PINPRH,PPRCONV,PPRSCONV, &
+ PDIRFLASWD,PSCAFLASWD,PDIRSRFSWD,OMASKkids )
+! #######################################################################
+!
+!!**** *TWO_WAY_n* - Relaxation of all fields toward the average value obtained
+!!**** by the nested model $n for TWO_WAY interactive gridnesting
+!!
+!! PURPOSE
+!! -------
+!! The purpose of TWO_WAY_n is:
+!! - first to average the fine scale fields of the inner model $n to
+!! the coarse mesh scale of the present outer model DAD($n).
+!! - second to apply the relaxation toward these average fields over the
+!! intersecting domain
+!
+!
+!!** METHOD
+!! ------
+!! Use a simple top hat horizontal average applied in the inner domain
+!! except in a halo inner band of IHALO width (default value 0).
+!! The relaxation equation writes:
+!! ___ t-1
+!! | \ rhodj * a |
+!! d (RHODJ * A) | t-1 /__ |
+!! -------------- = -K * RHODJ * |A - ----------------- |
+!! dt 2W | ___ |
+!! | \ rhodj |
+!! | /__ |
+!!
+!! In this routine $n denotes the nested model (with all variables X...,N...).
+!! KMI is the number of father model (all variables P..., K...)
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! MODULE MODD_CONF_n : all
+!!
+!! MODULE MODD_NESTING: NDT_2_WAY
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! J. P. Lafore *Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/11/97
+!! 20/01/98 remove the TKE and EPS change
+!! P. Jabouille 03/04/00 parallelisation
+!! N. Asencio 18/07/05 Add the surface parameters : precipitating
+!! hydrometeors, the Short and Long Wave
+!! + MASKkids array
+!! 20/05/06 Remove EPS
+!! M. Leriche 16/07/10 Add ice phase chemical species
+!! V.Masson, C.Lac 08/10 Corrections in relaxation
+!! J. Escobar 27/06/2011 correction for gridnesting with different SHAPE
+!! Bosseur & Filippi 07/2013 Adds Forefire
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Modification 01/2016 (JP Pinty) Add LIMA
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 29/03/2019: bugfix: use correct sizes for 3rd dimension in allocation and loops when CRAD/='NONE'
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+!
+USE MODD_PARAMETERS ! Declarative modules
+USE MODD_NESTING
+USE MODD_CONF
+USE MODD_NSV
+USE MODD_PARAM_ICE_n, ONLY : LSEDIC
+USE MODD_PARAM_C2R2, ONLY : LSEDC
+USE MODD_PARAM_LIMA, ONLY : NSEDC => LSEDC
+!
+USE MODD_FIELD_n ! modules relative to the inner (fine scale) model $n
+USE MODD_PRECIP_n , ONLY : XINPRC,XINPRR,XINPRS,XINPRG,XINPRH
+USE MODD_RADIATIONS_n ,ONLY:XDIRFLASWD,XSCAFLASWD,XDIRSRFSWD
+USE MODD_DEEP_CONVECTION_n ,ONLY : XPRCONV,XPRSCONV
+USE MODD_REF_n
+USE MODD_CONF_n
+USE MODD_PARAM_n
+USE MODI_SHUMAN
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of SV (father model)
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+REAL, INTENT(IN) :: PTSTEP ! Timestep duration
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! Variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM, PSVM
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS, PRSVS ! terms
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC,PINPRR,PINPRS,PINPRG,PINPRH &
+ ,PPRCONV,PPRSCONV ! precipitating variables
+LOGICAL, DIMENSION(:,:), INTENT(INOUT) :: OMASKkids ! true where kids exist
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDIRFLASWD,PSCAFLASWD ! Long wave radiation
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDIRSRFSWD ! Long wave radiation
+!
+!* 0.2 declarations of local variables
+!
+!
+INTEGER :: IIB,IJB,IIE,IJE
+INTEGER :: IKU,IKB
+INTEGER :: II1,II2,IJ1,IJ2,II1U,IJ1V,IWEST,ISOUTH,IDIST
+INTEGER :: IXOR,IXEND ! horizontal position (i,j) of the ORigin and END
+INTEGER :: IYOR,IYEND ! of the inner model $n domain, relative to outer model subdomain
+INTEGER :: IXORU,IYORV ! particular case dure to C grid
+INTEGER :: IDXRATIO,IDYRATIO ! x and y-direction resolution RATIO
+INTEGER :: IXOR_ll,IYOR_ll ! origin's coordinates of extended subdomain
+INTEGER :: IXDIM,IYDIM ! size of the extended dad subdomain
+!
+INTEGER :: JX,JY,JVAR ! loop index
+INTEGER :: IRR,ISV_USER ! number of moist and scalar var commun to both models
+!
+REAL :: ZK2W ! Relaxation value
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZAVE_RHODJ
+!
+! intermediate arrays for model communication
+REAL, DIMENSION(:, :, :), ALLOCATABLE :: ZTUM, ZTVM, ZTWM, ZTTHM
+REAL, DIMENSION(:, :, :, :), ALLOCATABLE :: ZTRM, ZTSVM
+REAL, DIMENSION(:, :, :), ALLOCATABLE :: ZUM, ZVM, ZWM, ZTHM
+REAL, DIMENSION(:, :, :, :), ALLOCATABLE :: ZRM, ZSVM
+REAL, DIMENSION(:, :, :), ALLOCATABLE :: ZTRHODJ, ZTRHODJU, ZTRHODJV
+REAL, DIMENSION(:, :, :), ALLOCATABLE :: ZRHODJ, ZRHODJU, ZRHODJV
+REAL, DIMENSION(:, :), ALLOCATABLE ::ZTINPRC,ZTINPRR,ZTINPRS,ZTINPRG,ZTINPRH,&
+ ZTPRCONV,ZTPRSCONV
+REAL, DIMENSION(:, :,:), ALLOCATABLE :: ZTDIRFLASWD,ZTSCAFLASWD
+REAL, DIMENSION(:, :,:), ALLOCATABLE :: ZTDIRSRFSWD
+REAL, DIMENSION(:, :), ALLOCATABLE ::ZINPRC,ZINPRR,ZINPRS,ZINPRG,ZINPRH,&
+ ZPRCONV,ZPRSCONV
+REAL, DIMENSION(:, :,:), ALLOCATABLE :: ZDIRFLASWD,ZSCAFLASWD
+REAL, DIMENSION(:, :,:), ALLOCATABLE :: ZDIRSRFSWD
+!
+INTEGER :: IINFO_ll, IDIMX, IDIMY ! size of intermediate arrays
+INTEGER :: IHALO ! band size where relaxation is not performed
+LOGICAL :: LINTER ! flag for intersection or not with the child domain
+INTEGER :: IMI ! Current model index KMI==NDAD(IMI)
+!
+INTEGER :: IIBC,IJBC,IIEC,IJEC
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PROLOGUE:
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+CALL GO_TOMODEL_ll(KMI, IINFO_ll)
+CALL GET_CHILD_DIM_ll(IMI, IDIMX, IDIMY, IINFO_ll)
+!
+! here we need to go back to SON domain for boundaries test
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+!
+IKU = SIZE(PTHM,3)
+IKB = JPVEXT+1
+!
+IDXRATIO = NDXRATIO_ALL(IMI)
+IDYRATIO = NDYRATIO_ALL(IMI)
+!
+IRR = MIN(KRR,NRR)
+ISV_USER = MIN(NSV_USER_A(KMI),NSV_USER_A(IMI))
+!
+! 1.1 Allocate array of horizontal average fields
+!
+ALLOCATE(ZTUM(IDIMX, IDIMY, SIZE(PUM, 3)))
+ALLOCATE(ZTVM(IDIMX, IDIMY, SIZE(PUM, 3)))
+ALLOCATE(ZTWM(IDIMX, IDIMY, SIZE(PUM, 3)))
+ALLOCATE(ZTTHM(IDIMX, IDIMY, SIZE(PUM, 3)))
+IF (IRR /= 0) THEN
+ ALLOCATE(ZTRM(IDIMX, IDIMY, SIZE(PUM, 3),IRR))
+ ELSE
+ ALLOCATE(ZTRM(0,0,0,0))
+ENDIF
+IF (KSV /= 0) THEN
+ ALLOCATE(ZTSVM(IDIMX, IDIMY, SIZE(PUM, 3),KSV))
+ELSE
+ ALLOCATE(ZTSVM(0,0,0,0))
+ENDIF
+!
+IF (LUSERC .AND. ( (LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
+ (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
+ (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
+ ALLOCATE(ZTINPRC(IDIMX, IDIMY))
+ELSE
+ ALLOCATE(ZTINPRC(0,0))
+ENDIF
+IF (LUSERR) THEN
+ ALLOCATE(ZTINPRR(IDIMX, IDIMY))
+ELSE
+ ALLOCATE(ZTINPRR(0,0))
+ENDIF
+IF (LUSERS) THEN
+ ALLOCATE(ZTINPRS(IDIMX, IDIMY))
+ELSE
+ ALLOCATE(ZTINPRS(0,0))
+ENDIF
+IF (LUSERG) THEN
+ ALLOCATE(ZTINPRG(IDIMX, IDIMY))
+ELSE
+ ALLOCATE(ZTINPRG(0,0))
+ENDIF
+IF (LUSERH) THEN
+ ALLOCATE(ZTINPRH(IDIMX, IDIMY))
+ELSE
+ ALLOCATE(ZTINPRH(0,0))
+ENDIF
+IF (CDCONV /= 'NONE') THEN
+ ALLOCATE(ZTPRCONV (IDIMX, IDIMY))
+ ALLOCATE(ZTPRSCONV(IDIMX, IDIMY))
+ ELSE
+ ALLOCATE(ZTPRCONV (0,0))
+ ALLOCATE(ZTPRSCONV(0,0))
+END IF
+IF (CRAD /= 'NONE') THEN
+ ALLOCATE(ZTDIRFLASWD(IDIMX, IDIMY, SIZE(PDIRFLASWD,3)))
+ ALLOCATE(ZTSCAFLASWD(IDIMX, IDIMY, SIZE(PSCAFLASWD,3)))
+ ALLOCATE(ZTDIRSRFSWD(IDIMX, IDIMY, SIZE(PDIRSRFSWD,3)))
+ELSE
+ ALLOCATE(ZTDIRFLASWD(0,0,0))
+ ALLOCATE(ZTSCAFLASWD(0,0,0))
+ ALLOCATE(ZTDIRSRFSWD(0,0,0))
+ENDIF
+!
+ALLOCATE(ZTRHODJ (IDIMX, IDIMY, SIZE(PUM, 3)))
+ALLOCATE(ZTRHODJU(IDIMX, IDIMY, SIZE(PUM, 3)))
+ALLOCATE(ZTRHODJV(IDIMX, IDIMY, SIZE(PUM, 3)))
+!
+!
+ZK2W = 1. / (PTSTEP * NDT_2_WAY(NDAD(IMI)))
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. AVERAGE OF SCALAR VARIABLES
+! ---------------------------
+!
+IIBC=JPHEXT+2
+IIEC=IDIMX-JPHEXT-1
+IJBC=JPHEXT+2
+IJEC=IDIMY-JPHEXT-1
+!
+!* 2.1 summation of rhodj
+!
+ZTRHODJ(:,:,:) = 0.
+DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTRHODJ(IIBC:IIEC,IJBC:IJEC,:) = ZTRHODJ(IIBC:IIEC,IJBC:IJEC,:) &
+ +XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+ END DO
+END DO
+!
+!* 2.2 temperature
+!
+ZTTHM(:,:,:) = 0.
+DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTTHM(IIBC:IIEC,IJBC:IJEC,:) = ZTTHM(IIBC:IIEC,IJBC:IJEC,:) &
+ +XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
+ *XTHT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+!
+ END DO
+END DO
+!
+!
+!* 2.5 moist variables
+!
+DO JVAR=1,IRR
+ ZTRM(:,:,:,JVAR) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTRM(IIBC:IIEC,IJBC:IJEC,:,JVAR) = ZTRM(IIBC:IIEC,IJBC:IJEC,:,JVAR) &
+ +XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
+ *XRT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR)
+ END DO
+ END DO
+END DO
+!
+!* 2.6 scalar variables SV
+!
+! User scalar variables
+IF (KSV /= 0) THEN
+ DO JVAR=1,ISV_USER
+ ZTSVM(:,:,:,JVAR) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR) = ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR) &
+ +XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
+ *XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR)
+ END DO
+ END DO
+ END DO
+! C2R2 scalar variables
+IF (NSV_C2R2_A(IMI) > 0) THEN
+ ! nested model uses C2R2 microphysical scheme
+ DO JVAR=1,NSV_C2R2_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_C2R2BEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_C2R2BEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_C2R2BEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_C2R2BEG_A(IMI))
+ END DO
+ END DO
+ END DO
+END IF
+! C1R3 scalar variables
+IF (NSV_C1R3_A(IMI) > 0) THEN
+ ! nested model uses C1R3 microphysical scheme
+ DO JVAR=1,NSV_C1R3_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_C1R3BEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_C1R3BEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_C1R3BEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_C1R3BEG_A(IMI))
+ END DO
+ END DO
+ END DO
+END IF
+! LIMA scalar variables
+IF (NSV_LIMA_A(IMI) > 0) THEN
+ ! nested model uses LIMA microphysical scheme
+ DO JVAR=1,NSV_LIMA_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_LIMA_BEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LIMA_BEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LIMA_BEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LIMA_BEG_A(IMI))
+ END DO
+ END DO
+ END DO
+END IF
+! Electrical scalar variables
+IF (NSV_ELEC_A(IMI) > 0) THEN
+ ! nested model uses electrical scheme
+ DO JVAR=1,NSV_ELEC_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_ELECBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_ELECBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_ELECBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_ELECBEG_A(IMI))
+ END DO
+ END DO
+ END DO
+END IF
+! Chemical scalar variables
+DO JVAR=1,NSV_CHEM_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_CHEMBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CHEMBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CHEMBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CHEMBEG_A(IMI))
+ END DO
+ END DO
+END DO
+! Ice phase chemical scalar variables
+IF (NSV_CHIC_A(IMI) > 0) THEN
+ ! nested model uses aqueous chemistry and ice3/4 scheme
+ DO JVAR=1,NSV_CHIC_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_CHICBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CHICBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CHICBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CHICBEG_A(IMI))
+ END DO
+ END DO
+ END DO
+END IF
+! NOX variables
+DO JVAR=1,NSV_LNOX_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_LNOXBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LNOXBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LNOXBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LNOXBEG_A(IMI))
+ END DO
+ END DO
+END DO
+! Orilam scalar variables
+DO JVAR=1,NSV_AER_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_AERBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_AERBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_AERBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_AERBEG_A(IMI))
+ END DO
+ END DO
+END DO
+DO JVAR=1,NSV_AERDEP_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_AERDEPBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_AERDEPBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_AERDEPBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_AERDEPBEG_A(IMI))
+ END DO
+ END DO
+END DO
+! Dust scalar variables
+DO JVAR=1,NSV_DST_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_DSTBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_DSTBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_DSTBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_DSTBEG_A(IMI))
+ END DO
+ END DO
+END DO
+DO JVAR=1,NSV_DSTDEP_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_DSTDEPBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_DSTDEPBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_DSTDEPBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_DSTDEPBEG_A(IMI))
+ END DO
+ END DO
+END DO
+! Salt scalar variables
+DO JVAR=1,NSV_SLT_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_SLTBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_SLTBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_SLTBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_SLTBEG_A(IMI))
+ END DO
+ END DO
+END DO
+DO JVAR=1,NSV_SLTDEP_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_SLTDEPBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_SLTDEPBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_SLTDEPBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_SLTDEPBEG_A(IMI))
+ END DO
+ END DO
+END DO
+! lagrangian variables
+DO JVAR=1,NSV_LG_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_LGBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LGBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LGBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LGBEG_A(IMI))
+ END DO
+ END DO
+END DO
+END IF
+! Passive scalar variables
+IF (NSV_PP_A(IMI) > 0) THEN
+DO JVAR=1,NSV_PP_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_PPBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_PPBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_PPBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_PPBEG_A(IMI))
+ END DO
+ END DO
+END DO
+END IF
+#ifdef MNH_FOREFIRE
+! ForeFire variables
+IF (NSV_FF_A(IMI) > 0) THEN
+DO JVAR=1,NSV_FF_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_FFBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_FFBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_FFBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_FFBEG_A(IMI))
+ END DO
+ END DO
+END DO
+END IF
+#endif
+! Conditional sampling variables
+IF (NSV_CS_A(IMI) > 0) THEN
+DO JVAR=1,NSV_CS_A(KMI)
+ ZTSVM(:,:,:,JVAR-1+NSV_CSBEG_A(KMI)) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CSBEG_A(KMI)) = &
+ &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CSBEG_A(KMI))+&
+ &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CSBEG_A(IMI))
+ END DO
+ END DO
+END DO
+END IF
+! Precipitating variables
+ IF (LUSERR) THEN
+ ZTINPRR(:,:) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTINPRR(IIBC:IIEC,IJBC:IJEC) = ZTINPRR(IIBC:IIEC,IJBC:IJEC) &
+ +XINPRR(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
+ END DO
+ END DO
+ ZTINPRR(IIBC:IIEC,IJBC:IJEC)=ZTINPRR(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
+ END IF
+!
+ IF (LUSERC .AND. ((LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
+ (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
+ (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
+ ZTINPRC(:,:) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTINPRC(IIBC:IIEC,IJBC:IJEC) = ZTINPRC(IIBC:IIEC,IJBC:IJEC) &
+ +XINPRC(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
+ END DO
+ END DO
+ ZTINPRC(IIBC:IIEC,IJBC:IJEC)=ZTINPRC(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
+ END IF
+!
+ IF (LUSERS) THEN
+ ZTINPRS(:,:) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTINPRS(IIBC:IIEC,IJBC:IJEC) = ZTINPRS(IIBC:IIEC,IJBC:IJEC) &
+ +XINPRS(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
+ END DO
+ END DO
+ ZTINPRS(IIBC:IIEC,IJBC:IJEC) = ZTINPRS(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
+ END IF
+!
+ IF (LUSERG) THEN
+ ZTINPRG(:,:) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTINPRG(IIBC:IIEC,IJBC:IJEC) = ZTINPRG(IIBC:IIEC,IJBC:IJEC) &
+ +XINPRG(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
+ END DO
+ END DO
+ ZTINPRG(IIBC:IIEC,IJBC:IJEC) =ZTINPRG(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
+ END IF
+!
+ IF (LUSERH) THEN
+ ZTINPRH(:,:) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTINPRH(IIBC:IIEC,IJBC:IJEC) = ZTINPRH(IIBC:IIEC,IJBC:IJEC) &
+ +XINPRH(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
+ END DO
+ END DO
+ ZTINPRH(IIBC:IIEC,IJBC:IJEC) =ZTINPRH(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
+ END IF
+!
+ IF (CDCONV /= 'NONE') THEN
+ ZTPRCONV(:,:) = 0.
+ ZTPRSCONV(:,:) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTPRCONV(IIBC:IIEC,IJBC:IJEC) = ZTPRCONV(IIBC:IIEC,IJBC:IJEC) &
+ +XPRCONV(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
+ ZTPRSCONV(IIBC:IIEC,IJBC:IJEC) = ZTPRSCONV(IIBC:IIEC,IJBC:IJEC) &
+ +XPRSCONV(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
+ END DO
+ END DO
+ ZTPRCONV(IIBC:IIEC,IJBC:IJEC) = ZTPRCONV(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
+ ZTPRSCONV(IIBC:IIEC,IJBC:IJEC) = ZTPRSCONV(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
+ END IF
+! Short Wave and Long Wave variables
+ IF (CRAD /= 'NONE') THEN
+ ZTDIRFLASWD(:,:,:) = 0.
+ ZTSCAFLASWD(:,:,:) = 0.
+ ZTDIRSRFSWD(:,:,:) = 0.
+ DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTDIRFLASWD(IIBC:IIEC,IJBC:IJEC,:) = ZTDIRFLASWD(IIBC:IIEC,IJBC:IJEC,:)&
+ +XDIRFLASWD(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+ ZTSCAFLASWD(IIBC:IIEC,IJBC:IJEC,:) = ZTSCAFLASWD(IIBC:IIEC,IJBC:IJEC,:)&
+ +XSCAFLASWD(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+ ZTDIRSRFSWD(IIBC:IIEC,IJBC:IJEC,:) = ZTDIRSRFSWD(IIBC:IIEC,IJBC:IJEC,:)&
+ +XDIRSRFSWD(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+ END DO
+ END DO
+ ZTDIRFLASWD(IIBC:IIEC,IJBC:IJEC,:) = ZTDIRFLASWD(IIBC:IIEC,IJBC:IJEC,:)/(IDXRATIO*IDYRATIO)
+ ZTSCAFLASWD(IIBC:IIEC,IJBC:IJEC,:) = ZTSCAFLASWD(IIBC:IIEC,IJBC:IJEC,:)/(IDXRATIO*IDYRATIO)
+ ZTDIRSRFSWD(IIBC:IIEC,IJBC:IJEC,:) = ZTDIRSRFSWD(IIBC:IIEC,IJBC:IJEC,:)/(IDXRATIO*IDYRATIO)
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. AVERAGE OF WIND VARIABLES
+! -------------------------
+!
+!* 3.1 vertical wind W
+!
+ZTWM(:,:,:) = 0.
+DO JX=1,IDXRATIO
+ DO JY=1,IDYRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTWM(IIBC:IIEC,IJBC:IJEC,IKB) = ZTWM(IIBC:IIEC,IJBC:IJEC,IKB) &
+ +2.*XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB) &
+ *XWT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB)
+!
+ ZTWM(IIBC:IIEC,IJBC:IJEC,IKB+1:IKU) = ZTWM(IIBC:IIEC,IJBC:IJEC,IKB+1:IKU) &
+ +(XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB+1:IKU ) &
+ + XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB :IKU-1))&
+ *XWT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB+1:IKU)
+ END DO
+END DO
+!
+!* 3.2 horizontal wind U
+!
+ZTRHODJU(:,:,:) = 0.
+!
+IF(LWEST_ll()) THEN
+ II1U = IIB+IDXRATIO !C grid
+ IWEST=JPHEXT+3
+ELSE
+ II1U = IIB
+ IWEST=JPHEXT+2
+ENDIF
+!
+II2 = IIE+1-IDXRATIO
+!
+DO JY=1,IDYRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTRHODJU(IWEST:IIEC,IJBC:IJEC,:) = ZTRHODJU(IWEST:IIEC,IJBC:IJEC,:) &
+ +XRHODJ(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
+ +XRHODJ(II1U-1:II2-1:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+END DO
+!
+!
+ZTUM(:,:,:) = 0.
+DO JY=1,IDYRATIO
+ IJ1 = IJB+JY-1
+ IJ2 = IJE+JY-IDYRATIO
+ ZTUM(IWEST:IIEC,IJBC:IJEC,:) = ZTUM(IWEST:IIEC,IJBC:IJEC,:) &
+ +(XRHODJ(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
+ +XRHODJ(II1U-1:II2-1:IDXRATIO,IJ1:IJ2:IDYRATIO,:)) &
+ *XUT(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+END DO
+!
+!
+!* 3.3 horizontal wind V
+!
+ZTRHODJV(:,:,:) = 0.
+!
+IF(LSOUTH_ll() .AND. .NOT. L2D) THEN
+ IJ1V = IJB+IDYRATIO !C grid
+ ISOUTH=JPHEXT+3
+ELSE
+ IJ1V = IJB
+ ISOUTH=JPHEXT+2
+ENDIF
+!
+IJ2 = IJE+1-IDYRATIO
+!
+DO JX=1,IDXRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ ZTRHODJV(IIBC:IIEC,ISOUTH:IJEC,:) = ZTRHODJV(IIBC:IIEC,ISOUTH:IJEC,:) &
+ +XRHODJ(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:) &
+ +XRHODJ(II1:II2:IDXRATIO,IJ1V-1:IJ2-1:IDYRATIO,:)
+END DO
+!
+!
+ZTVM(:,:,:) = 0.
+DO JX=1,IDXRATIO
+ II1 = IIB+JX-1
+ II2 = IIE+JX-IDXRATIO
+ ZTVM(IIBC:IIEC,ISOUTH:IJEC,:) = ZTVM(IIBC:IIEC,ISOUTH:IJEC,:) &
+ +(XRHODJ(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:) &
+ + XRHODJ(II1:II2:IDXRATIO,IJ1V-1:IJ2-1:IDYRATIO,:)) &
+ *XVT(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:)
+END DO
+!
+!
+!* 4. EXCHANGE OF DATA
+! ----------------
+!
+!
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+CALL GET_FEEDBACK_COORD_ll(IXOR,IYOR,IXEND,IYEND,IINFO_ll) ! physical domain's origine
+!
+!
+IF (IINFO_ll == 0) THEN
+ LINTER=.TRUE.
+ELSE
+ LINTER=.FALSE.
+ENDIF
+!
+! Allocate array which will receive average child fields
+!
+IF (LINTER) THEN
+ ALLOCATE(ZUM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
+ ALLOCATE(ZVM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
+ ALLOCATE(ZWM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
+ ALLOCATE(ZTHM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
+ ALLOCATE(ZRHODJ (IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
+ ALLOCATE(ZRHODJU(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
+ ALLOCATE(ZRHODJV(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
+ IF (IRR /= 0) THEN
+ ALLOCATE(ZRM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3),IRR))
+ END IF
+ IF (KSV /= 0) THEN
+ ALLOCATE(ZSVM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3),KSV))
+ ENDIF
+ IF (LUSERR) THEN
+ ALLOCATE(ZINPRR(IXOR:IXEND,IYOR:IYEND))
+ ELSE
+ ALLOCATE(ZINPRR(0,0))
+ END IF
+ IF (LUSERC .AND. ((LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
+ (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
+ (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
+ ALLOCATE(ZINPRC(IXOR:IXEND,IYOR:IYEND))
+ ELSE
+ ALLOCATE(ZINPRC(0,0))
+ END IF
+ IF (LUSERS) THEN
+ ALLOCATE(ZINPRS(IXOR:IXEND,IYOR:IYEND))
+ ELSE
+ ALLOCATE(ZINPRS(0,0))
+ END IF
+ IF (LUSERG) THEN
+ ALLOCATE(ZINPRG(IXOR:IXEND,IYOR:IYEND))
+ ELSE
+ ALLOCATE(ZINPRG(0,0))
+ END IF
+ IF (LUSERH) THEN
+ ALLOCATE(ZINPRH(IXOR:IXEND,IYOR:IYEND))
+ ELSE
+ ALLOCATE(ZINPRH(0,0))
+ END IF
+ IF (CDCONV /= 'NONE') THEN
+ ALLOCATE(ZPRCONV(IXOR:IXEND,IYOR:IYEND))
+ ALLOCATE(ZPRSCONV(IXOR:IXEND,IYOR:IYEND))
+ ELSE
+ ALLOCATE(ZPRCONV(0,0))
+ ALLOCATE(ZPRSCONV(0,0))
+ END IF
+ IF (CRAD /= 'NONE') THEN
+ ALLOCATE(ZDIRFLASWD(IXOR:IXEND,IYOR:IYEND, SIZE(PDIRFLASWD, 3)))
+ ALLOCATE(ZSCAFLASWD(IXOR:IXEND,IYOR:IYEND, SIZE(PSCAFLASWD, 3)))
+ ALLOCATE(ZDIRSRFSWD(IXOR:IXEND,IYOR:IYEND, SIZE(PDIRSRFSWD, 3)))
+ ELSE
+ !3rd dimension size can also be allocated with a zero size
+ ALLOCATE( ZDIRFLASWD(0, 0, SIZE( PDIRFLASWD, 3 )) )
+ ALLOCATE( ZSCAFLASWD(0, 0, SIZE( PSCAFLASWD, 3 )) )
+ ALLOCATE( ZDIRSRFSWD(0, 0, SIZE( PDIRSRFSWD, 3 )) )
+ ENDIF
+ELSE
+ ALLOCATE(ZUM(0,0,0))
+ ALLOCATE(ZVM(0,0,0))
+ ALLOCATE(ZWM(0,0,0))
+ ALLOCATE(ZTHM(0,0,0))
+ IF (IRR /= 0) ALLOCATE(ZRM(0,0,0,IRR))
+ IF (KSV /= 0) ALLOCATE(ZSVM(0,0,0,KSV))
+ ALLOCATE(ZRHODJ (0,0,0))
+ ALLOCATE(ZRHODJU(0,0,0))
+ ALLOCATE(ZRHODJV(0,0,0))
+ ALLOCATE(ZINPRC(0,0))
+ ALLOCATE(ZINPRR(0,0))
+ ALLOCATE(ZINPRS(0,0))
+ ALLOCATE(ZINPRG(0,0))
+ ALLOCATE(ZINPRH(0,0))
+ ALLOCATE(ZPRCONV(0,0))
+ ALLOCATE(ZPRSCONV(0,0))
+ !3rd dimension of ZDIRFLASWD, ZSCAFLASWD and ZDIRSRFSWD is allocated with a not necessarily zero size
+ !because it needs to be to this size for the SET_LSFIELD_2WAY_ll loops if CRAD/='NONE'
+ ALLOCATE( ZDIRFLASWD(0, 0, SIZE( PDIRFLASWD, 3 )) )
+ ALLOCATE( ZSCAFLASWD(0, 0, SIZE( PSCAFLASWD, 3 )) )
+ ALLOCATE( ZDIRSRFSWD(0, 0, SIZE( PDIRSRFSWD, 3 )) )
+ENDIF
+!
+! Initialize the list for the forcing
+!
+CALL SET_LSFIELD_2WAY_ll(ZUM, ZTUM)
+CALL SET_LSFIELD_2WAY_ll(ZVM, ZTVM)
+CALL SET_LSFIELD_2WAY_ll(ZWM, ZTWM)
+CALL SET_LSFIELD_2WAY_ll(ZTHM, ZTTHM)
+DO JVAR=1,IRR
+ CALL SET_LSFIELD_2WAY_ll(ZRM(:,:,:,JVAR), ZTRM(:,:,:,JVAR))
+ENDDO
+DO JVAR=1,KSV
+ CALL SET_LSFIELD_2WAY_ll(ZSVM(:,:,:,JVAR), ZTSVM(:,:,:,JVAR))
+ENDDO
+IF (LUSERR) THEN
+ CALL SET_LSFIELD_2WAY_ll(ZINPRR , ZTINPRR)
+END IF
+!
+IF (LUSERC .AND. ((LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
+ (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
+ (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
+ CALL SET_LSFIELD_2WAY_ll(ZINPRC , ZTINPRC)
+END IF
+IF (LUSERS) THEN
+ CALL SET_LSFIELD_2WAY_ll(ZINPRS , ZTINPRS)
+END IF
+IF (LUSERG) THEN
+ CALL SET_LSFIELD_2WAY_ll(ZINPRG , ZTINPRG)
+END IF
+IF (LUSERH) THEN
+ CALL SET_LSFIELD_2WAY_ll(ZINPRH , ZTINPRH)
+END IF
+IF (CDCONV /= 'NONE') THEN
+ CALL SET_LSFIELD_2WAY_ll(ZPRCONV , ZTPRCONV)
+ CALL SET_LSFIELD_2WAY_ll(ZPRSCONV , ZTPRSCONV)
+END IF
+IF (CRAD /= 'NONE') THEN
+ DO JVAR = 1, SIZE( PDIRFLASWD, 3 )
+ CALL SET_LSFIELD_2WAY_ll(ZDIRFLASWD(:,:,JVAR) , ZTDIRFLASWD(:,:,JVAR))
+ END DO
+ DO JVAR = 1, SIZE( PSCAFLASWD, 3 )
+ CALL SET_LSFIELD_2WAY_ll(ZSCAFLASWD(:,:,JVAR) , ZTSCAFLASWD(:,:,JVAR))
+ END DO
+ DO JVAR = 1, SIZE( PDIRSRFSWD, 3 )
+ CALL SET_LSFIELD_2WAY_ll(ZDIRSRFSWD(:,:,JVAR) , ZTDIRSRFSWD(:,:,JVAR))
+ END DO
+END IF
+CALL SET_LSFIELD_2WAY_ll(ZRHODJ, ZTRHODJ)
+CALL SET_LSFIELD_2WAY_ll(ZRHODJU, ZTRHODJU)
+CALL SET_LSFIELD_2WAY_ll(ZRHODJV, ZTRHODJV)
+!
+CALL LS_FEEDBACK_ll(IINFO_ll)
+CALL GO_TOMODEL_ll(KMI, IINFO_ll)
+CALL UNSET_LSFIELD_2WAY_ll(IMI)
+!
+DEALLOCATE(ZTUM,ZTVM,ZTWM,ZTTHM,ZTRHODJ,ZTRHODJU,ZTRHODJV)
+DEALLOCATE(ZTRM,ZTSVM)
+DEALLOCATE(ZTINPRC,ZTINPRR,ZTINPRS,ZTINPRG,ZTINPRH,ZTPRCONV,ZTPRSCONV)
+DEALLOCATE(ZTDIRFLASWD,ZTSCAFLASWD,ZTDIRSRFSWD)
+!
+IF (.NOT. LINTER) THEN ! no computation for the dad subdomain
+ DEALLOCATE(ZUM,ZVM,ZWM,ZTHM,ZRHODJ,ZRHODJU,ZRHODJV)
+ IF (IRR /= 0) DEALLOCATE(ZRM)
+ IF (KSV /= 0) DEALLOCATE(ZSVM)
+ DEALLOCATE(ZINPRC,ZINPRR,ZINPRS,ZINPRG,ZINPRH,ZPRCONV,ZPRSCONV)
+ DEALLOCATE(ZDIRFLASWD,ZSCAFLASWD,ZDIRSRFSWD)
+RETURN
+ENDIF
+!
+!
+! 5. RELAXATION
+! -----------
+! 5.1 Compute the bounds of relaxation area
+!
+IHALO=2
+!!$IF (JPHEXT/=1) STOP ! boundaries are hard coded supposing JPHEXT=1
+!
+CALL GET_OR_ll('B',IXOR_ll,IYOR_ll)
+CALL GET_DIM_EXT_ll('B',IXDIM,IYDIM)
+!
+IF(LWEST_ll()) THEN
+ IDIST=IXOR_ll+1-(NXOR_ALL(IMI)+1) ! comparison of first physical
+ ! points of subdomain and current processor
+ELSE
+ IDIST=IXOR_ll+NHALO-(NXOR_ALL(IMI)+1)! comparison of first physical
+ ! points of subdomain and current processor
+ENDIF
+!
+IF(IDIST<=0) THEN ! west side of the child domain
+ IXOR=IXOR+IHALO
+ENDIF
+!
+IF(IDIST>=1 .AND. IDIST<=IHALO-1) THEN
+ IXOR=IXOR+IHALO-IDIST
+ENDIF
+!
+! C grid for v component
+IF(IDIST >=IHALO+1) IXORU=IXOR ! interior child domain
+IF(IDIST>=1 .AND. IDIST<=IHALO) IXORU=IXOR+1 ! partial overlapping of the relaxation area
+IF(IDIST<=0) IXORU=IXOR+1
+!
+IF(LEAST_ll()) THEN
+ IDIST=(NXEND_ALL(IMI)-1)-(IXOR_ll-1+IXDIM-1) ! comparison of last physical
+ ! points of subdomain and current processor
+ELSE
+ IDIST=(NXEND_ALL(IMI)-1)-(IXOR_ll-1+IXDIM-NHALO)! comparison of last physical
+ ! points of subdomain and current processor
+ENDIF
+!
+IF(IDIST<=0) IXEND=IXEND-IHALO ! east side of the child domain
+IF(IDIST>=1 .AND. IDIST<=IHALO-1) IXEND=IXEND-IHALO+IDIST
+!
+!
+IF(.NOT.L2D) THEN
+ IF(LSOUTH_ll()) THEN
+ IDIST=IYOR_ll+1-(NYOR_ALL(IMI)+1)! comparison of first physical
+ ! points of subdomain and current processor
+ ELSE
+ IDIST=IYOR_ll+NHALO-(NYOR_ALL(IMI)+1)! comparison of first physical
+ ! points of subdomain and current processor
+ ENDIF
+!
+ IF(IDIST<=0) THEN ! south side of the child domain
+ IYOR=IYOR+IHALO
+ ENDIF
+!
+ IF(IDIST>=1 .AND. IDIST<=IHALO-1) THEN
+ IYOR=IYOR+IHALO-IDIST
+ ENDIF
+!
+! C grid for v component
+ IF(IDIST >=IHALO+1) IYORV=IYOR ! interior child domain
+ IF(IDIST>=1 .AND. IDIST<=IHALO) IYORV=IYOR+1 ! partial overlapping of the relaxation area
+ IF(IDIST<=0) IYORV=IYOR+1
+!
+!
+!
+ IF(LNORTH_ll()) THEN
+ IDIST=(NYEND_ALL(IMI)-1)-(IYOR_ll-1+IYDIM-1)! comparison of last physical
+ ! points of subdomain and current processor
+ ELSE
+ IDIST=(NYEND_ALL(IMI)-1)-(IYOR_ll-1+IYDIM-NHALO)! comparison of last physical
+ ! points of subdomain and current processor
+ ENDIF
+ IF(IDIST<=0) IYEND=IYEND-IHALO ! north side of the child domain
+ IF(IDIST>=1 .AND. IDIST<=IHALO-1) IYEND=IYEND-IHALO+IDIST
+!
+ELSE
+ IYORV=IYOR+1 ! no parallelized
+ENDIF
+
+! at this point, IXOR:IXEND,IYOR:IYEND define the 2way area outside
+! the relaxation area
+ IF (LUSERR) THEN
+ PINPRR(IXOR:IXEND,IYOR:IYEND)=ZINPRR(IXOR:IXEND,IYOR:IYEND)
+ ENDIF
+ IF (LUSERC .AND. ((LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
+ (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
+ (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
+ PINPRC(IXOR:IXEND,IYOR:IYEND)=ZINPRC(IXOR:IXEND,IYOR:IYEND)
+ ENDIF
+ IF (LUSERS) THEN
+ PINPRS(IXOR:IXEND,IYOR:IYEND)=ZINPRS(IXOR:IXEND,IYOR:IYEND)
+ ENDIF
+ IF (LUSERG) THEN
+ PINPRG(IXOR:IXEND,IYOR:IYEND)=ZINPRG(IXOR:IXEND,IYOR:IYEND)
+ ENDIF
+ IF (LUSERH) THEN
+ PINPRH(IXOR:IXEND,IYOR:IYEND)=ZINPRH(IXOR:IXEND,IYOR:IYEND)
+ ENDIF
+ IF (CDCONV /= 'NONE') THEN
+ PPRCONV(IXOR:IXEND,IYOR:IYEND)=ZPRCONV(IXOR:IXEND,IYOR:IYEND)
+ PPRSCONV(IXOR:IXEND,IYOR:IYEND)=ZPRSCONV(IXOR:IXEND,IYOR:IYEND)
+ END IF
+ IF (CRAD /= 'NONE') THEN
+ PDIRFLASWD(IXOR:IXEND,IYOR:IYEND,:)=ZDIRFLASWD(IXOR:IXEND,IYOR:IYEND,:)
+ PSCAFLASWD(IXOR:IXEND,IYOR:IYEND,:)=ZSCAFLASWD(IXOR:IXEND,IYOR:IYEND,:)
+ PDIRSRFSWD(IXOR:IXEND,IYOR:IYEND,:)=ZDIRSRFSWD(IXOR:IXEND,IYOR:IYEND,:)
+ ENDIF
+ DEALLOCATE(ZINPRC,ZINPRR,ZINPRS,ZINPRG,ZINPRH,ZPRCONV,ZPRSCONV)
+ DEALLOCATE(ZDIRFLASWD,ZSCAFLASWD,ZDIRSRFSWD)
+!
+!* initialize the OMASKkids array
+!
+OMASKkids(IXOR:IXEND,IYOR:IYEND)=.TRUE.
+!
+!
+! 5.2 relaxation computation
+!
+PRTHS(IXOR:IXEND,IYOR:IYEND,:) = PRTHS(IXOR:IXEND,IYOR:IYEND,:) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * ( PTHM(IXOR:IXEND,IYOR:IYEND,:) &
+ -ZTHM(IXOR:IXEND,IYOR:IYEND,:)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+!
+DO JVAR=1,IRR
+ PRRS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRRS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PRM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZRM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+!
+! User scalar variables
+DO JVAR=1,ISV_USER
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! C2R2 scalar variables
+DO JVAR=NSV_C2R2BEG_A(KMI),NSV_C2R2END_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! C1R3 scalar variables
+DO JVAR=NSV_C1R3BEG_A(KMI),NSV_C1R3END_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! LIMA scalar variables
+DO JVAR=NSV_LIMA_BEG_A(KMI),NSV_LIMA_END_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! Electrical scalar variables
+DO JVAR=NSV_ELECBEG_A(KMI),NSV_ELECEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! Chemical scalar variables
+DO JVAR=NSV_CHEMBEG_A(KMI),NSV_CHEMEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! Ice phase chemical scalar variables
+DO JVAR=NSV_CHICBEG_A(KMI),NSV_CHICEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! NOX variables
+DO JVAR=NSV_LNOXBEG_A(KMI),NSV_LNOXEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! Orilam scalar variables
+DO JVAR=NSV_AERBEG_A(KMI),NSV_AEREND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+DO JVAR=NSV_AERDEPBEG_A(KMI),NSV_AERDEPEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! Dust scalar variables
+DO JVAR=NSV_DSTBEG_A(KMI),NSV_DSTEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+DO JVAR=NSV_DSTDEPBEG_A(KMI),NSV_DSTDEPEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! Salt scalar variables
+DO JVAR=NSV_SLTBEG_A(KMI),NSV_SLTEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+DO JVAR=NSV_SLTDEPBEG_A(KMI),NSV_SLTDEPEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! Lagrangian scalar variables
+DO JVAR=NSV_LGBEG_A(KMI),NSV_LGEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+! Passive pollutant variables
+DO JVAR=NSV_PPBEG_A(KMI),NSV_PPEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+#ifdef MNH_FOREFIRE
+
+! ForeFire variables
+DO JVAR=NSV_FFBEG_A(KMI),NSV_FFEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+#endif
+! Conditional sampling variables
+DO JVAR=NSV_CSBEG_A(KMI),NSV_CSEND_A(KMI)
+ PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
+ -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+ENDDO
+!
+ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB) = 2.*ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB)
+ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB+1:IKU) = ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB+1:IKU) &
+ +ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB:IKU-1)
+!
+ZAVE_RHODJ=MZM(PRHODJ)
+PRWS(IXOR:IXEND,IYOR:IYEND,:) = PRWS(IXOR:IXEND,IYOR:IYEND,:) &
+ - ZK2W * ZAVE_RHODJ(IXOR:IXEND,IYOR:IYEND,:) * ( PWM(IXOR:IXEND,IYOR:IYEND,:) &
+ -ZWM(IXOR:IXEND,IYOR:IYEND,:)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
+!
+ZAVE_RHODJ=MXM(PRHODJ)
+PRUS(IXORU:IXEND,IYOR:IYEND,:) = PRUS(IXORU:IXEND,IYOR:IYEND,:) &
+ - ZK2W * ZAVE_RHODJ(IXORU:IXEND,IYOR:IYEND,:) * ( PUM(IXORU:IXEND,IYOR:IYEND,:) &
+ -ZUM(IXORU:IXEND,IYOR:IYEND,:)/ZRHODJU(IXORU:IXEND,IYOR:IYEND,:) )
+!
+ZAVE_RHODJ=MYM(PRHODJ)
+PRVS(IXOR:IXEND,IYORV:IYEND,:) = PRVS(IXOR:IXEND,IYORV:IYEND,:) &
+ - ZK2W * ZAVE_RHODJ(IXOR:IXEND,IYORV:IYEND,:) * ( PVM(IXOR:IXEND,IYORV:IYEND,:) &
+ -ZVM(IXOR:IXEND,IYORV:IYEND,:)/ZRHODJV(IXOR:IXEND,IYORV:IYEND,:) )
+!
+DEALLOCATE(ZUM,ZVM,ZWM,ZTHM,ZRHODJ,ZRHODJU,ZRHODJV)
+IF (IRR /= 0) DEALLOCATE(ZRM)
+IF (KSV /= 0) DEALLOCATE(ZSVM)
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE TWO_WAY_n
diff --git a/src/PHYEX/ext/update_nsv.f90 b/src/PHYEX/ext/update_nsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f54a72169a96b85ca43c4c958e61dbdedc514c3e
--- /dev/null
+++ b/src/PHYEX/ext/update_nsv.f90
@@ -0,0 +1,187 @@
+!MNH_LIC Copyright 2001-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######spl
+ MODULE MODI_UPDATE_NSV
+! ######################
+!
+INTERFACE
+ SUBROUTINE UPDATE_NSV(KMI)
+ INTEGER, INTENT(IN) :: KMI ! Model index
+ END SUBROUTINE UPDATE_NSV
+!
+END INTERFACE
+END MODULE MODI_UPDATE_NSV
+! ######spl
+ SUBROUTINE UPDATE_NSV(KMI)
+! ##########################
+
+!!**** *UPDATE_NSV* - routine that updates the NSV_* variables for the
+!! current model. It is intended to be called from
+!! any MesoNH routine WITH or WITHOUT $n before using
+!! the NSV_* variables.
+!! Modify (Escobar ) 2/2014 : add Forefire var
+!! Modify (Vie) 2016 : add LIMA
+!! V. Vionnet 7/2017 : add blowing snow var
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/11/2021: add TSVLIST and TSVLIST_A to store the metadata of all the scalar variables
+! P. Wautelet 14/01/2022: add CSV_CHEM_LIST(_A) to store the list of all chemical variables
+! P. Wautelet 20/02/2023: manage CSV(_A) + bugfix: reallocate size was wrong in some scenarii
+!-------------------------------------------------------------------------------
+!
+USE MODD_CONF, ONLY: NVERB
+USE MODD_FIELD, ONLY: tfieldmetadata
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX, NMNHNAMELGTMAX
+
+USE MODE_LIMA_UPDATE_NSV, ONLY: LIMA_UPDATE_NSV
+use mode_msg
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KMI ! Model index
+
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE :: YSVNAMES_TMP
+CHARACTER(LEN=6), DIMENSION(:,:), ALLOCATABLE :: YSV_TMP
+CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE :: YSVCHEM_LIST_TMP
+INTEGER :: JI, JJ
+INTEGER :: ISV
+TYPE(tfieldmetadata), DIMENSION(:,:), ALLOCATABLE :: YSVLIST_TMP
+!
+! STOP if INI_NSV has not be called yet
+IF ( .NOT. LINI_NSV(KMI) ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'UPDATE_NSV', 'can not continue because INI_NSV was not called' )
+END IF
+!
+! Update the NSV_* variables from original NSV_*_A arrays
+! that have been initialized in ini_nsv.f90 for model KMI
+!
+
+! Allocate/reallocate CSV_CHEM_LIST_A
+IF ( .NOT. ALLOCATED( TNSV%CSV_CHEM_LIST_A ) ) THEN
+ ALLOCATE( TNSV%CSV_CHEM_LIST_A( NSV_CHEM_LIST_A(KMI), KMI) )
+ CSV_CHEM_LIST_A => TNSV%CSV_CHEM_LIST_A
+ENDIF
+!If CSV_CHEM_LIST_A is too small, enlarge it and transfer data
+IF ( SIZE( CSV_CHEM_LIST_A, 1 ) < NSV_CHEM_LIST_A(KMI) .OR. SIZE( CSV_CHEM_LIST_A, 2 ) < KMI ) THEN
+ ALLOCATE( YSVCHEM_LIST_TMP( MAX( SIZE(CSV_CHEM_LIST_A,1), NSV_CHEM_LIST_A(KMI) ), MAX( SIZE(CSV_CHEM_LIST_A,2), KMI ) ) )
+ DO JJ = 1, SIZE( CSV_CHEM_LIST_A, 2 )
+ DO JI = 1, SIZE( CSV_CHEM_LIST_A, 1 )
+ YSVCHEM_LIST_TMP(JI, JJ) = CSV_CHEM_LIST_A(JI, JJ)
+ END DO
+ END DO
+ CALL MOVE_ALLOC( FROM = YSVCHEM_LIST_TMP, TO = TNSV%CSV_CHEM_LIST_A )
+ CSV_CHEM_LIST_A => TNSV%CSV_CHEM_LIST_A
+END IF
+
+CSV_CHEM_LIST => CSV_CHEM_LIST_A(:,KMI)
+
+! Allocate/reallocate CSV_A
+IF ( .NOT. ALLOCATED( TNSV%CSV_A ) ) THEN
+ ALLOCATE( TNSV%CSV_A( NSV_A(KMI), KMI) )
+ CSV_A => TNSV%CSV_A
+ENDIF
+!If CSV_A is too small, enlarge it and transfer data
+IF ( SIZE( CSV_A, 1 ) < NSV_A(KMI) .OR. SIZE( CSV_A, 2 ) < KMI ) THEN
+ ALLOCATE( YSV_TMP( MAX( SIZE(CSV_A,1), NSV_A(KMI) ), MAX( SIZE(CSV_A,2), KMI ) ) )
+ DO JJ = 1, SIZE( CSV_A, 2 )
+ DO JI = 1, SIZE( CSV_A, 1 )
+ YSV_TMP(JI, JJ) = CSV_A(JI, JJ)
+ END DO
+ END DO
+ CALL MOVE_ALLOC( FROM = YSV_TMP, TO = TNSV%CSV_A )
+ CSV_A => TNSV%CSV_A
+END IF
+
+CSV => CSV_A(:,KMI)
+
+! Allocate/reallocate TSVLIST_A
+IF ( .NOT. ALLOCATED( TNSV%TSVLIST_A ) ) THEN
+ ALLOCATE( TNSV%TSVLIST_A( NSV_A(KMI), KMI) )
+ TSVLIST_A => TNSV%TSVLIST_A
+ENDIF
+!If TSVLIST_A is too small, enlarge it and transfer data
+IF ( SIZE( TSVLIST_A, 1 ) < NSV_A(KMI) .OR. SIZE( TSVLIST_A, 2 ) < KMI ) THEN
+ ALLOCATE( YSVLIST_TMP( MAX( SIZE(TSVLIST_A,1), NSV_A(KMI) ), MAX( SIZE(TSVLIST_A,2), KMI ) ) )
+ DO JJ = 1, SIZE( TSVLIST_A, 2 )
+ DO JI = 1, SIZE( TSVLIST_A, 1 )
+ YSVLIST_TMP(JI, JJ) = TSVLIST_A(JI, JJ)
+ END DO
+ END DO
+ CALL MOVE_ALLOC( FROM = YSVLIST_TMP, TO = TNSV%TSVLIST_A )
+ TSVLIST_A => TNSV%TSVLIST_A
+END IF
+
+TSVLIST => TSVLIST_A(:,KMI)
+
+NSV = NSV_A(KMI)
+NSV_USER = NSV_USER_A(KMI)
+NSV_C2R2 = NSV_C2R2_A(KMI)
+NSV_C2R2BEG = NSV_C2R2BEG_A(KMI)
+NSV_C2R2END = NSV_C2R2END_A(KMI)
+NSV_C1R3 = NSV_C1R3_A(KMI)
+NSV_C1R3BEG = NSV_C1R3BEG_A(KMI)
+NSV_C1R3END = NSV_C1R3END_A(KMI)
+!
+ISV=-1
+CALL LIMA_UPDATE_NSV(LDINIT=.FALSE., KMI=KMI, KSV=ISV, CDCLOUD='LIMA', LDUPDATE=.TRUE.)
+!
+NSV_ELEC = NSV_ELEC_A(KMI)
+NSV_ELECBEG = NSV_ELECBEG_A(KMI)
+NSV_ELECEND = NSV_ELECEND_A(KMI)
+NSV_CHEM = NSV_CHEM_A(KMI)
+NSV_CHEMBEG = NSV_CHEMBEG_A(KMI)
+NSV_CHEMEND = NSV_CHEMEND_A(KMI)
+NSV_CHGS = NSV_CHGS_A(KMI)
+NSV_CHGSBEG = NSV_CHGSBEG_A(KMI)
+NSV_CHGSEND = NSV_CHGSEND_A(KMI)
+NSV_CHAC = NSV_CHAC_A(KMI)
+NSV_CHACBEG = NSV_CHACBEG_A(KMI)
+NSV_CHACEND = NSV_CHACEND_A(KMI)
+NSV_CHIC = NSV_CHIC_A(KMI)
+NSV_CHICBEG = NSV_CHICBEG_A(KMI)
+NSV_CHICEND = NSV_CHICEND_A(KMI)
+NSV_LNOX = NSV_LNOX_A(KMI)
+NSV_LNOXBEG = NSV_LNOXBEG_A(KMI)
+NSV_LNOXEND = NSV_LNOXEND_A(KMI)
+NSV_DST = NSV_DST_A(KMI)
+NSV_DSTBEG = NSV_DSTBEG_A(KMI)
+NSV_DSTEND = NSV_DSTEND_A(KMI)
+NSV_DSTDEP = NSV_DSTDEP_A(KMI)
+NSV_DSTDEPBEG = NSV_DSTDEPBEG_A(KMI)
+NSV_DSTDEPEND = NSV_DSTDEPEND_A(KMI)
+NSV_SLT = NSV_SLT_A(KMI)
+NSV_SLTBEG = NSV_SLTBEG_A(KMI)
+NSV_SLTEND = NSV_SLTEND_A(KMI)
+NSV_SLTDEPBEG = NSV_SLTDEPBEG_A(KMI)
+NSV_SLTDEPEND = NSV_SLTDEPEND_A(KMI)
+NSV_AER = NSV_AER_A(KMI)
+NSV_AERBEG = NSV_AERBEG_A(KMI)
+NSV_AEREND = NSV_AEREND_A(KMI)
+NSV_AERDEPBEG = NSV_AERDEPBEG_A(KMI)
+NSV_AERDEPEND = NSV_AERDEPEND_A(KMI)
+NSV_LG = NSV_LG_A(KMI)
+NSV_LGBEG = NSV_LGBEG_A(KMI)
+NSV_LGEND = NSV_LGEND_A(KMI)
+NSV_PP = NSV_PP_A(KMI)
+NSV_PPBEG = NSV_PPBEG_A(KMI)
+NSV_PPEND = NSV_PPEND_A(KMI)
+#ifdef MNH_FOREFIRE
+NSV_FF = NSV_FF_A(KMI)
+NSV_FFBEG = NSV_FFBEG_A(KMI)
+NSV_FFEND = NSV_FFEND_A(KMI)
+#endif
+NSV_FIRE = NSV_FIRE_A(KMI)
+NSV_FIREBEG = NSV_FIREBEG_A(KMI)
+NSV_FIREEND = NSV_FIREEND_A(KMI)
+NSV_CS = NSV_CS_A(KMI)
+NSV_CSBEG = NSV_CSBEG_A(KMI)
+NSV_CSEND = NSV_CSEND_A(KMI)
+NSV_SNW = NSV_SNW_A(KMI)
+NSV_SNWBEG = NSV_SNWBEG_A(KMI)
+NSV_SNWEND = NSV_SNWEND_A(KMI)
+!
+
+END SUBROUTINE UPDATE_NSV
diff --git a/src/PHYEX/ext/ver_interp_field.f90 b/src/PHYEX/ext/ver_interp_field.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d0092e917c7f9f1ea3232c1eba012cccf5d80b71
--- /dev/null
+++ b/src/PHYEX/ext/ver_interp_field.f90
@@ -0,0 +1,327 @@
+!MNH_LIC Copyright 1997-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_VER_INTERP_FIELD
+!#######################
+!
+INTERFACE
+!
+ SUBROUTINE VER_INTERP_FIELD(HTURB,KRR,KSV,PZZ_LS,PZZ, &
+ PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT, &
+ PSRCT,PSIGS, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM )
+!
+CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+INTEGER, INTENT(IN) :: KRR ! number of moist variables
+INTEGER, INTENT(IN) :: KSV ! number of scalar variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ_LS ! initial 3D grid
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! new 3D grid
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT ! model 2
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTKET ! variables
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT ! at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHVT,PHUT !
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRCT,PSIGS ! secondary
+ ! prognostic variables
+ ! Larger Scale fields
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM, PLSVM, PLSWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSTHM, PLSRVM ! Mass
+END SUBROUTINE VER_INTERP_FIELD
+!
+END INTERFACE
+!
+END MODULE MODI_VER_INTERP_FIELD
+!
+! ##########################################################################
+ SUBROUTINE VER_INTERP_FIELD(HTURB,KRR,KSV,PZZ_LS,PZZ, &
+ PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT, &
+ PSRCT,PSIGS, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM )
+! ##########################################################################
+!
+!!**** *VER_INTERP_FIELD * - interpolate the 3D and LS 2D fields from one
+!! vertical grid PZZ_LS to another PZZ
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1 of the documentation
+!! SUBROUTINE VER_INTERP_FIELD (Book2 of the documentation)
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson * METEO-FRANCE *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 17/07/97
+!! 14/09/97 (V. Masson) Interpolation of relative humidity
+!! 05/06 Remobe KEPS
+!! 2014 (M.Faivre)
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF_n, ONLY : CONF_MODEL
+USE MODD_TURB_n, ONLY: XTKEMIN
+USE MODD_PARAMETERS
+USE MODD_VER_INTERP_LIN
+!
+USE MODI_SHUMAN
+USE MODI_COEF_VER_INTERP_LIN
+USE MODI_VER_INTERP_LIN
+!$20140709
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_FIELD_n ! modules relative to the outer model $n
+USE MODD_LSFIELD_n
+USE MODE_MPPDB
+!$20140710
+USE MODE_ll
+USE MODD_LBC_n
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
+INTEGER, INTENT(IN) :: KRR ! number of moist variables
+INTEGER, INTENT(IN) :: KSV ! number of scalar variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ_LS ! initial 3D grid
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! new 3D grid
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT ! model 2
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTKET ! variables
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT ! at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHVT,PHUT !
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRCT,PSIGS ! secondary
+ ! prognostic variables
+ ! Larger Scale fields
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM, PLSVM, PLSWM ! Wind
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSTHM, PLSRVM ! Mass
+!* 0.2 Declarations of local variables
+!
+INTEGER :: JRR, JSV
+INTEGER :: IKU
+INTEGER :: IKB
+REAL, DIMENSION(SIZE(PZZ_LS,1),SIZE(PZZ_LS,2),SIZE(PZZ_LS,3)) :: ZGRID1, ZGRID2
+!$20140709
+TYPE(LIST_ll), POINTER :: TZLSFIELD_ll ! list of LS fields
+INTEGER :: IINFO_ll
+!$20140710
+INTEGER JI,JJ,IIB,IJB,IIE,IJE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Prologue
+! --------
+!
+IKU=SIZE(PZZ,3)
+!
+IKB=1+JPVEXT
+!$20140710
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. variables which always exist
+! ----------------------------
+!
+!* 2.1 U component
+! -----------
+!
+!* shift of grids to mass points
+ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
+ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
+ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
+ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
+!* move the first physical level if above the target grid
+ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
+!$20140710
+CALL MPPDB_CHECK3D(ZGRID1,"VERINTERPFIELDbefMXM:ZGRID1",PRECISION)
+CALL MPPDB_CHECK3D(ZGRID2,"VERINTERPFIELDbefMXM:ZGRID2",PRECISION)
+!* shift to U points
+!$20140710pb with MXM,MYM: MPPDB pb
+!$if cancel MXM, MYM then PUM,PVM are ok
+ZGRID1(:,:,:)=MXM(ZGRID1(:,:,:))
+ZGRID2(:,:,:)=MXM(ZGRID2(:,:,:))
+DO JI=JPHEXT,1,-1
+ ZGRID1(JI,:,:)=2.*ZGRID1(JI+1,:,:)-ZGRID1(JI+2,:,:)
+ ZGRID2(JI,:,:)=2.*ZGRID2(JI+1,:,:)-ZGRID2(JI+2,:,:)
+ENDDO
+!$20140710 update_halo
+NULLIFY(TZLSFIELD_ll)
+CALL ADD3DFIELD_ll( TZLSFIELD_ll, ZGRID1, 'VER_INTERP_FIELD::ZGRID1' )
+CALL ADD3DFIELD_ll( TZLSFIELD_ll, ZGRID2, 'VER_INTERP_FIELD::ZGRID2' )
+CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZLSFIELD_ll)
+!
+!$20140710
+CALL MPPDB_CHECK3D(ZGRID1,"VERINTERPFIELDaftMXM:ZGRID1",PRECISION)
+CALL MPPDB_CHECK3D(ZGRID2,"VERINTERPFIELDaftMXM:ZGRID2",PRECISION)
+!
+!$20140710 add NKLIN and XCOEFLIN in COEF_VER_INTERP
+CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
+!
+PUT (:,:,:) = VER_INTERP_LIN(PUT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+PLSUM (:,:,:) = VER_INTERP_LIN(PLSUM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+!$20140709
+CALL MPPDB_CHECK3D(PUT,"VERINTERPFIELD:PUT",PRECISION)
+!$
+!
+!* 2.2 V component
+! -----------
+!
+!* shift of grids to mass points
+ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
+ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
+ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
+ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
+!* move the first physical level if above the target grid
+ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
+!* shift to V points
+
+ZGRID1(:,:,:)=MYM(ZGRID1(:,:,:))
+ZGRID2(:,:,:)=MYM(ZGRID2(:,:,:))
+DO JJ=JPHEXT,1,-1
+ ZGRID1(:,JJ,:)=2.*ZGRID1(:,JJ+1,:)-ZGRID1(:,JJ+2,:)
+ ZGRID2(:,JJ,:)=2.*ZGRID2(:,JJ+1,:)-ZGRID2(:,JJ+2,:)
+ENDDO
+!$20140711 updatehalo(zg1,2) also here
+NULLIFY(TZLSFIELD_ll)
+CALL ADD3DFIELD_ll( TZLSFIELD_ll, ZGRID1, 'VER_INTERP_FIELD::ZGRID1' )
+CALL ADD3DFIELD_ll( TZLSFIELD_ll, ZGRID2, 'VER_INTERP_FIELD::ZGRID2' )
+CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
+CALL CLEANLIST_ll(TZLSFIELD_ll)
+!$
+CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
+!
+!$20140710
+CALL MPPDB_CHECK3D(XCOEFLIN,"VERINTERPFIELDaftVerinterplin:XCOEFLIN",PRECISION)
+PVT (:,:,:) = VER_INTERP_LIN(PVT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+PLSVM (:,:,:) = VER_INTERP_LIN(PLSVM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+!$20140710
+CALL MPPDB_CHECK3D(PVT,"VERINTERPFIELDaftVerinterplin:PVT",PRECISION)
+!
+!* 2.3 W component
+! -----------
+!
+ZGRID1(:,:,:)=PZZ_LS(:,:,:)
+ZGRID2(:,:,:)=PZZ (:,:,:)
+!* move the first physical level if above the target grid
+ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
+!
+CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
+!
+PWT (:,:,:) = VER_INTERP_LIN(PWT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+PLSWM (:,:,:) = VER_INTERP_LIN(PLSWM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+!
+!* 2.4 thermodynamical variables
+! -------------------------
+!
+!* shift of grids to mass points
+ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
+ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
+ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
+ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
+!
+CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
+!
+PTHVT (:,:,:) = VER_INTERP_LIN(PTHVT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+PLSTHM(:,:,:) = VER_INTERP_LIN(PLSTHM(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+!
+IF ( SIZE(PLSRVM,1) /= 0 ) THEN
+ PLSRVM(:,:,:) = VER_INTERP_LIN(PLSRVM(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ PLSRVM=MAX(PLSRVM,0.)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. moist variables
+! ---------------
+!
+DO JRR=1,KRR
+ PRT (:,:,:,JRR) = VER_INTERP_LIN(PRT (:,:,:,JRR),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ PRT (:,:,:,JRR) = MAX(PRT(:,:,:,JRR),0.)
+END DO
+!
+IF (CONF_MODEL(1)%NRR>=1) THEN
+ PHUT(:,:,:) = VER_INTERP_LIN(PHUT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ PHUT(:,:,:) = MIN(MAX(PHUT(:,:,:),0.),100.)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. scalar variables
+! ----------------
+!
+DO JSV=1,KSV
+ PSVT (:,:,:,JSV) = VER_INTERP_LIN(PSVT (:,:,:,JSV),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ PSVT (:,:,:,JSV) = MAX(PSVT(:,:,:,JSV),0.)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. TKE variable
+! ------------
+!
+!* shift of grids to mass points
+ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
+ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
+ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
+ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
+!* move the first physical level if above the target grid
+ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
+!
+CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
+!
+IF (HTURB /= 'NONE') THEN
+ PTKET(:,:,:) = VER_INTERP_LIN(PTKET (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ PTKET=MAX(PTKET,XTKEMIN)
+ENDIF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. secondary prognostic variables
+! ------------------------------
+!
+IF (KRR > 1 .AND. HTURB /= 'NONE') THEN
+ PSRCT (:,:,:) = VER_INTERP_LIN(PSRCT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ PSIGS (:,:,:) = VER_INTERP_LIN(PSIGS (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+DEALLOCATE(NKLIN)
+DEALLOCATE(XCOEFLIN)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE VER_INTERP_FIELD
+!
diff --git a/src/PHYEX/ext/write_desfmn.f90 b/src/PHYEX/ext/write_desfmn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..908c2eff83a767d24cddf6d5c7b1aebdb7f589ea
--- /dev/null
+++ b/src/PHYEX/ext/write_desfmn.f90
@@ -0,0 +1,730 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_WRITE_DESFM_n
+! #########################
+!
+INTERFACE
+!
+SUBROUTINE WRITE_DESFM_n(KMI,TPDATAFILE)
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
+!
+END SUBROUTINE WRITE_DESFM_n
+!
+END INTERFACE
+!
+END MODULE MODI_WRITE_DESFM_n
+!
+!
+! ###################################################
+ SUBROUTINE WRITE_DESFM_n(KMI,TPDATAFILE)
+! ###################################################
+!
+!!**** *WRITE_DESFM_n * - routine to write a descriptor file ( DESFM )
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to write the descriptive part of a Mesonh
+! file (FM-file). The resulting file is called DESFM.
+!
+!!
+!!** METHOD
+!! ------
+!!
+!! This routine writes in the file HDESFM, previously opened, the group of
+!! all the namelists used to specify a Mesonh simulation.
+!! If verbose option is high enough : NVERB>=5, the variables in descriptor
+!! file are printed on the right output-listing corresponding tomodel _n.
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODN_LUNIT_n : contains declarations of namelist NAM_LUNITn
+!! and module MODD_LUNIT_n
+!!
+!!
+!! Module MODN_CONF_n : contains declaration of namelist NAM_CONFn and
+!! uses module MODD_CONF1 (configuration variables
+!! for model _n )
+!!
+!! Module MODN_DYN_n : contains declaration of namelist NAM_DYNn and
+!! uses module MODD_DYN_n (dynamic control variables
+!! for model _n )
+!!
+!! Module MODN_ADV_n : contains declaration of namelist NAM_ADVn and
+!! uses module MODD_ADV_n (control variables for the
+!! advection scheme for model _n )
+!!
+!! Module MODN_PARAM_n : contains declaration of namelist NAM_PARAMn and
+!! uses module MODD_PARAM_n (names of the physical
+!! parameterizations for model _n )
+!!
+!! Module MODN_PARAM_RAD_n : contains declaration of the control parameters
+!! for calling the radiation scheme
+!!
+!! Module MODN_PARAM_KAFR_n : contains declaration of control parameters
+!! for calling the deep convection scheme
+!!
+!! Module MODN_LBC_n : contains declaration of namelis NAM_LBCn and
+!! uses module MODD_LBC_n (lateral boundary conditions)
+!!
+!!
+!! Module MODN_TURB_n : contains declaration of turbulence scheme options
+!! present in the namelist
+!!
+!! Module MODN_CONF : contains declaration of namelist NAM_CONF and
+!! uses module MODD_CONF (configuration variables)
+!!
+!! Module MODN_DYN : contains the declaration of namelist NAM_DYN and
+!! uses module MODD_DYN (dynamic control variables)
+!!
+!! Module MODN_BUDGET : contains declaration of all the namelists
+!! related to the budget computations
+!!
+!! Module MODN_LES : contains declaration of the control parameters
+!! for Large Eddy Simulations' storages
+!! Module MODN_BLANK_n : contains declaration of MesoNH developper variables
+!! for test and debugging purposes.
+!!
+!!
+!! REFERENCE
+!! ---------
+!! None
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/06/94
+!! Updated V.Ducrocq 06/09/94
+!! Updated J.Stein 20/10/94 to include NAM_OUTn
+!! Updated J.Stein 24/10/94 change routine name
+!! Updated J.Stein 26/10/94 add the OWRIGET argument
+!! Updated J.Stein 06/12/94 add the LS fields
+!! Updated J.Stein 09/01/95 add the turbulence scheme
+!! Updated J.Stein 09/01/95 add the 1D switch
+!! Updated J.Stein 20/03/95 remove R from the historical var.
+!! Updated Ph.Hereil 20/06/95 add the budgets
+!! Updated J.-P. Pinty 15/09/95 add the radiations
+!! Updated J.Vila 06/02/96 implementation of scalar
+!! advection schemes
+!! Updated J.Stein 20/02/96 cleaning + add the LES namelist
+!! Modifications 25/04/96 (Suhre) add NAM_BLANK
+!! Modifications 25/04/96 (Suhre) add NAM_FRC
+!! Modifications 25/04/96 (Suhre) add NAM_CH_MNHCn and NAM_CH_SOLVER
+!! Modifications 11/04/96 (Pinty) add the ice concentration
+!! Modifications 11/01/97 (Pinty) add the deep convection
+!! Temporary Modification (Masson 06/09/96) manual write of the first and
+!! third namelists because of compiler version.
+!! Modifications J.-P. Lafore 22/07/96 gridnesting implementation
+!! Modifications J.-P. Lafore 29/07/96 add NAM_FMOUT (renamed in NAM_OUTPUT/NAM_BACKUP)
+!! Modifications V. Masson 10/07/97 add NAM_PARAM_GROUNDn
+!! Modifications V. Masson 28/07/97 supress LSTEADY_DMASS
+!! Modifications P. Jabouille 03/10/01 LHORELAX_ modifications
+!! Modifications P. Jabouille 12/03/02 conditional writing of namelists
+!! Modifications J.-P. Pinty 29/11/02 add C3R5, ICE2, ICE4, CELEC
+!! Modification V. Masson 01/2004 removes surface (externalization)
+!! Modification P. Tulet 01/2005 add dust, orilam
+!! Modification 05/2006 Remove EPS and OWRIGET
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 02/2018 Q.Libois ECRAD
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Modification V. Vionnet 07/2017 add blowing snow variables
+!! Modification F.Auguste 02/2021 add IBM
+!! E.Jezequel 02/2021 add stations read from CSV file
+! A. Costes 12/2021: add Blaze fire model
+! P. Wautelet 27/04/2022: add namelist for profilers
+! P. Wautelet 13/07/2022: add namelist for flyers and balloons
+! P. Wautelet 19/01/2023: bugfix for ForeFire
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CONF
+USE MODD_DYN_n, ONLY: LHORELAX_SVLIMA, LHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE, ONLY: LFOREFIRE
+#endif
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAMETERS
+USE MODD_PROFILER_n, ONLY: LPROFILER
+USE MODD_STATION_n, ONLY: LSTATION
+!
+USE MODE_MSG
+!
+! USE MODN_AIRCRAFTS
+USE MODN_BACKUP
+! USE MODN_BALLOONS
+USE MODN_CONF
+USE MODN_DYN
+USE MODN_NESTING
+USE MODN_OUTPUT
+USE MODN_BUDGET
+USE MODN_LES
+USE MODN_DYN_n
+USE MODN_ADV_n
+USE MODN_PARAM_n
+USE MODN_PARAM_RAD_n
+USE MODN_PARAM_ECRAD_n
+USE MODN_PARAM_KAFR_n
+USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICEN_INIT
+USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
+USE MODN_CONF_n
+USE MODN_LUNIT_n
+USE MODN_LBC_n
+USE MODN_NUDGING_n
+USE MODD_TURB_n, ONLY: TURBN_INIT
+USE MODD_NEB_n, ONLY: NEBN_INIT
+USE MODN_BLANK_n
+USE MODN_FRC
+USE MODN_CH_MNHC_n
+USE MODN_CH_SOLVER_n
+USE MODN_PARAM_C2R2
+USE MODN_PARAM_C1R3
+USE MODN_ELEC
+USE MODN_SERIES
+USE MODN_SERIES_n
+USE MODN_TURB_CLOUD
+USE MODN_CH_ORILAM
+USE MODN_DUST
+USE MODN_SALT
+USE MODN_PASPOL
+USE MODN_CONDSAMP
+USE MODN_2D_FRC
+USE MODN_LATZ_EDFLX
+#ifdef MNH_FOREFIRE
+USE MODN_FOREFIRE
+#endif
+USE MODN_BLOWSNOW_n
+USE MODN_BLOWSNOW
+USE MODN_IBM_PARAM_n
+USE MODN_RECYCL_PARAM_n
+USE MODN_PROFILER_n, LDIAG_SURFRAD_PROF => LDIAG_SURFRAD
+USE MODN_STATION_n, LDIAG_SURFRAD_STAT => LDIAG_SURFRAD
+USE MODN_FIRE_n
+USE MODN_FLYERS
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILUSEG ! logical unit number of EXSEG file
+INTEGER :: ILUOUT ! Logical unit number for output-listing TLUOUT file
+!
+LOGICAL :: GHORELAX_UVWTH, &
+ GHORELAX_RV, GHORELAX_RC, GHORELAX_RR, &
+ GHORELAX_RI, GHORELAX_RS, GHORELAX_RG, &
+ GHORELAX_TKE, GHORELAX_SVC2R2, GHORELAX_SVPP, &
+ GHORELAX_SVCS, GHORELAX_SVCHIC, GHORELAX_SVFIRE,&
+#ifdef MNH_FOREFIRE
+ GHORELAX_SVFF, &
+#endif
+ GHORELAX_SVCHEM, GHORELAX_SVC1R3, &
+ GHORELAX_SVELEC, GHORELAX_SVLIMA,GHORELAX_SVSNW
+LOGICAL :: GHORELAX_SVDST, GHORELAX_SVSLT, GHORELAX_SVAER
+LOGICAL, DIMENSION(JPSVMAX) :: GHORELAX_SV
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. UPDATE DESFM FILE
+! -----------------
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_DESFM_n','called for '//TRIM(TPDATAFILE%CNAME))
+!
+IF (.NOT.ASSOCIATED(TPDATAFILE%TDESFILE)) &
+ CALL PRINT_MSG(NVERB_FATAL,'IO','WRITE_DESFM_n','TDESFILE not associated for '//TRIM(TPDATAFILE%CNAME))
+!
+ILUSEG = TPDATAFILE%TDESFILE%NLU
+!
+CALL INIT_NAM_LUNITn
+WRITE(UNIT=ILUSEG,NML=NAM_LUNITn)
+IF (CPROGRAM/='MESONH') THEN
+ LUSECI=.FALSE.
+ NSV_USER = 0
+ENDIF
+CALL INIT_NAM_CONFn
+WRITE(UNIT=ILUSEG,NML=NAM_CONFn)
+!
+!
+CALL INIT_NAM_DYNn
+IF (CPROGRAM/='MESONH') THEN ! impose default value for next simulation
+ GHORELAX_UVWTH = LHORELAX_UVWTH
+ GHORELAX_RV = LHORELAX_RV
+ GHORELAX_RC = LHORELAX_RC
+ GHORELAX_RR = LHORELAX_RR
+ GHORELAX_RI = LHORELAX_RI
+ GHORELAX_RS = LHORELAX_RS
+ GHORELAX_RG = LHORELAX_RG
+ GHORELAX_TKE = LHORELAX_TKE
+ GHORELAX_SV(:) = LHORELAX_SV(:)
+ GHORELAX_SVC2R2= LHORELAX_SVC2R2
+ GHORELAX_SVC1R3= LHORELAX_SVC1R3
+ GHORELAX_SVLIMA= LHORELAX_SVLIMA
+ GHORELAX_SVELEC= LHORELAX_SVELEC
+ GHORELAX_SVCHEM= LHORELAX_SVCHEM
+ GHORELAX_SVCHIC= LHORELAX_SVCHIC
+ GHORELAX_SVDST = LHORELAX_SVDST
+ GHORELAX_SVSLT = LHORELAX_SVSLT
+ GHORELAX_SVPP = LHORELAX_SVPP
+ GHORELAX_SVFIRE = LHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+ GHORELAX_SVFF = LHORELAX_SVFF
+#endif
+ GHORELAX_SVCS = LHORELAX_SVCS
+ GHORELAX_SVAER = LHORELAX_SVAER
+ GHORELAX_SVSNW = LHORELAX_SVSNW
+!
+ LHORELAX_UVWTH = .FALSE.
+ LHORELAX_RV = .FALSE.
+ LHORELAX_RC = .FALSE.
+ LHORELAX_RR = .FALSE.
+ LHORELAX_RI = .FALSE.
+ LHORELAX_RS = .FALSE.
+ LHORELAX_RG = .FALSE.
+ LHORELAX_TKE = .FALSE.
+ LHORELAX_SV(:) = .FALSE.
+ LHORELAX_SVC2R2= .FALSE.
+ LHORELAX_SVC1R3= .FALSE.
+ LHORELAX_SVLIMA= .FALSE.
+ LHORELAX_SVELEC= .FALSE.
+ LHORELAX_SVCHEM= .FALSE.
+ LHORELAX_SVCHIC= .FALSE.
+ LHORELAX_SVLG = .FALSE.
+ LHORELAX_SVPP = .FALSE.
+ LHORELAX_SVFIRE = .FALSE.
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF = .FALSE.
+#endif
+ LHORELAX_SVCS = .FALSE.
+ LHORELAX_SVDST= .FALSE.
+ LHORELAX_SVSLT= .FALSE.
+ LHORELAX_SVAER= .FALSE.
+ LHORELAX_SVSNW= .FALSE.
+ELSE !return to namelist meaning of LHORELAX_SV
+ GHORELAX_SV(:) = LHORELAX_SV(:)
+ LHORELAX_SV(NSV_USER+1:)=.FALSE.
+END IF
+WRITE(UNIT=ILUSEG,NML=NAM_DYNn)
+!
+IF (LIBM_LSF) THEN
+ !
+ CALL INIT_NAM_IBM_PARAMn
+ !
+ WRITE(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+ !
+ IF (CPROGRAM/='MESONH') THEN
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ END IF
+ !
+END IF
+!
+CALL INIT_NAM_ADVn
+WRITE(UNIT=ILUSEG,NML=NAM_ADVn)
+IF (CPROGRAM/='MESONH') THEN
+ CTURB = 'NONE'
+ CRAD = 'NONE'
+ CCLOUD = 'NONE'
+ CDCONV = 'NONE'
+ CSCONV = 'NONE'
+ CELEC = 'NONE'
+ CACTCCN = 'NONE'
+END IF
+CALL INIT_NAM_PARAMn
+WRITE(UNIT=ILUSEG,NML=NAM_PARAMn)
+!
+CALL INIT_NAM_PARAM_RADn
+IF(CRAD /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_PARAM_RADn)
+#ifdef MNH_ECRAD
+CALL INIT_NAM_PARAM_ECRADn
+IF(CRAD /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn)
+#endif
+!
+CALL INIT_NAM_PARAM_KAFRn
+IF(CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') &
+ WRITE(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
+!
+IF (CSCONV == 'EDKF' ) CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+!
+CALL INIT_NAM_LBCn
+WRITE(UNIT=ILUSEG,NML=NAM_LBCn)
+!
+CALL INIT_NAM_NUDGINGn
+WRITE(UNIT=ILUSEG,NML=NAM_NUDGINGn)
+!
+IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+!
+CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+!
+CALL INIT_NAM_BLANKn
+WRITE(UNIT=ILUSEG,NML=NAM_BLANKn)
+!
+!IF (CPROGRAM/='MESONH') THEN
+! LUSECHEM = .FALSE.
+! LORILAM = .FALSE.
+! LDEPOS_AER = .FALSE.
+! LDUST = .FALSE.
+! LDEPOS_DST = .FALSE.
+! LSALT = .FALSE.
+! LDEPOS_SLT = .FALSE.
+! LPASPOL = .FALSE.
+! LCONDSAMP = .FALSE.
+!END IF
+CALL INIT_NAM_CH_MNHCn
+IF(LUSECHEM .OR. LCH_CONV_LINOX .OR. LCH_CONV_SCAV) &
+ WRITE(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
+!
+CALL INIT_NAM_CH_SOLVERn
+IF(LUSECHEM) WRITE(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
+!
+CALL INIT_NAM_BLOWSNOWn
+IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
+IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
+!
+CALL INIT_NAM_PROFILERn
+IF(LPROFILER) WRITE(UNIT=ILUSEG,NML=NAM_PROFILERn)
+!
+CALL INIT_NAM_STATIONn
+IF(LSTATION) WRITE(UNIT=ILUSEG,NML=NAM_STATIONn)
+!
+IF(LDUST) WRITE(UNIT=ILUSEG,NML=NAM_DUST)
+IF(LSALT) WRITE(UNIT=ILUSEG,NML=NAM_SALT)
+IF(LPASPOL) WRITE(UNIT=ILUSEG,NML=NAM_PASPOL)
+#ifdef MNH_FOREFIRE
+IF(LFOREFIRE) WRITE(UNIT=ILUSEG,NML=NAM_FOREFIRE)
+#endif
+!
+CALL INIT_NAM_FIREn
+WRITE(UNIT=ILUSEG,NML=NAM_FIREn)
+!
+IF(LCONDSAMP) WRITE(UNIT=ILUSEG,NML=NAM_CONDSAMP)
+IF(LORILAM.AND.LUSECHEM) WRITE(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
+!
+CALL INIT_NAM_SERIESn
+IF(LSERIES) WRITE(UNIT=ILUSEG,NML=NAM_SERIESn)
+IF(L2D_ADV_FRC .OR. L2D_REL_FRC) WRITE(UNIT=ILUSEG,NML=NAM_2D_FRC)
+!
+IF (LUV_FLX .OR. LTH_FLX) WRITE(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
+!
+IF (CPROGRAM/='MESONH') THEN
+ LLG = .FALSE.
+END IF
+WRITE(UNIT=ILUSEG,NML=NAM_CONF)
+WRITE(UNIT=ILUSEG,NML=NAM_DYN)
+WRITE(UNIT=ILUSEG,NML=NAM_NESTING)
+!WRITE(UNIT=ILUSEG,NML=NAM_BACKUP)
+!WRITE(UNIT=ILUSEG,NML=NAM_OUTPUT)
+IF(CBUTYPE /= 'NONE') THEN
+ IF(CBUTYPE=='SKIP') CBUTYPE='CART'
+ WRITE(UNIT=ILUSEG,NML=NAM_BUDGET)
+END IF
+IF(LBU_RU) WRITE(UNIT=ILUSEG,NML=NAM_BU_RU)
+IF(LBU_RV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RV)
+IF(LBU_RW) WRITE(UNIT=ILUSEG,NML=NAM_BU_RW)
+IF(LBU_RTH) WRITE(UNIT=ILUSEG,NML=NAM_BU_RTH)
+IF(LBU_RTKE) WRITE(UNIT=ILUSEG,NML=NAM_BU_RTKE)
+IF(LBU_RRV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRV)
+IF(LBU_RRC) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRC)
+IF(LBU_RRR) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRR)
+IF(LBU_RRI) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRI)
+IF(LBU_RRS) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRS)
+IF(LBU_RRG) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRG)
+IF(LBU_RRH) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRH)
+IF(LBU_RSV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RSV)
+IF(LLES_MEAN .OR. LLES_RESOLVED .OR. LLES_SUBGRID .OR. LLES_UPDRAFT &
+.OR. LLES_DOWNDRAFT .OR. LLES_SPECTRA) WRITE(UNIT=ILUSEG,NML=NAM_LES)
+IF(LFORCING .OR. LTRANS) WRITE(UNIT=ILUSEG,NML=NAM_FRC)
+IF(CCLOUD(1:3) == 'ICE') CALL PARAM_ICEN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') &
+ WRITE(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
+IF(CCLOUD == 'C3R5' ) WRITE(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
+IF(CCLOUD == 'LIMA' ) CALL PARAM_LIMA_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+IF(CELEC /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_ELEC)
+IF(LSERIES) WRITE(UNIT=ILUSEG,NML=NAM_SERIES)
+IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
+WRITE(UNIT=ILUSEG,NML=NAM_FLYERS)
+!Not possible (for the moment): arrays have been deallocated after ini_aircraft: WRITE(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
+!Not possible (for the moment): arrays have been deallocated after ini_balloon: WRITE(UNIT=ILUSEG,NML=NAM_BALLOONS)
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. WRITE UPDATED DESFM ON OUTPUT LISTING
+! -------------------------------------
+!
+IF (NVERB >= 5) THEN
+!
+ ILUOUT = TLUOUT%NLU
+!
+ WRITE(UNIT=ILUOUT,FMT="(/,'DESCRIPTOR OF SEGMENT FOR MODEL ',I2)") KMI
+ WRITE(UNIT=ILUOUT,FMT="( '------------------------------- ' )")
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** LOGICAL UNITSn **********')")
+ WRITE(UNIT=ILUOUT,NML=NAM_LUNITn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** CONFIGURATIONn **********')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CONFn)
+!
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** DYNAMICn ****************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_DYNn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** ADVECTIONn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_ADVn)
+ !
+ IF (LIBM_LSF) THEN
+ WRITE(UNIT=ILUOUT,FMT="('********** IBM_PARAMn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
+ ENDIF
+ !
+ IF (LRECYCL) THEN
+ WRITE(UNIT=ILUOUT,FMT="('********** RECYCL_PARAMn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
+ ENDIF
+ !
+ WRITE(UNIT=ILUOUT,FMT="('********** PARAMETERIZATIONSn ******')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAMn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** RADIATIONn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_RADn)
+#ifdef MNH_ECRAD
+ WRITE(UNIT=ILUOUT,FMT="('********** ECRADn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_ECRADn)
+#endif
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** CONVECTIONn *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_KAFRn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ PARAM_MFSHALLn *******')")
+ CALL PARAM_MFSHALLN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** LBCn ********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_LBCn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** NUDGINGn*****************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** TURBn *******************')")
+ CALL TURBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** NEBn *******************')")
+ CALL NEBN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL MONITORn *******')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CH_MNHCn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ CHEMICAL SOLVERn ******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CH_SOLVERn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ TEMPORAL SERIESn ******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_SERIESn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLOWING SNOW SCHEME ****************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOWn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLAZE *******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_FIREn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLANKn *****************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ ICE SCHEME ***********************')")
+ CALL PARAM_ICEN_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+!
+ IF (KMI==1) THEN
+ WRITE(UNIT=ILUOUT,FMT="(/,'PART OF SEGMENT FILE COMMON TO ALL THE MODELS')")
+ WRITE(UNIT=ILUOUT,FMT="( '---------------------------------------------')")
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ CONFIGURATION ********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CONF)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ DYNAMIC **************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_DYN)
+!
+ WRITE(UNIT=ILUOUT,FMT="(/,'********** NESTING **************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_NESTING)
+!
+! WRITE(UNIT=ILUOUT,FMT="(/,'********** BACKUP ***************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BACKUP)
+!
+! WRITE(UNIT=ILUOUT,FMT="(/,'********** OUTPUT ***************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_OUTPUT)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ BUDGET ***************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BUDGET)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RU ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ U BUDGET *************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RU)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ V BUDGET *************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RV)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RW ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ W BUDGET *************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RW)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RTH ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ TH BUDGET ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RTH)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RTKE ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ TKE BUDGET ***********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RTKE)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RRV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ RV BUDGET ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RRV)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RRC ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ RC BUDGET ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RRC)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RRR ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ RR BUDGET ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RRR)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RRI ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ RI BUDGET ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RRI)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RRS ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ RS BUDGET ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RRS)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RRG ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ RG BUDGET ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RRG)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RRH ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ RH BUDGET ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RRH)
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RSV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
+ WRITE(UNIT=ILUOUT,FMT="('************ SVx BUDGET ***********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BU_RSV)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ LES ******************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_LES)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ FORCING **************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_FRC)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** DUST SCHEME ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_DUST)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** PASPOL *****************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PASPOL)
+!
+#ifdef MNH_FOREFIRE
+ WRITE(UNIT=ILUOUT,FMT="('********** FOREFIRE *****************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_FOREFIRE)
+!
+#endif
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** CONDSAMP****************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CONDSAMP)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** SALT SCHEME ************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_SALT)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLOWING SNOW SCHEME ****************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOW)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ ORILAM SCHEME ********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_CH_ORILAM)
+!
+ IF( CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5') THEN
+ WRITE(UNIT=ILUOUT,FMT="('*********** C2R2 SCHEME *********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
+ IF( CCLOUD == 'C3R5' ) THEN
+ WRITE(UNIT=ILUOUT,FMT="('*********** C1R3 SCHEME *********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C1R3)
+ END IF
+ END IF
+!
+ IF( CCLOUD == 'LIMA' ) THEN
+ WRITE(UNIT=ILUOUT,FMT="('*********** LIMA SCHEME *********************')")
+ CALL PARAM_LIMA_INIT(CPROGRAM, TPDATAFILE, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
+ END IF
+!
+ IF( CCLOUD == 'KHKO' ) THEN
+ WRITE(UNIT=ILUOUT,FMT="('*********** KHKO SCHEME *********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
+ END IF
+!
+ IF( CELEC /= 'NONE' ) THEN
+ WRITE(UNIT=ILUOUT,FMT="('*********** ELEC SCHEME *********************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_ELEC)
+ END IF
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ TEMPORAL SERIES ****************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_SERIES)
+!
+ WRITE(UNIT=ILUOUT,FMT="('************ MIXING LENGTH FOR CLOUD ***********')")
+ WRITE(UNIT=ILUOUT,NML=NAM_TURB_CLOUD)
+!
+ END IF
+!
+END IF
+!
+IF (CPROGRAM /='MESONH') THEN !return to previous LHORELAX_
+ LHORELAX_UVWTH = GHORELAX_UVWTH
+ LHORELAX_RV = GHORELAX_RV
+ LHORELAX_RC = GHORELAX_RC
+ LHORELAX_RR = GHORELAX_RR
+ LHORELAX_RI = GHORELAX_RI
+ LHORELAX_RS = GHORELAX_RS
+ LHORELAX_RG = GHORELAX_RG
+ LHORELAX_TKE = GHORELAX_TKE
+ LHORELAX_SV(:) = GHORELAX_SV(:)
+ LHORELAX_SVC2R2= GHORELAX_SVC2R2
+ LHORELAX_SVC1R3= GHORELAX_SVC1R3
+ LHORELAX_SVLIMA= GHORELAX_SVLIMA
+ LHORELAX_SVELEC= GHORELAX_SVELEC
+ LHORELAX_SVCHEM= GHORELAX_SVCHEM
+ LHORELAX_SVCHIC= GHORELAX_SVCHIC
+ LHORELAX_SVLG = .FALSE.
+ LHORELAX_SVDST = GHORELAX_SVDST
+ LHORELAX_SVSLT = GHORELAX_SVSLT
+ LHORELAX_SVPP = GHORELAX_SVPP
+ LHORELAX_SVFIRE = GHORELAX_SVFIRE
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF = GHORELAX_SVFF
+#endif
+ LHORELAX_SVCS = GHORELAX_SVCS
+ LHORELAX_SVAER = GHORELAX_SVAER
+ LHORELAX_SVSNW = GHORELAX_SVSNW
+ELSE
+ LHORELAX_SV(:) = GHORELAX_SV(:)
+ENDIF
+CALL UPDATE_NAM_DYNn
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE WRITE_DESFM_n
diff --git a/src/PHYEX/ext/write_lesn.f90 b/src/PHYEX/ext/write_lesn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..44f915343d63daec3f7f285412ab3fdb75b6fd2d
--- /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: tfieldmetadata_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(tfieldmetadata_base) :: tfield
+type(tfieldmetadata_base) :: tfieldx
+type(tfieldmetadata_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 tfieldmetadata_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_n, 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/ext/write_lfifm1_for_diag.f90 b/src/PHYEX/ext/write_lfifm1_for_diag.f90
new file mode 100644
index 0000000000000000000000000000000000000000..84ff78bdab8ce9d1759df3baa7a02dc307bd0382
--- /dev/null
+++ b/src/PHYEX/ext/write_lfifm1_for_diag.f90
@@ -0,0 +1,4201 @@
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!################################
+MODULE MODI_WRITE_LFIFM1_FOR_DIAG
+!################################
+INTERFACE
+ SUBROUTINE WRITE_LFIFM1_FOR_DIAG(TPFILE,HDADFILE)
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
+CHARACTER(LEN=28), INTENT(IN) :: HDADFILE ! corresponding FM-file name of
+ ! its DAD model
+!
+END SUBROUTINE WRITE_LFIFM1_FOR_DIAG
+END INTERFACE
+END MODULE MODI_WRITE_LFIFM1_FOR_DIAG
+!
+! ##################################################
+ SUBROUTINE WRITE_LFIFM1_FOR_DIAG(TPFILE,HDADFILE)
+! ##################################################
+!
+!!**** *WRITE_LFIFM1* - routine to write a LFIFM file for model 1
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to write an initial LFIFM File
+! of name YFMFILE2//'.lfi' with the FM routines.
+!
+!!** METHOD
+!! ------
+!! The data are written in the LFIFM file :
+!! - dimensions
+!! - grid variables
+!! - configuration variables
+!! - prognostic variables at time t and t-dt
+!! - 1D anelastic reference state
+!!
+!! The localization on the model grid is also indicated :
+!!
+!! IGRID = 1 for mass grid point
+!! IGRID = 2 for U grid point
+!! IGRID = 3 for V grid point
+!! IGRID = 4 for w grid point
+!! IGRID = 0 for meaningless case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FMWRIT : FM-routine to write a record
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_DIM1 : contains dimensions
+!! Module MODD_TIME1 : contains time variables and uses MODD_TIME
+!! Module MODD_GRID : contains spatial grid variables for all models
+!! Module MODD_GRID1 : contains spatial grid variables
+!! Module MODD_REF : contains reference state variables
+!! Module MODD_LUNIT1: contains logical unit variables.
+!! Module MODD_CONF : contains configuration variables for all models
+!! Module MODD_CONF1 : contains configuration variables
+!! Module MODD_FIELD1 : contains prognostic variables
+!! Module MODD_GR_FIELD1 : contains surface prognostic variables
+!! Module MODD_LSFIELD1 : contains Larger Scale variables
+!! Module MODD_PARAM1 : contains parameterization options
+!! Module MODD_TURB1 : contains turbulence options
+!! Module MODD_FRC : contains forcing variables
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/05/94
+!! V. Ducrocq 27/06/94
+!! J.Stein 20/10/94 (name of the FMFILE)
+!! J.Stein 06/12/94 add the LS fields
+!! J.P. Lafore 09/01/95 add the DRYMASST
+!! J.Stein 20/01/95 add TKE and change the ycomment for the water
+!! variables
+!! J.Stein 23/01/95 add a TKE switch and MODD_PARAM1
+!! J.Stein 16/03/95 remove R from the historical variables
+!! J.Stein 20/03/95 add the EPS var.
+!! J.Stein 30/06/95 add the variables related to the subgrid condens
+!! S. Belair 01/09/95 add surface variables and ground parameters
+!! J.-P. Pinty 15/09/95 add the radiation parameters
+!! J.Stein 23/01/96 add the TSZ0 option for the surface scheme
+!! M.Georgelin 13/12/95 add the forcing variables
+!! J.-P. Pinty 15/02/96 add external control for the forcing
+!! J.Stein P.Bougeault 15/03/96 add the cloud fraction and change the
+!! surface parameters for TSZ0 option
+!! J.Stein P.Jabouille 30/04/96 add the storage type
+!! J.Stein P.Jabouille 20/05/96 switch for XSIGS and XSRC
+!! J.Stein 10/10/96 change Xsrc into XSRCM and XRCT
+!! J.P. Lafore 30/07/96 add YFMFILE2 and HDADFILE writing
+!! corresponding to MY_NAME and DAD_NAME (for nesting)
+!! V.Masson 08/10/96 add LTHINSHELL
+!! J.-P. Pinty 15/12/96 add the microphysics (ice)
+!! J.-P. Pinty 11/01/97 add the deep convection
+!! J.-P. Pinty 27/01/97 split the recording of the SV array
+!! J.-P. Pinty 29/01/97 set recording of PRCONV and PACCONV in mm/h and
+!! mm respectively
+!! J. Viviand 04/02/97 convert precipitation rates in mm/h
+!! P. Hereil 04/12/97 add the calculation of cloud top and moist PV
+!! P.Hereil N Asencio 3/02/98 add the calculation of precipitation on large scale grid mesh
+!! N Asencio 2/10/98 suppress flux calculation if start file
+!! V Masson 25/11/98 places dummy arguments in module MODD_DIAG_FLAG
+!! V Masson 04/01/00 removes TSZ0 option
+!! J.-P. Pinty 29/11/02 add C3R5, ICE2, ICE4, CELEC
+!! V Masson 01/2004 removes surface (externalization)
+!! P. Tulet 01/2005 add dust, orilam
+!! M. Leriche 04/2007 add aqueous concentration in M
+!! O. Caumont 03/2008 add simulation of radar observations
+!! O. Caumont 14/09/2009 modifications to allow for polar outputs (radar diagnostics)
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! G. Tanguy 10/2009 add possibility to run radar after
+!! PREP_REAL_CASE with AROME
+!! O. Caumont 01/2011 [radar diagnostics] add control check for NMAX; revise comments
+!! O. Caumont 05/2011 [radar diagnostics] change output format
+!! G.Tanguy/ JP Pinty/ JP Chabureau 18/05/2011 : add lidar simulator
+!! S.Bielli 12/2012 : add latitude and longitude
+!! F. Duffourg 02/2013 : add new fields
+!! J.Escobar 21/03/2013: for HALOK get correctly local array dim/bound
+!! J. escobar 27/03/2014 : write LAT/LON only in not CARTESIAN case
+!! G.Delautier 2014 : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM
+!! C. Augros 2014 : new radar simulator (T matrice)
+!! D.Ricard 2015 : add THETAES + POVOES (LMOIST_ES=T)
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! C.Lac 04/2016 : add visibility and droplet deposition
+!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
+!! T.Dauhut 10/2017 : add parallel 3D clustering
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! D.Ricard and P.Marquet 2016-2017 : THETAL + THETAS1 POVOS1 or THETAS2 POVOS2
+!! if LMOIST_L LMOIST_S1 or LMOIST_S2
+! P. Wautelet 08/02/2019: minor bug: compute ZWORK36 only when needed
+! S Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 18/03/2020: remove ICE2 option
+! B. Vie 06/2020: Add prognostic supersaturation for LIMA
+! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
+! J.L Redelsperger 03/2021 Adding OCEAN LES Case and Autocoupled O-A LES
+! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BLOWSNOW, ONLY: LBLOWSNOW, NBLOWSNOW3D
+USE MODD_BLOWSNOW_n, ONLY: XSNWSUBL3D
+USE MODD_CH_AERO_n, ONLY: XN3D, XRG3D, XSIG3D
+USE MODD_CH_AEROSOL
+USE MODD_CH_M9_n, ONLY: NEQAQ
+USE MODD_CH_MNHC_n, ONLY: LCH_CONV_LINOX, LUSECHEM, XRTMIN_AQ
+USE MODD_CONDSAMP, ONLY: LCONDSAMP
+USE MODD_CONF, ONLY: CBIBUSER, CEQNSYS, CPROGRAM, L1D, L2D, LCARTESIAN, LFORCING, LPACK, LTHINSHELL, NBUGFIX, NMASDEV
+USE MODD_CONF_n, ONLY: IDX_RVT, IDX_RCT, IDX_RRT, IDX_RIT, IDX_RST, IDX_RGT, IDX_RHT, &
+ LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG, LUSERH, &
+ LUSECI, NRR, NRRI, NRRL
+USE MODD_CST, ONLY: XALPI, XAVOGADRO, XBETAI, XCI, XCL, XCPD, XCPV, XG, XGAMI, XLSTT, XLVTT, &
+ XMD, XMV, XP00, XPI, XRADIUS, XRHOLW, XRD, XRV, XTT
+USE MODD_CSTS_DUST, ONLY: XDENSITY_DUST, XM3TOUM3, XMOLARWEIGHT_DUST
+USE MODD_CURVCOR_n, ONLY: XCORIOZ
+USE MODD_DEEP_CONVECTION_n, ONLY: XCG_RATE, XCG_TOTAL_NUMBER, XIC_RATE, XIC_TOTAL_NUMBER, XPACCONV, XPRCONV, XPRSCONV
+USE MODD_DIAG_FLAG
+USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
+USE MODD_DUST, ONLY: LDEPOS_DST, LDUST, NMODE_DST
+USE MODD_DYN_n, ONLY: LOCEAN
+use modd_field, only: tfieldmetadata, tfieldlist, TYPEINT, TYPEREAL
+USE MODD_FIELD_n, ONLY: XCIT, XCLDFR, XICEFR, XPABSM, XPABST, XRT, XSIGS, XSRCT, XSVT, XTHT, XTKET, XUT, XVT, XWT, XZWS
+USE MODD_FRC, ONLY: NFRC, XGXTHFRC, XGYTHFRC, XPGROUNDFRC, XRVFRC, XTENDRVFRC, XTENDTHFRC, XTHFRC, XUFRC, XVFRC, XWFRC
+USE MODD_GRID, ONLY: XBETA, XLAT0, XLATORI, XLON0, XLONORI, XRPK
+USE MODD_GRID_n, only: LSLEVE, NEXTE_XMIN, NEXTE_YMIN, XHATM_BOUND, &
+ XLAT, XLEN1, XLEN2, XLON, XZS, XXHAT, XXHATM, XYHAT, XYHATM, XZHAT, XZSMT, XZTOP, XZZ
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LSFIELD_n, ONLY: XLSRVM, XLSTHM, XLSUM, XLSVM, XLSWM
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
+USE MODD_MPIF
+USE MODD_NESTING, ONLY: NDXRATIO_ALL, NDYRATIO_ALL, NXOR_ALL, NYOR_ALL
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, XUNDEF
+USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_CONC
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM, &
+ LSCAV, LLIMA_DIAG, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_CONC, CAERO_MASS
+USE MODD_PARAM_n, ONLY: CCLOUD, CDCONV, CELEC, CSURF, CTURB
+USE MODD_PASPOL, ONLY: LPASPOL
+USE MODD_PRECIP_n, ONLY: XACDEP, XACPRC, XACPRG, XACPRH, XACPRR, XACPRS, XEVAP3D, &
+ XINDEP, XINPRC, XINPRG, XINPRH, XINPRR, XINPRR3D, XINPRS
+use modd_precision, only: MNHREAL_MPI
+USE MODD_RADAR, ONLY: CNAME_RAD, LATT, LCART_RAD, LDNDZ, LREFR, LWBSCS, LWREFL, &
+ NBAZIM, NBELEV, NBRAD, NBSTEPMAX, NCURV_INTERPOL, NDIFF, NMAX, NPTS_H, NPTS_V, &
+ XALT_RAD, XDT_RAD, XELEV, XGRID, XLAM_RAD, XLAT_RAD, XLON_RAD, XSTEP_RAD
+USE MODD_REF, ONLY: LBOUSS, LCOUPLES, XEXNTOP, XEXNTOPO, XRHODREFZ, XRHODREFZO, XTHVREFZ, XTHVREFZO
+USE MODD_REF_n, ONLY: XEXNREF, XRHODREF, XTHVREF
+USE MODD_SALT, ONLY: LDEPOS_SLT, LSALT, NMODE_SLT
+USE MODD_TIME, ONLY: TDTEXP, TDTSEG
+USE MODD_TIME_n, ONLY: TDTCUR, TDTMOD
+USE MODD_TURB_n, only: CTOM, XBL_DEPTH
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+
+USE MODE_AERO_PSD, ONLY: PPP2AERO
+USE MODE_BLOWSNOW_PSD, ONLY: PPP2SNOW
+USE MODE_DUST_PSD, ONLY: PPP2DUST
+use mode_field, only: Find_field_id_from_mnhname
+USE MODE_GRIDPROJ, ONLY: SM_LATLON
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_MODELN_HANDLER, only: GET_CURRENT_MODEL_INDEX
+use mode_msg
+USE MODE_SALT_PSD, ONLY: PPP2SALT
+USE MODE_THERMO, ONLY: QSAT, SM_FOES
+USE MODE_TOOLS, ONLY: UPCASE
+USE MODE_TOOLS_ll, ONLY: GET_DIM_EXT_ll, GET_INDICE_ll
+
+USE MODI_CALCSOUND
+USE MODI_CLUSTERING
+USE MODI_COMPUTE_MEAN_PRECIP
+USE MODI_CONTRAV
+USE MODI_GPS_ZENITH
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_INI_RADAR
+USE MODI_LIDAR
+USE MODI_RADAR_RAIN_ICE
+USE MODI_RADAR_SIMULATOR
+USE MODI_SHUMAN
+USE MODI_UV_TO_ZONAL_AND_MERID
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
+CHARACTER(LEN=28), INTENT(IN) :: HDADFILE ! corresponding FM-file name of
+ ! its DAD model
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: IRESP ! return-code for the file routines
+!
+CHARACTER(LEN=3) :: YFRC ! to mark the time of the forcing
+CHARACTER(LEN=31) :: YFGRI ! file name for GPS stations
+!
+INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
+!
+INTEGER :: JLOOP,JI,JJ,JK,JSV,JT,JH,JV,JEL ! loop index
+INTEGER :: IMI ! Current model index
+!
+REAL :: ZRV_OV_RD ! XRV / XRD
+REAL :: ZGAMREF ! Standard atmosphere lapse rate (K/m)
+REAL :: ZX0D ! work real scalar
+REAL :: ZLATOR, ZLONOR ! geographical coordinates of 1st mass point
+!
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPOVO
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZTEMP
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCORIOZ
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK31,ZWORK32
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK33,ZWORK34
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK21,ZWORK22
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK23,ZWORK24
+REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZWORK42 ! reflectivity on a cartesian grid (PREFL_CART)
+REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZWORK42_BIS
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZWORK43 ! latlon coordinates of cartesian grid points (PLATLON)
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZPHI,ZTHETAE,ZTHETAV
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTHETAES,ZTHETAL,ZTHETAS1,ZTHETAS2
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZVISIKUN,ZVISIGUL,ZVISIZHA
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWORK1
+integer :: ICURR,INBOUT,IERR
+!
+REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSP+NCARB+NSOA,JPMODE):: ZPTOTA
+REAL,DIMENSION(:,:,:,:), POINTER :: ZSDSTDEP
+REAL,DIMENSION(:,:,:,:), POINTER :: ZSSLTDEP
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIG_DST, ZRG_DST, ZN0_DST
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIG_SLT, ZRG_SLT, ZN0_SLT
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZBET_SNW, ZRG_SNW
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMA_SNW
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZRHOT, ZTMP ! work array
+!
+! GBOTUP = True does clustering from bottom up to top, False top down to surface
+LOGICAL :: GBOTUP ! clustering propagation
+LOGICAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: GCLOUD ! mask
+INTEGER,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ICLUSTERID, ICLUSTERLV
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCLDSIZE
+
+!ECRITURE DANS UN FICHIER ASCII DE RESULTATS
+!INITIALISATION DU NOM DE FICHIER CREE EN PARALLELE AVEC CELUI LFI
+TYPE(TFILEDATA),POINTER :: TZRSFILE
+INTEGER :: ILURS
+CHARACTER(LEN=32) :: YRS
+CHARACTER(LEN=3),DIMENSION(:),ALLOCATABLE :: YRAD
+CHARACTER(LEN=2*INT(NBSTEPMAX*XSTEP_RAD/XGRID)*2*9+1), DIMENSION(:), ALLOCATABLE :: CLATLON
+CHARACTER(LEN=2*9) :: CBUFFER
+CHARACTER(LEN=4) :: YELEV
+CHARACTER(LEN=3) :: YGRID_SIZE
+INTEGER :: IEL,IIELV
+CHARACTER(LEN=5) :: YVIEW ! Upward or Downward integration
+INTEGER :: IACCMODE
+!
+!-------------------------------------------------------------------------------
+INTEGER :: IAUX ! work variable
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW1, ZW2, ZW3
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK35,ZWORK36
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK25,ZWORK26
+REAL :: ZEAU ! Mean precipitable water
+INTEGER, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2)) ::IKTOP ! level in which is the altitude 3000m
+REAL, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2),SIZE(XZZ,3)) :: ZDELTAZ ! interval (m) between two levels K
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+!
+CHARACTER(LEN=2) :: INDICE
+CHARACTER(LEN=100) :: YMSG
+INTEGER :: IID
+TYPE(TFIELDMETADATA) :: TZFIELD, TZFIELD2D
+TYPE(TFIELDMETADATA), DIMENSION(2) :: TZFIELD2
+!
+! LIMA LIDAR
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMP1, ZTMP2, ZTMP3, ZTMP4
+!
+! hauteur couche limite
+REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZZZ_GRID1
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZTHVSOL,ZSHMIX
+REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZZONWIND,ZMERWIND,ZFFWIND2,ZRIB
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. ARRAYS BOUNDS INITIALIZATION
+!
+CALL GET_DIM_EXT_ll ('B',IIU,IJU)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKU=NKMAX+2*JPVEXT
+IKB=1+JPVEXT
+IKE=IKU-JPVEXT
+
+IMI = GET_CURRENT_MODEL_INDEX()
+ILUOUT0 = TLUOUT0%NLU
+TZRSFILE => NULL()
+!-------------------------------------------------------------------------------
+!
+!* 1. WRITES IN THE LFI FILE
+! ----------------------
+!
+!* 1.0 TPFILE%CNAME and HDADFILE :
+!
+CALL IO_Field_write(TPFILE,'MASDEV', NMASDEV)
+CALL IO_Field_write(TPFILE,'BUGFIX', NBUGFIX)
+CALL IO_Field_write(TPFILE,'BIBUSER', CBIBUSER)
+CALL IO_Field_write(TPFILE,'PROGRAM', CPROGRAM)
+!
+CALL IO_Field_write(TPFILE,'L1D', L1D)
+CALL IO_Field_write(TPFILE,'L2D', L2D)
+CALL IO_Field_write(TPFILE,'PACK', LPACK)
+!
+CALL IO_Field_write(TPFILE,'MY_NAME', TPFILE%CNAME)
+CALL IO_Field_write(TPFILE,'DAD_NAME', HDADFILE)
+!
+IF (LEN_TRIM(HDADFILE)>0) THEN
+ CALL IO_Field_write(TPFILE,'DXRATIO',NDXRATIO_ALL(1))
+ CALL IO_Field_write(TPFILE,'DYRATIO',NDYRATIO_ALL(1))
+ CALL IO_Field_write(TPFILE,'XOR', NXOR_ALL(1))
+ CALL IO_Field_write(TPFILE,'YOR', NYOR_ALL(1))
+END IF
+!
+CALL IO_Field_write(TPFILE,'SURF', CSURF)
+!
+!* 1.1 Type and Dimensions :
+!
+CALL IO_Field_write(TPFILE,'STORAGE_TYPE','DI')
+!
+CALL IO_Field_write(TPFILE,'IMAX',NIMAX_ll)
+CALL IO_Field_write(TPFILE,'JMAX',NJMAX_ll)
+CALL IO_Field_write(TPFILE,'KMAX',NKMAX)
+!
+CALL IO_Field_write(TPFILE,'JPHEXT',JPHEXT)
+!
+!* 1.2 Grid variables :
+!
+IF (.NOT.LCARTESIAN) THEN
+ CALL IO_Field_write(TPFILE,'RPK', XRPK)
+ CALL IO_Field_write(TPFILE,'LONORI',XLONORI)
+ CALL IO_Field_write(TPFILE,'LATORI',XLATORI)
+!
+!* diagnostic of 1st mass point
+!
+ CALL SM_LATLON( XLATORI, XLONORI, XHATM_BOUND(NEXTE_XMIN), XHATM_BOUND(NEXTE_YMIN), ZLATOR, ZLONOR )
+!
+ CALL IO_Field_write(TPFILE,'LONOR',ZLONOR)
+ CALL IO_Field_write(TPFILE,'LATOR',ZLATOR)
+!
+END IF
+!
+CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL)
+CALL IO_Field_write(TPFILE,'LAT0',XLAT0)
+CALL IO_Field_write(TPFILE,'LON0',XLON0)
+CALL IO_Field_write(TPFILE,'BETA',XBETA)
+!
+CALL IO_Field_write(TPFILE,'XHAT',XXHAT)
+CALL IO_Field_write(TPFILE,'YHAT',XYHAT)
+CALL IO_Field_write(TPFILE,'ZHAT',XZHAT)
+CALL IO_Field_write(TPFILE,'ZTOP',XZTOP)
+!
+CALL IO_Field_write(TPFILE,'ZS', XZS)
+CALL IO_Field_write(TPFILE,'ZWS', XZWS)
+CALL IO_Field_write(TPFILE,'ZSMT', XZSMT)
+CALL IO_Field_write(TPFILE,'SLEVE',LSLEVE)
+!
+IF (LSLEVE) THEN
+ CALL IO_Field_write(TPFILE,'LEN1',XLEN1)
+ CALL IO_Field_write(TPFILE,'LEN2',XLEN2)
+END IF
+!
+!
+CALL IO_Field_write(TPFILE,'DTMOD',TDTMOD)
+CALL IO_Field_write(TPFILE,'DTCUR',TDTCUR)
+CALL IO_Field_write(TPFILE,'DTEXP',TDTEXP)
+CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG)
+!
+!* 1.3 Configuration variables :
+!
+CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
+CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS)
+CALL IO_Field_write(TPFILE,'LOCEAN', LOCEAN)
+CALL IO_Field_write(TPFILE,'LCOUPLES', LCOUPLES)
+!
+IF (LCARTESIAN .AND. LWIND_ZM) THEN
+ LWIND_ZM=.FALSE.
+ PRINT*,'YOU ARE IN CARTESIAN GEOMETRY SO LWIND_ZM IS FORCED TO FALSE'
+END IF
+!* 1.4 Reference state variables :
+!
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZO)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZO)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOPO)
+ELSE
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+END IF
+!
+CALL IO_Field_write(TPFILE,'RHODREF',XRHODREF)
+CALL IO_Field_write(TPFILE,'THVREF', XTHVREF)
+!
+!
+!* 1.5 Variables necessary for plots
+!
+! PABST,THT,POVOM for cross sections at constant pressure
+! level or constant theta level or constant PV level
+!
+IF (INDEX(CISO,'PR') /= 0) THEN
+ CALL IO_Field_write(TPFILE,'PABST',XPABST)
+END IF
+!
+IF (INDEX(CISO,'TK') /= 0) THEN
+ CALL IO_Field_write(TPFILE,'THT',XTHT)
+END IF
+!
+ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
+ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
+ZVOX(:,:,2)=ZVOX(:,:,3)
+ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
+ZVOY(:,:,2)=ZVOY(:,:,3)
+ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
+ZVOZ(:,:,2)=ZVOZ(:,:,3)
+ZVOZ(:,:,1)=ZVOZ(:,:,3)
+ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
+ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
+ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
+ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
+ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
+ZPOVO(:,:,1) =-1.E+11
+ZPOVO(:,:,IKU)=-1.E+11
+IF (INDEX(CISO,'EV') /= 0) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'POVOT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'POVOT', &
+ CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_POtential VOrticity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPOVO)
+END IF
+!
+!
+IF (LVAR_RS) THEN
+ CALL IO_Field_write(TPFILE,'UT',XUT)
+ CALL IO_Field_write(TPFILE,'VT',XVT)
+ !
+ IF (LWIND_ZM) THEN
+ TZFIELD2(1) = TFIELDMETADATA( &
+ CMNHNAME = 'UM_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Zonal component of horizontal wind', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ TZFIELD2(2) = TFIELDMETADATA( &
+ CMNHNAME = 'VM_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Meridian component of horizontal wind', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ CALL UV_TO_ZONAL_AND_MERID(XUT,XVT,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
+ END IF
+ !
+ CALL IO_Field_write(TPFILE,'WT',XWT)
+ !
+ ! write mixing ratio for water vapor required to plot radio-soundings
+ !
+ IF (LUSERV) THEN
+ CALL IO_Field_write(TPFILE,'RVT',XRT(:,:,:,IDX_RVT))
+ END IF
+END IF
+!
+!* Latitude and Longitude arrays
+!
+IF (.NOT.LCARTESIAN) THEN
+ CALL IO_Field_write(TPFILE,'LAT',XLAT)
+ CALL IO_Field_write(TPFILE,'LON',XLON)
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.6 Other pronostic variables
+!
+ZTEMP(:,:,:)=XTHT(:,:,:)*(XPABST(:,:,:)/ XP00) **(XRD/XCPD)
+!
+IF (LVAR_TURB) THEN
+ IF (CTURB /= 'NONE') THEN
+ CALL IO_Field_write(TPFILE,'TKET',XTKET)
+ !
+ IF( NRR > 1 ) THEN
+ CALL IO_Field_write(TPFILE,'SRCT',XSRCT)
+ CALL IO_Field_write(TPFILE,'SIGS',XSIGS)
+ END IF
+ !
+ IF(CTOM=='TM06') THEN
+ CALL IO_Field_write(TPFILE,'BL_DEPTH',XBL_DEPTH)
+ END IF
+ END IF
+END IF
+!
+!* Rains
+!
+IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN
+ !
+ ! explicit species
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRR*3.6E6)
+ !
+ CALL IO_Field_write(TPFILE,'INPRR3D',XINPRR3D)
+ CALL IO_Field_write(TPFILE,'EVAP3D', XEVAP3D)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRR*1.0E3)
+ !
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR.&
+ CCLOUD == 'KHKO' .OR. CCLOUD == 'LIMA') THEN
+ IF (SIZE(XINPRC) /= 0 ) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRC*3.6E6)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRC*1.0E3)
+ END IF
+ IF (SIZE(XINDEP) /= 0 ) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XINDEP*3.6E6)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_write(TPFILE,TZFIELD,XACDEP*1.0E3)
+ END IF
+ END IF
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRS*3.6E6)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRS*1.0E3)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRG*3.6E6)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRG*1.0E3)
+ !
+ IF (SIZE(XINPRH) /= 0 ) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRH*3.6E6)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRH*1.0E3)
+ ENDIF
+ !
+ ZWORK21(:,:) = XINPRR(:,:) + XINPRS(:,:) + XINPRG(:,:)
+ IF (SIZE(XINPRC) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:)
+ IF (SIZE(XINPRH) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XINPRH(:,:)
+ CALL FIND_FIELD_ID_FROM_MNHNAME('INPRT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*3.6E6)
+ !
+ ZWORK21(:,:) = XACPRR(:,:) + XACPRS(:,:) + XACPRG(:,:)
+ IF (SIZE(XINPRC) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:)
+ IF (SIZE(XINPRH) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XACPRH(:,:)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*1.0E3)
+ !
+ END IF
+ !
+ !* Convective rain
+ !
+ IF (CDCONV /= 'NONE') THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('PRCONV',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPRCONV*3.6E6)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('PACCONV',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPACCONV*1.0E3)
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME('PRSCONV',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'mm hour-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPRSCONV*3.6E6)
+ END IF
+END IF
+IF (LVAR_PR ) THEN
+ !Precipitable water in kg/m**2
+ ZWORK21(:,:) = 0.
+ ZWORK22(:,:) = 0.
+ ZWORK23(:,:) = 0.
+ ZWORK31(:,:,:) = DZF(XZZ(:,:,:))
+ DO JK = IKB,IKE
+ !* Calcul de qtot
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
+ ZWORK23(IIB:IIE,IJB:IJE) = XRT(IIB:IIE,IJB:IJE,JK,1) + &
+ XRT(IIB:IIE,IJB:IJE,JK,2) + XRT(IIB:IIE,IJB:IJE,JK,3) + &
+ XRT(IIB:IIE,IJB:IJE,JK,4) + XRT(IIB:IIE,IJB:IJE,JK,5) + &
+ XRT(IIB:IIE,IJB:IJE,JK,6)
+ ELSE
+ ZWORK23(IIB:IIE,IJB:IJE) = XRT(IIB:IIE,IJB:IJE,JK,1)
+ ENDIF
+ !* Calcul de l'eau precipitable
+ ZWORK21(IIB:IIE,IJB:IJE)=XRHODREF(IIB:IIE,IJB:IJE,JK)* &
+ ZWORK23(IIB:IIE,IJB:IJE)* ZWORK31(IIB:IIE,IJB:IJE,JK)
+ !* Sum
+ ZWORK22(IIB:IIE,IJB:IJE) = ZWORK22(IIB:IIE,IJB:IJE)+ZWORK21(IIB:IIE,IJB:IJE)
+ ZWORK21(:,:) = 0.
+ ZWORK23(:,:) = 0.
+ END DO
+ !* Precipitable water in kg/m**2
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'PRECIP_WAT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'PRECIP_WAT', &
+ CUNITS = 'kg m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
+ENDIF
+!
+!
+!* Flux d'humidite et d'hydrometeores
+IF (LHU_FLX) THEN
+ ZWORK35(:,:,:) = XRHODREF(:,:,:) * XRT(:,:,:,1)
+ ZWORK31(:,:,:) = MXM(ZWORK35(:,:,:)) * XUT(:,:,:)
+ ZWORK32(:,:,:) = MYM(ZWORK35(:,:,:)) * XVT(:,:,:)
+ ZWORK35(:,:,:) = GX_U_M(ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK32,XDYY,XDZZ,XDZY)
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
+ ZWORK36(:,:,:) = ZWORK35(:,:,:) + XRHODREF(:,:,:) * (XRT(:,:,:,2) + &
+ XRT(:,:,:,3) + XRT(:,:,:,4) + XRT(:,:,:,5) + XRT(:,:,:,6))
+ ZWORK33(:,:,:) = MXM(ZWORK36(:,:,:)) * XUT(:,:,:)
+ ZWORK34(:,:,:) = MYM(ZWORK36(:,:,:)) * XVT(:,:,:)
+ ZWORK36(:,:,:) = GX_U_M(ZWORK33,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK34,XDYY,XDZZ,XDZY)
+ ENDIF
+ !
+ ! Integration sur 3000 m
+ !
+ IKTOP(:,:)=0
+ DO JK=1,IKU-1
+ WHERE (((XZZ(:,:,JK) -XZS(:,:))<= 3000.0) .AND. ((XZZ(:,:,JK+1) -XZS(:,:))> 3000.0))
+ IKTOP(:,:)=JK
+ END WHERE
+ END DO
+ ZDELTAZ(:,:,:)=DZF(XZZ)
+ ZWORK21(:,:) = 0.
+ ZWORK22(:,:) = 0.
+ ZWORK25(:,:) = 0.
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ IAUX=IKTOP(JI,JJ)
+ DO JK=IKB,IAUX-1
+ ZWORK21(JI,JJ) = ZWORK21(JI,JJ) + ZWORK31(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
+ ZWORK22(JI,JJ) = ZWORK22(JI,JJ) + ZWORK32(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
+ ZWORK25(JI,JJ) = ZWORK25(JI,JJ) + ZWORK35(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
+ ENDDO
+ IF (IAUX >= IKB) THEN
+ ZDELTAZ(JI,JJ,IAUX)= 3000. - (XZZ(JI,JJ,IAUX) -XZS(JI,JJ))
+ ZWORK21(JI,JJ) = ZWORK21(JI,JJ) + ZWORK31(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
+ ZWORK22(JI,JJ) = ZWORK22(JI,JJ) + ZWORK32(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
+ ZWORK25(JI,JJ) = ZWORK25(JI,JJ) + ZWORK35(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
+ ENDIF
+ ENDDO
+ ENDDO
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
+ ZWORK23(:,:) = 0.
+ ZWORK24(:,:) = 0.
+ ZWORK26(:,:) = 0.
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ IAUX=IKTOP(JI,JJ)
+ DO JK=IKB,IAUX-1
+ ZWORK23(JI,JJ) = ZWORK23(JI,JJ) + ZWORK33(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
+ ZWORK24(JI,JJ) = ZWORK24(JI,JJ) + ZWORK34(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
+ ZWORK26(JI,JJ) = ZWORK26(JI,JJ) + ZWORK36(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
+ ENDDO
+ IF (IAUX >= IKB) THEN
+ ZDELTAZ(JI,JJ,IAUX)= 3000. - (XZZ(JI,JJ,IAUX) -XZS(JI,JJ))
+ ZWORK23(JI,JJ) = ZWORK23(JI,JJ) + ZWORK33(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
+ ZWORK24(JI,JJ) = ZWORK24(JI,JJ) + ZWORK34(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
+ ZWORK26(JI,JJ) = ZWORK26(JI,JJ) + ZWORK36(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDIF
+ ! Ecriture
+ ! composantes U et V du flux surfacique d'humidite
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UM90', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM90', &
+ CUNITS = 'kg s-1 m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VM90', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM90', &
+ CUNITS = 'kg s-1 m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
+ ! composantes U et V du flux d'humidite integre sur 3000 metres
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UM91', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM91', &
+ CUNITS = 'kg s-1 m-1', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VM91', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM91', &
+ CUNITS = 'kg s-1 m-1', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
+ !
+ ! Convergence d'humidite
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HMCONV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HMCONV', &
+ CUNITS = 'kg s-1 m-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Horizontal CONVergence of moisture flux', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK35)
+ !
+ ! Convergence d'humidite integre sur 3000 metres
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HMCONV3000', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HMCONV3000', &
+ CUNITS = 'kg s-1 m-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Horizontal CONVergence of moisture flux', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK25)
+ !
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
+ ! composantes U et V du flux surfacique d'hydrometeores
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UM92', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM92', &
+ CUNITS = 'kg s-1 m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VM92', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM92', &
+ CUNITS = 'kg s-1 m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
+ ! composantes U et V du flux d'hydrometeores integre sur 3000 metres
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UM93', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM93', &
+ CUNITS = 'kg s-1 m-1', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK23)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VM93', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM93', &
+ CUNITS = 'kg s-1 m-1', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK24)
+ ! Convergence d'hydrometeores
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HMCONV_TT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HMCONV_TT', &
+ CUNITS = 'kg s-1 m-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Horizontal CONVergence of hydrometeor flux', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK36)
+ ! Convergence d'hydrometeores integre sur 3000 metres
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HMCONV3000_TT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HMCONV3000_TT', &
+ CUNITS = 'kg s-1 m-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Horizontal CONVergence of hydrometeor flux', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK26)
+ ENDIF
+ENDIF
+!
+!* Moist variables
+!
+IF (LVAR_MRW .OR. LLIMA_DIAG) THEN
+ IF (NRR >=1) THEN
+ ! Moist variables are written individually in file
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for moist variables', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ IF (LUSERV) THEN
+ TZFIELD%CMNHNAME = 'MRV'
+ TZFIELD%CLONGNAME = 'MRV'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MRV'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RVT)*1.E3)
+ END IF
+ IF (LUSERC) THEN
+ TZFIELD%CMNHNAME = 'MRC'
+ TZFIELD%CLONGNAME = 'MRC'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MRC'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*1.E3)
+!
+ TZFIELD%CMNHNAME = 'VRC'
+ TZFIELD%CLONGNAME = 'VRC'
+ TZFIELD%CUNITS = 'ppv' !vol/vol
+ TZFIELD%CCOMMENT = 'X_Y_Z_VRC (vol/vol)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*XRHODREF(:,:,:)/1.E3)
+ END IF
+ IF (LUSERR) THEN
+ TZFIELD%CMNHNAME = 'MRR'
+ TZFIELD%CLONGNAME = 'MRR'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MRR'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*1.E3)
+!
+ TZFIELD%CMNHNAME = 'VRR'
+ TZFIELD%CLONGNAME = 'VRR'
+ TZFIELD%CUNITS = 'ppv' !vol/vol
+ TZFIELD%CCOMMENT = 'X_Y_Z_VRR (vol/vol)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*XRHODREF(:,:,:)/1.E3)
+ END IF
+ IF (LUSERI) THEN
+ TZFIELD%CMNHNAME = 'MRI'
+ TZFIELD%CLONGNAME = 'MRI'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MRI'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RIT)*1.E3)
+!
+ IF (LUSECI) THEN
+ CALL IO_Field_write(TPFILE,'CIT',XCIT(:,:,:))
+ END IF
+ END IF
+ IF (LUSERS) THEN
+ TZFIELD%CMNHNAME = 'MRS'
+ TZFIELD%CLONGNAME = 'MRS'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MRS'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RST)*1.E3)
+ END IF
+ IF (LUSERG) THEN
+ TZFIELD%CMNHNAME = 'MRG'
+ TZFIELD%CLONGNAME = 'MRG'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MRG'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RGT)*1.E3)
+ END IF
+ IF (LUSERH) THEN
+ TZFIELD%CMNHNAME = 'MRH'
+ TZFIELD%CLONGNAME = 'MRH'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MRH'
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RHT)*1.E3)
+ END IF
+ END IF
+END IF
+!
+!* Scalar Variables
+!
+! User scalar variables
+! individually in the file
+IF (LVAR_MRSV) THEN
+ DO JSV = 1,NSV_USER
+ TZFIELD = TSVLIST(JSV)
+ WRITE( TZFIELD%CMNHNAME, '( A4, I3.3 )' ) 'MRSV', JSV
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'g kg-1'
+ WRITE( TZFIELD%CCOMMENT, '( A, I3.3 )' ) 'Mixing Ratio for user Scalar Variable', JSV
+ CALL IO_Field_write( TPFILE, TZFIELD, XSVT(:,:,:,JSV) * 1.E3 )
+ END DO
+END IF
+! microphysical C2R2 scheme scalar variables
+IF(LVAR_MRW) THEN
+ DO JSV = NSV_C2R2BEG,NSV_C2R2END
+ TZFIELD = TSVLIST(JSV)
+ IF (JSV < NSV_C2R2END) THEN
+ TZFIELD%CUNITS = 'cm-3'
+ ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-6
+ ELSE
+ TZFIELD%CUNITS = 'l-1'
+ ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-3
+ END IF
+ WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','MRSV',JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END DO
+ ! microphysical C3R5 scheme additional scalar variables
+ DO JSV = NSV_C1R3BEG,NSV_C1R3END
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'l-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E-3)
+ END DO
+END IF
+!
+! microphysical LIMA scheme scalar variables
+!
+IF (LLIMA_DIAG) THEN
+ IF (NSV_LIMA_END>=NSV_LIMA_BEG) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic LIMA diag', & !Temporary name to ease identification
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ END IF
+ !
+ DO JSV = NSV_LIMA_BEG,NSV_LIMA_END
+ !
+ TZFIELD%CUNITS = 'cm-3'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
+ !
+! Nc
+ IF (JSV .EQ. NSV_LIMA_NC) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(1))
+ END IF
+! Nr
+ IF (JSV .EQ. NSV_LIMA_NR) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(2))
+ END IF
+! N CCN free
+ IF (JSV .GE. NSV_LIMA_CCN_FREE .AND. JSV .LT. NSV_LIMA_CCN_ACTI) THEN
+ WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1)
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(3))//INDICE
+ END IF
+! N CCN acti
+ IF (JSV .GE. NSV_LIMA_CCN_ACTI .AND. JSV .LT. NSV_LIMA_CCN_ACTI + NMOD_CCN) THEN
+ WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_ACTI + 1)
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(4))//INDICE
+ END IF
+! Scavenging
+ IF (JSV .EQ. NSV_LIMA_SCAVMASS) THEN
+ TZFIELD%CMNHNAME = TRIM(CAERO_MASS(1))
+ TZFIELD%CUNITS = 'kg cm-3'
+ END IF
+! Ni
+ IF (JSV .EQ. NSV_LIMA_NI) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(1))
+ END IF
+! Ns
+ IF (JSV .EQ. NSV_LIMA_NS) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(2))
+ END IF
+! Ng
+ IF (JSV .EQ. NSV_LIMA_NG) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(3))
+ END IF
+! Nh
+ IF (JSV .EQ. NSV_LIMA_NH) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(4))
+ END IF
+! N IFN free
+ IF (JSV .GE. NSV_LIMA_IFN_FREE .AND. JSV .LT. NSV_LIMA_IFN_NUCL) THEN
+ WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1)
+ TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(5))//INDICE
+ END IF
+! N IFN nucl
+ IF (JSV .GE. NSV_LIMA_IFN_NUCL .AND. JSV .LT. NSV_LIMA_IFN_NUCL + NMOD_IFN) THEN
+ WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1)
+ TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(6))//INDICE
+ END IF
+! N IMM nucl
+ IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
+ WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1))
+ TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(7))//INDICE
+ END IF
+! Hom. freez. of CCN
+ IF (JSV .EQ. NSV_LIMA_HOM_HAZE) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(8))
+ END IF
+ !
+! Supersaturation
+ IF (JSV .EQ. NSV_LIMA_SPRO) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(5))
+ END IF
+ !
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-6*XRHODREF(:,:,:)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END DO
+!
+ IF (LUSERC) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'LWC', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LWC', &
+ CUNITS = 'g m-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_LWC', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ ZWORK31(:,:,:)=XRT(:,:,:,2)*1.E3*XRHODREF(:,:,:)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END IF
+!
+ IF (LUSERI) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'IWC', &
+ CSTDNAME = '', &
+ CLONGNAME = 'IWC', &
+ CUNITS = 'g m-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MRI', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ ZWORK31(:,:,:)=XRT(:,:,:,4)*1.E3*XRHODREF(:,:,:)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END IF
+!
+END IF
+IF (LELECDIAG .AND. CELEC .NE. "NONE") THEN
+ DO JSV = NSV_ELECBEG,NSV_ELECEND
+ TZFIELD = TSVLIST(JSV)
+ IF ( JSV > NSV_ELECBEG .AND. JSV < NSV_ELECEND ) THEN
+ TZFIELD%CUNITS = 'C m-3'
+ WRITE( TZFIELD%CCOMMENT, '( A6, A3, I3.3 )' ) 'X_Y_Z_', 'SVT', JSV
+ ELSE
+ TZFIELD%CUNITS = 'm-3'
+ WRITE( TZFIELD%CCOMMENT, '( A6, A3, I3.3, A8 )' ) 'X_Y_Z_', 'SVT', JSV, ' (nb ions/m3)'
+ END IF
+ ZWORK31(:,:,:)=XSVT(:,:,:,JSV) * XRHODREF(:,:,:) ! C/kg --> C/m3
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END DO
+END IF
+!
+! Lagrangian variables
+IF (LTRAJ) THEN
+ DO JSV = NSV_LGBEG, NSV_LGEND
+ TZFIELD = TSVLIST(JSV)
+ WRITE(TZFIELD%CCOMMENT,'(A6,A20,I3.3,A4)')'X_Y_Z_','Lagrangian variable ',JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ END DO
+
+ ! X coordinate
+ DO JK=1,IKU
+ DO JJ=1,IJU
+ ZWORK31(:,JJ,JK) = 1E-3*XXHATM(:)
+ END DO
+ END DO
+
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'X', &
+ CSTDNAME = '', &
+ CLONGNAME = 'X', &
+ CUNITS = 'km', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_X coordinate', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+
+ ! Y coordinate
+ DO JK=1,IKU
+ DO JI=1,IIU
+ ZWORK31(JI,:,JK) = 1E-3 * XYHATM(:)
+ END DO
+ END DO
+
+ TZFIELD%CMNHNAME = 'Y'
+ TZFIELD%CLONGNAME = 'Y'
+ TZFIELD%CCOMMENT = 'X_Y_Z_Y coordinate'
+
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+END IF
+!
+! Passive polluant scalar variables
+IF (LPASPOL) THEN
+ ALLOCATE(ZRHOT( SIZE(XTHT,1), SIZE(XTHT,2),SIZE(XTHT,3)))
+ ALLOCATE(ZTMP( SIZE(XTHT,1), SIZE(XTHT,2),SIZE(XTHT,3)))
+!
+!* Density
+!
+ ZRHOT(:,:,:)=XPABST(:,:,:)/(XRD*XTHT(:,:,:)*((XPABST(:,:,:)/XP00)**(XRD/XCPD)))
+!
+!* Conversion g/m3.
+!
+ ZRHOT(:,:,:)=ZRHOT(:,:,:)*1000.0
+ !
+ DO JSV = NSV_PPBEG, NSV_PPEND
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'g m-3'
+
+ ZTMP(:,:,:)=ABS( XSVT(:,:,:,JSV)*ZRHOT(:,:,:) )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTMP)
+ END DO
+
+ DEALLOCATE(ZTMP)
+ DEALLOCATE(ZRHOT)
+END IF
+! Conditional sampling variables
+IF (LCONDSAMP) THEN
+ DO JSV = NSV_CSBEG, NSV_CSEND
+ TZFIELD = TSVLIST(JSV)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ END DO
+END IF
+! chemical scalar variables in gas phase ppb
+IF (LCHEMDIAG) THEN
+ DO JSV = NSV_CHGSBEG,NSV_CHGSEND
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'ppb'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHIM',JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ END DO
+END IF
+IF (LCHAQDIAG) THEN !aqueous concentration in M
+ ZWORK31(:,:,:)=0.
+ DO JSV = NSV_CHACBEG, NSV_CHACBEG-1+NEQAQ/2 !cloud water
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'mol l-1' !Original value: 'M' (molar) but not known by udunits => replaced by equivalent mol l-1
+ WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHAQ',JSV
+ WHERE(((XRT(:,:,:,2)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
+ ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,2))
+ ENDWHERE
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END DO
+ !
+ ZWORK31(:,:,:)=0.
+ DO JSV = NSV_CHACBEG+NEQAQ/2, NSV_CHACEND !rain water
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'mol l-1' !Original value: 'M' (molar) but not known by udunits => replaced by equivalent mol l-1
+ WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHAQ',JSV
+ WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
+ ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3))
+ ENDWHERE
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END DO
+
+
+
+
+! ZWORK31(:,:,:)=0.
+! DO JSV = NSV_CHICBEG,NSV_CHICEND ! ice phase
+! TZFIELD%CMNHNAME = TRIM(CICNAMES(JSV-NSV_CHICBEG+1))
+! TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+! WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3,A4)')'X_Y_Z_','CHIC',JSV,' (M)'
+! WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
+! ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3))
+! ENDWHERE
+! CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+! END DO
+END IF
+! Aerosol
+IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN
+ DO JSV = NSV_AERBEG, NSV_AEREND
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'ppb'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','AERO',JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ END DO
+ !
+ 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 (CRGUNIT=="MASS") THEN
+ XRG3D(:,:,:,1) = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2)
+ XRG3D(:,:,:,2) = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2)
+ ELSE
+ XRG3D(:,:,:,1) = XINIRADIUSI
+ XRG3D(:,:,:,2) = XINIRADIUSJ
+ END IF
+ XSIG3D(:,:,:,1) = XINISIGI
+ XSIG3D(:,:,:,2) = XINISIGJ
+ XN3D(:,:,:,1) = XN0IMIN
+ XN3D(:,:,:,2) = XN0JMIN
+
+ ZPTOTA(:,:,:,:,:) = 0.
+
+ CALL PPP2AERO(XSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND),&
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ PSIG3D=XSIG3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PRG3D=XRG3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PN3D=XN3D(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PCTOTA=ZPTOTA(IIB:IIE,IJB:IJE,IKB:IKE,:,:))
+
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for aerosol modes', &
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ DO JJ=1,JPMODE
+ WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'RGA',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'um'
+ WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'RG (nb) AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,XRG3D(:,:,:,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'RGAM',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'um'
+ WRITE(TZFIELD%CCOMMENT,'(A20,I1)')'RG (m) AEROSOL MODE ',JJ
+ ZWORK31(:,:,:)=XRG3D(:,:,:,JJ) / (EXP(-3.*(LOG(XSIG3D(:,:,:,JJ)))**2))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'N0A',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'cm-3'
+ WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,XN3D(:,:,:,JJ)*1.E-6)
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'SIGA',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = '1'
+ WRITE(TZFIELD%CCOMMENT,'(A19,I1)')'SIGMA AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,XSIG3D(:,:,:,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MSO4',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS SO4 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SO4,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MNO3',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS NO3 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NO3,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MNH3',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS NH3 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NH3,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MH2O',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS H2O AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_H2O,JJ))
+ !
+ IF (NSOA .EQ. 10) THEN
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA1',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA1 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA1,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA2',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA2 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA2,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA3',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA3 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA3,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA4',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA4 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA4,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA5',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA5 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA5,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA6',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA6 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA6,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA7',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA7 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA7,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA8',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA8 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA8,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA9',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA9 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA9,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'MSOA10',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A24,I1)')'MASS SOA10 AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA10,JJ))
+ END IF
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'MOC',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'MASS OC AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_OC,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'MBC',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'MASS BC AEROSOL MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_BC,JJ))
+ ENDDO
+END IF
+! Dust variables
+IF (LDUST) THEN
+ IF(.NOT.ALLOCATED(ZSIG_DST)) &
+ ALLOCATE(ZSIG_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST))
+ IF(.NOT.ALLOCATED(ZRG_DST)) &
+ ALLOCATE(ZRG_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST))
+ IF(.NOT.ALLOCATED(ZN0_DST)) &
+ ALLOCATE(ZN0_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST))
+ !
+ DO JSV = NSV_DSTBEG, NSV_DSTEND
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'ppb'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','DUST',JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ END DO
+ !
+ CALL PPP2DUST(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND),XRHODREF,&
+ PSIG3D=ZSIG_DST, PRG3D=ZRG_DST, PN3D=ZN0_DST)
+
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for dust modes', &
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ TZFIELD2D = TFIELDMETADATA( &
+ CMNHNAME = 'generic for dust modes', &
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+
+ DO JJ=1,NMODE_DST
+ WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'DSTRGA',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'um'
+ WRITE(TZFIELD%CCOMMENT,'(A18,I1)')'RG (nb) DUST MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZRG_DST(:,:,:,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTRGAM',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'um'
+ WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'RG (m) DUST MODE ',JJ
+ ZWORK31(:,:,:)=ZRG_DST(:,:,:,JJ) / (EXP(-3.*(LOG(ZSIG_DST(:,:,:,JJ)))**2))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'DSTN0A',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm-3'
+ WRITE(TZFIELD%CCOMMENT,'(A13,I1)')'N0 DUST MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZN0_DST(:,:,:,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTSIGA',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = '1'
+ WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'SIGMA DUST MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSIG_DST(:,:,:,JJ))
+ !DUST MASS CONCENTRATION
+ WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'DSTMSS',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A14,I1)')'MASSCONC MODE ',JJ
+ ZWORK31(:,:,:)= ZN0_DST(:,:,:,JJ)*4./3.*3.14*2500.*1e9 & !kg-->ug
+ * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
+ * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ !DUST BURDEN (g/m2)
+ ZWORK21(:,:)=0.0
+ DO JK=IKB,IKE
+ ZWORK31(:,:,JK) = ZWORK31(:,:,JK) *(XZZ(:,:,JK+1)-XZZ(:,:,JK)) &
+ *1.d-6 ! Convert to ug/m2-->g/m2 in each layer
+ END DO
+ !
+ DO JK=IKB,IKE
+ DO JT=IJB,IJE
+ DO JI=IIB,IIE
+ ZWORK21(JI,JT)=ZWORK21(JI,JT)+ZWORK31(JI,JT,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+ WRITE(TZFIELD2D%CMNHNAME,'(A7,I1)')'DSTBRDN',JJ
+ TZFIELD2D%CLONGNAME = TRIM(TZFIELD2D%CMNHNAME)
+ TZFIELD2D%CUNITS = 'g m-2'
+ WRITE(TZFIELD2D%CCOMMENT,'(A6,I1)')'BURDEN',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZWORK21)
+ ENDDO
+END IF
+IF (LDUST.AND.LDEPOS_DST(IMI)) THEN
+ DO JSV = NSV_DSTBEG, NSV_DSTEND
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'ppb'
+ WRITE(TZFIELD%CCOMMENT,'(A,I3.3)') 'X_Y_Z_DUSTDEP', JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ END DO
+ !
+ ZSDSTDEP => XSVT(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for dustdep modes', &
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ DO JJ=1,NMODE_DST
+ ! FOR CLOUDS
+ WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPN0A',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ
+ TZFIELD%CUNITS = 'm-3'
+ ! CLOUD: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS
+ ZWORK31(:,:,:) = ZSDSTDEP(:,:,:,JJ) &!==>molec_{aer}/molec_{air}
+ *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air}
+ *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air}
+ /XDENSITY_DUST &!==>m3_{aer}/m3_{air}
+ *XM3TOUM3 &!==>um3_{aer}/m3_{air}
+ /(XPI*4./3.) !==>um3_{aer}/m3_{air}
+ !==>volume 3rd moment
+ !CLOUD: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS
+ ZWORK31(:,:,:)= ZWORK31(:,:,:)/ &
+ ((ZRG_DST(:,:,:,JJ)**3)* &
+ EXP(4.5 * LOG(ZSIG_DST(:,:,:,JJ))**2))
+ !CLOUD: RETURN TO CONCENTRATION #/m3
+ ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ &
+ (XAVOGADRO*XRHODREF(:,:,:))
+ !CLOUD: Get number concentration (#/molec_{air}==>#/m3)
+ ZWORK31(:,:,:)= &
+ ZWORK31(:,:,:) & !#/molec_{air}
+ * XAVOGADRO & !==>#/mole
+ / XMD & !==>#/kg_{air}
+ * XRHODREF(:,:,:) !==>#/m3
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ ! CLOUD: DUST MASS CONCENTRATION
+ WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPMSS',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ
+ TZFIELD%CUNITS = 'ug m-3'
+ ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
+ * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
+ * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ ! FOR RAIN DROPS
+ WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPN0A',JJ+NMODE_DST
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ+NMODE_DST
+ TZFIELD%CUNITS = 'm-3'
+ ! RAIN: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS
+ ZWORK31(:,:,:)=ZSDSTDEP(:,:,:,JJ+NMODE_DST) &!==>molec_{aer}/molec_{air}
+ *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air}
+ *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air}
+ *(1.d0/XDENSITY_DUST) &!==>m3_{aer}/m3_{air}
+ *XM3TOUM3 &!==>um3_{aer}/m3_{air}
+ /(XPI*4./3.) !==>um3_{aer}/m3_{air}
+ !==>volume 3rd moment
+ !RAIN: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS
+ ZWORK31(:,:,:)= ZWORK31(:,:,:)/ &
+ ((ZRG_DST(:,:,:,JJ)**3)* &
+ EXP(4.5 * LOG(ZSIG_DST(:,:,:,JJ))**2))
+ !RAIN: RETURN TO CONCENTRATION #/m3
+ ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ &
+ (XAVOGADRO*XRHODREF(:,:,:))
+ !RAIN: Get number concentration (#/molec_{air}==>#/m3)
+ ZWORK31(:,:,:)= &
+ ZWORK31(:,:,:) & !#/molec_{air}
+ * XAVOGADRO & !==>#/mole
+ / XMD & !==>#/kg_{air}
+ * XRHODREF(:,:,:) !==>#/m3
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ ! RAIN: DUST MASS CONCENTRATION
+ WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPMSS',JJ+NMODE_DST
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ+NMODE_DST
+ TZFIELD%CUNITS = 'ug m-3'
+ ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
+ * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
+ * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END DO
+
+ ZSDSTDEP => NULL()
+!
+END IF
+! Sea Salt variables
+IF (LSALT) THEN
+ IF(.NOT.ALLOCATED(ZSIG_SLT)) &
+ ALLOCATE(ZSIG_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT))
+ IF(.NOT.ALLOCATED(ZRG_SLT)) &
+ ALLOCATE(ZRG_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT))
+ IF(.NOT.ALLOCATED(ZN0_SLT)) &
+ ALLOCATE(ZN0_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT))
+ !
+ DO JSV = NSV_SLTBEG, NSV_SLTEND
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'ppb'
+ WRITE(TZFIELD%CCOMMENT,'(A,I3.3)') 'X_Y_Z_SALT', JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ END DO
+ !
+ CALL PPP2SALT(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND),XRHODREF,&
+ PSIG3D=ZSIG_SLT, PRG3D=ZRG_SLT, PN3D=ZN0_SLT)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for salt modes', &
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ TZFIELD2D = TFIELDMETADATA( &
+ CMNHNAME = 'generic for salt modes', &
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ !
+ DO JJ=1,NMODE_SLT
+ WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'SLTRGA',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'um'
+ WRITE(TZFIELD%CCOMMENT,'(A18,I1)')'RG (nb) SALT MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZRG_SLT(:,:,:,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTRGAM',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'um'
+ WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'RG (m) SALT MODE ',JJ
+ ZWORK31(:,:,:)=ZRG_SLT(:,:,:,JJ) / (EXP(-3.*(LOG(ZSIG_SLT(:,:,:,JJ)))**2))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'SLTN0A',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm-3'
+ WRITE(TZFIELD%CCOMMENT,'(A13,I1)')'N0 SALT MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZN0_SLT(:,:,:,JJ))
+ !
+ WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTSIGA',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = '1'
+ WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'SIGMA SALT MODE ',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSIG_SLT(:,:,:,JJ))
+ !SALT MASS CONCENTRATION
+ WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'SLTMSS',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'ug m-3'
+ WRITE(TZFIELD%CCOMMENT,'(A14,I1)')'MASSCONC MODE ',JJ
+ ZWORK31(:,:,:)= ZN0_SLT(:,:,:,JJ)*4./3.*3.14*2500.*1e9 & !kg-->ug
+ * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
+ * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ !SALT BURDEN (g/m2)
+ ZWORK21(:,:)=0.0
+ DO JK=IKB,IKE
+ ZWORK31(:,:,JK) = ZWORK31(:,:,JK) *(XZZ(:,:,JK+1)-XZZ(:,:,JK)) &
+ *1.d-6 ! Convert to ug/m2-->g/m2 in each layer
+ END DO
+ !
+ DO JK=IKB,IKE
+ DO JT=IJB,IJE
+ DO JI=IIB,IIE
+ ZWORK21(JI,JT)=ZWORK21(JI,JT)+ZWORK31(JI,JT,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+ WRITE(TZFIELD2D%CMNHNAME,'(A7,I1)')'SLTBRDN',JJ
+ TZFIELD2D%CLONGNAME = TRIM(TZFIELD2D%CMNHNAME)
+ TZFIELD2D%CUNITS = 'g m-2'
+ WRITE(TZFIELD2D%CCOMMENT,'(A6,I1)')'BURDEN',JJ
+ CALL IO_Field_write(TPFILE,TZFIELD2D,ZWORK21)
+ ENDDO
+END IF
+IF (LSALT.AND.LDEPOS_SLT(IMI)) THEN
+ !
+ DO JSV = NSV_SLTDEPBEG, NSV_SLTDEPEND
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'ppb'
+ WRITE(TZFIELD%CCOMMENT,'(A,I3.3)') 'X_Y_Z_SALTDEP', JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ END DO
+ !
+ ZSSLTDEP => XSVT(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for saltdep modes', &
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ DO JJ=1,NMODE_SLT
+ ! FOR CLOUDS
+ WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPN0A',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ
+ TZFIELD%CUNITS = 'm-3'
+ ! CLOUD: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS
+ ZWORK31(:,:,:) = ZSSLTDEP(:,:,:,JJ) &!==>molec_{aer}/molec_{air}
+ *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air}
+ *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air}
+ /XDENSITY_DUST &!==>m3_{aer}/m3_{air}
+ *XM3TOUM3 &!==>um3_{aer}/m3_{air}
+ /(XPI*4./3.) !==>um3_{aer}/m3_{air}
+ !==>volume 3rd moment
+ !CLOUD: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS
+ ZWORK31(:,:,:) = ZWORK31(:,:,:)/ &
+ ((ZRG_SLT(:,:,:,JJ)**3)* &
+ EXP(4.5 * LOG(ZSIG_SLT(:,:,:,JJ))**2))
+ !CLOUD: RETURN TO CONCENTRATION #/m3
+ ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ &
+ (XAVOGADRO*XRHODREF(:,:,:))
+ !CLOUD: Get number concentration (#/molec_{air}==>#/m3)
+ ZWORK31(:,:,:)= &
+ ZWORK31(:,:,:) & !#/molec_{air}
+ * XAVOGADRO & !==>#/mole
+ / XMD & !==>#/kg_{air}
+ * XRHODREF(:,:,:) !==>#/m3
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ ! CLOUD: DUST MASS CONCENTRATION
+ WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPMSS',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ
+ TZFIELD%CUNITS = 'ug m-3'
+ ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
+ * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
+ * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ ! FOR RAIN DROPS
+ WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPN0A',JJ+NMODE_SLT
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ+NMODE_SLT
+ TZFIELD%CUNITS = 'm-3'
+ ! RAIN: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS
+ ZWORK31(:,:,:) = ZSSLTDEP(:,:,:,JJ+NMODE_SLT) &!==>molec_{aer}/molec_{air}
+ *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air}
+ *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air}
+ /XDENSITY_DUST &!==>m3_{aer}/m3_{air}
+ *XM3TOUM3 &!==>um3_{aer}/m3_{air}
+ /(XPI*4./3.) !==>um3_{aer}/m3_{air}
+ !==>volume 3rd moment
+ !RAIN: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS
+ ZWORK31(:,:,:)= ZWORK31(:,:,:)/ &
+ ((ZRG_SLT(:,:,:,JJ)**3)* &
+ EXP(4.5 * LOG(ZSIG_SLT(:,:,:,JJ))**2))
+ !RAIN: RETURN TO CONCENTRATION #/m3
+ ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ &
+ (XAVOGADRO*XRHODREF(:,:,:))
+ !RAIN: Get number concentration (#/molec_{air}==>#/m3)
+ ZWORK31(:,:,:)= &
+ ZWORK31(:,:,:) & !#/molec_{air}
+ * XAVOGADRO & !==>#/mole
+ / XMD & !==>#/kg_{air}
+ * XRHODREF(:,:,:) !==>#/m3
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ ! RAIN: DUST MASS CONCENTRATION
+ WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPMSS',JJ+NMODE_SLT
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ+NMODE_SLT
+ TZFIELD%CUNITS = 'ug m-3'
+ ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
+ * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
+ * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END DO
+
+ ZSSLTDEP => NULL()
+!
+END IF
+!
+! Blowing snow variables
+!
+IF(LBLOWSNOW) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SNWSUBL3D', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SNWSUBL3D', &
+ CUNITS = 'kg m-3 s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_INstantaneous 3D Drifting snow sublimation flux', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XSNWSUBL3D(:,:,:))
+ !
+ ZWORK21(:,:) = 0.
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+XSNWSUBL3D(:,:,JK) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW*3600*24
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'COL_SNWSUBL', &
+ CSTDNAME = '', &
+ CLONGNAME = 'COL_SNWSUBL', &
+ CUNITS = 'mm day-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Column Sublimation Rate (mmSWE/day)', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21(:,:))
+ !
+ IF(.NOT.ALLOCATED(ZBET_SNW)) &
+ ALLOCATE(ZBET_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3)))
+ IF(.NOT.ALLOCATED(ZRG_SNW)) &
+ ALLOCATE(ZRG_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3)))
+ IF(.NOT.ALLOCATED(ZMA_SNW)) &
+ ALLOCATE(ZMA_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3),NBLOWSNOW3D))
+ !
+ CALL PPP2SNOW(XSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND),XRHODREF,&
+ PBET3D=ZBET_SNW, PRG3D=ZRG_SNW, PM3D=ZMA_SNW)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SNWRGA', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SNWRGA', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'RG (mean) SNOW', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZRG_SNW(:,:,:))
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SNWBETA', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SNWBETA', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'BETA SNOW', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZBET_SNW(:,:,:))
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SNWNOA', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SNWNOA', &
+ CUNITS = 'm-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'NUM CONC SNOW (#/m3)', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZMA_SNW(:,:,:,1))
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SNWMASS', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SNWMASS', &
+ CUNITS = 'kg m-3', &
+ CDIR = 'XY', &
+ CCOMMENT = 'MASS CONC SNOW', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZMA_SNW(:,:,:,2))
+ !
+ ZWORK21(:,:) = 0.
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+ZMA_SNW(:,:,JK,2) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THDS', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THDS', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_THickness of Drifting Snow (mm SWE)', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21(:,:))
+END IF
+! linox scalar variables
+IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) THEN
+ DO JSV = NSV_LNOXBEG, NSV_LNOXEND
+ TZFIELD = TSVLIST(JSV)
+ TZFIELD%CUNITS = 'ppb'
+ WRITE(TZFIELD%CCOMMENT,'(A,I3.3)') 'X_Y_Z_LNOX', JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ END DO
+END IF
+!
+!* Large Scale variables
+!
+IF (LVAR_LS) THEN
+ CALL IO_Field_write(TPFILE,'LSUM', XLSUM)
+ CALL IO_Field_write(TPFILE,'LSVM', XLSVM)
+ !
+ IF (LWIND_ZM) THEN
+ TZFIELD2(1) = TFIELDMETADATA( &
+ CMNHNAME = 'LSUM_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LSUM_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Large Scale Zonal component of horizontal wind', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ TZFIELD2(2) = TFIELDMETADATA( &
+ CMNHNAME = 'LSVM_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LSVM_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Large Scale Meridian component of horizontal wind', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ CALL UV_TO_ZONAL_AND_MERID(XLSUM,XLSVM,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
+ ENDIF
+ !
+ CALL IO_Field_write(TPFILE,'LSWM', XLSWM)
+ CALL IO_Field_write(TPFILE,'LSTHM',XLSTHM)
+!
+ IF (LUSERV) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('LSRVM',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CUNITS = 'g kg-1'
+ CALL IO_Field_write(TPFILE,TZFIELD,XLSRVM(:,:,:)*1.E3)
+ END IF
+END IF
+!
+!* Forcing variables
+!
+IF (LVAR_FRC .AND. LFORCING) THEN
+!
+ DO JT=1,NFRC
+ WRITE (YFRC,'(I3.3)') JT
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'UFRC'//YFRC, &
+ CUNITS = 'm s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Zonal component of horizontal forcing wind', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XUFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'VFRC'//YFRC, &
+ CUNITS = 'm s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Meridian component of horizontal forcing wind', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XVFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'WFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'WFRC'//YFRC, &
+ CUNITS = 'm s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Vertical forcing wind', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XWFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'THFRC'//YFRC, &
+ CUNITS = 'K', &
+ CDIR = '--', &
+ CCOMMENT = 'Forcing potential temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'RVFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'RVFRC'//YFRC, &
+ CUNITS = 'kg kg-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Forcing vapor mixing ratio', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XRVFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TENDTHFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TENDTHFRC'//YFRC, &
+ CUNITS = 'K s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale potential temperature tendency for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XTENDTHFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TENDRVFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TENDRVFRC'//YFRC, &
+ CUNITS = 'kg kg-1 s-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale vapor mixing ratio tendency for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XTENDRVFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'GXTHFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'GXTHFRC'//YFRC, &
+ CUNITS = 'K m-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale potential temperature gradient for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XGXTHFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'GYTHFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'GYTHFRC'//YFRC, &
+ CUNITS = 'K m-1', &
+ CDIR = '--', &
+ CCOMMENT = 'Large-scale potential temperature gradient for forcing', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XGYTHFRC(:,JT))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'PGROUNDFRC'//YFRC, &
+ CSTDNAME = '', &
+ CLONGNAME = 'PGROUNDFRC'//YFRC, &
+ CUNITS = 'Pa', &
+ CDIR = '--', &
+ CCOMMENT = 'Forcing ground pressure', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 0, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XPGROUNDFRC(JT))
+!
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.7 Some diagnostic variables
+!
+IF (LTPZH .OR. LCOREF) THEN
+!
+!* Temperature in celsius
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TEMP', &
+ CSTDNAME = 'air_temperature', &
+ CLONGNAME = 'TEMP', &
+ CUNITS = 'celsius', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_TEMPerature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ ZWORK31(:,:,:)=ZTEMP(:,:,:) - XTT
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+!* Pressure in hPa
+ CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'PRES'
+ TZFIELD%CUNITS = 'hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPABST(:,:,:)*1E-2)
+!
+!* Geopotential in meters
+ CALL IO_Field_write(TPFILE,'ALT',XZZ)
+!
+!* Relative humidity in percent
+ IF (LUSERV) THEN
+ ZWORK31(:,:,:)=SM_FOES(ZTEMP(:,:,:))
+ ZWORK33(:,:,:)=ZWORK31(:,:,:)
+ ZWORK31(:,:,:)=(XMV/XMD)*ZWORK31(:,:,:)/(XPABST(:,:,:)-ZWORK31(:,:,:))
+ ZWORK32(:,:,:)=100.*XRT(:,:,:,1)/ZWORK31(:,:,:)
+ IF (CCLOUD(1:3) =='ICE' .OR. CCLOUD =='C3R5' .OR. CCLOUD == 'LIMA') THEN
+ WHERE ( ZTEMP(:,:,:)< XTT)
+ ZWORK31(:,:,:) = EXP( XALPI - XBETAI/ZTEMP(:,:,:) &
+ - XGAMI*ALOG(ZTEMP(:,:,:)) ) !saturation over ice
+ ZWORK33(:,:,:)=ZWORK31(:,:,:)
+ ZWORK31(:,:,:)=(XMV/XMD)*ZWORK31(:,:,:)/(XPABST(:,:,:)-ZWORK31(:,:,:))
+ ZWORK32(:,:,:)=100.*XRT(:,:,:,1)/ZWORK31(:,:,:)
+ END WHERE
+ END IF
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'REHU', &
+ CSTDNAME = 'relative_humidity', &
+ CLONGNAME = 'REHU', &
+ CUNITS = 'percent', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_RElative HUmidity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VPRES', &
+ CSTDNAME = 'water_vapor_partial_pressure_in_air', &
+ CLONGNAME = 'VPRES', &
+ CUNITS = 'hPa', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Vapor PRESsure', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ ZWORK33(:,:,:)=ZWORK33(:,:,:)*ZWORK32(:,:,:)*1E-4
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
+ !
+ IF (LCOREF) THEN
+ ZWORK33(:,:,:)=(77.6*( XPABST(:,:,:)*1E-2 &
+ +ZWORK33(:,:,:)*4810/ZTEMP(:,:,:)) &
+ -6*ZWORK33(:,:,:) )/ZTEMP(:,:,:)
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'COREF', &
+ CSTDNAME = '', &
+ CLONGNAME = 'COREF', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_REFraction COindex (N-units)', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
+ !
+ ZWORK33(:,:,:)=ZWORK33(:,:,:)+MZF(XZZ(:,:,:))*1E6/XRADIUS
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MCOREF', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MCOREF', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Modified REFraction COindex (M-units)', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
+ END IF
+ ELSE
+ PRINT*, 'NO WATER VAPOR IN ',TPFILE%CNAME,' RELATIVE HUMIDITY IS NOT COMPUTED'
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Virtual potential temperature
+!
+IF ( LMOIST_V .OR. LMSLP .OR. CBLTOP/='NONE' ) THEN
+ ALLOCATE(ZTHETAV(IIU,IJU,IKU))
+!
+ IF(NRR > 0) THEN
+! compute the ratio : 1 + total water mass / dry air mass
+ ZRV_OV_RD = XRV / XRD
+ ZTHETAV(:,:,:) = 1. + XRT(:,:,:,1)
+ DO JLOOP = 2,1+NRRL+NRRI
+ ZTHETAV(:,:,:) = ZTHETAV(:,:,:) + XRT(:,:,:,JLOOP)
+ END DO
+! compute the virtual potential temperature when water is present in any form
+ ZTHETAV(:,:,:) = XTHT(:,:,:) * (1.+XRT(:,:,:,1)*ZRV_OV_RD) / ZTHETAV(:,:,:)
+ ELSE
+! compute the virtual potential temperature when water is absent
+ ZTHETAV(:,:,:) = XTHT(:,:,:)
+ END IF
+!
+ IF (LMOIST_V .AND. NRR > 0) THEN
+! Virtual potential temperature
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THETAV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THETAV', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Virtual potential temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAV)
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Fog Visibility
+!
+IF (LVISI) THEN
+!
+ IF ((CCLOUD /= 'NONE') .AND. (CCLOUD /='REVE')) ALLOCATE(ZVISIKUN(IIU,IJU,IKU))
+ IF ((CCLOUD == 'C2R2') .OR. (CCLOUD =='KHKO')) THEN
+ ALLOCATE(ZVISIGUL(IIU,IJU,IKU))
+ ALLOCATE(ZVISIZHA(IIU,IJU,IKU))
+ END IF
+!
+ IF ((CCLOUD /= 'NONE') .AND. (CCLOUD /='REVE')) THEN
+ ZVISIKUN(:,:,:) = 10000.
+ WHERE ( XRT(:,:,:,2) >= 1E-08 )
+ ZVISIKUN(:,:,:) =0.027/(XRT(:,:,:,2)*XRHODREF(:,:,:))**0.88*1000.
+ END WHERE
+! Visibity Kunkel
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VISIKUN', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VISIKUN', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Visibility Kunkel', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZVISIKUN)
+!
+ IF ((CCLOUD == 'C2R2') .OR. (CCLOUD =='KHKO')) THEN
+ ZVISIGUL(:,:,:) = 10000.
+ ZVISIZHA(:,:,:) = 10000.
+ WHERE ( (XRT(:,:,:,2) >= 1E-08 ) .AND. (XSVT(:,:,:,NSV_C2R2BEG+1) >=0.001 ) )
+ ZVISIGUL(:,:,:) =1.002/(XRT(:,:,:,2)*XRHODREF(:,:,:)*XSVT(:,:,:,NSV_C2R2BEG+1))**0.6473*1000.
+ ZVISIZHA(:,:,:) =0.187/(XRT(:,:,:,2)*XRHODREF(:,:,:)*XSVT(:,:,:,NSV_C2R2BEG+1))**0.34*1000.
+ END WHERE
+! Visibity Gultepe
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VISIGUL', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VISIGUL', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Visibility Gultepe', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZVISIGUL)
+! Visibity Zhang
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VISIZHA', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VISIZHA', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Visibility Zhang', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZVISIZHA)
+!
+ DEALLOCATE(ZVISIGUL,ZVISIZHA)
+ END IF
+ DEALLOCATE(ZVISIKUN)
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Thetae computation according eq.(21), (43) of Bolton 1980 (MWR108,p 1046-1053)
+!
+IF (( LMOIST_E .OR. LBV_FR ) .AND. (NRR>0)) THEN
+ ALLOCATE(ZTHETAE(IIU,IJU,IKU))
+ !
+ ZWORK31(:,:,:) = MAX(XRT(:,:,:,1),1.E-10)
+ ZTHETAE(:,:,:)= ( 2840./ &
+ (3.5*ALOG(XTHT(:,:,:)*( XPABST(:,:,:)/XP00 )**(XRD/XCPD) ) &
+ - ALOG( XPABST(:,:,:)*0.01*ZWORK31(:,:,:) / ( 0.622+ZWORK31(:,:,:) ) ) &
+ -4.805 ) ) + 55.
+ ZTHETAE(:,:,:)= XTHT(:,:,:) * EXP( (3376. / ZTHETAE(:,:,:) - 2.54) &
+ *ZWORK31(:,:,:) *(1. +0.81 *ZWORK31(:,:,:)) )
+!
+ IF (LMOIST_E) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THETAE', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THETAE', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Equivalent potential temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAE)
+ END IF
+END IF
+!-------------------------------------------------------------------------------
+!
+!* Thetaes computation
+!
+IF (LMOIST_ES .AND. (NRR>0)) THEN
+ ALLOCATE(ZTHETAES(IIU,IJU,IKU))
+ ZWORK31(:,:,:) = MAX(QSAT(ZTEMP(:,:,:),XPABST(:,:,:)),1.E-10)
+ ZTHETAES(:,:,:)= ( 2840./ &
+ (3.5*ALOG(XTHT(:,:,:)*( XPABST(:,:,:)/XP00 )**(XRD/XCPD) ) &
+ - ALOG( XPABST(:,:,:)*0.01*ZWORK31(:,:,:) / ( 0.622+ZWORK31(:,:,:) ) ) &
+ -4.805 ) ) + 55.
+ ZTHETAES(:,:,:)= XTHT(:,:,:) * EXP( (3376. / ZTHETAE(:,:,:) - 2.54) &
+ *ZWORK31(:,:,:) *(1. +0.81 *ZWORK31(:,:,:)) )
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THETAES', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THETAES', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Equivalent Saturated potential temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAES)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!* The Liquid-Water potential temperature (Betts, 1973)
+! (also needed for THETAS1 or THETAS2)
+!
+IF ( LMOIST_L .OR. LMOIST_S1 .OR. LMOIST_S2 ) THEN
+!
+ ALLOCATE(ZTHETAL(IIU,IJU,IKU))
+!
+ IF(NRR > 1) THEN
+! The latent heat of Vaporization:
+ ZWORK31(:,:,:) = XLVTT + (XCPV-XCL)*(ZTEMP(:,:,:)-XTT)
+! The latent heat of Sublimation:
+ ZWORK32(:,:,:) = XLSTT + (XCPV-XCI)*(ZTEMP(:,:,:)-XTT)
+! The numerator in the exponential
+! and the total water mixing ratio:
+ ZTHETAL(:,:,:) = 0.0
+ ZWORK33(:,:,:) = XRT(:,:,:,1)
+ DO JLOOP = 2,1+NRRL
+ ZTHETAL(:,:,:) = ZTHETAL(:,:,:) + XRT(:,:,:,JLOOP)*ZWORK31(:,:,:)
+ ZWORK33(:,:,:) = ZWORK33(:,:,:) + XRT(:,:,:,JLOOP)
+ END DO
+ DO JLOOP = 1+NRRL+1,1+NRRL+NRRI
+ ZTHETAL(:,:,:) = ZTHETAL(:,:,:) + XRT(:,:,:,JLOOP)*ZWORK32(:,:,:)
+ ZWORK33(:,:,:) = ZWORK33(:,:,:) + XRT(:,:,:,JLOOP)
+ END DO
+! compute the liquid-water potential temperature
+! theta_l = theta * exp[ -(L_vap * ql + L_sub * qi) / (c_pd * T) ]
+! when water is present in any form:
+ ZTHETAL(:,:,:) = XTHT(:,:,:) &
+ * exp(-ZTHETAL(:,:,:)/(1.0+ZWORK33(:,:,:))/XCPD/ZTEMP(:,:,:))
+ ELSE
+! compute the liquid-water potential temperature
+! when water is absent:
+ ZTHETAL(:,:,:) = XTHT(:,:,:)
+ END IF
+!
+ IF (LMOIST_L .AND. NRR > 0) THEN
+ ! Liquid-Water potential temperature
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THETAL', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THETAL', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Liquid water potential temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAL)
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* The Moist-air Entropy potential temperature (Marquet, QJ2011, HDR2016)
+!
+IF ( LMOIST_S1 .OR. LMOIST_S2 ) THEN
+ IF (LMOIST_S1) THEN
+ ALLOCATE(ZTHETAS1(IIU,IJU,IKU))
+ END IF
+ IF (LMOIST_S2) THEN
+ ALLOCATE(ZTHETAS2(IIU,IJU,IKU))
+ END IF
+!
+! The total water (ZWORK31) and condensed water (ZWORK32) mixing ratios:
+ ZWORK32(:,:,:) = 0.0
+ IF(NRR > 0) THEN
+ DO JLOOP = 2,1+NRRL+NRRI
+ ZWORK32(:,:,:) = ZWORK32(:,:,:) + XRT(:,:,:,JLOOP)
+ END DO
+ END IF
+ ZWORK31(:,:,:) = ZWORK32(:,:,:) + XRT(:,:,:,1)
+!
+ IF (LMOIST_S1) THEN
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! thetas1 = thetal * exp[ 5.87 * qt ] ; with qt=rt/(1+rt)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ ZTHETAS1(:,:,:) = ZTHETAL(:,:,:) * &
+ exp( 5.87*ZWORK31(:,:,:)/(1.0+ZWORK31(:,:,:)) )
+ END IF
+ IF (LMOIST_S2) THEN
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! thetas2 = thetal * exp[ (5.87-0.46*ln(rv/0.0124)-0.46*qc) * qt ]
+! where qt=rt/(1+rt) and qc=rc/(1+rt)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ ZWORK33(:,:,:) = 5.87 - 0.46 * log(MAX(XRT(:,:,:,1),1.E-10)/0.0124)
+ ZTHETAS2(:,:,:) = ZTHETAL(:,:,:) * &
+ exp( ZWORK33(:,:,:)*ZWORK31(:,:,:)/(1.0+ZWORK31(:,:,:)) &
+ - 0.46*ZWORK32(:,:,:)/(1.0+ZWORK31(:,:,:)) )
+ END IF
+ IF (LMOIST_S1) THEN
+! The Moist-air Entropy potential temperature (1st order)
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THETAS1', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THETAS1', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Moist air Entropy (1st order) potential temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAS1)
+ END IF
+ IF (LMOIST_S2) THEN
+! The Moist-air Entropy potential temperature (2nd order)
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THETAS2', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THETAS2', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Moist air Entropy (2nd order) potential temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAS2)
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!!
+!
+!* Vorticity quantities
+!
+IF (LVORT) THEN
+! Vorticity x
+ ZWORK31(:,:,:)=MYF(MZF(MXM(ZVOX(:,:,:))))
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UM1', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM1', &
+ CUNITS = 's-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_x component of vorticity', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+! Vorticity y
+ ZWORK32(:,:,:)=MZF(MXF(MYM(ZVOY(:,:,:))))
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VM1', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM1', &
+ CUNITS = 's-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_y component of vorticity', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
+ !
+ IF (LWIND_ZM) THEN
+ TZFIELD2(1) = TFIELDMETADATA( &
+ CMNHNAME = 'UM1_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM1_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Zonal component of horizontal vorticity', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ TZFIELD2(2) = TFIELDMETADATA( &
+ CMNHNAME = 'VM1_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM1_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Meridian component of horizontal vorticity', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
+ ENDIF
+!
+! Vorticity z
+ ZWORK31(:,:,:)=MXF(MYF(MZM(ZVOZ(:,:,:))))
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'WM1', &
+ CSTDNAME = '', &
+ CLONGNAME = 'WM1', &
+ CUNITS = 's-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_relative vorticity', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+! Absolute Vorticity
+ ZWORK31(:,:,:)=MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:)
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ABVOR', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ABVOR', &
+ CUNITS = 's-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_z ABsolute VORticity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+END IF
+!
+IF ( LMEAN_POVO ) THEN
+ !
+ ALLOCATE(IWORK1(SIZE(XTHT,1),SIZE(XTHT,2)))
+ !
+ IWORK1(:,:)=0
+ ZWORK21(:,:)=0.
+ IF (XMEAN_POVO(1)>XMEAN_POVO(2)) THEN
+ !Invert values (smallest must be first)
+ ZX0D = XMEAN_POVO(1)
+ XMEAN_POVO(1) = XMEAN_POVO(2)
+ XMEAN_POVO(2) = ZX0D
+ END IF
+ DO JK=IKB,IKE
+ WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2)))
+ ZWORK21(:,:)=ZWORK21(:,:)+ZPOVO(:,:,JK)
+ IWORK1(:,:)=IWORK1(:,:)+1
+ END WHERE
+ END DO
+ WHERE (IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) )
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MEAN_POVO', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MEAN_POVO', &
+ CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MEAN of POtential VOrticity', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+END IF
+!
+! Virtual Potential Vorticity in PV units
+IF (LMOIST_V .AND. (NRR>0) ) THEN
+ ZWORK31(:,:,:)=GX_M_M(ZTHETAV,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(ZTHETAV,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(ZTHETAV,XDZZ)
+ ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
+ ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'POVOV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'POVOV', &
+ CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Virtual POtential VOrticity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
+!
+ IF (LMEAN_POVO) THEN
+ IWORK1(:,:)=0
+ ZWORK21(:,:)=0.
+ DO JK=IKB,IKE
+ WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2)))
+ ZWORK21(:,:)=ZWORK21(:,:)+ZWORK34(:,:,JK)
+ IWORK1(:,:)=IWORK1(:,:)+1
+ END WHERE
+ END DO
+ WHERE(IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) )
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MEAN_POVOV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MEAN_POVOV', &
+ CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MEAN of Virtual POtential VOrticity', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+END IF
+!
+! Equivalent Potential Vorticity in PV units
+IF (LMOIST_E .AND. (NRR>0) ) THEN
+!
+ ZWORK31(:,:,:)=GX_M_M(ZTHETAE,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(ZTHETAE,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(ZTHETAE,XDZZ)
+ ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
+ ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'POVOE', &
+ CSTDNAME = '', &
+ CLONGNAME = 'POVOE', &
+ CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Equivalent POtential VOrticity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
+!
+ IF (LMEAN_POVO) THEN
+ IWORK1(:,:)=0
+ ZWORK21(:,:)=0.
+ DO JK=IKB,IKE
+ WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2)))
+ ZWORK21(:,:)=ZWORK21(:,:)+ZWORK34(:,:,JK)
+ IWORK1(:,:)=IWORK1(:,:)+1
+ END WHERE
+ END DO
+ WHERE(IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) )
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MEAN_POVOE', &
+ CSTDNAME = '', &
+ CLONGNAME = 'MEAN_POVOE', &
+ CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_MEAN of Equivalent POtential VOrticity', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ DEALLOCATE(IWORK1)
+ END IF
+ !
+END IF
+!
+! Equivalent Saturated Potential Vorticity in PV units
+IF (LMOIST_ES .AND. (NRR>0) ) THEN
+ ZWORK31(:,:,:)=GX_M_M(ZTHETAES,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(ZTHETAES,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(ZTHETAES,XDZZ)
+ ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
+ ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'POVOES', &
+ CSTDNAME = '', &
+ CLONGNAME = 'POVOES', &
+ CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Equivalent Saturated POtential VOrticity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
+ENDIF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* Horizontal divergence
+!
+IF (LDIV) THEN
+!
+ ZWORK31=GX_U_M(XUT,XDXX,XDZZ,XDZX) + GY_V_M(XVT,XDYY,XDZZ,XDZY)
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HDIV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HDIV', &
+ CUNITS = 's-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Horizontal DIVergence', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+ IF (LUSERV) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HMDIV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HMDIV', &
+ CUNITS = 'kg m-3 s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Horizontal Moisture DIVergence HMDIV', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ ZWORK31=MXM(XRHODREF*XRT(:,:,:,1))*XUT
+ ZWORK32=MYM(XRHODREF*XRT(:,:,:,1))*XVT
+ ZWORK33=GX_U_M(ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK32,XDYY,XDZZ,XDZY)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
+ END IF
+!
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* Clustering
+!
+IF (LCLSTR) THEN
+ GCLOUD(:,:,:)=.FALSE.
+ GBOTUP=LBOTUP
+ IF (CFIELD=='W') THEN
+ WHERE(XWT(:,:,:).GT.XTHRES) GCLOUD(:,:,:)=.TRUE.
+ END IF
+ IF (CFIELD=='CLOUD') THEN
+ WHERE((XRT(:,:,:,2)+XRT(:,:,:,4)+XRT(:,:,:,5)+XRT(:,:,:,6)).GT.XTHRES) GCLOUD(:,:,:)=.TRUE.
+ END IF
+ PRINT *,'CALL CLUSTERING COUNT(GCLOUD)=',COUNT(GCLOUD)
+ CALL CLUSTERING(GBOTUP,GCLOUD,XWT,ICLUSTERID,ICLUSTERLV,ZCLDSIZE)
+ PRINT *,'GOT OUT OF CLUSTERING'
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLUSTERID', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CLUSTERID', &
+ CUNITS = '', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_CLUSTER (ID NUMBER)', &
+ NGRID = 1, &
+ NTYPE = TYPEINT, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ICLUSTERID)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLUSTERLV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CLUSTERLV', &
+ CUNITS = '', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_CLUSTER (BASE OR TOP LEVEL)', &
+ NGRID = 1, &
+ NTYPE = TYPEINT, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ICLUSTERLV)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLDSIZE', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CLDSIZE', &
+ CUNITS = '', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_CLDSIZE (HOR. SECTION)', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCLDSIZE)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Geostrophic and Ageostrophic wind (m/s)
+!
+IF (LGEO .OR. LAGEO) THEN
+ ALLOCATE(ZPHI(IIU,IJU,IKU))
+ IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
+ ZPHI(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)-XEXNREF(:,:,:)
+ !
+ ZPHI(1,1,:)=2*ZPHI(1,2,:)-ZPHI(1,3,:)
+ ZPHI(1,IJU,:)=2*ZPHI(1,IJU-1,:)-ZPHI(1,IJU-2,:)
+ ZPHI(IIU,1,:)=2*ZPHI(IIU,2,:)-ZPHI(IIU,3,:)
+ ZPHI(IIU,IJU,:)=2*ZPHI(IIU,IJU-1,:)-ZPHI(IIU,IJU-2,:)
+ ZWORK31(:,:,:)=-MXM(GY_M_M(ZPHI,XDYY,XDZZ,XDZY)*XCPD*XTHVREF/ZCORIOZ)
+ !
+ ZPHI(1,1,:)=2*ZPHI(2,1,:)-ZPHI(3,1,:)
+ ZPHI(IIU,1,:)=2*ZPHI(IIU-1,1,:)-ZPHI(IIU-2,1,:)
+ ZPHI(1,IJU,:)=2*ZPHI(2,IJU,:)-ZPHI(3,IJU,:)
+ ZPHI(IIU,IJU,:)=2*ZPHI(IIU-1,IJU,:)-ZPHI(IIU-2,IJU,:)
+ ZWORK32(:,:,:)=MYM(GX_M_M(ZPHI,XDXX,XDZZ,XDZX)*XCPD*XTHVREF/ZCORIOZ)
+ !
+ ELSE IF(CEQNSYS=='LHE') THEN
+ ZPHI(:,:,:)= ((XPABST(:,:,:)/XP00)**(XRD/XCPD)-XEXNREF(:,:,:)) &
+ * XCPD * XTHVREF(:,:,:)
+ !
+ ZPHI(1,1,:)=2*ZPHI(1,2,:)-ZPHI(1,3,:)
+ ZPHI(1,IJU,:)=2*ZPHI(1,IJU-1,:)-ZPHI(1,IJU-2,:)
+ ZPHI(IIU,1,:)=2*ZPHI(IIU,2,:)-ZPHI(IIU,3,:)
+ ZPHI(IIU,IJU,:)=2*ZPHI(IIU,IJU-1,:)-ZPHI(IIU,IJU-2,:)
+ ZWORK31(:,:,:)=-MXM(GY_M_M(ZPHI,XDYY,XDZZ,XDZY)/ZCORIOZ)
+ !
+ ZPHI(1,1,:)=2*ZPHI(2,1,:)-ZPHI(3,1,:)
+ ZPHI(IIU,1,:)=2*ZPHI(IIU-1,1,:)-ZPHI(IIU-2,1,:)
+ ZPHI(1,IJU,:)=2*ZPHI(2,IJU,:)-ZPHI(3,IJU,:)
+ ZPHI(IIU,IJU,:)=2*ZPHI(IIU-1,IJU,:)-ZPHI(IIU-2,IJU,:)
+ ZWORK32(:,:,:)=MYM(GX_M_M(ZPHI,XDXX,XDZZ,XDZX)/ZCORIOZ)
+ END IF
+ DEALLOCATE(ZPHI)
+!
+ IF (LGEO) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UM88', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM88', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_U component of GEOstrophic wind', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VM88', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM88', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_V component of GEOstrophic wind', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
+ !
+ IF (LWIND_ZM) THEN
+ TZFIELD2(1) = TFIELDMETADATA( &
+ CMNHNAME = 'UM88_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM88_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Zonal component of GEOstrophic wind', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ TZFIELD2(2) = TFIELDMETADATA( &
+ CMNHNAME = 'VM88_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM88_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Meridian component of GEOstrophic wind', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
+ ENDIF
+!
+! wm necessary to plot vertical cross sections of wind vectors
+ CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'WM88'
+ TZFIELD%CLONGNAME = 'WM88'
+ CALL IO_Field_write(TPFILE,TZFIELD,XWT)
+ END IF
+!
+ IF (LAGEO) THEN
+ ZWORK31(:,:,:)=XUT(:,:,:)-ZWORK31(:,:,:)
+ ZWORK32(:,:,:)=XVT(:,:,:)-ZWORK32(:,:,:)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UM89', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM89', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_U component of AGEOstrophic wind', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VM89', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM89', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_V component of AGEOstrophic wind', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
+ !
+ IF (LWIND_ZM) THEN
+ TZFIELD2(1) = TFIELDMETADATA( &
+ CMNHNAME = 'UM89_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM89_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Zonal component of AGEOstrophic wind', &
+ NGRID = 2, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ TZFIELD2(2) = TFIELDMETADATA( &
+ CMNHNAME = 'VM89_ZM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM89_ZM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Meridian component of AGEOstrophic wind', &
+ NGRID = 3, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
+ ENDIF
+!
+! wm necessary to plot vertical cross sections of wind vectors
+ CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%CMNHNAME = 'WM89'
+ TZFIELD%CLONGNAME = 'WM89'
+ CALL IO_Field_write(TPFILE,TZFIELD,XWT)
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Contravariant wind field
+!
+!
+IF(LWIND_CONTRAV) THEN!$
+ CALL CONTRAV ((/"TEST","TEST"/),(/"TEST","TEST"/),XUT,XVT,XWT,XDXX,XDYY,XDZZ,XDZX,XDZY, &
+ ZWORK31,ZWORK32,ZWORK33,2)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'WNORM', &
+ CSTDNAME = '', &
+ CLONGNAME = 'WNORM', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_W surface normal wind', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* Mean Sea Level Pressure in hPa
+!
+IF (LMSLP) THEN
+ ZGAMREF=-6.5E-3
+! Exner function at the first mass point
+ ZWORK21(:,:) = (XPABST(:,:,IKB) /XP00)**(XRD/XCPD)
+! virtual temperature at the first mass point
+ ZWORK21(:,:) = ZWORK21(:,:) * ZTHETAV(:,:,IKB)
+! virtual temperature at ground level
+ ZWORK21(:,:) = ZWORK21(:,:) - ZGAMREF*((XZZ(:,:,IKB)+XZZ(:,:,IKB+1))/2.-XZS(:,:))
+! virtual temperature at sea level
+ ZWORK22(:,:) = ZWORK21(:,:) - ZGAMREF*XZS(:,:)
+! average underground virtual temperature
+ ZWORK22(:,:) = 0.5*(ZWORK21(:,:)+ZWORK22(:,:))
+! surface pressure
+ ZWORK21(:,:) = ( XPABST(:,:,IKB) + XPABST(:,:,IKB-1) )*.5
+! sea level pressure (hPa)
+ ZWORK22(:,:) = 1.E-2*ZWORK21(:,:)*EXP(XG*XZS(:,:)/(XRD*ZWORK22(:,:)))
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'MSLP', &
+ CSTDNAME = 'air_pressure_at_sea_level', &
+ CLONGNAME = 'MSLP', &
+ CUNITS = 'hPa', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Mean Sea Level Pressure', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* Vapor, cloud water and ice thickness
+!
+IF (LTHW) THEN
+!
+ ZWORK21(:,:) = 0.
+ IF(SIZE(XRT,4)>=1)THEN
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,1) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THVW', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THVW', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_THickness of Vapor Water', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+ !
+ ZWORK21(:,:) = 0.
+ IF(SIZE(XRT,4)>=2)THEN
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,2) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! cloud water in mm unit
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THCW', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THCW', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_THickness of Cloud Water', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+ !
+ ZWORK21(:,:) = 0.
+ IF(SIZE(XRT,4)>=3)THEN
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,3) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! rain water in mm unit
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THRW', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THRW', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_THickness of Rain Water', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+ !
+ ZWORK21(:,:) = 0.
+ IF(SIZE(XRT,4)>=4)THEN
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,4) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! ice thickness in mm unit
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THIC', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THIC', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_THickness of ICe', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+ !
+ ZWORK21(:,:) = 0.
+ IF(SIZE(XRT,4)>=5)THEN
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,5) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! snow thickness in mm unit
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THSN', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THSN', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_THickness of SNow', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+ !
+ ZWORK21(:,:) = 0.
+ IF(SIZE(XRT,4)>=6)THEN
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,6) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! graupel thickness in mm unit
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THGR', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THGR', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_THickness of GRaupel', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+ !
+ ZWORK21(:,:) = 0.
+ IF(SIZE(XRT,4)>=7)THEN
+ DO JK = IKB,IKE
+ ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,7) * &
+ (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
+ END DO
+ ZWORK21(:,:) = ZWORK21(:,:)*1000. ! hail thickness in mm unit
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'THHA', &
+ CSTDNAME = '', &
+ CLONGNAME = 'THHA', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_THickness of HAil', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Accumulated and instantaneous total precip rates in mm and mm/h
+!
+IF (LTOTAL_PR .AND. SIZE (XACPRR)>0 ) THEN
+ ZWORK21(:,:) = 0.
+ !
+ IF (LUSERR) THEN
+ ZWORK21(:,:) = XACPRR(:,:)*1E3
+ END IF
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
+ ZWORK21(:,:) = ZWORK21(:,:) + (XACPRS(:,:) + XACPRG(:,:))*1E3
+ IF (SIZE(XINPRC) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:) *1E3
+ IF (SIZE(XINPRH) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XACPRH(:,:) *1E3
+ END IF
+ IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' &
+ .OR. CCLOUD == 'LIMA' ) THEN
+ IF (SIZE(XINPRC) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:) *1E3
+ END IF
+ IF (CDCONV /= 'NONE') THEN
+ ZWORK21(:,:) = ZWORK21(:,:) + XPACCONV(:,:)*1E3
+ END IF
+ IF (LUSERR .OR. CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
+ CCLOUD == 'LIMA' .OR. CDCONV /= 'NONE') THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ACTOPR', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ACTOPR', &
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_ACccumulated TOtal Precipitation Rate', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ ELSE
+ PRINT * ,'YOU WANT TO COMPUTE THE ACCUMULATED RAIN'
+ PRINT * ,'BUT NO RAIN IS PRESENT IN THE MODEL'
+ END IF
+ !
+ ! calculation of the mean accumulated precipitations in the mesh-grid of a
+ !large-scale model
+ IF (LMEAN_PR .AND. LUSERR) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic LS_ACTOPR', & !Temporary name to ease identification
+ CUNITS = 'mm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Large Scale ACccumulated TOtal Precipitation Rate', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ !
+ DO JK=1,SIZE(XMEAN_PR),2
+ IF (XMEAN_PR(JK) .NE. XUNDEF .AND. XMEAN_PR(JK+1) .NE. XUNDEF) THEN
+ PRINT * ,'MEAN accumulated RAIN: GRID ', XMEAN_PR(JK), XMEAN_PR(JK+1)
+ CALL COMPUTE_MEAN_PRECIP(ZWORK21,XMEAN_PR(JK:JK+1),ZWORK22,TZFIELD%NGRID)
+ !
+ JI=INT(XMEAN_PR(JK))
+ JJ=INT(XMEAN_PR(JK+1))
+ WRITE(TZFIELD%CMNHNAME,'(A9,2I2.2)')'LS_ACTOPR',JI,JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
+ END IF
+ END DO
+ !
+ END IF
+ !
+ !
+ ZWORK21(:,:) = 0.
+ !
+ IF (LUSERR) THEN
+ ZWORK21(:,:) = XINPRR(:,:)*3.6E6
+ END IF
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
+ ZWORK21(:,:) = ZWORK21(:,:) + (XINPRS(:,:) + XINPRG(:,:))*3.6E6
+ IF (SIZE(XINPRC) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:) *3.6E6
+ IF (SIZE(XINPRH) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XINPRH(:,:) *3.6E6
+ END IF
+ IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' &
+ .OR. CCLOUD == 'LIMA' ) THEN
+ IF (SIZE(XINPRC) /= 0 ) &
+ ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:) *3.6E6
+ END IF
+ IF (CDCONV /= 'NONE') THEN
+ ZWORK21(:,:) = ZWORK21(:,:) + XPRCONV(:,:)*3.6E6
+ END IF
+ IF (LUSERR .OR. CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
+ CCLOUD == 'LIMA' .OR. CDCONV /= 'NONE') THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'INTOPR', &
+ CSTDNAME = '', &
+ CLONGNAME = 'INTOPR', &
+ CUNITS = 'mm hour-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_INstantaneous TOtal Precipitation Rate', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ ELSE
+ PRINT * ,'YOU WANT TO COMPUTE THE RAIN RATE'
+ PRINT * ,'BUT NO RAIN IS PRESENT IN THE MODEL'
+ END IF
+!
+ ! calculation of the mean instantaneous precipitations in the mesh-grid of a
+ ! large-scale model
+ IF (LMEAN_PR .AND. LUSERR) THEN
+ CALL COMPUTE_MEAN_PRECIP(ZWORK21,XMEAN_PR,ZWORK22,TZFIELD%NGRID)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'LS_INTOPR', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LS_INTOPR', &
+ CUNITS = 'mm hour-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Large Scale INstantaneous TOtal Precipitation Rate', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
+ END IF
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* CAPEMAX, CINMAX (corresponding to CAPEMAX), CAPE, CIN, DCAPE, VKE in J/kg
+!
+IF (NCAPE >=0 .AND. LUSERV) THEN
+ ZWORK31(:,:,:) = XRT(:,:,:,1) * 1000. ! vapour mixing ratio in g/kg
+ ZWORK32(:,:,:)=0.0
+ ZWORK33(:,:,:)=0.0
+ ZWORK34(:,:,:)=0.0
+ CALL CALCSOUND( XPABST(:,:,IKB:IKE)* 0.01 ,ZTEMP(:,:,IKB:IKE)- XTT, &
+ ZWORK31(:,:,IKB:IKE), &
+ ZWORK32(:,:,IKB:IKE),ZWORK33(:,:,IKB:IKE), &
+ ZWORK34(:,:,IKB:IKE),ZWORK21,ZWORK22 )
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CAPEMAX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CAPEMAX', &
+ CUNITS = 'J kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_MAX of Convective Available Potential Energy', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CINMAX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'CINMAX', &
+ CUNITS = 'J kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_MAX of Convective INhibition energy', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
+ !
+ IF (NCAPE >=1) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CAPE3D', &
+ CSTDNAME = 'atmosphere_convective_available_potential_energy', &
+ CLONGNAME = 'CAPE3D', &
+ CUNITS = 'J kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Convective Available Potential Energy', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CIN3D', &
+ CSTDNAME = 'atmosphere_convective_inhibition', &
+ CLONGNAME = 'CIN3D', &
+ CUNITS = 'J kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Convective INhibition energy', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'DCAPE3D', &
+ CSTDNAME = '', &
+ CLONGNAME = 'DCAPE3D', &
+ CUNITS = 'J kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = '', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
+ END IF
+ !
+ IF (NCAPE >=2) THEN
+ ZWORK31(:,:,1:IKU-1)= 0.5*(XWT(:,:,1:IKU-1)+XWT(:,:,2:IKU))
+ ZWORK31(:,:,IKU) = 0.
+ ZWORK31=0.5*ZWORK31**2
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VKE', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VKE', &
+ CUNITS = 'J kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Vertical Kinetic Energy', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END IF
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* B-V frequency to assess thermal tropopause
+!
+IF (LBV_FR) THEN
+ ZWORK32(:,:,:)=DZM(XTHT(:,:,:))/ MZM(XTHT(:,:,:))
+ DO JK=1,IKU
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ IF(ZWORK32(JI,JJ,JK)<0.) THEN
+ ZWORK31(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) )
+ ELSE
+ ZWORK31(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) )
+ END IF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'BV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'BV', &
+ CUNITS = 's-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Brunt-Vaissala frequency', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+ IF (NRR > 0) THEN
+ ZWORK32(:,:,:)=DZM(ZTHETAE(:,:,:))/ MZM(ZTHETAE(:,:,:))
+ DO JK=1,IKU
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ IF (ZWORK32(JI,JJ,JK)<0.) THEN
+ ZWORK31(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) )
+ ELSE
+ ZWORK31(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) )
+ END IF
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'BVE', &
+ CSTDNAME = '', &
+ CLONGNAME = 'BVE', &
+ CUNITS = 's-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Equivalent Brunt-Vaissala frequency', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END IF
+END IF
+!
+IF(ALLOCATED(ZTHETAE)) DEALLOCATE(ZTHETAE)
+IF(ALLOCATED(ZTHETAES)) DEALLOCATE(ZTHETAES)
+!-------------------------------------------------------------------------------
+!
+!* GPS synthetic ZTD, ZHD, ZWD
+!
+IF ( NGPS>=0 ) THEN
+ ! surface temperature
+ ZGAMREF=-6.5E-3
+ ZWORK21(:,:) = ZTEMP(:,:,IKB) - ZGAMREF*((XZZ(:,:,IKB)+XZZ(:,:,IKB+1))/2.-XZS(:,:))
+ !
+ YFGRI=ADJUSTL(ADJUSTR(TPFILE%CNAME)//'GPS')
+ CALL GPS_ZENITH (YFGRI,XRT(:,:,:,1),ZTEMP,XPABST,ZWORK21,ZWORK22,ZWORK23,ZWORK24)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ZTD', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ZTD', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Zenithal Total Delay', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
+ !
+ IF (NGPS>=1) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ZHD', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ZHD', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Zenithal Hydrostatic Delay', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK23)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ZWD', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ZWD', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Zenithal Wet Delay', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK24)
+ !
+ END IF
+ !
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Radar reflectivities
+!
+IF(LRADAR .AND. LUSERR) THEN
+! CASE PREP_REAL_CASE after arome
+ IF (CCLOUD=='NONE' .OR. CCLOUD=='KESS') THEN
+ DEALLOCATE(XCIT)
+ ALLOCATE(XCIT(IIU,IJU,IKU))
+ XCIT(:,:,:)=800.
+ CALL INI_RADAR('PLAT')
+ ELSE IF (CCLOUD=='LIMA') THEN
+ DEALLOCATE(XCIT)
+ ALLOCATE(XCIT(IIU,IJU,IKU))
+ XCIT(:,:,:)=XSVT(:,:,:,NSV_LIMA_NI)
+ CALL INI_RADAR('PLAT')
+ END IF
+!
+ IF (NVERSION_RAD == 1) THEN
+! original version of radar diagnostics
+ WRITE(ILUOUT0,*) 'radar diagnostics from RADAR_RAIN_ICE routine'
+ IF (CCLOUD=='LIMA') THEN
+ ALLOCATE( ZW1(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3)) )
+ ALLOCATE( ZW2(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3)) )
+ ALLOCATE( ZW3(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3)) )
+ IF ( NMOM_S >= 2 ) ZW1(:,:,:)=XSVT(:,:,:,NSV_LIMA_NS)
+ IF ( NMOM_G >= 2 ) ZW2(:,:,:)=XSVT(:,:,:,NSV_LIMA_NG)
+ IF ( NMOM_H >= 2 ) ZW3(:,:,:)=XSVT(:,:,:,NSV_LIMA_NH)
+ CALL RADAR_RAIN_ICE( XRT, XCIT, XRHODREF, ZTEMP, ZWORK31, ZWORK32, &
+ ZWORK33, ZWORK34,XSVT(:,:,:,NSV_LIMA_NR), &
+ ZW1(:,:,:), ZW2(:,:,:), ZW3(:,:,:) )
+ DEALLOCATE( ZW1, ZW2, ZW3 )
+ ELSE
+ CALL RADAR_RAIN_ICE (XRT, XCIT, XRHODREF, ZTEMP, ZWORK31, ZWORK32, &
+ ZWORK33, ZWORK34 )
+ ENDIF
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'RARE', &
+ CSTDNAME = 'equivalent_reflectivity_factor', &
+ CLONGNAME = 'RARE', &
+ CUNITS = 'dBZ', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_RAdar REflectivity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VDOP', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VDOP', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_radar DOPpler fall speed', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ZDR', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ZDR', &
+ CUNITS = 'dBZ', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Differential polar Reflectivity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'KDP', &
+ CSTDNAME = '', &
+ CLONGNAME = 'KDP', &
+ CUNITS = 'degree km-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Differential Phase Reflectivity', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
+!
+ ELSE
+ !
+ WRITE(ILUOUT0,*) 'radar diagnostics from RADAR_SIMULATOR routine'
+
+ NBRAD=COUNT(XLAT_RAD(:) /= XUNDEF)
+ NMAX=INT(NBSTEPMAX*XSTEP_RAD/XGRID)
+ IF(NBSTEPMAX*XSTEP_RAD/XGRID/=NMAX .AND. (LCART_RAD)) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG', &
+ 'NBSTEPMAX*XSTEP_RAD/XGRID is not an integer; please choose another combination')
+ ENDIF
+ DO JI=1,NBRAD
+ NBELEV(JI)=COUNT(XELEV(JI,:) /= XUNDEF)
+ WRITE(ILUOUT0,*) 'Number of ELEVATIONS : ', NBELEV(JI), 'FOR RADAR:', JI
+ END DO
+ IIELV=MAXVAL(NBELEV(1:NBRAD))
+ WRITE(ILUOUT0,*) 'Maximum number of ELEVATIONS',IIELV
+ WRITE(ILUOUT0,*) 'YOU HAVE ASKED FOR ', NBRAD, 'RADARS'
+ !
+ IF (LCART_RAD) NBAZIM=8*NMAX ! number of azimuths
+ WRITE(ILUOUT0,*) ' Number of AZIMUTHS : ', NBAZIM
+ IF (LCART_RAD) THEN
+ ALLOCATE(ZWORK43(NBRAD,4*NMAX,2*NMAX))
+ ELSE
+ ALLOCATE(ZWORK43(1,NBAZIM,1))
+ END IF
+!! Some controls...
+ IF(NBRAD/=COUNT(XLON_RAD(:) /= XUNDEF).OR.NBRAD/=COUNT(XALT_RAD(:) /= XUNDEF).OR. &
+ NBRAD/=COUNT(XLAM_RAD(:) /= XUNDEF).OR.NBRAD/=COUNT(XDT_RAD(:) /= XUNDEF).OR. &
+ NBRAD/=COUNT(CNAME_RAD(:) /= "UNDEF")) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG','inconsistency in DIAG1.nam')
+ END IF
+ IF(NCURV_INTERPOL==0.AND.(LREFR.OR.LDNDZ)) THEN
+ LREFR=.FALSE.
+ LDNDZ=.FALSE.
+ WRITE(ILUOUT0,*) "Warning: cannot output refractivity nor its vertical gradient when NCURV_INTERPOL=0"
+ END IF
+ IF(MOD(NPTS_H,2)==0) THEN
+ NPTS_H=NPTS_H+1
+ WRITE(ILUOUT0,*) "Warning: NPTS_H has to be ODD. Setting it to ",NPTS_H
+ END IF
+ IF(MOD(NPTS_V,2)==0) THEN
+ NPTS_V=NPTS_V+1
+ WRITE(ILUOUT0,*) "Warning: NPTS_V has to be ODD. Setting it to ",NPTS_V
+ END IF
+ IF(LWBSCS.AND.LWREFL) THEN
+ LWREFL=.FALSE.
+ WRITE(ILUOUT0,*) "Warning: LWREFL cannot be set to .TRUE. if LWBSCS is also set to .TRUE.. Setting LWREFL to .FALSE.."
+ END IF
+ IF(CCLOUD=="LIMA" .AND. NDIFF/=7) THEN
+ WRITE(YMSG,*) 'NDIFF=',NDIFF,' not available with CCLOUD=LIMA'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG',YMSG)
+ END IF
+ INBOUT=28 !28: Temperature + RHR, RHS, RHG, ZDA, ZDS, ZDG, KDR, KDS, KDG
+ IF (CCLOUD=='LIMA') INBOUT=INBOUT+1 ! rain concentration CRT
+ IF(LREFR) INBOUT=INBOUT+1 !+refractivity
+ IF(LDNDZ) INBOUT=INBOUT+1 !+refractivity vertical gradient
+ IF(LATT) INBOUT=INBOUT+12 !+AER-AEG AVR-AVG (vertical specific attenuation) and ATR-ATG
+ IF ( CCLOUD=='ICE4' ) THEN
+ INBOUT=INBOUT+5 ! HAIL ZEH RHH ZDH KDH M_H
+ IF (LATT) THEN
+ INBOUT=INBOUT+3 ! AEH AVH ATH
+ ENDIF
+ END IF
+ WRITE(ILUOUT0,*) "Nombre de variables dans ZWORK42 en sortie de radar_simulator:",INBOUT
+
+ IF (LCART_RAD) THEN
+ ALLOCATE(ZWORK42(NBRAD,IIELV,2*NMAX,2*NMAX,INBOUT))
+ ELSE
+ ALLOCATE(ZWORK42(NBRAD,IIELV,NBAZIM,NBSTEPMAX+1,INBOUT))
+ ALLOCATE(ZWORK42_BIS(NBRAD,IIELV,NBAZIM,NBSTEPMAX+1,INBOUT))
+ END IF
+ !
+ IF (CCLOUD=='LIMA') THEN
+ CALL RADAR_SIMULATOR(XUT,XVT,XWT,XRT,XSVT(:,:,:,NSV_LIMA_NI),XRHODREF,&
+ ZTEMP,XPABST,ZWORK42,ZWORK43,XSVT(:,:,:,NSV_LIMA_NR))
+ ELSE ! ICE3
+ CALL RADAR_SIMULATOR(XUT,XVT,XWT,XRT,XCIT,XRHODREF,ZTEMP,XPABSM,ZWORK42,ZWORK43)
+ ENDIF
+ ALLOCATE(YRAD(INBOUT))
+ YRAD(1:8)=(/"ZHH","ZDR","KDP","CSR","ZER","ZEI","ZES","ZEG"/)
+ ICURR=9
+ IF (CCLOUD=='ICE4') THEN
+ YRAD(ICURR)="ZEH"
+ ICURR=ICURR+1
+ END IF
+ YRAD(ICURR)="VRU"
+ ICURR=ICURR+1
+ IF(LATT) THEN
+ IF (CCLOUD=='ICE4') THEN
+ YRAD(ICURR:ICURR+14)=(/"AER","AEI","AES","AEG","AEH","AVR","AVI","AVS","AVG","AVH","ATR","ATI","ATS","ATG","ATH"/)
+ ICURR=ICURR+15
+ ELSE
+ YRAD(ICURR:ICURR+11)=(/"AER","AEI","AES","AEG","AVR","AVI","AVS","AVG","ATR","ATI","ATS","ATG"/)
+ ICURR=ICURR+12
+ END IF
+ END IF
+ YRAD(ICURR:ICURR+2)=(/"RHV","PDP","DHV"/)
+ ICURR=ICURR+3
+ YRAD(ICURR:ICURR+2)=(/"RHR","RHS","RHG"/)
+ ICURR=ICURR+3
+ IF (CCLOUD=='ICE4') THEN
+ YRAD(ICURR)="RHH"
+ ICURR=ICURR+1
+ END IF
+ YRAD(ICURR:ICURR+2)=(/"ZDA","ZDS","ZDG"/)
+ ICURR=ICURR+3
+ IF (CCLOUD=='ICE4') THEN
+ YRAD(ICURR)="ZDH"
+ ICURR=ICURR+1
+ END IF
+ YRAD(ICURR:ICURR+2)=(/"KDR","KDS","KDG"/)
+ ICURR=ICURR+3
+ IF (CCLOUD=='ICE4') THEN
+ YRAD(ICURR)="KDH"
+ ICURR=ICURR+1
+ END IF
+ YRAD(ICURR:ICURR+4)=(/"HAS","M_R","M_I","M_S","M_G"/)
+ ICURR=ICURR+5
+ IF (CCLOUD=='ICE4') THEN
+ YRAD(ICURR)="M_H"
+ ICURR=ICURR+1
+ END IF
+ YRAD(ICURR:ICURR+1)=(/"CIT","TEM"/)
+ ICURR=ICURR+2
+ IF (CCLOUD=='LIMA') THEN
+ YRAD(ICURR)="CRT"
+ ICURR=ICURR+1
+ ENDIF
+ IF(LREFR) THEN
+ YRAD(ICURR)="RFR"
+ ICURR=ICURR+1
+ END IF
+ IF(LDNDZ) THEN
+ YRAD(ICURR)="DNZ"
+ ICURR=ICURR+1
+ END IF
+ IF (LCART_RAD) THEN
+ DO JI=1,NBRAD
+ IEL=NBELEV(JI)
+ ! writing latlon in internal files
+ ALLOCATE(CLATLON(2*NMAX))
+ CLATLON=""
+ DO JV=2*NMAX,1,-1
+ DO JH=1,2*NMAX
+ WRITE(CBUFFER,'(2(f8.3,1X))') ZWORK43(JI,2*JH-1,JV),ZWORK43(JI,2*JH,JV)
+ CLATLON(JV)=TRIM(CLATLON(JV)) // " " // TRIM(CBUFFER)
+ END DO
+ CLATLON(JV)=TRIM(ADJUSTL(CLATLON(JV)))
+ END DO
+ DO JEL=1,IEL
+ WRITE(YELEV,'(I2.2,A1,I1.1)') FLOOR(XELEV(JI,JEL)),'.',&
+ INT(ANINT(10.*XELEV(JI,JEL))-10*INT(XELEV(JI,JEL)))
+ WRITE(YGRID_SIZE,'(I3.3)') 2*NMAX
+ DO JJ=1,SIZE(ZWORK42(:,:,:,:,:),5)
+ YRS=YRAD(JJ)//CNAME_RAD(JI)(1:3)//YELEV//YGRID_SIZE//TRIM(TPFILE%CNAME)
+ CALL IO_File_add2list(TZRSFILE,YRS,'TXT','WRITE',KRECL=8192)
+ CALL IO_File_open(TZRSFILE,HSTATUS='NEW')
+ ILURS = TZRSFILE%NLU
+ WRITE(ILURS,'(A,4F12.6,2I5)') '**domaine LATLON ',ZWORK43(JI,1,1),ZWORK43(JI,4*NMAX-1,2*NMAX), &
+ ZWORK43(JI,2,1),ZWORK43(JI,4*NMAX,2*NMAX),2*NMAX,2*NMAX !! HEADER
+ DO JV=2*NMAX,1,-1
+ DO JH=1,2*NMAX
+ WRITE(ILURS,'(E11.5,1X)',ADVANCE='NO') ZWORK42(JI,JEL,JH,JV,JJ)
+ END DO
+ WRITE(ILURS,*) ''
+ END DO
+
+ DO JV=2*NMAX,1,-1
+ WRITE(ILURS,*) CLATLON(JV)
+ END DO
+ CALL IO_File_close(TZRSFILE)
+ TZRSFILE => NULL()
+ END DO
+ END DO
+ DEALLOCATE(CLATLON)
+ END DO
+ ELSE ! polar output
+ CALL MPI_ALLREDUCE(ZWORK42, ZWORK42_BIS, SIZE(ZWORK42), MNHREAL_MPI, MPI_MAX, NMNH_COMM_WORLD, IERR)
+ DO JI=1,NBRAD
+ IEL=NBELEV(JI)
+ DO JEL=1,IEL
+ WRITE(YELEV,'(I2.2,A1,I1.1)') FLOOR(XELEV(JI,JEL)),'.',&
+ INT(ANINT(10.*XELEV(JI,JEL))-10*INT(XELEV(JI,JEL)))
+ DO JJ=1,SIZE(ZWORK42(:,:,:,:,:),5)
+ YRS="P"//YRAD(JJ)//CNAME_RAD(JI)(1:3)//YELEV//TRIM(TPFILE%CNAME)
+ CALL IO_File_add2list(TZRSFILE,YRS,'TXT','WRITE')
+ CALL IO_File_open(TZRSFILE)
+ ILURS = TZRSFILE%NLU
+ DO JH=1,NBAZIM
+ DO JV=1,NBSTEPMAX+1
+ WRITE(ILURS,"(F15.7)") ZWORK42_BIS(JI,JEL,JH,JV,JJ)
+ END DO
+ END DO
+ CALL IO_File_close(TZRSFILE)
+ TZRSFILE => NULL()
+ END DO
+ END DO
+ END DO
+ END IF !polar output
+ DEALLOCATE(ZWORK42,ZWORK43)
+ END IF
+END IF
+!
+IF (LLIDAR) THEN
+ PRINT *,'CALL LIDAR/RADAR with TPFILE%CNAME =',TPFILE%CNAME
+ YVIEW=' '
+ YVIEW=TRIM(CVIEW_LIDAR)
+ PRINT *,'CVIEW_LIDAR REQUESTED ',YVIEW
+ IF (YVIEW/='NADIR'.AND.YVIEW/='ZENIT') YVIEW='NADIR'
+ PRINT *,'CVIEW_LIDAR USED ',YVIEW
+ PRINT *,'XALT_LIDAR REQUESTED (m) ',XALT_LIDAR
+ PRINT *,'XWVL_LIDAR REQUESTED (m) ',XWVL_LIDAR
+ IF (XWVL_LIDAR==XUNDEF) XWVL_LIDAR=0.532E-6
+ IF (XWVL_LIDAR<1.E-7.OR.XWVL_LIDAR>2.E-6) THEN
+ PRINT *,'CAUTION: THE XWVL_LIDAR REQUESTED IS OUTSIDE THE USUAL RANGE'
+ XWVL_LIDAR=0.532E-6
+ ENDIF
+ PRINT *,'XWVL_LIDAR USED (m) ',XWVL_LIDAR
+!
+ IF (LDUST) THEN
+ IACCMODE=MIN(2,NMODE_DST)
+ ALLOCATE(ZTMP1(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1))
+ ALLOCATE(ZTMP2(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1))
+ ALLOCATE(ZTMP3(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1))
+ ZTMP1(:,:,:,1)=ZN0_DST(:,:,:,IACCMODE)
+ ZTMP2(:,:,:,1)=ZRG_DST(:,:,:,IACCMODE)
+ ZTMP3(:,:,:,1)=ZSIG_DST(:,:,:,IACCMODE)
+ SELECT CASE ( CCLOUD )
+ CASE('KESS''ICE3','ICE4')
+ CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
+ XRT, ZWORK31, ZWORK32, &
+ PDSTC=ZTMP1, &
+ PDSTD=ZTMP2, &
+ PDSTS=ZTMP3)
+ CASE('C2R2')
+ CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
+ XRT, ZWORK31, ZWORK32, &
+ PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C2R2END), &
+ PDSTC=ZTMP1, &
+ PDSTD=ZTMP2, &
+ PDSTS=ZTMP3)
+ CASE('C3R5')
+ CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
+ XRT, ZWORK31, ZWORK32, &
+ PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C1R3END-1), &
+ PDSTC=ZTMP1, &
+ PDSTD=ZTMP2, &
+ PDSTS=ZTMP3)
+ CASE('LIMA')
+! PCT(2) = droplets (3)=drops (4)=ice crystals
+ ALLOCATE(ZTMP4(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 4))
+ ZTMP4(:,:,:,1)=0.
+ ZTMP4(:,:,:,2)=XSVT(:,:,:,NSV_LIMA_NC)
+ ZTMP4(:,:,:,3)=XSVT(:,:,:,NSV_LIMA_NR)
+ ZTMP4(:,:,:,4)=XSVT(:,:,:,NSV_LIMA_NI)
+!
+ CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, MAX(XCLDFR,XICEFR),&
+ XRT, ZWORK31, ZWORK32, &
+ PCT=ZTMP4, &
+ PDSTC=ZTMP1, &
+ PDSTD=ZTMP2, &
+ PDSTS=ZTMP3)
+!
+ END SELECT
+ ELSE
+ SELECT CASE ( CCLOUD )
+ CASE('KESS','ICE3','ICE4')
+ CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
+ XRT, ZWORK31, ZWORK32)
+ CASE('C2R2')
+ CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
+ XRT, ZWORK31, ZWORK32, &
+ PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C2R2END))
+ CASE('C3R5')
+ CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
+ XRT, ZWORK31, ZWORK32, &
+ PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C1R3END-1))
+ CASE('LIMA')
+! PCT(2) = droplets (3)=drops (4)=ice crystals
+ ALLOCATE(ZTMP4(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 4))
+ ZTMP4(:,:,:,1)=0.
+ ZTMP4(:,:,:,2)=XSVT(:,:,:,NSV_LIMA_NC)
+ ZTMP4(:,:,:,3)=XSVT(:,:,:,NSV_LIMA_NR)
+ ZTMP4(:,:,:,4)=XSVT(:,:,:,NSV_LIMA_NI)
+!
+ CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, MAX(XCLDFR,XICEFR),&
+ XRT, ZWORK31, ZWORK32, &
+ PCT=ZTMP4)
+ END SELECT
+ ENDIF
+!
+ IF( ALLOCATED(ZTMP1) ) DEALLOCATE(ZTMP1)
+ IF( ALLOCATED(ZTMP2) ) DEALLOCATE(ZTMP2)
+ IF( ALLOCATED(ZTMP3) ) DEALLOCATE(ZTMP3)
+ IF( ALLOCATED(ZTMP4) ) DEALLOCATE(ZTMP4)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'LIDAR', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LIDAR', &
+ CUNITS = 'm-1 sr-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Normalized_Lidar_Profile', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'LIPAR', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LIPAR', &
+ CUNITS = 'm-1 sr-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Particle_Lidar_Profile', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Height of boundary layer
+!
+IF (CBLTOP == 'THETA') THEN
+ !
+ ! methode de la parcelle
+ !
+ ALLOCATE(ZSHMIX(IIU,IJU))
+
+ ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
+ ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2)
+ ZWORK21(:,:) = ZTHETAV(:,:,IKB)+0.5
+ ZSHMIX(:,:) = 0.0
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ DO JK=IKB,IKE
+ IF ( ZTHETAV(JI,JJ,JK).GT.ZWORK21(JI,JJ) ) THEN
+ ZSHMIX(JI,JJ) = ZWORK31(JI,JJ,JK-1) &
+ +( ZWORK31(JI,JJ,JK) - ZWORK31 (JI,JJ,JK-1) ) &
+ /( ZTHETAV(JI,JJ,JK) - ZTHETAV(JI,JJ,JK-1) ) &
+ *( ZWORK21(JI,JJ) - ZTHETAV(JI,JJ,JK-1) )
+ EXIT
+ END IF
+ END DO
+ END DO
+ END DO
+ ZSHMIX(:,:)=ZSHMIX(:,:)-XZS(:,:)
+ ZSHMIX(:,:)=MAX(ZSHMIX(:,:),50.0)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HBLTOP', &
+ CSTDNAME = 'atmosphere_boundary_layer_thickness', &
+ CLONGNAME = 'HBLTOP', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Height of Boundary Layer TOP', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSHMIX)
+ !
+ DEALLOCATE(ZSHMIX)
+ELSEIF (CBLTOP == 'RICHA') THEN
+ !
+ ! methode du "bulk Richardson number"
+ !
+ ALLOCATE(ZRIB(IIU,IJU,IKU))
+ ALLOCATE(ZSHMIX(IIU,IJU))
+
+ ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
+ ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2)
+ ZWORK32=MXF(XUT)
+ ZWORK33=MYF(XVT)
+ ZWORK34=ZWORK32**2+ZWORK33**2
+ DO JK=IKB,IKE
+ ZRIB(:,:,JK)=XG*ZWORK31(:,:,JK)*(ZTHETAV(:,:,JK)-ZTHETAV(:,:,IKB))/(ZTHETAV(:,:,IKB)*ZWORK34(:,:,JK))
+ ENDDO
+ ZSHMIX=0.0
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ DO JK=IKB,IKE
+ IF ( ZRIB(JI,JJ,JK).GT.0.25 ) THEN
+ ZSHMIX(JI,JJ) = ZWORK31(JI,JJ,JK-1) &
+ +( ZWORK31(JI,JJ,JK) - ZWORK31(JI,JJ,JK-1) ) &
+ *( 0.25 - ZRIB(JI,JJ,JK-1) ) &
+ /( ZRIB(JI,JJ,JK) - ZRIB(JI,JJ,JK-1) )
+ EXIT
+ END IF
+ END DO
+ END DO
+ END DO
+ ZSHMIX(:,:)=ZSHMIX(:,:)-XZS(:,:)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HBLTOP', &
+ CSTDNAME = 'atmosphere_boundary_layer_thickness', &
+ CLONGNAME = 'HBLTOP', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Height of Boundary Layer TOP', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSHMIX)
+ !
+ DEALLOCATE(ZRIB,ZSHMIX)
+ENDIF
+!
+IF (ALLOCATED(ZTHETAV)) DEALLOCATE(ZTHETAV)
+!
+!
+!* Ligthning
+!
+IF ( LCH_CONV_LINOX ) THEN
+ CALL IO_Field_write(TPFILE,'IC_RATE', XIC_RATE)
+ CALL IO_Field_write(TPFILE,'CG_RATE', XCG_RATE)
+ CALL IO_Field_write(TPFILE,'IC_TOTAL_NB',XIC_TOTAL_NUMBER)
+ CALL IO_Field_write(TPFILE,'CG_TOTAL_NB',XCG_TOTAL_NUMBER)
+END IF
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+!* 1.8 My own variables :
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+END SUBROUTINE WRITE_LFIFM1_FOR_DIAG
diff --git a/src/PHYEX/ext/write_lfifm1_for_diag_supp.f90 b/src/PHYEX/ext/write_lfifm1_for_diag_supp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..380dc9fd629a10d16c344098535ea0a109226bd3
--- /dev/null
+++ b/src/PHYEX/ext/write_lfifm1_for_diag_supp.f90
@@ -0,0 +1,1664 @@
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################################
+ MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
+! ######################################
+INTERFACE
+!
+ SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP(TPFILE)
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+END SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP
+!
+END INTERFACE
+!
+END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
+!
+! ##############################################
+ SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP(TPFILE)
+! ##############################################
+!
+!!**** *WRITE_LFIFM1_FOR_DIAG_SUPP* - write records in the diag file
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to write in the file
+! of name YFMFILE//'.lfi' with the FM routines.
+!
+!!** METHOD
+!! ------
+!! The data are written in the LFIFM file :
+!! - diagnostics from the convection
+!! - diagnostics from the radiatif transfer code
+!!
+!! The localization on the model grid is also indicated :
+!! IGRID = 1 for mass grid point
+!! IGRID = 2 for U grid point
+!! IGRID = 3 for V grid point
+!! IGRID = 4 for w grid point
+!! IGRID = 0 for meaningless case
+!!
+!! EXTERNAL
+!! --------
+!! FMWRIT : FM-routine to write a record
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! J. Stein *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/09/00
+!! N. Asencio 15/09/00 computation of temperature and height of clouds is moved
+!! here and deleted in WRITE_LFIFM1_FOR_DIAG routine
+!! I. Mallet 02/11/00 add the call to RADTR_SATEL
+!! J.-P. Chaboureau 11/12/03 add call the CALL_RTTOV (table NRTTOVINFO to
+!! choose the platform, the satellite, the sensor for all channels
+!! (see the table in rttov science and validation report) and the
+!! type of calculations in the namelist: 0 = tb, 1 = tb + jacobian,
+!! 2 = tb + adjoint, 3 = tb + jacobian + adjoint)
+!! V. Masson 01/2004 removes surface (externalization)
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! October 2011 (C.Lac) FF10MAX : interpolation of 10m wind
+!! between 2 Meso-NH levels if 10m is above the first atmospheric level
+!! 2015 : D.Ricard add UM10/VM10 for LCARTESIAN=T cases
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! P.Tulet : Diag for salt and orilam
+!! J.-P. Chaboureau 07/03/2016 fix the dimensions of local arrays
+!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
+!! J.-P. Chaboureau 31/10/2016 add the call to RTTOV11
+!! F. Brosse 10/2016 add chemical production destruction terms outputs
+!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
+!! J.-P. Chaboureau 01/2018 add altitude interpolation
+!! J.-P. Chaboureau 01/2018 add coarse graining
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.-P. Chaboureau 07/2018 bug fix on XEMIS when calling CALL_RTTOVxx
+!! J.-P. Chaboureau 09/04/2021 add the call to RTTOV13
+! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
+!! D. Ricard & Q.Rodier 08/2023 add some diagnostics on pressure levels
+!! (temperature, relative and specific humidity, vertical velocity, TKE)
+!! D. Ricard 08/2023 add a diagnostic: maximum of cloud fraction on vertical levels
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_CH_BUDGET_n, ONLY: CNAMES_BUDGET, NEQ_BUDGET, XTCHEM
+USE MODD_CH_FLX_n, ONLY: XCHFLX
+USE MODD_CH_PRODLOSSTOT_n, ONLY: CNAMES_PRODLOSST, NEQ_PLT, XLOSS, XPROD
+USE MODD_CST, ONLY: XCPD, XP00, XRD, XTT, XMV, XMD, XALPI, XGAMI, XBETAI
+USE MODD_CURVCOR_n, ONLY: XCORIOZ
+USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_ZON10M, XCURRENT_MER10M, &
+ XCURRENT_SFCO2, XCURRENT_SWD, XCURRENT_LWD, &
+ XCURRENT_SWU, XCURRENT_LWU
+USE MODD_DUST, ONLY: LDUST
+use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
+ tfieldmetadata, tfieldlist, TYPEINT, TYPEREAL
+use modd_field
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_CONF, ONLY: LCARTESIAN
+USE MODD_CONF_n, ONLY: LUSERC, LUSERI, LUSERV, NRR
+USE MODD_DEEP_CONVECTION_n, ONLY: NCLBASCONV, NCLTOPCONV, XCAPE, XDMFCONV, XDRCCONV, XDRICONV, XDRVCONV, &
+ XDTHCONV, XDSVCONV, XMFCONV, XPRLFLXCONV, XPRSFLXCONV, XUMFCONV
+USE MODD_DIAG_FLAG, ONLY: CRAD_SAT, LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
+ NCONV_KF, NDXCOARSE, NRAD_3D, NRTTOVINFO, XISOAL, XISOPR, XISOTH
+USE MODD_FIELD_n, ONLY: XCLDFR, XICEFR, XPABST, XSIGS, XTHT, XTKET, XRT, XUT, XVT, XWT
+USE MODD_GRID_n, ONLY: XZHAT, XZZ
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
+USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
+USE MODD_NSV, ONLY: NSV, NSV_CHEMBEG, NSV_CHEMEND, TSVLIST
+USE MODD_PARAMETERS, ONLY: JPVEXT, NUNDEF, XUNDEF
+USE MODD_PARAM_KAFR_n, ONLY: LCHTRANS
+USE MODD_PARAM_n, ONLY: CRAD, CSURF, CCLOUD
+USE MODD_PARAM_RAD_n, only: NRAD_COLNBR
+USE MODD_RADIATIONS_N, ONLY: NCLEARCOL_TM1, NDLON, NFLEV, NSTATM, &
+ XAER, XAZIM, XCCO2, XDIR_ALB, XDIRFLASWD, XDIRSRFSWD, XDTHRAD, XEMIS, &
+ XFLALWD, XSCA_ALB, XSCAFLASWD, XSTATM, XTSRAD, XZENITH
+USE MODD_RAD_TRANSF, ONLY: JPGEOST
+USE MODD_REF_n, ONLY: XRHODREF
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TIME_n, ONLY: TDTCUR
+USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
+
+use mode_field, only: Find_field_id_from_mnhname
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_NEIGHBORAVG, ONLY: BLOCKAVG, MOVINGAVG
+USE MODE_THERMO, ONLY: SM_FOES
+USE MODE_TOOLS_LL, ONLY: GET_INDICE_ll
+
+#ifdef MNH_RTTOV_8
+USE MODI_CALL_RTTOV8
+#endif
+#ifdef MNH_RTTOV_11
+USE MODI_CALL_RTTOV11
+#endif
+#ifdef MNH_RTTOV_13
+USE MODI_CALL_RTTOV13
+#endif
+USE MODI_GET_SURF_UNDEF
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_UV
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_PINTER
+USE MODI_SHUMAN
+USE MODI_RADTR_SATEL
+USE MODI_UV_TO_ZONAL_AND_MERID
+USE MODI_ZINTER
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
+INTEGER :: IKRAD
+!
+INTEGER :: JI,JJ,JK,JSV,JRR ! loop index
+!
+! variables for Diagnostic variables related to deep convection
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK21,ZWORK22
+!
+! variables for computation of temperature and height of clouds
+REAL :: ZCLMR ! value of mixing ratio tendency for detection of cloud top
+LOGICAL, DIMENSION(:,:), ALLOCATABLE :: GMASK2
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWORK1, IWORK2
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ICL_HE_ST
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK31,ZTEMP
+!
+! variables needed for the transfer radiatif diagnostic code
+INTEGER :: ITOTGEO
+INTEGER, DIMENSION (JPGEOST) :: INDGEO
+CHARACTER(LEN=8), DIMENSION (JPGEOST) :: YNAM_SAT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZIRBT, ZWVBT
+REAL :: ZUNDEF ! undefined value in SURFEX
+!
+! variables needed for 10m wind
+INTEGER :: ILEVEL
+!
+INTEGER :: IPRES, ITH
+CHARACTER(LEN=4) :: YCAR4
+CHARACTER(LEN=4), DIMENSION(SIZE(XISOPR)) :: YPRES
+CHARACTER(LEN=4), DIMENSION(SIZE(XISOTH)) :: YTH
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH, &
+ ZRT,ZQV,ZMRVP,ZWRES1,ZTEMPP
+REAL, DIMENSION(:), ALLOCATABLE :: ZTH
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPOVO
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCORIOZ
+TYPE(TFIELDMETADATA) :: TZFIELD
+TYPE(TFIELDMETADATA), DIMENSION(2) :: TZFIELD2
+!
+! variables needed for altitude interpolation
+INTEGER :: IAL
+REAL :: ZFILLVAL
+REAL, DIMENSION(:), ALLOCATABLE :: ZAL
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWAL
+!
+! variables needed for coarse graining
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZUT_PRM,ZVT_PRM,ZWT_PRM
+REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZUU_AVG,ZVV_AVG,ZWW_AVG
+INTEGER :: IDX, IID, IRESP
+CHARACTER(LEN=3) :: YDX
+!-------------------------------------------------------------------------------
+!
+!* 0. ARRAYS BOUNDS INITIALIZATION
+!
+IIU=SIZE(XTHT,1)
+IJU=SIZE(XTHT,2)
+IKU=SIZE(XTHT,3)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=IKU-JPVEXT
+!
+ALLOCATE(ZWORK21(IIU,IJU))
+ALLOCATE(ZWORK31(IIU,IJU,IKU))
+ALLOCATE(ZTEMP(IIU,IJU,IKU))
+ZTEMP(:,:,:)=XTHT(:,:,:)*(XPABST(:,:,:)/ XP00) **(XRD/XCPD)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DIAGNOSTIC RELATED TO CONVECTION
+! --------------------------------
+!
+!* Diagnostic variables related to deep convection
+!
+IF (NCONV_KF >= 0) THEN
+ CALL IO_Field_write(TPFILE,'CAPE',XCAPE)
+!
+ ! top height (km) of convective clouds
+ ZWORK21(:,:)= 0.
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (NCLTOPCONV(JI,JJ)/=0) ZWORK21(JI,JJ)= XZZ(JI,JJ,NCLTOPCONV(JI,JJ))/1.E3
+ END DO
+ END DO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLTOPCONV', &
+ CSTDNAME = 'convective_cloud_top_altitude', &
+ CLONGNAME = 'CLTOPCONV', &
+ CUNITS = 'km', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Top of Convective Cloud', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+!
+ ! base height (km) of convective clouds
+ ZWORK21(:,:)= 0.
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (NCLBASCONV(JI,JJ)/=0) ZWORK21(JI,JJ)= XZZ(JI,JJ,NCLBASCONV(JI,JJ))/1.E3
+ END DO
+ END DO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLBASCONV', &
+ CSTDNAME = 'convective_cloud_base_altitude', &
+ CLONGNAME = 'CLBASCONV', &
+ CUNITS = 'km', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Base of Convective Cloud', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+END IF
+
+IF (NCONV_KF >= 1) THEN
+ CALL IO_Field_write(TPFILE,'DTHCONV',XDTHCONV)
+ CALL IO_Field_write(TPFILE,'DRVCONV',XDRVCONV)
+ CALL IO_Field_write(TPFILE,'DRCCONV',XDRCCONV)
+ CALL IO_Field_write(TPFILE,'DRICONV',XDRICONV)
+!
+ IF ( LCHTRANS .AND. NSV > 0 ) THEN
+ ! scalar variables are recorded
+ ! individually in the file
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for DSVCONV', & !Temporary name to ease identification
+ CUNITS = 's-1', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+
+ DO JSV = 1, NSV
+ TZFIELD%CMNHNAME = 'DSVCONV_' // TRIM( TSVLIST(JSV)%CMNHNAME )
+ TZFIELD%CLONGNAME = 'DSVCONV_' // TRIM( TSVLIST(JSV)%CLONGNAME )
+ TZFIELD%CCOMMENT = 'Convective tendency for ' // TRIM( TSVLIST(JSV)%CMNHNAME )
+ CALL IO_Field_write( TPFILE, TZFIELD, XDSVCONV(:,:,:,JSV) )
+ END DO
+ END IF
+END IF
+
+IF (NCONV_KF >= 2) THEN
+ CALL IO_Field_write(TPFILE,'PRLFLXCONV',XPRLFLXCONV)
+ CALL IO_Field_write(TPFILE,'PRSFLXCONV',XPRSFLXCONV)
+ CALL IO_Field_write(TPFILE,'UMFCONV', XUMFCONV)
+ CALL IO_Field_write(TPFILE,'DMFCONV', XDMFCONV)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* Height and temperature of clouds top
+!
+IF (LCLD_COV .AND. LUSERC) THEN
+ ALLOCATE(IWORK1(IIU,IJU),IWORK2(IIU,IJU))
+ ALLOCATE(ICL_HE_ST(IIU,IJU))
+ ALLOCATE(GMASK2(IIU,IJU))
+ ALLOCATE(ZWORK22(IIU,IJU))
+!
+! Explicit clouds
+!
+ ICL_HE_ST(:,:)=IKB !initialization
+ IWORK1(:,:)=IKB ! with the
+ IWORK2(:,:)=IKB ! ground values
+ ZCLMR=1.E-4 ! detection of clouds for cloud mixing ratio > .1g/kg
+!
+ GMASK2(:,:)=.TRUE.
+ ZWORK31(:,:,:)= MZM( XRT(:,:,:,2) ) ! cloud mixing ratio at zz levels
+ DO JK=IKE,IKB,-1
+ WHERE ( (GMASK2(:,:)).AND.(ZWORK31(:,:,JK)>ZCLMR) )
+ GMASK2(:,:)=.FALSE.
+ IWORK1(:,:)=JK
+ END WHERE
+ END DO
+!
+ IF (LUSERI) THEN
+ GMASK2(:,:)=.TRUE.
+ ZWORK31(:,:,:)= MZM( XRT(:,:,:,4) ) ! cloud mixing ratio at zz levels
+ DO JK=IKE,IKB,-1
+ WHERE ( (GMASK2(:,:)).AND.(ZWORK31(:,:,JK)>ZCLMR) )
+ GMASK2(:,:)=.FALSE.
+ IWORK2(:,:)=JK
+ END WHERE
+ END DO
+ END IF
+!
+ ZWORK21(:,:)=0.
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ICL_HE_ST(JI,JJ)=MAX(IWORK1(JI,JJ),IWORK2(JI,JJ) )
+ ZWORK21(JI,JJ) =XZZ(JI,JJ,ICL_HE_ST(JI,JJ)) ! height (m) of explicit clouds
+ END DO
+ END DO
+!
+ WHERE ( ZWORK21(:,:)==XZZ(:,:,IKB) ) ZWORK21=0. ! set the height to
+ ! 0 if there is no cloud
+ ZWORK21(:,:)=ZWORK21(:,:)/1.E3 ! height (km) of explicit clouds
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HECL', &
+ CSTDNAME = '', &
+ CLONGNAME = 'HECL', &
+ CUNITS = 'km', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Height of Explicit CLoud top', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+!
+! Higher top of the different species of clouds
+!
+ IWORK1(:,:)=IKB ! initialization with the ground values
+ ZWORK31(:,:,:)=MZM(ZTEMP(:,:,:)) ! temperature (K) at zz levels
+ IF(CRAD/='NONE') ZWORK31(:,:,IKB)=XTSRAD(:,:)
+ ZWORK21(:,:)=0.
+ ZWORK22(:,:)=0.
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IWORK1(JI,JJ)=ICL_HE_ST(JI,JJ)
+ IF (NCONV_KF >=0) &
+ IWORK1(JI,JJ)= MAX(ICL_HE_ST(JI,JJ),NCLTOPCONV(JI,JJ))
+ ZWORK21(JI,JJ)= XZZ(JI,JJ,IWORK1(JI,JJ)) ! max. cloud height (m)
+ ZWORK22(JI,JJ)= ZWORK31(JI,JJ,IWORK1(JI,JJ))-XTT ! cloud temperature (C)
+ END DO
+ END DO
+!
+ IF (NCONV_KF <0) THEN
+ PRINT*,'YOU DO NOT ASK FOR CONVECTIVE DIAGNOSTICS (NCONV_KF<0), SO'
+ PRINT*,' HC not written in FM-file (equal to HEC)'
+ ELSE
+ WHERE ( ZWORK21(:,:)==XZZ(:,:,IKB) ) ZWORK21(:,:)=0. ! set the height to
+ ! 0 if there is no cloud
+ ZWORK21(:,:)=ZWORK21(:,:)/1.E3 ! max. cloud height (km)
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'HCL', &
+ CSTDNAME = 'cloud_top_altitude', &
+ CLONGNAME = 'HCL', &
+ CUNITS = 'km', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Height of CLoud top', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ ENDIF
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TCL', &
+ CSTDNAME = 'air_temperature_at_cloud_top', &
+ CLONGNAME = 'TCL', &
+ CUNITS = 'celsius', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Height of CLoud top', &
+ NGRID = 4, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
+!
+ CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR)
+ CALL IO_Field_write(TPFILE,'ICEFR',XICEFR)
+!
+ ZWORK21(:,:)=0.0
+ ZWORK21(IIB:IIE,IJB:IJE)=MAXVAL(XCLDFR(IIB:IIE,IJB:IJE,JPVEXT+1:IKE),DIM=3)
+
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'CLDFRMAX', &
+ !Invalid CF convention standard name: CSTDNAME = 'max_cloud_fraction', &
+ CLONGNAME = 'CLDFRMAX', &
+ CUNITS = '1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_MAx of CLoud fraction', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ !
+! Visibility
+!
+ ZWORK31(:,:,:)= 1.E4 ! 10 km for clear sky
+ WHERE (XRT(:,:,:,2) > 0.)
+ ZWORK31(:,:,:)=3.9E3/(144.7*(XRHODREF(:,:,:)*1.E3*XRT(:,:,:,2)/(1.+XRT(:,:,:,2)))**0.88)
+ END WHERE
+!
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VISI_HOR', &
+ CSTDNAME = 'visibility_in_air', &
+ CLONGNAME = 'VISI_HOR', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_VISI_HOR', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!
+ DEALLOCATE(IWORK1,IWORK2,ICL_HE_ST,GMASK2,ZWORK22)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. DIAGNOSTIC RELATED TO RADIATIONS
+! --------------------------------
+!
+IF (NRAD_3D >= 0) THEN
+ IF (CRAD /= 'NONE') THEN
+ CALL IO_Field_write(TPFILE,'DTHRAD', XDTHRAD)
+ CALL IO_Field_write(TPFILE,'FLALWD', XFLALWD)
+ CALL IO_Field_write(TPFILE,'DIRFLASWD', XDIRFLASWD)
+ CALL IO_Field_write(TPFILE,'SCAFLASWD', XSCAFLASWD)
+ CALL IO_Field_write(TPFILE,'DIRSRFSWD', XDIRSRFSWD)
+ CALL IO_Field_write(TPFILE,'CLEARCOL_TM1',NCLEARCOL_TM1)
+ CALL IO_Field_write(TPFILE,'ZENITH', XZENITH)
+ CALL IO_Field_write(TPFILE,'AZIM', XAZIM)
+ CALL IO_Field_write(TPFILE,'DIR_ALB', XDIR_ALB)
+ CALL IO_Field_write(TPFILE,'SCA_ALB', XSCA_ALB)
+ !
+ CALL PRINT_MSG(NVERB_INFO,'IO','WRITE_LFIFM1_FOR_DIAG_SUPP','EMIS: writing only first band')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP)
+ TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
+ TZFIELD%NDIMS = 2
+ TZFIELD%NDIMLIST(3) = TZFIELD%NDIMLIST(4)
+ TZFIELD%NDIMLIST(4) = NMNHDIM_UNUSED
+ CALL IO_Field_write(TPFILE,TZFIELD,XEMIS(:,:,1))
+ !
+ CALL IO_Field_write(TPFILE,'TSRAD', XTSRAD)
+ ELSE
+ PRINT*,'YOU WANT DIAGNOSTICS RELATED TO RADIATION'
+ PRINT*,' BUT NO RADIATIVE SCHEME WAS ACTIVATED IN THE MODEL'
+ END IF
+END IF
+IF (NRAD_3D >= 1) THEN
+ IF (LDUST) THEN
+!Dust optical depth between two vertical levels
+ ZWORK31(:,:,:)=0.
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK31(:,:,JK)= XAER(:,:,IKRAD,3)
+ END DO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'DSTAOD3D', &
+ CSTDNAME = '', &
+ CLONGNAME = 'DSTAOD3D', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_DuST Aerosol Optical Depth', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!Dust optical depth
+ ZWORK21(:,:)=0.0
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZWORK21(JI,JJ)=ZWORK21(JI,JJ)+XAER(JI,JJ,IKRAD,3)
+ ENDDO
+ ENDDO
+ ENDDO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'DSTAOD2D', &
+ CSTDNAME = '', &
+ CLONGNAME = 'DSTAOD2D', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_DuST Aerosol Optical Depth', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+!Dust extinction (optical depth per km)
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK31(:,:,JK)= XAER(:,:,IKRAD,3)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
+ ENDDO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'DSTEXT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'DSTEXT', &
+ CUNITS = 'km-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_DuST EXTinction', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END IF
+ IF (LSALT) THEN
+!Salt optical depth between two vertical levels
+ ZWORK31(:,:,:)=0.
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK31(:,:,JK)= XAER(:,:,IKRAD,2)
+ END DO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SLTAOD3D', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SLTAOD3D', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Salt Aerosol Optical Depth', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!Salt optical depth
+ ZWORK21(:,:)=0.0
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZWORK21(JI,JJ)=ZWORK21(JI,JJ)+XAER(JI,JJ,IKRAD,2)
+ ENDDO
+ ENDDO
+ ENDDO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SLTAOD2D', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SLTAOD2D', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Salt Aerosol Optical Depth', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+!Salt extinction (optical depth per km)
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK31(:,:,JK)= XAER(:,:,IKRAD,2)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
+ ENDDO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SLTEXT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SLTEXT', &
+ CUNITS = 'km-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Salt EXTinction', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END IF
+ IF (LORILAM) THEN
+!Orilam anthropogenic optical depth between two vertical levels
+ ZWORK31(:,:,:)=0.
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK31(:,:,JK)= XAER(:,:,IKRAD,4)
+ END DO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'AERAOD3D', &
+ CSTDNAME = '', &
+ CLONGNAME = 'AERAOD3D', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Anthropogenic Aerosol Optical Depth', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!Orilam anthropogenic optical depth
+ ZWORK21(:,:)=0.0
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ZWORK21(JI,JJ)=ZWORK21(JI,JJ)+XAER(JI,JJ,IKRAD,4)
+ ENDDO
+ ENDDO
+ ENDDO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'AERAOD2D', &
+ CSTDNAME = '', &
+ CLONGNAME = 'AERAOD2D', &
+ CUNITS = 'm', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Anthropogenic Aerosol Optical Depth', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+!Orilam anthropogenic extinction (optical depth per km)
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK31(:,:,JK)= XAER(:,:,IKRAD,4)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
+ ENDDO
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'AEREXT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'AEREXT', &
+ CUNITS = 'km-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Z_Anthropogenic EXTinction', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+! Net surface gaseous fluxes
+IF (LCHEMDIAG) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for net chemical flux', & !Temporary name to ease identification
+ CUNITS = 'ppb m s-1', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ !
+ DO JSV = NSV_CHEMBEG, NSV_CHEMEND
+ TZFIELD%CMNHNAME = 'FLX_' // TRIM( TSVLIST(JSV)%CMNHNAME )
+ TZFIELD%CLONGNAME = 'FLX_' // TRIM( TSVLIST(JSV)%CLONGNAME )
+ WRITE(TZFIELD%CCOMMENT,'(A6,A,A)')'X_Y_Z_',TRIM( TSVLIST(JSV)%CMNHNAME ),' Net chemical flux'
+ CALL IO_Field_write(TPFILE,TZFIELD,XCHFLX(:,:,JSV-NSV_CHEMBEG+1) * 1E9)
+ END DO
+END IF
+!-------------------------------------------------------------------------------
+!
+!* Brightness temperatures from the radiatif transfer code (Morcrette, 1991)
+!
+IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. NRR /=0) THEN
+ ALLOCATE (ZIRBT(IIU,IJU),ZWVBT(IIU,IJU))
+ ITOTGEO=0
+ IF (INDEX(CRAD_SAT,'GOES-E') /= 0) THEN
+ ITOTGEO= ITOTGEO+1
+ INDGEO(ITOTGEO) = 1
+ YNAM_SAT(ITOTGEO) = 'GOES-E'
+ END IF
+ IF (INDEX(CRAD_SAT,'GOES-W') /= 0) THEN
+ ITOTGEO= ITOTGEO+1
+ INDGEO(ITOTGEO) = 2
+ YNAM_SAT(ITOTGEO) = 'GOES-W'
+ END IF
+ IF (INDEX(CRAD_SAT,'GMS') /= 0) THEN
+ ITOTGEO= ITOTGEO+1
+ INDGEO(ITOTGEO) = 3
+ YNAM_SAT(ITOTGEO) = 'GMS'
+ END IF
+ IF (INDEX(CRAD_SAT,'INDSAT') /= 0) THEN
+ ITOTGEO= ITOTGEO+1
+ INDGEO(ITOTGEO) = 4
+ YNAM_SAT(ITOTGEO) = 'INDSAT'
+ END IF
+ IF (INDEX(CRAD_SAT,'METEOSAT') /= 0) THEN
+ ITOTGEO= ITOTGEO+1
+ INDGEO(ITOTGEO) = 5
+ YNAM_SAT(ITOTGEO) = 'METEOSAT'
+ END IF
+ PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURES FOR ',ITOTGEO,' SATELLITE(S)'
+ IF (NRR==1) THEN
+ PRINT*,' THERE IS ONLY VAPOR WATER IN YOUR ATMOSPHERE'
+ PRINT*,' IRBT WILL NOT TAKE INTO ACCOUNT CLOUDS.'
+ END IF
+ !
+ DO JI=1,ITOTGEO
+ ZIRBT(:,:) = XUNDEF
+ ZWVBT(:,:) = XUNDEF
+ CALL RADTR_SATEL( TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
+ NDLON, NFLEV, NSTATM, NRAD_COLNBR, XEMIS(:,:,1), &
+ XCCO2, XTSRAD, XSTATM, XTHT, XRT, XPABST, XZZ, &
+ XSIGS, XMFCONV, MAX(XCLDFR,XICEFR), LUSERI, LSIGMAS, &
+ LSUBG_COND, LRAD_SUBG_COND, ZIRBT, ZWVBT, &
+ INDGEO(JI), VSIGQSAT )
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = TRIM(YNAM_SAT(JI))//'_IRBT', &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM(YNAM_SAT(JI))//'_IRBT', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = TRIM(YNAM_SAT(JI))//' Infra-Red Brightness Temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZIRBT)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = TRIM(YNAM_SAT(JI))//'_WVBT', &
+ CSTDNAME = '', &
+ CLONGNAME = TRIM(YNAM_SAT(JI))//'_WVBT', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = TRIM(YNAM_SAT(JI))//' Water-Vapor Brightness Temperature', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWVBT)
+ END DO
+ DEALLOCATE(ZIRBT,ZWVBT)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* Brightness temperatures from the Radiatif Transfer for Tiros Operational
+! Vertical Sounder (RTTOV) code
+!
+IF (NRTTOVINFO(1,1) /= NUNDEF) THEN
+! PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURE COMPUTED BY THE RTTOV CODE'
+#if defined(MNH_RTTOV_8)
+ CALL CALL_RTTOV8(NDLON, NFLEV, NSTATM, XEMIS(:,:,1), XTSRAD, XSTATM, XTHT, XRT, &
+ XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
+ LUSERI, NRTTOVINFO, TPFILE )
+#elif defined(MNH_RTTOV_11)
+ CALL CALL_RTTOV11(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
+ XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
+ LUSERI, NRTTOVINFO, TPFILE )
+#elif defined(MNH_RTTOV_13)
+ CALL CALL_RTTOV13(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
+ XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
+ LUSERI, NRTTOVINFO, TPFILE )
+#else
+PRINT *, "RTTOV LIBRARY NOT AVAILABLE = ###CALL_RTTOV####"
+#endif
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. DIAGNOSTIC RELATED TO SURFACE
+! -----------------------------
+!
+IF (CSURF=='EXTE') THEN
+!! Since SURFEX7 (masdev49) XCURRENT_ZON10M and XCURRENT_MER10M
+!! are equal to XUNDEF of SURFEX if the first atmospheric level
+!! is under 10m
+ CALL GET_SURF_UNDEF(ZUNDEF)
+!
+ ILEVEL=IKB
+ !While there are XUNDEF values and we aren't at model's top
+ DO WHILE(ANY(XCURRENT_ZON10M(IIB:IIE,IJB:IJE)==ZUNDEF) .AND. (ILEVEL/=IKE-1) )
+
+ !Where interpolation is needed and possible
+ !(10m is between ILEVEL and ILEVEL+1 or 10m is below the bottom level)
+ WHERE(XCURRENT_ZON10M(IIB:IIE,IJB:IJE)==ZUNDEF .AND. &
+ ( XZHAT(ILEVEL+1) + XZHAT(ILEVEL+2)) /2. >10.)
+
+ !Interpolation between ILEVEL and ILEVEL+1
+ XCURRENT_ZON10M(IIB:IIE,IJB:IJE)=XUT(IIB:IIE,IJB:IJE,ILEVEL) + &
+ (XUT(IIB:IIE,IJB:IJE,ILEVEL+1)-XUT(IIB:IIE,IJB:IJE,ILEVEL)) * &
+ ( 10.- (XZHAT(ILEVEL)+XZHAT(ILEVEL+1))/2. ) / &
+ ( (XZHAT(ILEVEL+2)-XZHAT(ILEVEL)) /2.)
+ XCURRENT_MER10M(IIB:IIE,IJB:IJE)=XVT(IIB:IIE,IJB:IJE,ILEVEL) + &
+ (XVT(IIB:IIE,IJB:IJE,ILEVEL+1)-XVT(IIB:IIE,IJB:IJE,ILEVEL)) * &
+ (10.- (XZHAT(ILEVEL)+XZHAT(ILEVEL+1))/2. ) / &
+ ( (XZHAT(ILEVEL+2)-XZHAT(ILEVEL)) /2.)
+ END WHERE
+ ILEVEL=ILEVEL+1 !level just higher
+ END DO
+ !
+ ! in this case (argument KGRID=0), input winds are ZONal and MERidian
+ ! and, output ones are in MesoNH grid
+ IF (.NOT. LCARTESIAN) THEN
+ TZFIELD2(1) = TFIELDMETADATA( &
+ CMNHNAME = 'UM10', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM10', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Zonal wind at 10m', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ !
+ TZFIELD2(2) = TFIELDMETADATA( &
+ CMNHNAME = 'VM10', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM10', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Meridian wind at 10m', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ !
+ CALL UV_TO_ZONAL_AND_MERID(XCURRENT_ZON10M,XCURRENT_MER10M,KGRID=0,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
+ ELSE
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'UM10', &
+ CSTDNAME = '', &
+ CLONGNAME = 'UM10', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Zonal wind at 10m', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_ZON10M)
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'VM10', &
+ CSTDNAME = '', &
+ CLONGNAME = 'VM10', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'Meridian wind at 10m', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_MER10M)
+ ENDIF
+ !
+ IF (SIZE(XTKET)>0) THEN
+ ZWORK21(:,:) = SQRT(XCURRENT_ZON10M(:,:)**2+XCURRENT_MER10M(:,:)**2)
+ ZWORK21(:,:) = ZWORK21(:,:) + 4. * SQRT(XTKET(:,:,IKB))
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'FF10MAX', &
+ CSTDNAME = '', &
+ CLONGNAME = 'FF10MAX', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_FF10MAX', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
+ END IF
+ !
+ IF(ANY(XCURRENT_SFCO2/=XUNDEF))THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SFCO2', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SFCO2', &
+ CUNITS = 'mg m-2 s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'CO2 Surface flux', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SFCO2)
+ END IF
+ !
+ IF ( CRAD /= 'NONE' ) THEN
+ IF(ANY(XCURRENT_SWD/=XUNDEF))THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SWD', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SWD', &
+ CUNITS = 'W m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = 'incoming ShortWave at the surface', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SWD)
+ END IF
+ !
+ IF(ANY(XCURRENT_SWU/=XUNDEF))THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'SWU', &
+ CSTDNAME = '', &
+ CLONGNAME = 'SWU', &
+ CUNITS = 'W m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = 'outcoming ShortWave at the surface', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SWU)
+ END IF
+!
+ IF(ANY(XCURRENT_LWD/=XUNDEF))THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'LWD', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LWD', &
+ CUNITS = 'W m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = 'incoming LongWave at the surface', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_LWD)
+ END IF
+!
+ IF(ANY(XCURRENT_LWU/=XUNDEF))THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'LWU', &
+ CSTDNAME = '', &
+ CLONGNAME = 'LWU', &
+ CUNITS = 'W m-2', &
+ CDIR = 'XY', &
+ CCOMMENT = 'outcoming LongWave at the surface', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_LWU)
+ END IF
+ END IF ! CRAD/='NONE'
+END IF
+
+! MODIF FP NOV 2012
+!-------------------------------------------------------------------------------
+!
+!* 4. DIAGNOSTIC ON PRESSURE LEVELS
+! -----------------------------
+!
+IF (LISOPR .AND. XISOPR(1)/=0.) THEN
+!
+!
+ALLOCATE(ZWORK32(IIU,IJU,IKU))
+ALLOCATE(ZWORK33(IIU,IJU,IKU))
+ALLOCATE(ZWORK34(IIU,IJU,IKU))
+!
+! *************************************************
+! Determine the pressure level where to interpolate
+! *************************************************
+ IPRES=0
+ DO JI=1,SIZE(XISOPR)
+ IF (XISOPR(JI)<=10..OR.XISOPR(JI)>1000.) EXIT
+ IPRES=IPRES+1
+ WRITE(YCAR4,'(I4)') INT(XISOPR(JI))
+ YPRES(IPRES)=ADJUSTL(YCAR4)
+ END DO
+
+ ALLOCATE(ZWRES(IIU,IJU,IPRES))
+ ALLOCATE(ZTEMPP(IIU,IJU,IPRES))
+ ZWRES(:,:,:)=XUNDEF
+ ALLOCATE(ZPRES(IIU,IJU,IPRES))
+ IPRES=0
+ DO JI=1,SIZE(XISOPR)
+ IF (XISOPR(JI)<=10..OR.XISOPR(JI)>1000.) EXIT
+ IPRES=IPRES+1
+ ZPRES(:,:,IPRES)=XISOPR(JI)*100.
+ END DO
+ PRINT *,'PRESSURE LEVELS WHERE TO INTERPOLATE=',ZPRES(1,1,:)
+ !
+ TZFIELD = TFIELDMETADATA(&
+ CMNHNAME = 'variables at pressure levels', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ !
+!
+!* Standard Variables
+!
+! *********************
+! Potential Temperature
+! *********************
+ CALL PINTER(XTHT, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'THT'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'K'
+ TZFIELD%CCOMMENT = 'X_Y_potential temperature '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+! *********************
+! Temperature
+! *********************
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'TEMP'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'K'
+ TZFIELD%CCOMMENT = 'X_Y_air temperature '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*(ZPRES(:,:,JK)/XP00)**(XRD/XCPD))
+ END DO
+ ZTEMPP(:,:,:)=ZWRES(:,:,:)
+! *********************
+! Wind
+! *********************
+ ZWORK31(:,:,:) = MXF(XUT(:,:,:))
+ CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'UT'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CCOMMENT = 'X_Y_U component of wind '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ !
+ ZWORK31(:,:,:) = MYF(XVT(:,:,:))
+ CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'VT'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ !
+ ZWORK31(:,:,:) = MZF(XWT(:,:,:))
+ CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'WT'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+! *********************
+! Turbulent kinetic energy
+! *********************
+ CALL PINTER(XTKET, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'TKET'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm 2 s-2'
+ TZFIELD%CCOMMENT = 'X_Y_turbulent kinetic energy '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+! *********************
+! Water Vapour Mixing Ratio
+! *********************
+ CALL PINTER(XRT(:,:,:,1), XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'MRV'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Vapor Mixing Ratio '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*1.E3)
+ END DO
+!
+! *********************
+! Relative humidity
+! *********************
+ IF (LUSERV) THEN
+ ALLOCATE(ZWRES1(IIU,IJU,IPRES))
+ ALLOCATE(ZMRVP(IIU,IJU,IPRES))
+ ZMRVP(:,:,:)=ZWRES(:,:,:)
+ ZWRES1(:,:,:)=SM_FOES(ZTEMPP(:,:,:))
+ ZWRES1(:,:,:)=(XMV/XMD)*ZWRES1(:,:,:)/(ZPRES(:,:,:)-ZWRES1(:,:,:))
+ ZWRES(:,:,:)=100.*ZMRVP(:,:,:)/ZWRES1(:,:,:)
+ IF (CCLOUD(1:3) =='ICE' .OR. CCLOUD =='C3R5' .OR. CCLOUD == 'LIMA') THEN
+ WHERE ( ZTEMPP(:,:,:)< XTT)
+ ZWRES1(:,:,:) = EXP( XALPI - XBETAI/ZTEMPP(:,:,:) &
+ - XGAMI*ALOG(ZTEMPP(:,:,:)) ) !saturation over ice
+ ZWRES1(:,:,:)=(XMV/XMD)*ZWRES1(:,:,:)/(ZPRES(:,:,:)-ZWRES1(:,:,:))
+ ZWRES(:,:,:)=100.*ZMRVP(:,:,:)/ZWRES1(:,:,:)
+ END WHERE
+ END IF
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'REHU'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'percent'
+ TZFIELD%CCOMMENT = 'X_Y_Relative humidity '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ DEALLOCATE(ZWRES1,ZMRVP,ZTEMPP)
+ END IF
+ !
+ ALLOCATE(ZRT(IIU,IJU,IKU))
+ ALLOCATE(ZQV(IIU,IJU,IKU))
+ ZRT(:,:,:)=0.
+ DO JRR=1,NRR
+ ZRT(:,:,:) = ZRT(:,:,:) + XRT(:,:,:,JRR)
+ END DO
+ ZQV(:,:,:) = XRT(:,:,:,1) / (1.0 + ZRT(:,:,:))
+ ! *********************
+ ! Water specific humidity
+ ! *********************
+ CALL PINTER(ZQV, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'QV'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CCOMMENT = 'X_Y_Vapor Specific humidity '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+ DEALLOCATE(ZRT,ZQV)
+! *********************
+! Geopotential in meters
+! *********************
+ ZWORK31(:,:,:) = MZF(XZZ(:,:,:))
+ CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
+ IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
+ DO JK=1,IPRES
+ TZFIELD%CMNHNAME = 'ALT'//TRIM(YPRES(JK))//'HPA'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CCOMMENT = 'X_Y_ALTitude '//TRIM(YPRES(JK))//' hPa'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ END DO
+!
+ DEALLOCATE(ZWRES,ZPRES,ZWORK32,ZWORK33,ZWORK34)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. DIAGNOSTIC ON POTENTIEL TEMPERATURE LEVELS
+! -----------------------------
+!
+IF (LISOTH .AND.XISOTH(1)/=0.) THEN
+!
+!
+ALLOCATE(ZWORK32(IIU,IJU,IKU))
+ALLOCATE(ZWORK33(IIU,IJU,IKU))
+ALLOCATE(ZWORK34(IIU,IJU,IKU))
+!
+! *************************************************
+! Determine the potentiel temperature level where to interpolate
+! *************************************************
+ ITH=0
+ DO JI=1,SIZE(XISOTH)
+ IF (XISOTH(JI)<=100..OR.XISOTH(JI)>1000.) EXIT
+ ITH=ITH+1
+ WRITE(YCAR4,'(I4)') INT(XISOTH(JI))
+ YTH(ITH)=ADJUSTL(YCAR4)
+ END DO
+
+ ALLOCATE(ZWTH(IIU,IJU,ITH))
+ ZWTH(:,:,:)=XUNDEF
+ ALLOCATE(ZTH(ITH))
+ ZTH(:) = XISOTH(1:ITH)
+
+ PRINT *,'POTENTIAL TEMPERATURE LEVELS WHERE TO INTERPOLATE=',ZTH(:)
+ !
+ TZFIELD = TFIELDMETADATA(&
+ CMNHNAME = 'variables at pot. temp. levels', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 2, &
+ LTIMEDEP = .TRUE. )
+ !
+!
+!* Standard Variables
+!
+! *********************
+! Pressure
+! *********************
+ CALL ZINTER(XPABST, XTHT, ZWTH, ZTH, IIU, IJU, IKU, IKB, ITH, XUNDEF)
+ DO JK=1,ITH
+ TZFIELD%CMNHNAME = 'PABST'//TRIM(YTH(JK))//'K'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'Pa'
+ TZFIELD%CCOMMENT = 'X_Y_pressure '//TRIM(YTH(JK))//' K'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
+ END DO
+! *********************
+! Potential Vorticity
+! *********************
+ ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
+ ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
+ ZVOX(:,:,2)=ZVOX(:,:,3)
+ ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
+ ZVOY(:,:,2)=ZVOY(:,:,3)
+ ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
+ ZVOZ(:,:,2)=ZVOZ(:,:,3)
+ ZVOZ(:,:,1)=ZVOZ(:,:,3)
+ ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
+ ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
+ ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
+ ZPOVO(:,:,1) =-1.E+11
+ ZPOVO(:,:,IKU)=-1.E+11
+ CALL ZINTER(ZPOVO, XTHT, ZWTH, ZTH, IIU, IJU, IKU, IKB, ITH, XUNDEF)
+ DO JK=1,ITH
+ TZFIELD%CMNHNAME = 'POVOT'//TRIM(YTH(JK))//'K'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'PVU'
+ TZFIELD%CCOMMENT = 'X_Y_POtential VOrticity '//TRIM(YTH(JK))//' K'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
+ END DO
+! *********************
+! Wind
+! *********************
+ ZWORK31(:,:,:) = MXF(XUT(:,:,:))
+ CALL ZINTER(ZWORK31, XTHT, ZWTH, ZTH, IIU, IJU, IKU, IKB, ITH, XUNDEF)
+ DO JK=1,ITH
+ TZFIELD%CMNHNAME = 'UT'//TRIM(YTH(JK))//'K'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CCOMMENT = 'X_Y_U component of wind '//TRIM(YTH(JK))//' K'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
+ END DO
+ !
+ ZWORK31(:,:,:) = MYF(XVT(:,:,:))
+ CALL ZINTER(ZWORK31, XTHT, ZWTH, ZTH, IIU, IJU, IKU, IKB, ITH, XUNDEF)
+ DO JK=1,ITH
+ TZFIELD%CMNHNAME = 'VT'//TRIM(YTH(JK))//'K'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YTH(JK))//' K'
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
+ END DO
+!
+ DEALLOCATE(ZWTH,ZTH,ZWORK32,ZWORK33,ZWORK34)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 6. DIAGNOSTIC ON ALTITUDE LEVELS
+! -----------------------------
+!
+IF (LISOAL .AND.XISOAL(1)/=0.) THEN
+!
+!
+ ZFILLVAL = -99999.
+ ALLOCATE(ZWORK32(IIU,IJU,IKU))
+ ALLOCATE(ZWORK33(IIU,IJU,IKU))
+!
+! *************************************************
+! Determine the altitude level where to interpolate
+! *************************************************
+ IAL=0
+ DO JI=1,SIZE(XISOAL)
+ IF (XISOAL(JI)<0.) EXIT
+ IAL=IAL+1
+ END DO
+ ALLOCATE(ZWAL(IIU,IJU,IAL))
+ ZWAL(:,:,:)=XUNDEF
+ ALLOCATE(ZAL(IAL))
+ ZAL(:) = XISOAL(1:IAL)
+ PRINT *,'ALTITUDE LEVELS WHERE TO INTERPOLATE=',ZAL(:)
+! *********************
+! Altitude
+! *********************
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_ALT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_ALT', &
+ CUNITS = 'm', &
+ CDIR = '--', &
+ CCOMMENT = 'Z_alt ALT', &
+ NGRID = 0, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 1, &
+ LTIMEDEP = .FALSE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZAL)
+!
+!* Standard Variables
+!
+! *********************
+! Cloud
+! *********************
+ ZWORK31(:,:,:) = 0.
+ IF (SIZE(XRT,4) >= 2) ZWORK31(:,:,:) = XRT(:,:,:,2) ! Rc
+ IF (SIZE(XRT,4) >= 4) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,4) !Ri
+ ZWORK31(:,:,:) = ZWORK31(:,:,:)*1.E3
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_CLOUD', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_CLOUD', &
+ CUNITS = 'g kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_cloud ALT', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Precipitation
+! *********************
+ ZWORK31(:,:,:) = 0.
+ IF (SIZE(XRT,4) >= 3) ZWORK31(:,:,:) = XRT(:,:,:,3) ! Rr
+ IF (SIZE(XRT,4) >= 5) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,5) !Rsnow
+ IF (SIZE(XRT,4) >= 6) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,6) !Rgraupel
+ IF (SIZE(XRT,4) >= 7) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,7) !Rhail
+ ZWORK31(:,:,:) = ZWORK31(:,:,:)*1.E3
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_PRECIP', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_PRECIP', &
+ CUNITS = 'g kg-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_precipitation ALT', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Potential temperature
+! *********************
+ CALL ZINTER(XTHT, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_THETA', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_THETA', &
+ CUNITS = 'K', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_potential temperature ALT', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Pressure
+! *********************
+ CALL ZINTER(XPABST, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_PRESSURE', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_PRESSURE', &
+ CUNITS = 'Pa', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_pressure ALT', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Potential Vorticity
+! *********************
+ ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
+ ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
+ ZVOX(:,:,2)=ZVOX(:,:,3)
+ ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
+ ZVOY(:,:,2)=ZVOY(:,:,3)
+ ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
+ ZVOZ(:,:,2)=ZVOZ(:,:,3)
+ ZVOZ(:,:,1)=ZVOZ(:,:,3)
+ ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
+ ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
+ + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
+ ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
+ ZPOVO(:,:,1) =-1.E+11
+ ZPOVO(:,:,IKU)=-1.E+11
+ CALL ZINTER(ZPOVO, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_PV', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_PV', &
+ CUNITS = 'PVU', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_Potential Vorticity ALT', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Wind
+! *********************
+ ZWORK31(:,:,:) = MXF(XUT(:,:,:))
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_U', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_U', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_U component of wind ALT', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+ !
+ ZWORK31(:,:,:) = MYF(XVT(:,:,:))
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_V', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_V', &
+ CUNITS = 'm s-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_V component of wind ALT', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Dust extinction (optical depth per km)
+! *********************
+ IF (NRAD_3D >= 1.AND.LDUST) THEN
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK31(:,:,JK)= XAER(:,:,IKRAD,3)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
+ ENDDO
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'ALT_DSTEXT', &
+ CSTDNAME = '', &
+ CLONGNAME = 'ALT_DSTEXT', &
+ CUNITS = 'km-1', &
+ CDIR = 'XY', &
+ CCOMMENT = 'X_Y_DuST EXTinction ALT', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+ END IF
+!
+! *********************
+ DEALLOCATE(ZWAL,ZAL,ZWORK32,ZWORK33)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. COARSE GRAINING DIAGNOSTIC
+! --------------------------
+!
+IF (LCOARSE) THEN
+ IDX = NDXCOARSE
+!-------------------------------
+! AVERAGE OF TKE BY BLOCK OF IDX POINTS
+ CALL BLOCKAVG(XUT,IDX,IDX,ZWORK31)
+ ZUT_PRM=XUT-ZWORK31
+ CALL BLOCKAVG(XVT,IDX,IDX,ZWORK31)
+ ZVT_PRM=XVT-ZWORK31
+ CALL BLOCKAVG(XWT,IDX,IDX,ZWORK31)
+ ZWT_PRM=XWT-ZWORK31
+!
+ ZWORK31=MXF(ZUT_PRM*ZUT_PRM)
+ CALL BLOCKAVG(ZWORK31,IDX,IDX,ZUU_AVG)
+ ZWORK31=MYF(ZVT_PRM*ZVT_PRM)
+ CALL BLOCKAVG(ZWORK31,IDX,IDX,ZVV_AVG)
+ ZWORK31=MZF(ZWT_PRM*ZWT_PRM)
+ CALL BLOCKAVG(ZWORK31,IDX,IDX,ZWW_AVG)
+ CALL BLOCKAVG(XTKET,IDX,IDX,ZWORK31)
+ ZWORK31=0.5*( ZUU_AVG+ZVV_AVG+ZWW_AVG ) + ZWORK31
+ WRITE (YDX,FMT='(I3.3)') IDX
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TKEBAVG'//YDX, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TKEBAVG'//YDX, &
+ CUNITS = 'm2 s-2', &
+ CDIR = 'XY', &
+ CCOMMENT = 'TKE_BLOCKAVG'//YDX, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+!---------------------------------
+! MOVING AVERAGE OF TKE OVER IDX+1 POINTS
+ IDX = IDX/2
+ CALL MOVINGAVG(XUT,IDX,IDX,ZWORK31)
+ ZUT_PRM=XUT-ZWORK31
+ CALL MOVINGAVG(XVT,IDX,IDX,ZWORK31)
+ ZVT_PRM=XVT-ZWORK31
+ CALL MOVINGAVG(XWT,IDX,IDX,ZWORK31)
+ ZWT_PRM=XWT-ZWORK31
+!
+ ZWORK31=MXF(ZUT_PRM*ZUT_PRM)
+ CALL MOVINGAVG(ZWORK31,IDX,IDX,ZUU_AVG)
+ ZWORK31=MYF(ZVT_PRM*ZVT_PRM)
+ CALL MOVINGAVG(ZWORK31,IDX,IDX,ZVV_AVG)
+ ZWORK31=MZF(ZWT_PRM*ZWT_PRM)
+ CALL MOVINGAVG(ZWORK31,IDX,IDX,ZWW_AVG)
+ CALL MOVINGAVG(XTKET,IDX,IDX,ZWORK31)
+ ZWORK31=0.5*( ZUU_AVG+ZVV_AVG+ZWW_AVG ) + ZWORK31
+ WRITE (YDX,FMT='(I3.3)') 2*IDX+1
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'TKEMAVG'//YDX, &
+ CSTDNAME = '', &
+ CLONGNAME = 'TKEMAVG'//YDX, &
+ CUNITS = 'm2 s-2', &
+ CDIR = 'XY', &
+ CCOMMENT = 'TKE_MOVINGAVG'//YDX, &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. DIAGNOSTIC RELATED TO CHEMISTRY
+! -------------------------------
+!
+IF (NEQ_BUDGET>0) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for CNAMES_BUDGET', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CUNITS = 'ppv s-1', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 4, &
+ LTIMEDEP = .TRUE. )
+ !
+ DO JSV = 1, NEQ_BUDGET
+ TZFIELD%CMNHNAME = TRIM(CNAMES_BUDGET(JSV))//'_BUDGET'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_BUDGET(JSV))//'_BUDGET'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTCHEM(JSV)%XB_REAC(:,:,:,:))
+ END DO
+ !
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for reaction list', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CUNITS = '', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEINT, &
+ NDIMS = 1, &
+ LTIMEDEP = .TRUE. )
+ !
+ DO JSV=1, NEQ_BUDGET
+ TZFIELD%CMNHNAME = TRIM(CNAMES_BUDGET(JSV))//'_CHREACLIST'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CCOMMENT = TRIM(CNAMES_BUDGET(JSV))//'_REACTION_LIST'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTCHEM(JSV)%NB_REAC(:))
+ END DO
+END IF
+!
+!
+! chemical prod/loss terms
+IF (NEQ_PLT>0) THEN
+ TZFIELD = TFIELDMETADATA( &
+ CMNHNAME = 'generic for CNAMES_PRODLOSST', & !Temporary name to ease identification
+ CSTDNAME = '', &
+ CUNITS = 'ppv s-1', &
+ CDIR = 'XY', &
+ NGRID = 1, &
+ NTYPE = TYPEREAL, &
+ NDIMS = 3, &
+ LTIMEDEP = .TRUE. )
+ !
+ DO JSV = 1, NEQ_PLT
+ TZFIELD%CMNHNAME = TRIM(CNAMES_PRODLOSST(JSV))//'_PROD'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_PRODLOSST(JSV))//'_PROD'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPROD(:,:,:,JSV))
+ !
+ TZFIELD%CMNHNAME = TRIM(CNAMES_PRODLOSST(JSV))//'_LOSS'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_PRODLOSST(JSV))//'_LOSS'
+ CALL IO_Field_write(TPFILE,TZFIELD,XLOSS(:,:,:,JSV))
+ END DO
+END IF
+!
+!
+DEALLOCATE(ZWORK21,ZWORK31,ZTEMP)
+!
+END SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP
diff --git a/src/PHYEX/ext/xy_to_latlon.f90 b/src/PHYEX/ext/xy_to_latlon.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9effbed461cfe363dbffd7da68038ce37bd3763e
--- /dev/null
+++ b/src/PHYEX/ext/xy_to_latlon.f90
@@ -0,0 +1,204 @@
+!MNH_LIC Copyright 1996-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ PROGRAM XY_TO_LATLON
+! ####################
+!
+!!**** *XY_TO_LATLON* program to compute latitude and longiude from x and y
+!! for a MESONH file
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! module MODE_GRIDPROJ : contains projection routines
+!! SM_LATLON and SM_XYHAT
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! module MODD_GRID : variables for projection:
+!! XLAT0,XLON0,XRPK,XBETA
+!!
+!! module MODD_PGDDIM : specify the dimentions of the data arrays:
+!! NPGDIMAX and NPGDJMAX
+!!
+!! module MODD_PGDGRID : grid variables:
+!! XPGDLONOR,XPGDLATOR: longitude and latitude of the
+!! origine point for the conformal projection.
+!! XPGDXHAT,XPGDYHAT: position x,y in the conformal plane
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 26/01/96
+!!
+!! no transfer of the file when closing Dec. 09, 1996 (V.Masson)
+!! + changes call to READ_HGRID
+! 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 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 14/04/2020: add missing initializations (XY_TO_LATLON was not working)
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+use MODD_CONF, only: CPROGRAM
+USE MODD_DIM_n
+USE MODD_GRID
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PGDDIM
+USE MODD_PGDGRID
+USE MODD_PARAMETERS
+USE MODD_LUNIT
+!
+USE MODE_FIELD, ONLY: INI_FIELD_LIST
+USE MODE_GRIDPROJ
+USE MODE_INIT_ll, only: SET_DIM_ll, SET_JP_ll
+USE MODE_IO, only: IO_Config_set, IO_Init
+use MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_MODELN_HANDLER, ONLY: GOTO_MODEL
+use MODE_SPLITTINGZ_ll
+!
+USE MODE_INI_CST, ONLY: INI_CST
+USE MODI_READ_HGRID
+!
+USE MODN_CONFIO, ONLY: NAM_CONFIO
+!
+IMPLICIT NONE
+!
+!* 0.2 Declaration of variables
+! ------------------------
+!
+CHARACTER(LEN=28) :: YINIFILE ! name of input FM file
+CHARACTER(LEN=28) :: YNAME ! true name of input FM file
+CHARACTER(LEN=28) :: YDAD ! name of dad of input FM file
+CHARACTER(LEN=2) :: YSTORAGE_TYPE
+INTEGER :: INAM ! Logical unit for namelist file
+INTEGER :: ILUOUT0 ! Logical unit for output file.
+INTEGER :: IRESP ! Return-code if problem eraised.
+REAL :: ZI,ZJ ! input positions of the point
+INTEGER :: II,IJ ! integer positions of the point
+REAL :: ZXHAT ! output conformal coodinate x
+REAL :: ZYHAT ! output conformal coodinate y
+REAL :: ZLAT ! output latitude
+REAL :: ZLON ! output longitude
+TYPE(TFILEDATA),POINTER :: TZINIFILE => NULL()
+TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL()
+!
+!* 0.3 Declaration of namelists
+! ------------------------
+!
+NAMELIST/NAM_INIFILE/ YINIFILE
+!----------------------------------------------------------------------------
+!
+ WRITE(*,*) '+---------------------------------+'
+ WRITE(*,*) '| program xy_to_latlon |'
+ WRITE(*,*) '+---------------------------------+'
+ WRITE(*,*) ''
+ WRITE(*,*) 'Warning: I and J are integer for flux points'
+!
+!* 1. Initializations
+! ---------------
+!
+CALL GOTO_MODEL(1)
+!
+CALL VERSION()
+!
+CPROGRAM='LAT2XY'
+!
+CALL IO_Init()
+!
+CALL INI_CST()
+!
+CALL INI_FIELD_LIST()
+!
+!* 2. Reading of namelist file
+! ------------------------
+!
+CALL IO_File_add2list(TZNMLFILE,'XY2LATLON1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE)
+INAM=TZNMLFILE%NLU
+READ(INAM,NAM_INIFILE)
+!
+READ(INAM,NAM_CONFIO)
+CALL IO_Config_set()
+CALL IO_File_close(TZNMLFILE)
+!
+!* 1. Opening of MESONH file
+! ----------------------
+!
+CALL IO_File_add2list(TZINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=2)
+CALL IO_File_open(TZINIFILE)
+!
+CALL IO_Field_read(TZINIFILE,'IMAX', NIMAX)
+CALL IO_Field_read(TZINIFILE,'JMAX', NJMAX)
+NKMAX = 1
+CALL IO_Field_read(TZINIFILE,'JPHEXT',JPHEXT)
+!
+CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DIM_ll(NIMAX, NJMAX, NKMAX)
+CALL INI_PARAZ_ll(IRESP)
+!
+!* 2. Reading of MESONH file
+! ----------------------
+!
+CALL READ_HGRID(0,TZINIFILE,YNAME,YDAD,YSTORAGE_TYPE)
+!
+!* 3. Closing of MESONH file
+! ----------------------
+!
+CALL IO_File_close(TZINIFILE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Reading of I and J
+! ------------------
+!
+DO
+ WRITE(*,*) '-------------------------------------------------------------------'
+ WRITE(*,*) 'please enter index I (real, quit or q to stop):'
+ READ(*,*,ERR=1) ZI
+ WRITE(*,*) 'please enter index J (real, quit or q to stop):'
+ READ(*,*,ERR=1) ZJ
+!
+ II=MAX(MIN(INT(ZI),NPGDIMAX+2*JPHEXT-1),1)
+ IJ=MAX(MIN(INT(ZJ),NPGDJMAX+2*JPHEXT-1),1)
+ ZXHAT=XPGDXHAT(II) + (ZI-REAL(II)) * ( XPGDXHAT(II+1) - XPGDXHAT(II) )
+ ZYHAT=XPGDYHAT(IJ) + (ZJ-REAL(IJ)) * ( XPGDYHAT(IJ+1) - XPGDYHAT(IJ) )
+!
+ WRITE(*,*) 'x=', ZXHAT
+ WRITE(*,*) 'y=', ZYHAT
+!
+ CALL SM_LATLON(XPGDLATOR,XPGDLONOR, &
+ ZXHAT,ZYHAT,ZLAT,ZLON)
+!
+ WRITE(*,*) 'lat=', ZLAT
+ WRITE(*,*) 'lon=', ZLON
+END DO
+1 WRITE(*,*) 'good bye'
+!
+!-------------------------------------------------------------------------------
+!
+END PROGRAM XY_TO_LATLON
diff --git a/src/PHYEX/ext/yomhook.f90 b/src/PHYEX/ext/yomhook.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a0b84f76453a48b91853e335a1d44433f981d457
--- /dev/null
+++ b/src/PHYEX/ext/yomhook.f90
@@ -0,0 +1,156 @@
+!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 YOMHOOK
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+LOGICAL :: LHOOK=.FALSE.
+INTEGER, PARAMETER :: JPHOOK=JPRB
+INTERFACE DR_HOOK
+MODULE PROCEDURE &
+ DR_HOOK_DEFAULT, &
+ DR_HOOK_FILE, &
+ DR_HOOK_SIZE, &
+ DR_HOOK_FILE_SIZE, &
+ DR_HOOK_MULTI_DEFAULT, &
+ DR_HOOK_MULTI_FILE, &
+ DR_HOOK_MULTI_SIZE, &
+ DR_HOOK_MULTI_FILE_SIZE
+END INTERFACE
+
+CONTAINS
+
+SUBROUTINE DR_HOOK_DEFAULT(CDNAME,KSWITCH,PKEY)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
+!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,'',0)
+END SUBROUTINE DR_HOOK_DEFAULT
+
+SUBROUTINE DR_HOOK_MULTI_DEFAULT(CDNAME,KSWITCH,PKEY)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
+!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),'',0)
+END SUBROUTINE DR_HOOK_MULTI_DEFAULT
+
+
+
+SUBROUTINE DR_HOOK_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
+!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,CDFILE,0)
+END SUBROUTINE DR_HOOK_FILE
+
+SUBROUTINE DR_HOOK_MULTI_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
+!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),CDFILE,0)
+END SUBROUTINE DR_HOOK_MULTI_FILE
+
+
+
+SUBROUTINE DR_HOOK_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
+!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,'',KSIZEINFO)
+END SUBROUTINE DR_HOOK_SIZE
+
+SUBROUTINE DR_HOOK_MULTI_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
+!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),'',KSIZEINFO)
+END SUBROUTINE DR_HOOK_MULTI_SIZE
+
+
+
+SUBROUTINE DR_HOOK_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
+!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+END SUBROUTINE DR_HOOK_FILE_SIZE
+
+SUBROUTINE DR_HOOK_MULTI_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
+!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),CDFILE,KSIZEINFO)
+END SUBROUTINE DR_HOOK_MULTI_FILE_SIZE
+
+END MODULE YOMHOOK
+!====================================================================
+SUBROUTINE DR_HOOK_DEFAULT(CDNAME,KSWITCH,PKEY)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
+!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,'',0)
+END SUBROUTINE DR_HOOK_DEFAULT
+
+SUBROUTINE DR_HOOK_MULTI_DEFAULT(CDNAME,KSWITCH,PKEY)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
+!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),'',0)
+END SUBROUTINE DR_HOOK_MULTI_DEFAULT
+
+
+
+SUBROUTINE DR_HOOK_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
+!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,CDFILE,0)
+END SUBROUTINE DR_HOOK_FILE
+
+SUBROUTINE DR_HOOK_MULTI_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
+!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),CDFILE,0)
+END SUBROUTINE DR_HOOK_MULTI_FILE
+
+
+
+SUBROUTINE DR_HOOK_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
+!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,'',KSIZEINFO)
+END SUBROUTINE DR_HOOK_SIZE
+
+SUBROUTINE DR_HOOK_MULTI_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
+!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),'',KSIZEINFO)
+END SUBROUTINE DR_HOOK_MULTI_SIZE
+
+
+
+SUBROUTINE DR_HOOK_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
+!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+END SUBROUTINE DR_HOOK_FILE_SIZE
+
+SUBROUTINE DR_HOOK_MULTI_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
+REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
+!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),CDFILE,KSIZEINFO)
+END SUBROUTINE DR_HOOK_MULTI_FILE_SIZE
+
diff --git a/src/PHYEX/ext/zoom_pgd.f90 b/src/PHYEX/ext/zoom_pgd.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2b50885c8b679b3940c28ef06825170ef5a02326
--- /dev/null
+++ b/src/PHYEX/ext/zoom_pgd.f90
@@ -0,0 +1,271 @@
+!MNH_LIC Copyright 2005-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################
+ PROGRAM ZOOM_PGD
+! ################
+!!
+!! PURPOSE
+!! -------
+!! This program zooms the physiographic data fields.
+!!
+!! METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original march 2005
+!! 10/10/2011 J.Escobar call INI_PARAZ_ll
+!! 30/03/2012 S.Bielli Add NAM_NCOUT
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! 08/07/2016 P.Wautelet Removed MNH_NCWRIT define
+!! 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
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
+USE MODD_IO, only: TFILE_OUTPUTLISTING, TFILEDATA
+USE MODD_LUNIT, ONLY : TLUOUT0, TOUTDATAFILE
+USE MODD_PARAMETERS, ONLY : XUNDEF, NUNDEF, JPVEXT, JPHEXT, JPMODELMAX
+USE MODD_PARAM_n, ONLY : CSURF
+USE MODD_DIM_n, ONLY : NIMAX, NJMAX
+USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
+use modd_precision, only: LFIINT
+!
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_POS
+USE MODE_IO, only: IO_Config_set, IO_Init
+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_MSG
+USE MODE_MODELN_HANDLER
+!
+USE MODI_READ_HGRID
+USE MODI_WRITE_HGRID
+USE MODI_SET_SUBDOMAIN
+!JUANZ
+USE MODE_SPLITTINGZ_ll
+!JUANZ
+!
+USE MODI_VERSION
+USE MODI_READ_ALL_NAMELISTS
+USE MODI_ZOOM_PGD_SURF_ATM
+USE MODI_WRITE_PGD_SURF_ATM_N
+USE MODD_MNH_SURFEX_n
+!
+USE MODN_CONFIO, ONLY : NAM_CONFIO
+USE MODE_INI_CST, ONLY: INI_CST
+!
+IMPLICIT NONE
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: IRESP ! return code for I/O
+INTEGER :: ILUOUT0
+INTEGER :: ILUNAM
+INTEGER :: IINFO_ll
+CHARACTER(LEN=28) :: CPGDFILE ! name of the PGD file
+CHARACTER(LEN=28) :: YZOOMFILE ! name of the output file
+CHARACTER(LEN=2) :: YZOOMNBR
+CHARACTER(LEN=28) :: YMY_NAME,YDAD_NAME
+CHARACTER(LEN=28) :: YPGDFILE
+CHARACTER(LEN=2) :: YSTORAGE_TYPE
+LOGICAL :: GFOUND
+INTEGER :: IXOR_DAD,IYOR_DAD ! compared to Dad file, if any
+INTEGER :: IXOR,IYOR ! given or computed
+INTEGER :: IDXRATIO,IDYRATIO
+TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL()
+TYPE(TFILEDATA),POINTER :: TZPGDFILE => NULL()
+TYPE(TFILEDATA),POINTER :: TZZOOMFILE => NULL()
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS1,ZZSMT1,ZZS2,ZZSMT2
+!
+NAMELIST/NAM_PGDFILE/CPGDFILE,YZOOMFILE,YZOOMNBR
+!------------------------------------------------------------------------------
+!
+CALL GOTO_MODEL(1)
+CALL VERSION
+CPROGRAM='ZOOMPG'
+CSTORAGE_TYPE = 'PG'
+!
+CALL INI_CST
+!
+!
+!* 1. Set default names and parallelized I/O
+! --------------------------------------
+!
+CALL IO_Init()
+!
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
+TFILE_OUTPUTLISTING => TLUOUT0
+ILUOUT0=TLUOUT0%NLU
+!
+CALL IO_File_add2list(TZNMLFILE,'PRE_ZOOM1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE)
+ILUNAM = TZNMLFILE%NLU
+!
+CPGDFILE = 'PGDFILE' ! name of the input file
+YZOOMFILE = ''
+YZOOMNBR = '00'
+CALL POSNAM( TZNMLFILE, 'NAM_PGDFILE', GFOUND )
+IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
+CALL POSNAM( TZNMLFILE, 'NAM_CONFIO', GFOUND )
+IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
+CALL IO_Config_set()
+!
+!------------------------------------------------------------------------------
+!
+!* 2. ZOOM OF PGD DOMAIN
+! ------------------
+!
+!* 2.1 Open PGD file
+! -------------
+!
+CALL IO_File_add2list(TZPGDFILE,TRIM(CPGDFILE),'PGD','READ',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=2,KLFIVERB=5)
+CALL IO_File_open(TZPGDFILE)
+!
+!* 2.2 Reading of initial grid
+! -----------------------
+!
+CALL READ_HGRID(1,TZPGDFILE,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
+!
+! NIMAX, NJMAX: size of input domain
+ALLOCATE(ZZS1 (NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
+ALLOCATE(ZZSMT1(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
+CALL IO_Field_read(TZPGDFILE,'ZS',ZZS1)
+CALL IO_Field_read(TZPGDFILE,'ZSMT',ZZSMT1)
+!
+!* 2.3 Define subdomain
+! ----------------
+!
+CALL SET_SUBDOMAIN(TZNMLFILE,TZPGDFILE,IXOR_DAD,IYOR_DAD,IXOR,IYOR,IDXRATIO,IDYRATIO)
+!
+CALL IO_File_close(TZNMLFILE)
+!
+! NIMAX, NJMAX: size of output domain
+!
+CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DAD0_ll()
+CALL SET_DIM_ll(NIMAX, NJMAX, 1)
+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+2*JPHEXT, 1)
+CALL SET_YOR_ll(1, 1)
+CALL SET_YEND_ll(NJMAX+2*JPHEXT, 1)
+CALL SET_DAD_ll(0, 1)
+!JUANZ CALL INI_PARA_ll(IINFO_ll)
+CALL INI_PARAZ_ll(IINFO_ll)
+!
+!
+!* 2.4 Writing of final grid
+! ---------------------
+!
+IF ( (LEN_TRIM(YZOOMFILE) == 0) .OR. (ADJUSTL(YZOOMFILE) == ADJUSTL(CPGDFILE)) ) THEN
+ YZOOMFILE=ADJUSTL(ADJUSTR(CPGDFILE)//'.z'//ADJUSTL(YZOOMNBR))
+END IF
+!
+CALL IO_File_add2list(TZZOOMFILE,TRIM(YZOOMFILE),'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
+!
+CALL IO_File_open(TZZOOMFILE)
+CALL WRITE_HGRID(1,TZZOOMFILE)
+!
+!* 2.5 Preparation of surface physiographic fields
+! -------------------------------------------
+!
+CALL IO_Field_read(TZPGDFILE,'SURF',CSURF)
+!
+!
+IF (CSURF=='EXTE') THEN
+ CALL SURFEX_ALLOC_LIST(1)
+ YSURF_CUR => YSURF_LIST(1)
+ CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
+ YPGDFILE = CPGDFILE
+ CPGDFILE = YZOOMFILE
+ TOUTDATAFILE => TZZOOMFILE
+ CALL GOTO_SURFEX(1)
+ CALL ZOOM_PGD_SURF_ATM(YSURF_CUR,'MESONH',YPGDFILE,'MESONH',YZOOMFILE,'MESONH')
+!
+!* 2.6 Writes the physiographic fields
+! -------------------------------
+!
+ CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
+ELSE
+ ALLOCATE(ZZS2(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
+ ZZS2(:,:)=ZZS1(IXOR:IXOR+NIMAX+2*JPHEXT-1,IYOR:IYOR+NJMAX+2*JPHEXT-1)
+ CALL IO_Field_write(TZZOOMFILE,'ZS',ZZS2)
+END IF
+!
+ALLOCATE(ZZSMT2(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
+ZZSMT2(:,:)=ZZSMT1(IXOR:IXOR+NIMAX+2*JPHEXT-1,IYOR:IYOR+NJMAX+2*JPHEXT-1)
+CALL IO_Field_write(TZZOOMFILE,'ZSMT',ZZSMT2)
+!
+!* 2.7 Write configuration variables in the output file
+! ------------------------------------------------
+!
+CALL IO_Header_write(TZZOOMFILE)
+CALL IO_Field_write(TZZOOMFILE,'DXRATIO',IDXRATIO)
+CALL IO_Field_write(TZZOOMFILE,'DYRATIO',IDYRATIO)
+CALL IO_Field_write(TZZOOMFILE,'XOR', IXOR_DAD)
+CALL IO_Field_write(TZZOOMFILE,'YOR', IYOR_DAD)
+CALL IO_Field_write(TZZOOMFILE,'L1D', L1D)
+CALL IO_Field_write(TZZOOMFILE,'L2D', L2D)
+CALL IO_Field_write(TZZOOMFILE,'PACK', LPACK)
+CALL IO_Field_write(TZZOOMFILE,'SURF', CSURF)
+CALL IO_File_close(TZZOOMFILE)
+!
+!* 2.8 Shift to new PGD file
+! ---------------------
+!
+CPGDFILE = YZOOMFILE
+!
+!------------------------------------------------------------------------------
+!
+!* 3. CLOSE PARALLELIZED I/O
+! ----------------------
+!
+CALL IO_File_close(TZPGDFILE)
+!
+WRITE(ILUOUT0,*)
+WRITE(ILUOUT0,*) '***************************'
+WRITE(ILUOUT0,*) '* ZOOM_PGD ends correctly *'
+WRITE(ILUOUT0,*) '***************************'
+!
+CALL FINALIZE_MNH()
+!
+!-------------------------------------------------------------------------------
+!
+END PROGRAM ZOOM_PGD
diff --git a/src/PHYEX/micro/LICENCE b/src/PHYEX/micro/LICENCE
new file mode 100644
index 0000000000000000000000000000000000000000..132cc3f33fa7fd4169a92b05241db59c8428a7ab
--- /dev/null
+++ b/src/PHYEX/micro/LICENCE
@@ -0,0 +1,51 @@
+Minpack Copyright Notice (1999) University of Chicago. All rights reserved
+
+Redistribution and use in source and binary forms, with or
+without modification, are permitted provided that the
+following conditions are met:
+
+1. Redistributions of source code must retain the above
+copyright notice, this list of conditions and the following
+disclaimer.
+
+2. Redistributions in binary form must reproduce the above
+copyright notice, this list of conditions and the following
+disclaimer in the documentation and/or other materials
+provided with the distribution.
+
+3. The end-user documentation included with the
+redistribution, if any, must include the following
+acknowledgment:
+
+ "This product includes software developed by the
+ University of Chicago, as Operator of Argonne National
+ Laboratory.
+
+Alternately, this acknowledgment may appear in the software
+itself, if and wherever such third-party acknowledgments
+normally appear.
+
+4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
+WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
+UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
+THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
+OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
+OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
+USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
+THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
+DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
+UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
+BE CORRECTED.
+
+5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
+HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
+ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
+INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
+ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
+PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
+SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
+(INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
+EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
+POSSIBILITY OF SUCH LOSS OR DAMAGES.
diff --git a/src/PHYEX/micro/c2r2_adjust.f90 b/src/PHYEX/micro/c2r2_adjust.f90
index c5e9d27bcd264a39895284056bb1fdaa9c22b715..7c2dc7e923d84ba8fed9e9af845fb0ef7a820bb6 100644
--- a/src/PHYEX/micro/c2r2_adjust.f90
+++ b/src/PHYEX/micro/c2r2_adjust.f90
@@ -7,6 +7,7 @@
MODULE MODI_C2R2_ADJUST
! #######################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE C2R2_ADJUST(KRR, TPFILE, HRAD, &
@@ -16,6 +17,7 @@ INTERFACE
PCCS, PSRCS, PCLDFR, PRRS )
!
USE MODD_IO, ONLY: TFILEDATA
+IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
diff --git a/src/PHYEX/micro/compute_frac_ice.func.h b/src/PHYEX/micro/compute_frac_ice.func.h
index 8c6d4e617d519e2277d3a7defe3b11c95513cafc..b425ef0f928e8829fc33f2cc8438fb2e765e8c30 100644
--- a/src/PHYEX/micro/compute_frac_ice.func.h
+++ b/src/PHYEX/micro/compute_frac_ice.func.h
@@ -2,7 +2,7 @@
!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)
+ ELEMENTAL SUBROUTINE COMPUTE_FRAC_ICE(HFRAC_ICE,NEBN,PFRAC_ICE,PT,KERR)
! ******* TO BE INCLUDED IN THE *CONTAINS* OF A SUBROUTINE, IN ORDER TO EASE AUTOMATIC INLINING ******
! => Don't use drHook !!!
@@ -21,13 +21,13 @@
!! R. El Khatib 12-Aug-2021 written as a include file
!
!! --------------------------------------------------------------------------
-USE MODD_NEB, ONLY : NEB_t
+USE MODD_NEB_n, 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
+TYPE(NEB_t), INTENT(IN) :: NEBN
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
@@ -39,7 +39,7 @@ INTEGER, OPTIONAL, INTENT(OUT) :: KERR ! Error code in retur
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
+ PFRAC_ICE = MAX( 0., MIN(1., (( NEBN%XTMAXMIX - PT ) / ( NEBN%XTMAXMIX - NEBN%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
diff --git a/src/PHYEX/micro/condensation.f90 b/src/PHYEX/micro/condensation.f90
index 23a7e9bb7df8697a2efb70cc7f3a693593501e00..0bcb57d47016ce2bd47ad0bbdfd42dae01547e3f 100644
--- a/src/PHYEX/micro/condensation.f90
+++ b/src/PHYEX/micro/condensation.f90
@@ -4,11 +4,11 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- SUBROUTINE CONDENSATION(D, CST, ICEP, NEB, TURBN, &
+ SUBROUTINE CONDENSATION(D, CST, ICEP, NEBN, 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, &
+ &OSIGMAS, OCND2, &
&PICLDFR, PWCLDFR, PSSIO, PSSIU, PIFR, PSIGQSAT, &
&PLV, PLS, PCPH, &
&PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -86,12 +86,11 @@
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
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_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_NEB_n, ONLY: NEB_t
USE MODD_TURB_n, ONLY: TURB_t
USE MODE_TIWMX, ONLY : ESATW, ESATI
USE MODE_ICECLOUD, ONLY : ICECLOUD
@@ -104,7 +103,7 @@ IMPLICIT NONE
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(NEB_t), INTENT(IN) :: NEBN
TYPE(TURB_t), INTENT(IN) :: TURBN
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
CHARACTER(LEN=4), INTENT(IN) :: HCONDENS
@@ -136,7 +135,6 @@ LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma
! or that from turbulence scheme
LOGICAL, INTENT(IN) :: OCND2 ! logical switch to sparate liquid and ice
! more rigid (DEFALT value : .FALSE.)
-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
@@ -189,7 +187,7 @@ REAL, DIMENSION(D%NIJT) :: ZDZ, ZARDUM, ZARDUM2, ZCLDINI
REAL :: ZDZFACT,ZDZREF
! LHGT_QS END
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: IERR
!
!
@@ -269,10 +267,7 @@ ELSE
DO JK=IKTB,IKTE
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)
-#else
CST%XCL*PRR(JIJ,JK) + &
-#endif
CST%XCI*(PRS(JIJ,JK) + PRG(JIJ,JK) )
ENDDO
ENDDO
@@ -287,14 +282,7 @@ IF ( .NOT. OSIGMAS ) THEN
END DO
END DO
! Determine tropopause/inversion height from minimum temperature
-#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 JIJ=IIJB,IIJE
@@ -357,7 +345,7 @@ DO JK=IKTB,IKTE
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
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE, NEBN, ZFRAC(JIJ), PT(JIJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
ENDDO
ENDIF
DO JIJ=IIJB,IIJE
@@ -382,18 +370,18 @@ DO JK=IKTB,IKTE
DO JIJ=IIJB,IIJE
IF (PSIGQSAT(JIJ)/=0.) THEN
ZDZFACT = 1.
- IF(LHGT_QS .AND. JK+1 <= IKTE)THEN
+ IF(NEBN%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
+ ELSEIF(NEBN%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
+ IF (NEBN%LSTATNW) THEN
ZSIGMA(JIJ) = SQRT((PSIGS(JIJ,JK))**2 + (PSIGQSAT(JIJ)*ZDZFACT*ZQSL(JIJ)*ZA(JIJ))**2)
ELSE
ZSIGMA(JIJ) = SQRT((2*PSIGS(JIJ,JK))**2 + (PSIGQSAT(JIJ)*ZQSL(JIJ)*ZA(JIJ))**2)
ENDIF
ELSE
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
ZSIGMA(JIJ) = PSIGS(JIJ,JK)
ELSE
ZSIGMA(JIJ) = 2*PSIGS(JIJ,JK)
diff --git a/src/PHYEX/micro/hypgeo.f90 b/src/PHYEX/micro/hypgeo.f90
index 0d3697f71e6843ee6e0ea044a9965de7762cd36b..378c3ce3d011fa69f9748ae882b6fb081c351f60 100644
--- a/src/PHYEX/micro/hypgeo.f90
+++ b/src/PHYEX/micro/hypgeo.f90
@@ -7,9 +7,11 @@
MODULE MODI_HYPGEO
!####################
!
+IMPLICIT NONE
INTERFACE
!
FUNCTION HYPGEO(PA,PB,PC,PF,PX) RESULT(PHYPGEO)
+IMPLICIT NONE
REAL, INTENT(IN) :: PA,PB,PC,PF
REAL, INTENT(IN) :: PX
REAL :: PHYPGEO
@@ -82,12 +84,9 @@ REAL :: PHYPGEO
!* 0.2 declarations of local variables
!
!
-INTEGER :: JN
-INTEGER :: ITMAX=100
REAL :: ZEPS,ZTEMP
-REAL :: ZFPMIN=1.E-30
REAL :: ZXH
-REAL :: ZX0,ZX1,ZZA,ZZB,ZZC,ZZD,Y(2)
+REAL :: ZX0,ZX1
!
!------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/hypser.f90 b/src/PHYEX/micro/hypser.f90
index 3a8bed13e8414d79e75eb4aa8d0b999aad0a36fb..330ba0bbecd501e68e4703a3178a2550fb497a6b 100644
--- a/src/PHYEX/micro/hypser.f90
+++ b/src/PHYEX/micro/hypser.f90
@@ -7,9 +7,11 @@
MODULE MODI_HYPSER
!####################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE HYPSER(PA,PB,PC,PX,PHYP)
+IMPLICIT NONE
REAL, INTENT(IN) :: PA,PB,PC
REAL, INTENT(IN) :: PX
REAL, INTENT(INOUT) :: PHYP
diff --git a/src/PHYEX/micro/ice_adjust.f90 b/src/PHYEX/micro/ice_adjust.f90
index e2981ff0107fa5d87b62c408022608aa35e95ca8..b480da71079ce570a02efe4b5e800f609bb1e9c6 100644
--- a/src/PHYEX/micro/ice_adjust.f90
+++ b/src/PHYEX/micro/ice_adjust.f90
@@ -4,8 +4,8 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################################################################
- SUBROUTINE ICE_ADJUST (D, CST, ICEP, NEB, TURBN, BUCONF, KRR, &
- &HFRAC_ICE, HBUNAME, OCND2, LHGT_QS, &
+ SUBROUTINE ICE_ADJUST (D, CST, ICEP, NEBN, TURBN, PARAMI, BUCONF, KRR, &
+ &HBUNAME, &
&PTSTEP, PSIGQSAT, &
&PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,&
&PPABST, PZZ, &
@@ -109,14 +109,14 @@
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE MODD_NEB, ONLY: NEB_t
+USE MODD_NEB_n, ONLY: NEB_t
USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_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 MODD_RAIN_ICE_PARAM_n, ONLY : RAIN_ICE_PARAM_t
!
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
!
@@ -131,16 +131,12 @@ IMPLICIT NONE
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(NEB_t), INTENT(IN) :: NEBN
TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
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
@@ -149,8 +145,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobia
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
+REAL, DIMENSION(MERGE(D%NIJT,0,NEBN%LSUBG_COND),&
+ MERGE(D%NKT,0,NEBN%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
@@ -220,7 +216,7 @@ INTEGER :: IKTB, IKTE, IIJB, IIJE
!
REAL, DIMENSION(D%NIJT,D%NKT) :: ZSIGS, ZSRCS
REAL, DIMENSION(D%NIJT) :: ZSIGQSAT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
@@ -311,7 +307,7 @@ DO JK=IKTB,IKTE
!
!* 5.2 compute the cloud fraction PCLDFR
!
- IF ( .NOT. TURBN%LSUBG_COND ) THEN
+ IF ( .NOT. NEBN%LSUBG_COND ) THEN
DO JIJ=IIJB,IIJE
IF (PRCS(JIJ,JK) + PRIS(JIJ,JK) > 1.E-12 / PTSTEP) THEN
PCLDFR(JIJ,JK) = 1.
@@ -322,7 +318,7 @@ DO JK=IKTB,IKTE
PSRCS(JIJ,JK) = PCLDFR(JIJ,JK)
END IF
ENDDO
- ELSE !TURBN%LSUBG_COND case
+ ELSE !NEBN%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
@@ -340,12 +336,12 @@ DO JK=IKTB,IKTE
!
IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
ZCRIAUT=ICEP%XCRIAUTC/PRHODREF(JIJ,JK)
- IF(TURBN%CSUBG_MF_PDF=='NONE')THEN
+ IF(PARAMI%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
+ ELSEIF(PARAMI%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
@@ -368,12 +364,12 @@ DO JK=IKTB,IKTE
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(PARAMI%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
+ ELSEIF(PARAMI%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
@@ -409,7 +405,7 @@ DO JK=IKTB,IKTE
(ZW1 * ZLV(JIJ,JK) + ZW2 * ZLS(JIJ,JK)) / ZCPH(JIJ,JK)
ENDDO
ENDIF
- ENDIF !TURBN%LSUBG_COND
+ ENDIF !NEBN%LSUBG_COND
ENDDO
!
IF(PRESENT(POUT_RV)) POUT_RV=ZRV
@@ -466,18 +462,18 @@ DO JK=IKTB,IKTE
ENDDO
ENDDO
!
-IF ( TURBN%LSUBG_COND ) THEN
+IF ( NEBN%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, &
+ CALL CONDENSATION(D, CST, ICEP, NEBN, TURBN, &
+ NEBN%CFRAC_ICE_ADJUST,NEBN%CCONDENS, NEBN%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, &
+ PSRCS, .TRUE., NEBN%LSIGMAS, PARAMI%LOCND2, &
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,&
@@ -492,11 +488,11 @@ ELSE
ZSIGQSAT(:)=0.
!We use ZSRCS because in Méso-NH, PSRCS can be a zero-length array in this case
!ZT is INOUT
- CALL CONDENSATION(D, CST, ICEP, NEB, TURBN, &
- HFRAC_ICE,TURBN%CCONDENS, TURBN%CLAMBDA3, &
+ CALL CONDENSATION(D, CST, ICEP, NEBN, TURBN, &
+ NEBN%CFRAC_ICE_ADJUST,NEBN%CCONDENS, NEBN%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, &
+ ZSRCS, .TRUE., .TRUE., PARAMI%LOCND2, &
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,&
diff --git a/src/PHYEX/micro/ice_adjust_elec.f90 b/src/PHYEX/micro/ice_adjust_elec.f90
index 5c8b704f97fc191e0dee9ec7d03e64b094a127af..64cdedf762c8c9bc2a02d0003385c649ce896b34 100644
--- a/src/PHYEX/micro/ice_adjust_elec.f90
+++ b/src/PHYEX/micro/ice_adjust_elec.f90
@@ -7,6 +7,7 @@
MODULE MODI_ICE_ADJUST_ELEC
! ###########################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE ICE_ADJUST_ELEC (KRR, KMI, HRAD, HTURBDIM, HSCONV, HMF_CLOUD, &
@@ -18,6 +19,7 @@ INTERFACE
PQPIT, PQPIS, PQCT, PQCS, &
PQRT, PQRS, PQIT, PQIS, PQST, PQSS, PQGT, PQGS, &
PQNIT, PQNIS, PRHT, PRHS, PQHT, PQHS )
+IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
@@ -28,7 +30,7 @@ CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
-LOGICAL :: OSIGMAS ! Switch for Sigma_s:
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
REAL, INTENT(IN) :: PTSTEP ! Double Time step
@@ -172,9 +174,9 @@ USE MODD_CST
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_RAIN_ICE_DESCR_n, ONLY : XRTMIN, XBI
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
+USE MODD_NEB_n, ONLY: NEBN
USE MODD_TURB_n, ONLY: TURBN
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
@@ -199,7 +201,7 @@ CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
-LOGICAL :: OSIGMAS ! Switch for Sigma_s:
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
REAL, INTENT(IN) :: PTSTEP ! Double Time step
@@ -385,11 +387,11 @@ DO JITER = 1, ITERMAX
ZSIGQSAT2D(:,:)=PSIGQSAT
ZW4 = 1. ! PRODREF is not used if HL variables are not present
!
- CALL CONDENSATION(D, CST, RAIN_ICE_PARAM, NEB, TURBN, &
+ CALL CONDENSATION(D, CST, RAIN_ICE_PARAMN, NEBN, 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., &
+ &OSIGMAS, .FALSE., &
&ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, ZSIGQSAT2D, &
&ZLV, ZLS, ZCPH)
!
diff --git a/src/PHYEX/micro/ini_ice_c1r3.f90 b/src/PHYEX/micro/ini_ice_c1r3.f90
index 3c4c6e266751e09f8aa78e26667b9c3d77ce2bf4..43d7c194f0aec823f993e9946451827722d5fc16 100644
--- a/src/PHYEX/micro/ini_ice_c1r3.f90
+++ b/src/PHYEX/micro/ini_ice_c1r3.f90
@@ -7,8 +7,10 @@
MODULE MODI_INI_ICE_C1R3
! ########################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE INI_ICE_C1R3 ( PTSTEP, PDZMIN, KSPLITG )
+IMPLICIT NONE
!
INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
! integration for rain
@@ -110,7 +112,7 @@ USE MODD_REF
!
use mode_msg
!
-USE MODD_RAIN_ICE_DESCR, ONLY : XFVELOS
+USE MODD_RAIN_ICE_DESCR_n, ONLY : XFVELOS
!
USE MODI_GAMMA
USE MODI_GAMMA_INC
@@ -1113,9 +1115,9 @@ CONTAINS
!
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, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PP ! order of the moment
REAL :: PMOMG ! result: moment of order ZP
!
!------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/ini_param_elec.f90 b/src/PHYEX/micro/ini_param_elec.f90
index 4b889da2e9ea859f05d5d6303ac3778b0161ca32..03bc5fc30c2dc413ea721f83cdda88a4c543ae0e 100644
--- a/src/PHYEX/micro/ini_param_elec.f90
+++ b/src/PHYEX/micro/ini_param_elec.f90
@@ -7,12 +7,14 @@
MODULE MODI_INI_PARAM_ELEC
! ##########################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVM, PRHO00, &
KRR, KND, PFDINFTY, IIU, IJU, IKU )
!
USE MODD_IO, ONLY : TFILEDATA
+IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
@@ -99,9 +101,9 @@ USE MODD_ELEC_PARAM
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, ONLY: NSV_ELECEND
USE MODD_PARAMETERS
-USE MODD_PARAM_ICE
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
+USE MODD_PARAM_ICE_n
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_PARAM_n
USE MODD_VAR_ll
!
USE MODE_IO_FIELD_READ, only: IO_Field_read
diff --git a/src/PHYEX/micro/ini_rain_c2r2.f90 b/src/PHYEX/micro/ini_rain_c2r2.f90
index b436b832df4291f0fcfe3b238435df0f4a5bc845..0989dc52dc8c64679eaaa4a718b81f54614f8f85 100644
--- a/src/PHYEX/micro/ini_rain_c2r2.f90
+++ b/src/PHYEX/micro/ini_rain_c2r2.f90
@@ -7,8 +7,10 @@
MODULE MODI_INI_RAIN_C2R2
! #########################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE INI_RAIN_C2R2 ( PTSTEP, PDZMIN, KSPLITR, HCLOUD )
+IMPLICIT NONE
!
INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
! integration for rain
@@ -619,9 +621,9 @@ CONTAINS
!
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, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PP ! order of the moment
REAL :: PMOMG ! result: moment of order ZP
!
!------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/ini_rain_ice_elec.f90 b/src/PHYEX/micro/ini_rain_ice_elec.f90
index f926dc064811621ab57deddb76b4bbbbbed435f0..3a0279455f46639c20443f68f27caa1b166700f3 100644
--- a/src/PHYEX/micro/ini_rain_ice_elec.f90
+++ b/src/PHYEX/micro/ini_rain_ice_elec.f90
@@ -7,9 +7,11 @@
MODULE MODI_INI_RAIN_ICE_ELEC
! #############################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE INI_RAIN_ICE_ELEC (KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD, &
KINTVL, PFDINFTY )
+IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
@@ -96,9 +98,9 @@ END MODULE MODI_INI_RAIN_ICE_ELEC
USE MODD_CST
USE MODD_LUNIT
USE MODD_PARAMETERS
-USE MODD_PARAM_ICE
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
+USE MODD_PARAM_ICE_n
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_PARAM_n
USE MODD_REF
USE MODD_ELEC_PARAM, ONLY : XGAMINC_RIM3, XFCI
USE MODD_ELEC_DESCR, ONLY : XFS
@@ -172,8 +174,6 @@ 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()
!
!-------------------------------------------------------------------------------
!
@@ -208,13 +208,6 @@ IF (CSEDIM == 'SPLI') THEN
END DO SPLIT
END IF
!
-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.
- CALL RAIN_ICE_DESCR_DEALLOCATE()
-END IF
-!
IF (HCLOUD == 'ICE4') THEN
CALL RAIN_ICE_DESCR_ALLOCATE(7)
ELSE IF (HCLOUD == 'ICE3') THEN
diff --git a/src/PHYEX/micro/lima.f90 b/src/PHYEX/micro/lima.f90
index 36474a920f88ec2b69ca5ca86947fa837a375b33..6665319bc5689b249629c1cf42b6ce5ded85919b 100644
--- a/src/PHYEX/micro/lima.f90
+++ b/src/PHYEX/micro/lima.f90
@@ -49,24 +49,20 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
USE MODD_CST, ONLY: CST_t
-USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
NSV_LIMA_NI, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE, &
NSV_LIMA_BEG
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
- LACTIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
+ LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
LSEDC, LSEDI, XRTMIN, XCTMIN, LDEPOC, XVDEPOC, &
NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
-USE MODD_PARAM_LIMA_COLD, ONLY: XAI, XBI
-USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XAC, XBC, XAR, XBR
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
use mode_tools, only: Countjv
USE MODE_LIMA_COMPUTE_CLOUD_FRACTIONS, ONLY: LIMA_COMPUTE_CLOUD_FRACTIONS
-USE MODE_LIMA_DROPS_TO_DROPLETS_CONV, ONLY: LIMA_DROPS_TO_DROPLETS_CONV
+
USE MODE_LIMA_INST_PROCS, ONLY: LIMA_INST_PROCS
USE MODE_LIMA_NUCLEATION_PROCS, ONLY: LIMA_NUCLEATION_PROCS
USE MODE_LIMA_SEDIMENTATION, ONLY: LIMA_SEDIMENTATION
@@ -273,13 +269,12 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZCF1D, ZIF1D, ZPF1D
! domain size and levels (AROME compatibility)
INTEGER :: KRR
! loops and packing
-INTEGER :: II, IPACK, JI, JJ, JK
+INTEGER :: II, IPACK, JI
integer :: idx
INTEGER, DIMENSION(:), ALLOCATABLE :: I1, I2, I3
! Inverse ov PTSTEP
REAL :: ZINV_TSTEP
! Work arrays
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZW3D
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: ZW2D
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZRT_SUM ! Total condensed water mr
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCPT ! Total condensed water mr
diff --git a/src/PHYEX/micro/lima_adjust.f90 b/src/PHYEX/micro/lima_adjust.f90
index abfe49fb7ebc640c3de1588cc78a245db2e6745a..4fab2b6109053a0651037d5549c914afe9f25cf5 100644
--- a/src/PHYEX/micro/lima_adjust.f90
+++ b/src/PHYEX/micro/lima_adjust.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_ADJUST
! #######################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, &
@@ -18,6 +19,7 @@ INTERFACE
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, only: NSV_LIMA_BEG
+IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
diff --git a/src/PHYEX/micro/lima_adjust_split.f90 b/src/PHYEX/micro/lima_adjust_split.f90
index e5d164e8b825675385fa1f301ef88dd305706440..5ad444ac70a7f4809ac7c52ce72aade0965e1a09 100644
--- a/src/PHYEX/micro/lima_adjust_split.f90
+++ b/src/PHYEX/micro/lima_adjust_split.f90
@@ -88,7 +88,7 @@ SUBROUTINE LIMA_ADJUST_SPLIT(D, CST, BUCONF, TBUDGETS, KBUDGETS,
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, &
NBUDGET_RC, NBUDGET_RI, NBUDGET_RV, NBUDGET_SV1, NBUMOD
USE MODD_CST, ONLY: CST_t
-USE MODD_CONF
+!USE MODD_CONF
!use modd_field, only: TFIELDDATA, TYPEREAL
!USE MODD_IO, ONLY: TFILEDATA
!USE MODD_LUNIT_n, ONLY: TLUOUT
@@ -98,15 +98,14 @@ 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_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
+USE MODD_NEB_n, ONLY: NEBN
USE MODD_TURB_n, ONLY: TURBN
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
!USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_msg
-use mode_tools, only: Countjv
!
USE MODI_CONDENSATION
USE MODE_LIMA_CCN_ACTIVATION, ONLY: LIMA_CCN_ACTIVATION
@@ -191,8 +190,7 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
PCIT, & ! Cloud ice conc. at t
!
PCCS, & ! Cloud water C. source
- PMAS, & ! Mass of scavenged AP
- PCIS ! Ice crystal C. source
+ PMAS ! Mass of scavenged AP
!
REAL, DIMENSION(:,:,:,:), ALLOCATABLE &
:: PNFS, & ! Free CCN C. source
@@ -228,11 +226,6 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2)) :: ZSIGQSAT2D
INTEGER, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) :: IVEC1
!
!INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
-INTEGER :: IKB ! K index value of the first inner mass point
-INTEGER :: IKE ! K index value of the last inner mass point
-INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
-INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
!INTEGER :: ILUOUT ! Logical unit of output listing
!
@@ -243,7 +236,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZCTMIN
!
integer :: idx
integer :: JI, JJ, JK, jl
-INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
+INTEGER :: JMOD
!
!!$TYPE(TFIELDMETADATA) :: TZFIELD
!
@@ -467,11 +460,11 @@ DO JITER =1,ITERMAX
END IF
IF (LADJ) THEN
- CALL CONDENSATION(D, CST, RAIN_ICE_PARAM, NEB, TURBN, &
+ CALL CONDENSATION(D, CST, RAIN_ICE_PARAMN, NEBN, 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.,&
+ Z_SIGS, .FALSE., PMFCONV, PCLDFR, Z_SRCS, GUSERI, G_SIGMAS, .FALSE., &
ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
ZSIGQSAT2D, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
END IF
diff --git a/src/PHYEX/micro/lima_cold.f90 b/src/PHYEX/micro/lima_cold.f90
index b4c6b16540847310eea1d18a38e22c5713e339d0..b9be5a7aca535ad2b53341b25f47060c37f61b4e 100644
--- a/src/PHYEX/micro/lima_cold.f90
+++ b/src/PHYEX/micro/lima_cold.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_COLD
! #####################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_COLD (CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
@@ -17,6 +18,7 @@ INTERFACE
!
USE MODD_NSV, only: NSV_LIMA_BEG
USE MODD_CST, ONLY: CST_t
+IMPLICIT NONE
!
TYPE(CST_t), INTENT(IN) :: CST
!
diff --git a/src/PHYEX/micro/lima_cold_hom_nucl.f90 b/src/PHYEX/micro/lima_cold_hom_nucl.f90
index cf9fbfe5898328b4b9f941a15c5a8b6fcefbb910..4971d2215a15ab383b56047f7b555abd1defbdfe 100644
--- a/src/PHYEX/micro/lima_cold_hom_nucl.f90
+++ b/src/PHYEX/micro/lima_cold_hom_nucl.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_COLD_HOM_NUCL
! ######################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, &
@@ -15,6 +16,7 @@ INTERFACE
PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
PCCT, &
PCCS, PCRS, PNFS, PCIS, PNHS )
+IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
REAL, INTENT(IN) :: PTSTEP ! Time step
diff --git a/src/PHYEX/micro/lima_cold_sedimentation.f90 b/src/PHYEX/micro/lima_cold_sedimentation.f90
index ce1e7141cb834219582687c600d947c1714ecb4d..76468f87b302ea753b5131b31f46a87c989d65e1 100644
--- a/src/PHYEX/micro/lima_cold_sedimentation.f90
+++ b/src/PHYEX/micro/lima_cold_sedimentation.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_COLD_SEDIMENTATION
! ###################################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, &
@@ -15,6 +16,7 @@ INTERFACE
PINPRS, PINPRG, PINPRH, &
PCSS, PCGS, PCHS)
!
+IMPLICIT NONE
LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
! cloud ice sedimentation
INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
diff --git a/src/PHYEX/micro/lima_cold_slow_processes.f90 b/src/PHYEX/micro/lima_cold_slow_processes.f90
index 64917a92a27c4bc1f32425e3d931f9919750fd89..364a7007f2c98d705bcfcfbb3d328b084f75678b 100644
--- a/src/PHYEX/micro/lima_cold_slow_processes.f90
+++ b/src/PHYEX/micro/lima_cold_slow_processes.f90
@@ -7,12 +7,14 @@
MODULE MODI_LIMA_COLD_SLOW_PROCESSES
! #####################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_COLD_SLOW_PROCESSES (PTSTEP, KMI, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRIS, PRSS, &
PCIT, PCIS, PCST, PCSS )
+IMPLICIT NONE
!
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KMI ! Model index
diff --git a/src/PHYEX/micro/lima_meyers.f90 b/src/PHYEX/micro/lima_meyers.f90
index 7e55e1ab7cbc257097990a208dfeebc1ecc50972..ca1c22825215509ad1cffa4097e0b5145f69ac23 100644
--- a/src/PHYEX/micro/lima_meyers.f90
+++ b/src/PHYEX/micro/lima_meyers.f90
@@ -7,12 +7,14 @@
MODULE MODI_LIMA_MEYERS
! #######################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_MEYERS (OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
PTHS, PRVS, PRCS, PRIS, &
PCCS, PCIS, PINS )
+IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
REAL, INTENT(IN) :: PTSTEP ! Time step
diff --git a/src/PHYEX/micro/lima_mixed.f90 b/src/PHYEX/micro/lima_mixed.f90
index 96fa6513876b27137b222d8b68de552fa8b65c9a..251521427ddb0bcf6772c2bf1b0741e99dc82c6d 100644
--- a/src/PHYEX/micro/lima_mixed.f90
+++ b/src/PHYEX/micro/lima_mixed.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_MIXED
! ######################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_MIXED (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
@@ -15,6 +16,7 @@ INTERFACE
PTHS, PRS, PSVS)
!
USE MODD_NSV, only: NSV_LIMA_BEG
+IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
! cloud ice sedimentation
diff --git a/src/PHYEX/micro/lima_mixed_fast_processes.f90 b/src/PHYEX/micro/lima_mixed_fast_processes.f90
index fbd6f4262aeee15270085e26359d1cf0939daf31..47b59eb8066528c40a966b9b7e176aab7649e133 100644
--- a/src/PHYEX/micro/lima_mixed_fast_processes.f90
+++ b/src/PHYEX/micro/lima_mixed_fast_processes.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_MIXED_FAST_PROCESSES
! #####################################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_MIXED_FAST_PROCESSES (PRHODREF, PZT, PPRES, PTSTEP, &
PLSFACT, PLVFACT, PKA, PDV, PCJ, &
@@ -18,6 +19,7 @@ INTERFACE
PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, &
PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
PCCS, PCRS, PCIS, PCSS, PCGS, PCHS )
+IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! RHO Dry REFerence
REAL, DIMENSION(:), INTENT(IN) :: PZT ! Temperature
diff --git a/src/PHYEX/micro/lima_mixed_slow_processes.f90 b/src/PHYEX/micro/lima_mixed_slow_processes.f90
index 609f54dd8d8f6d0a7ca7af505805ca7b9be8083f..79b664bdf2544cd2fd72296e42459a88dde45ace 100644
--- a/src/PHYEX/micro/lima_mixed_slow_processes.f90
+++ b/src/PHYEX/micro/lima_mixed_slow_processes.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
! #####################################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, PTSTEP, &
ZLSFACT, ZLVFACT, ZAI, ZCJ, &
@@ -17,6 +18,7 @@ INTERFACE
PRHODJ1D, GMICRO, PRHODJ, KMI, &
PTHS, PRVS, PRCS, PRIS, PRGS, PRHS, &
PCCS, PCIS )
+IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
diff --git a/src/PHYEX/micro/lima_mixrat_to_nconc.f90 b/src/PHYEX/micro/lima_mixrat_to_nconc.f90
index f21a1afe23918e0aaf509bdb44721646b7d1a812..854db4c89e65a0b87df300dbf69e50533f494756 100644
--- a/src/PHYEX/micro/lima_mixrat_to_nconc.f90
+++ b/src/PHYEX/micro/lima_mixrat_to_nconc.f90
@@ -6,9 +6,11 @@
! ################################
MODULE MODI_LIMA_MIXRAT_TO_NCONC
! ################################
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_MIXRAT_TO_NCONC(PPABST, PTHT, PRVT, PSVT)
!
+IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temperature
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water Vapor mix. ratio
@@ -52,7 +54,8 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, &
XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
NSPECIE, XFRAC, &
- CCCN_MODES, CIFN_SPECIES
+ CCCN_MODES, CIFN_SPECIES, &
+ PARAM_LIMA_ALLOCATE
!
IMPLICIT NONE
!
@@ -103,9 +106,9 @@ ZREHU(:,:,:) = MIN( 0.99, MAX( 0.01,ZREHU(:,:,:) ) )
! sea-salt, sulfate, hydrophilic (GADS data)
!
! NMOD_CCN=3
- IF (.NOT.(ALLOCATED(XR_MEAN_CCN))) ALLOCATE(XR_MEAN_CCN(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XLOGSIG_CCN))) ALLOCATE(XLOGSIG_CCN(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XRHO_CCN))) ALLOCATE(XRHO_CCN(NMOD_CCN))
+ IF (.NOT.(ASSOCIATED(XR_MEAN_CCN))) CALL PARAM_LIMA_ALLOCATE('XR_MEAN_CCN', NMOD_CCN)
+ IF (.NOT.(ASSOCIATED(XLOGSIG_CCN))) CALL PARAM_LIMA_ALLOCATE('XLOGSIG_CCN', NMOD_CCN)
+ IF (.NOT.(ASSOCIATED(XRHO_CCN))) CALL PARAM_LIMA_ALLOCATE('XRHO_CCN', NMOD_CCN)
IF( CCCN_MODES=='CAMS_ACC') THEN
XR_MEAN_CCN(:) = (/ 0.2E-6 , 0.5E-6 , 0.4E-6 /)
XLOGSIG_CCN(:) = (/ 0.693 , 0.476 , 0.788 /)
@@ -149,9 +152,9 @@ END DO
!
! NMOD_IFN=2
NSPECIE=4
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF (.NOT.(ASSOCIATED(XMDIAM_IFN))) CALL PARAM_LIMA_ALLOCATE('XMDIAM_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XSIGMA_IFN))) CALL PARAM_LIMA_ALLOCATE('XSIGMA_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XRHO_IFN))) CALL PARAM_LIMA_ALLOCATE('XRHO_IFN', NSPECIE)
IF( CIFN_SPECIES=='CAMS_ACC') THEN
XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.8E-6 /)
XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
@@ -162,7 +165,7 @@ END DO
XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
XRHO_IFN = (/2600., 2600., 1000., 1800./)
END IF
- IF (.NOT.(ALLOCATED(XFRAC))) ALLOCATE(XFRAC(NSPECIE,NMOD_IFN))
+ IF (.NOT.(ASSOCIATED(XFRAC))) CALL PARAM_LIMA_ALLOCATE('XFRAC', NSPECIE,NMOD_IFN)
XFRAC(1,1)=1.0
XFRAC(2,1)=0.0
XFRAC(3,1)=0.0
diff --git a/src/PHYEX/micro/lima_notadjust.f90 b/src/PHYEX/micro/lima_notadjust.f90
index 255eaa618018099ffbd634f2e738f5541e0a4479..24a052b39d199db950b8313c10a0baaed41a80a2 100644
--- a/src/PHYEX/micro/lima_notadjust.f90
+++ b/src/PHYEX/micro/lima_notadjust.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_NOTADJUST
! ##########################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE LIMA_NOTADJUST(KMI, TPFILE, HRAD, &
@@ -15,6 +16,7 @@ INTERFACE
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, only: NSV_LIMA_BEG
+IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
diff --git a/src/PHYEX/micro/lima_nucleation_procs.f90 b/src/PHYEX/micro/lima_nucleation_procs.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c239ca84cf69c23c4370c8488ee9cb6428669957
--- /dev/null
+++ b/src/PHYEX/micro/lima_nucleation_procs.f90
@@ -0,0 +1,394 @@
+!MNH_LIC Copyright 2018-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_LIMA_NUCLEATION_PROCS
+! ###############################
+!
+IMPLICIT NONE
+INTERFACE
+ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
+ PCLDFR, PICEFR, PPRCFR )
+!
+USE MODD_IO, ONLY: TFILEDATA
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom freezing
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
+!
+END SUBROUTINE LIMA_NUCLEATION_PROCS
+END INTERFACE
+END MODULE MODI_LIMA_NUCLEATION_PROCS
+! #############################################################################
+SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
+ PCLDFR, PICEFR, PPRCFR )
+! #############################################################################
+!
+!! PURPOSE
+!! -------
+!! Compute nucleation processes for the time-split version of LIMA
+!!
+!! AUTHOR
+!! ------
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+! M. Leriche 06/2019: missing update of PNFT after CCN hom. ncl.
+! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
+! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+! B. Vie 03/2022: Add option for 1-moment pristine ice
+!-------------------------------------------------------------------------------
+!
+use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
+ NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
+ NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO, NMOM_I, NMOM_C
+USE MODD_NEB_n, ONLY : LSUBG_COND
+
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+
+USE MODI_LIMA_CCN_ACTIVATION
+USE MODI_LIMA_CCN_HOM_FREEZING
+USE MODI_LIMA_MEYERS_NUCLEATION
+USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
+USE MODE_RAIN_ICE_NUCLEATION
+!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
+!
+!-------------------------------------------------------------------------------
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZTHS, ZRIS, ZRVS, ZRHT, ZCIT, ZT
+!
+integer :: idx
+INTEGER :: JL
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 .AND. NMOM_C.GE.2) THEN
+
+ IF (.NOT.LSUBG_COND .AND. .NOT.LSPRO) THEN
+
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ CALL LIMA_CCN_ACTIVATION( TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ END IF
+
+ WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
+
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_sv ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
+ Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ if (nmom_c.ge.2) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
+ CALL LIMA_MEYERS_NUCLEATION (PTSTEP, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
+ Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+ !
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if (nmod_ifn > 0 ) &
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+ z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ if (nmom_c.ge.2) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if (nmod_ifn > 0 ) &
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
+ -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LCOLD .AND. LNUCL .AND. NMOM_I.EQ.1) THEN
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+ !
+ ZTHS=PTHT/PTSTEP
+ ZRVS=PRVT/PTSTEP
+ ZRIS=PRIT/PTSTEP
+ ZRHT=0.
+ ZCIT=PCIT
+ ZT=PT
+ CALL RAIN_ICE_NUCLEATION(1+JPHEXT, SIZE(PT,1)-JPHEXT, 1+JPHEXT, SIZE(PT,2)-JPHEXT, 1+JPVEXT, SIZE(PT,3)-JPVEXT, 6, &
+ PTSTEP, PTHT, PPABST, PRHODJ, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ ZCIT, PEXNREF, ZTHS, ZRVS, ZRIS, ZT, ZRHT)
+ !
+! Z_TH_HIND=ZTHS*PTSTEP-PTHT
+! Z_RI_HIND=ZRIS*PTSTEP-PRIT
+! Z_CI_HIND=ZCIT-PCIT
+ PCIT=ZCIT
+ PRIT=ZRIS*PTSTEP
+ PTHT=ZTHS*PTSTEP
+ PRVT=ZRVS*PTSTEP
+! Z_TH_HINC=0.
+! Z_RC_HINC=0.
+! Z_CC_HINC=0.
+! !
+! if ( lbu_enable ) then
+! if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( lbudget_sv ) then
+! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! if (nmod_ifn > 0 ) &
+! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+! z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+! end if
+!
+! if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if ( lbudget_sv ) then
+! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! if (nmod_ifn > 0 ) &
+! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
+! -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+! end if
+! end if
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF ( LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1 .AND. NMOM_I.GE.2) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
+
+ CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, PNFT, PNHT, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_NUCLEATION_PROCS
diff --git a/src/PHYEX/micro/lima_phillips.f90 b/src/PHYEX/micro/lima_phillips.f90
index 2374f6725e657d915e3dce6501dab6ff527b0025..a2fb7d4ed358b40b14e2f32f95a528cf1a346fb3 100644
--- a/src/PHYEX/micro/lima_phillips.f90
+++ b/src/PHYEX/micro/lima_phillips.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_PHILLIPS
! #########################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_PHILLIPS (CST, OHHONI, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
@@ -16,6 +17,7 @@ INTERFACE
PNAS, PIFS, PINS, PNIS )
!
USE MODD_CST, ONLY: CST_t
+IMPLICIT NONE
TYPE(CST_t), INTENT(IN) :: CST
!
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
diff --git a/src/PHYEX/micro/lima_precip_scavenging.f90 b/src/PHYEX/micro/lima_precip_scavenging.f90
index ef8e03cf87cab141c05eeff43dd1aa52a02206bd..78d415912605c585c35ffe75c47985db47629aa2 100644
--- a/src/PHYEX/micro/lima_precip_scavenging.f90
+++ b/src/PHYEX/micro/lima_precip_scavenging.f90
@@ -5,7 +5,7 @@
!-----------------------------------------------------------------
!########################################################################
SUBROUTINE LIMA_PRECIP_SCAVENGING (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ HCLOUD, CDCONF, KLUOUT, KTCOUNT, PTSTEP, &
PRRT, PRHODREF, PRHODJ, PZZ, &
PPABST, PTHT, PSVT, PRSVS, PINPAP )
!########################################################################x
@@ -86,7 +86,7 @@ USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC,
XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
NMOD_CCN, XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
XALPHAR, XNUR, &
- LAERO_MASS, NDIAMR, NDIAMP, XT0SCAV, XTREF, XNDO, &
+ LAERO_MASS, NDIAMR, NDIAMP, XT0SCAV, XTREF, &
XMUA0, XT_SUTH_A, XMFPA0, XVISCW, XRHO00, &
XRTMIN, XCTMIN
USE MODD_PARAM_LIMA_WARM, ONLY: XCR, XDR
@@ -108,6 +108,7 @@ TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
+CHARACTER(LEN=5), INTENT(IN) :: CDCONF ! CCONF from MODD_CONF
INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
REAL, INTENT(IN) :: PTSTEP ! Double timestep except
@@ -135,7 +136,7 @@ INTEGER :: IKB !
INTEGER :: IKE !
!
INTEGER :: JSV ! CCN or IFN mode
-INTEGER :: J1, J2, IJ, JMOD
+INTEGER :: J1, J2, JMOD
!
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: GRAIN, &! Test where rain is present
@@ -148,7 +149,6 @@ REAL :: ZDENS_RATIO, & !density ratio
ZNUM, & !PNU-1.
ZSHAPE_FACTOR
!
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZW ! work array
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: PCRT ! cloud droplet conc.
!
REAL, DIMENSION(:), ALLOCATABLE :: ZLAMBDAR, & !slope parameter of the
@@ -189,7 +189,6 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOL_EF, &! Collision efficiency
ZSIZE_RATIO, &! Size Ratio
ZST ! Stokes number
!
-REAL, DIMENSION(SIZE(PRRT,1),SIZE(PRRT,2),SIZE(PRRT,3)) :: ZRRS
!
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: PMEAN_SCAV_COEF, & !Mean Scavenging
@@ -500,7 +499,7 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
IF (LAERO_MASS)THEN
PTOT_MASS_RATE(:,:,:) = PTOT_MASS_RATE(:,:,:) + &
UNPACK(ZTOT_MASS_RATE(:), MASK=GSCAV(:,:,:), FIELD=0.0)
- CALL SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ, &
+ CALL SCAV_MASS_SEDIMENTATION( HCLOUD, CDCONF, PTSTEP, KTCOUNT, PZZ, PRHODJ, &
PRHODREF, PRRT, PSVT(:,:,:,ISV_LIMA_SCAVMASS),&
PRSVS(:,:,:,ISV_LIMA_SCAVMASS), PINPAP )
PRSVS(:,:,:,ISV_LIMA_SCAVMASS)=PRSVS(:,:,:,ISV_LIMA_SCAVMASS) + &
@@ -576,7 +575,7 @@ CONTAINS
!
!------------------------------------------------------------------------------
! ##########################################################################
- SUBROUTINE SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ,&
+ SUBROUTINE SCAV_MASS_SEDIMENTATION( HCLOUD, CDCONF, PTSTEP, KTCOUNT, PZZ, PRHODJ,&
PRHODREF, PRAIN, PSVT_MASS, PRSVS_MASS, PINPAP )
! ##########################################################################
!
@@ -599,8 +598,6 @@ CONTAINS
!! Module MODD_PARAMETERS
!! JPHEXT : Horizontal external points number
!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
!!
!! REFERENCE
!! ---------
@@ -620,7 +617,6 @@ CONTAINS
! ------------
!
USE MODD_PARAMETERS
-USE MODD_CONF
!
USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN
USE MODD_PARAM_LIMA_WARM, ONLY : XBR, XDR, XFSEDRR
@@ -631,6 +627,7 @@ IMPLICIT NONE
!
!
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+CHARACTER(LEN=5), INTENT(IN) :: CDCONF
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KTCOUNT ! Current time step number
!
@@ -645,7 +642,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: JJ, JK, JN, JRR ! Loop indexes
+INTEGER :: JK, JN ! Loop indexes
INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
!
REAL :: ZTSPLITR ! Small time step for rain sedimentation
@@ -712,7 +709,7 @@ END IF firstcall
!
!* 2.2 time splitting loop initialization
!
-IF( (KTCOUNT==1) .AND. (CCONF=='START') ) THEN
+IF( (KTCOUNT==1) .AND. (CDCONF=='START') ) THEN
ZTSPLITR = PTSTEP / REAL(ISPLITR) ! Small time step
ZTSTEP = PTSTEP ! Large time step
ELSE
diff --git a/src/PHYEX/micro/lima_warm.f90 b/src/PHYEX/micro/lima_warm.f90
index 4f954463b5071171871a778652241b6c1bc44738..e4f1db134a5f1b3f1dad42bca2cf83a7eb048d88 100644
--- a/src/PHYEX/micro/lima_warm.f90
+++ b/src/PHYEX/micro/lima_warm.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_WARM
! #####################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
TPFILE, KRR, PZZ, PRHODJ, &
@@ -18,6 +19,7 @@ INTERFACE
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, only: NSV_LIMA_BEG
+IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
! activation by radiative
diff --git a/src/PHYEX/micro/lima_warm_coal.f90 b/src/PHYEX/micro/lima_warm_coal.f90
index 01d0bd60c6ecccca42efa09722ba36e0fda446f0..bac9042e65e5d46f2e3109f54f59b833e1d59d7e 100644
--- a/src/PHYEX/micro/lima_warm_coal.f90
+++ b/src/PHYEX/micro/lima_warm_coal.f90
@@ -7,12 +7,14 @@
MODULE MODI_LIMA_WARM_COAL
! ##########################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_WARM_COAL (PTSTEP, KMI, &
PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
PRCT, PRRT, PCCT, PCRT, &
PRCS, PRRS, PCCS, PCRS, &
PRHODJ )
+IMPLICIT NONE
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
diff --git a/src/PHYEX/micro/lima_warm_evap.f90 b/src/PHYEX/micro/lima_warm_evap.f90
index ac7ff4da9c14532290969bb9d6006e0fc39b3840..7d374b464bc55aa26354582183ed144ebcc6bcd2 100644
--- a/src/PHYEX/micro/lima_warm_evap.f90
+++ b/src/PHYEX/micro/lima_warm_evap.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_WARM_EVAP
! ##########################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_WARM_EVAP (PTSTEP, KMI, &
PRHODREF, PEXNREF, PPABST, ZT, &
@@ -14,6 +15,7 @@ INTERFACE
PRVT, PRCT, PRRT, PCRT, &
PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
PEVAP3D)
+IMPLICIT NONE
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
diff --git a/src/PHYEX/micro/lima_warm_nucl.f90 b/src/PHYEX/micro/lima_warm_nucl.f90
index 8591b848e0ade496014c0816624fb589b36b7804..2b4ce331ef47a3ea0ac34d839a5c021d9a5e7412 100644
--- a/src/PHYEX/micro/lima_warm_nucl.f90
+++ b/src/PHYEX/micro/lima_warm_nucl.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_WARM_NUCL
! ##########################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, &
PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
@@ -14,6 +15,7 @@ INTERFACE
PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
!
USE MODD_IO, ONLY: TFILEDATA
+IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
! activation by radiative
diff --git a/src/PHYEX/micro/lima_warm_sedimentation.f90 b/src/PHYEX/micro/lima_warm_sedimentation.f90
index f74899b381c08493f242eef9f5685cc514a95667..41e3c1ff18ab3af66e02a354f966eced7064c4a8 100644
--- a/src/PHYEX/micro/lima_warm_sedimentation.f90
+++ b/src/PHYEX/micro/lima_warm_sedimentation.f90
@@ -7,6 +7,7 @@
MODULE MODI_LIMA_WARM_SEDIMENTATION
! ###################################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
PZZ, PRHODREF, PPABST, ZT, &
@@ -14,6 +15,7 @@ INTERFACE
PRCT, PRRT, PCCT, PCRT, &
PRCS, PRRS, PCCS, PCRS, &
PINPRC, PINPRR, PINPRR3D )
+IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
! cloud droplet sedimentation
diff --git a/src/PHYEX/micro/modd_cloudparn.f90 b/src/PHYEX/micro/modd_cloudparn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fd8f2297149c9eab2daf277cac9f4bf9baecfefa
--- /dev/null
+++ b/src/PHYEX/micro/modd_cloudparn.f90
@@ -0,0 +1,79 @@
+!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 modd 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODD_CLOUDPAR_n
+! ######################
+!
+!!**** *MODD_CLOUDPAR$n* - declaration of the model-n dependant Microphysics
+!! constants
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! model-n dependant Microhysics constants.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_CLOUDPARn)
+!!
+!! AUTHOR
+!! ------
+!! E. Richard *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/12/95
+!! J.-P. Pinty 29/11/02 add C3R5, ICE2, ICE4, ELEC
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE CLOUDPAR_t
+!
+ INTEGER :: NSPLITR !< Number of required small time step integration
+ !! for rain sedimentation computation
+ INTEGER :: NSPLITG !< Number of required small time step integration
+ !! for ice hydrometeor sedimentation computation
+!
+!
+END TYPE CLOUDPAR_t
+
+TYPE(CLOUDPAR_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: CLOUDPAR_MODEL
+TYPE(CLOUDPAR_t), POINTER, SAVE :: CLOUDPARN => NULL()
+INTEGER, POINTER :: NSPLITR=>NULL()
+INTEGER, POINTER :: NSPLITG=>NULL()
+
+CONTAINS
+
+SUBROUTINE CLOUDPAR_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+CLOUDPARN => CLOUDPAR_MODEL(KTO)
+!
+! Save current state for allocated arrays
+!
+! Current model is set to model KTO
+NSPLITR=>CLOUDPAR_MODEL(KTO)%NSPLITR
+NSPLITG=>CLOUDPAR_MODEL(KTO)%NSPLITG
+
+END SUBROUTINE CLOUDPAR_GOTO_MODEL
+
+END MODULE MODD_CLOUDPAR_n
diff --git a/src/PHYEX/micro/modd_neb.f90 b/src/PHYEX/micro/modd_neb.f90
deleted file mode 100644
index ebca8d22354bb6009ad39ce5a5ba7abe5440485b..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/modd_neb.f90
+++ /dev/null
@@ -1,56 +0,0 @@
-!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 MODD_NEB
-! #############################
-!
-!!**** *MODD_NEB* - Declaration of nebulosity constants
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this declarative module is to declare some
-!! constants for nebulosity calculation
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! S. Riette (Meteo France)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 24 Aug 2011
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-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_nebn.f90 b/src/PHYEX/micro/modd_nebn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dce8f1d9aab9b16e9728812d8fbd01d52c26e5a3
--- /dev/null
+++ b/src/PHYEX/micro/modd_nebn.f90
@@ -0,0 +1,223 @@
+!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 MODD_NEB_n
+! #############################
+!> @file
+!!**** *MODD_NEB_n* - Declaration of nebulosity constants
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this declarative module is to declare some
+!! constants for nebulosity calculation
+!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Riette (Meteo France)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24 Aug 2011
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+!
+TYPE NEB_t
+ REAL :: XTMINMIX !< minimum temperature of mixed phase
+ REAL :: XTMAXMIX !< maximum temperature of mixed phase
+ LOGICAL :: LHGT_QS !< Switch for height dependent VQSIGSAT
+ CHARACTER(LEN=1) :: CFRAC_ICE_ADJUST !< ice fraction for adjustments
+ CHARACTER(LEN=1) :: CFRAC_ICE_SHALLOW_MF !< ice fraction for shallow_mf
+ REAL :: VSIGQSAT !< coeff applied to qsat variance contribution
+ CHARACTER(LEN=80) :: CCONDENS !< subrgrid condensation PDF
+ CHARACTER(LEN=4) :: CLAMBDA3 !< lambda3 choice for subgrid cloud scheme
+ LOGICAL :: LSTATNW !< updated full statistical cloud scheme
+ LOGICAL :: LSIGMAS !< Switch for using Sigma_s from turbulence scheme
+ LOGICAL :: LSUBG_COND !< Switch for subgrid condensation
+END TYPE NEB_t
+
+TYPE(NEB_t), DIMENSION(JPMODELMAX), SAVE, TARGET :: NEB_MODEL
+TYPE(NEB_t), POINTER, SAVE :: NEBN => NULL()
+
+REAL, POINTER :: XTMINMIX=>NULL(), &
+ XTMAXMIX=>NULL()
+LOGICAL, POINTER :: LHGT_QS=>NULL()
+CHARACTER(LEN=1), POINTER :: CFRAC_ICE_ADJUST => NULL()
+CHARACTER(LEN=1), POINTER :: CFRAC_ICE_SHALLOW_MF => NULL()
+REAL, POINTER :: VSIGQSAT=>NULL()
+CHARACTER(LEN=80),POINTER :: CCONDENS=>NULL()
+CHARACTER(LEN=4),POINTER :: CLAMBDA3=>NULL()
+LOGICAL, POINTER :: LSTATNW=>NULL()
+LOGICAL, POINTER :: LSIGMAS=>NULL()
+LOGICAL, POINTER :: LSUBG_COND=>NULL()
+!
+NAMELIST/NAM_NEBn/XTMINMIX, XTMAXMIX, LHGT_QS, CFRAC_ICE_ADJUST, CFRAC_ICE_SHALLOW_MF, &
+ &VSIGQSAT, CCONDENS, CLAMBDA3, LSTATNW, LSIGMAS, LSUBG_COND
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+SUBROUTINE NEB_GOTO_MODEL(KFROM, KTO)
+!! This subroutine associate all the pointers to the right component of
+!! the right strucuture. A value can be accessed through the structure NEBN
+!! or through the strucuture NEB_MODEL(KTO) or directly through these pointers.
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+IF(.NOT. ASSOCIATED(NEBN, NEB_MODEL(KTO))) THEN
+ !
+ NEBN => NEB_MODEL(KTO)
+ !
+ XTMINMIX => NEBN%XTMINMIX
+ XTMAXMIX => NEBN%XTMAXMIX
+ LHGT_QS => NEBN%LHGT_QS
+ CFRAC_ICE_ADJUST => NEBN%CFRAC_ICE_ADJUST
+ CFRAC_ICE_SHALLOW_MF => NEBN%CFRAC_ICE_SHALLOW_MF
+ VSIGQSAT => NEBN%VSIGQSAT
+ CCONDENS => NEBN%CCONDENS
+ CLAMBDA3 => NEBN%CLAMBDA3
+ LSTATNW => NEBN%LSTATNW
+ LSIGMAS => NEBN%LSIGMAS
+ LSUBG_COND => NEBN%LSUBG_COND
+ !
+ENDIF
+END SUBROUTINE NEB_GOTO_MODEL
+!
+SUBROUTINE NEBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ &LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
+!!*** *NEBN_INIT* - Code needed to initialize the MODD_NEB_n module
+!!
+!!* PURPOSE
+!! -------
+!! Sets the default values, reads the namelist, performs the checks and prints
+!!
+!!* METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Default values
+!! 2. Namelist
+!! 3. Checks
+!! 4. Prints
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Mar 2023
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
+USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
+INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
+INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
+LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDREADNAM !< Must we read the namelist (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDCHECK !< Must we perform some checks on values (defaults to .TRUE.)
+INTEGER, OPTIONAL, INTENT(IN) :: KPRINT !< Print level (defaults to 0): 0 for no print, 1 to safely print namelist,
+ !! 2 to print informative messages
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+LOGICAL :: LLDEFAULTVAL, LLREADNAM, LLCHECK, LLFOUND
+INTEGER :: IPRINT
+
+LLDEFAULTVAL=.TRUE.
+LLREADNAM=.TRUE.
+LLCHECK=.TRUE.
+IPRINT=0
+IF(PRESENT(LDDEFAULTVAL)) LLDEFAULTVAL=LDDEFAULTVAL
+IF(PRESENT(LDREADNAM )) LLREADNAM =LDREADNAM
+IF(PRESENT(LDCHECK )) LLCHECK =LDCHECK
+IF(PRESENT(KPRINT )) IPRINT =KPRINT
+!
+!* 1. DEFAULT VALUES
+! -----------------
+!
+IF(LLDEFAULTVAL) THEN
+ !NOTES ON GENERAL DEFAULTS AND MODEL-SPECIFIC DEFAULTS :
+ !- General default values *MUST* remain unchanged.
+ !- To change the default value for a given application,
+ ! an "IF(HPROGRAM=='...')" condition must be used.
+
+ !Freezing between 0 and -20. Other possibilities are 0/-40 or -5/-25
+ XTMAXMIX = 273.16
+ XTMINMIX = 253.16
+ LHGT_QS = .FALSE.
+ CFRAC_ICE_ADJUST='S'
+ CFRAC_ICE_SHALLOW_MF='S'
+ VSIGQSAT = 0.02
+ CCONDENS='CB02'
+ CLAMBDA3='CB'
+ LSUBG_COND=.FALSE.
+ LSIGMAS =.TRUE.
+ LSTATNW=.FALSE.
+
+ IF(HPROGRAM=='AROME') THEN
+ CFRAC_ICE_ADJUST='T'
+ CFRAC_ICE_SHALLOW_MF='T'
+ VSIGQSAT=0.
+ LSIGMAS=.FALSE.
+ ELSEIF(HPROGRAM=='LMDZ') THEN
+ LSUBG_COND=.TRUE.
+ ENDIF
+ENDIF
+!
+!* 2. NAMELIST
+! -----------
+!
+IF(LLREADNAM) THEN
+ CALL POSNAM_PHY(KUNITNML, 'NAM_NEBN', LDNEEDNAM, LLFOUND, KLUOUT)
+ IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_NEBn)
+ENDIF
+!
+!* 3. CHECKS
+! ---------
+!
+IF(LLCHECK) THEN
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CFRAC_ICE_ADJUST', CFRAC_ICE_ADJUST, 'T', 'O', 'N', 'S')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CFRAC_ICE_SHALLOW_MF', CFRAC_ICE_SHALLOW_MF, 'T', 'O', 'N', 'S')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CCONDENS', CCONDENS, 'CB02', 'GAUS')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CLAMBDA3', CLAMBDA3, 'CB', 'NONE')
+ENDIF
+!
+!* 3. PRINTS
+! ---------
+!
+IF(IPRINT>=1) THEN
+ WRITE(UNIT=KLUOUT,NML=NAM_NEBn)
+ENDIF
+!
+END SUBROUTINE NEBN_INIT
+!
+END MODULE MODD_NEB_n
diff --git a/src/PHYEX/micro/modd_param_c1r3.f90 b/src/PHYEX/micro/modd_param_c1r3.f90
index 700526c7aefa06b094cbae708a7095f6afb4e90d..cc1e68531da53b478c04ce72ffdfc50a9bbea151 100644
--- a/src/PHYEX/micro/modd_param_c1r3.f90
+++ b/src/PHYEX/micro/modd_param_c1r3.f90
@@ -45,6 +45,7 @@
!* 0. DECLARATIONS
! ------------
!
+IMPLICIT NONE
REAL,SAVE :: XALPHAI,XNUI, & ! Pristine ice distribution parameters
XALPHAS,XNUS, & ! Snow/aggregate distribution parameters
XALPHAG,XNUG ! Graupel distribution parameters
diff --git a/src/PHYEX/micro/modd_param_c2r2.f90 b/src/PHYEX/micro/modd_param_c2r2.f90
index 83d7f5d1cce8141fc6afc959356126181e0d2c1d..20f080c031a0494c221ec46b43f882902c6d620e 100644
--- a/src/PHYEX/micro/modd_param_c2r2.f90
+++ b/src/PHYEX/micro/modd_param_c2r2.f90
@@ -50,6 +50,7 @@
!* 0. DECLARATIONS
! ------------
!
+IMPLICIT NONE
REAL,SAVE :: XALPHAR,XNUR, & ! Raindrop distribution parameters
XALPHAC,XNUC ! Cloud droplet distribution parameters
!
diff --git a/src/PHYEX/micro/modd_param_icen.f90 b/src/PHYEX/micro/modd_param_icen.f90
index 8f7ea8f52195660c051d6204d788300fc215c487..9ea39306b764f20e53c5046b9341022d8d150e7b 100644
--- a/src/PHYEX/micro/modd_param_icen.f90
+++ b/src/PHYEX/micro/modd_param_icen.f90
@@ -4,10 +4,10 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- MODULE MODD_PARAM_ICE
+ MODULE MODD_PARAM_ICE_n
! #####################
-!
-!!**** *MODD_PARAM_ICE* - declaration of the control parameters for the
+!> @file
+!! *MODD_PARAM_ICE_n* - declaration of the control parameters for the
!! mixed phase cloud parameterization
!!
!! PURPOSE
@@ -15,8 +15,7 @@
!! The purpose of this declarative module is to define the set of space
!! and time control parameters for the microphysics.
!!
-!!
-!!** IMPLICIT ARGUMENTS
+!! IMPLICIT ARGUMENTS
!! ------------------
!! None
!!
@@ -30,61 +29,81 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 14/12/95
-!! Jan 2015 S. Riette: new ICE3/ICE4 parameters
-!! 01/10/16 (C.Lac) Add droplet deposition for fog
+!!
+!! - Original 14/12/95
+!! - Jan 2015 S. Riette: new ICE3/ICE4 parameters
+!! - 01/10/16 (C.Lac) Add droplet deposition for fog
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
!
TYPE PARAM_ICE_t
-LOGICAL :: LWARM ! When .TRUE. activates the formation of rain by
- ! the warm microphysical processes
-LOGICAL :: LSEDIC ! TRUE to enable the droplet sedimentation
-LOGICAL :: LDEPOSC ! TRUE to enable cloud droplet deposition
-REAL :: XVDEPOSC ! Droplet deposition velocity
-!
-CHARACTER(LEN=4) :: CPRISTINE_ICE ! Pristine ice type PLAT, COLU or BURO
-CHARACTER(LEN=4) :: CSEDIM ! Sedimentation calculation mode
-!
-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 :: XTSTEP_TS ! Approximative time step for time-splitting (0 for no time-splitting)
-!
-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 :: 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 :: XSPLIT_MAXCFL ! Maximum CFL number allowed for SPLIT scheme
-LOGICAL :: LSNOW_T ! Snow parameterization from Wurtz (2021)
-!
-LOGICAL :: LPACK_INTERP !To pack arrays before computing the different interpolations (kernels and other)
-LOGICAL :: LPACK_MICRO !To pack arrays before computing the process tendencies
+LOGICAL :: LWARM !< When .TRUE. activates the formation of rain by
+ !! the warm microphysical processes
+LOGICAL :: LSEDIC !< TRUE to enable the droplet sedimentation
+LOGICAL :: LDEPOSC !< TRUE to enable cloud droplet deposition
+REAL :: XVDEPOSC !< Droplet deposition velocity
+!
+CHARACTER(LEN=4) :: CPRISTINE_ICE !< Pristine ice type PLAT, COLU or BURO
+CHARACTER(LEN=4) :: CSEDIM !< Sedimentation calculation mode
+!
+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_MICRO !< 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 :: XTSTEP_TS !< Approximative time step for time-splitting (0 for no time-splitting)
+!
+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
+CHARACTER(LEN=4) :: CSUBG_AUCV_RC !< type of subgrid rc->rr autoconv. method
+CHARACTER(LEN=80) :: CSUBG_AUCV_RI !< type of subgrid ri->rs autoconv. method
+CHARACTER(LEN=80) :: CSUBG_MF_PDF !< PDF to use for MF cloud autoconversions
+!
+LOGICAL :: LADJ_BEFORE !< must we perform an adjustment before rain_ice call
+LOGICAL :: LADJ_AFTER !< must we perform an adjustment after rain_ice call
+LOGICAL :: LSEDIM_AFTER !< sedimentation done before (.FALSE.) or after (.TRUE.) microphysics
+!
+REAL :: XSPLIT_MAXCFL !< Maximum CFL number allowed for SPLIT scheme
+LOGICAL :: LSNOW_T !< Snow parameterization from Wurtz (2021)
+!
+LOGICAL :: LPACK_INTERP !< To pack arrays before computing the different interpolations (kernels and other)
+LOGICAL :: LPACK_MICRO !< To pack arrays before computing the process tendencies
+!
+INTEGER :: NPROMICRO !< Size of cache-blocking bloc (0 to deactivate)
+!
+LOGICAL :: LCRIAUTI !< .T. to compute XACRIAUTI and XBCRIAUTI (from XCRIAUTI and XT0CRIAUTI);
+ !! .F. to compute XT0CRIAUTI (from XCRIAUTI and XBCRIAUTI)
+REAL :: XCRIAUTI_NAM !< Minimum value for the ice->snow autoconversion threshold
+REAL :: XT0CRIAUTI_NAM !< Threshold temperature (???) for the ice->snow autoconversion threshold
+REAL :: XBCRIAUTI_NAM !< B barameter for the ice->snow autoconversion 10**(aT+b) law
+REAL :: XACRIAUTI_NAM !< A barameter for the ice->snow autoconversion 10**(aT+b) law
+REAL :: XCRIAUTC_NAM !< Threshold for liquid cloud -> rain autoconversion (kg/m**3)
+REAL :: XRDEPSRED_NAM !< Tuning factor of sublimation of snow
+REAL :: XRDEPGRED_NAM !< Tuning factor of sublimation of graupel
+!
+LOGICAL :: LOCND2 !< Logical switch to separate liquid and ice
+REAL, DIMENSION(40) :: XFRMIN_NAM
+!
END TYPE PARAM_ICE_t
!
-TYPE(PARAM_ICE_t), SAVE, TARGET :: PARAM_ICE
+TYPE(PARAM_ICE_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: PARAM_ICE_MODEL
+TYPE(PARAM_ICE_t), POINTER, SAVE :: PARAM_ICEN => NULL()
!
LOGICAL, POINTER :: LWARM => NULL(), &
LSEDIC => NULL(), &
@@ -100,67 +119,322 @@ LOGICAL, POINTER :: LWARM => NULL(), &
LCRFLIMIT => NULL(), &
LADJ_BEFORE => NULL(), &
LADJ_AFTER => NULL(), &
- LSEDIM_AFTER => NULL(),&
- LSNOW_T => NULL(),&
- LPACK_INTERP => NULL(),&
- LPACK_MICRO => NULL()
+ LSEDIM_AFTER => NULL(), &
+ LSNOW_T => NULL(), &
+ LPACK_INTERP => NULL(), &
+ LPACK_MICRO => NULL(), &
+ LCRIAUTI => NULL(), &
+ LOCND2 => NULL()
REAL, POINTER :: XVDEPOSC => NULL(), &
XFRACM90 => NULL(), &
XMRSTEP => NULL(), &
XTSTEP_TS => NULL(), &
- XSPLIT_MAXCFL => NULL()
+ XSPLIT_MAXCFL => NULL(), &
+ XCRIAUTI_NAM => NULL(), &
+ XT0CRIAUTI_NAM => NULL(), &
+ XBCRIAUTI_NAM => NULL(), &
+ XACRIAUTI_NAM => NULL(), &
+ XCRIAUTC_NAM => NULL(), &
+ XRDEPSRED_NAM => NULL(), &
+ XRDEPGRED_NAM => NULL()
+REAL, DIMENSION(:), POINTER :: XFRMIN_NAM => NULL()
-INTEGER, POINTER :: NMAXITER => NULL()
+INTEGER, POINTER :: NMAXITER_MICRO => NULL(), &
+ NPROMICRO => 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()
+CHARACTER(LEN=4),POINTER :: CSUBG_AUCV_RC=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_AUCV_RI=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_MF_PDF=>NULL()
+!
+NAMELIST/NAM_PARAM_ICEn/LWARM,LSEDIC,LCONVHG,CPRISTINE_ICE,CSEDIM,LDEPOSC,XVDEPOSC, &
+ LRED, LFEEDBACKT, &
+ LEVLIMIT,LNULLWETG,LWETGPOST,LNULLWETH,LWETHPOST, &
+ CSNOWRIMING,XFRACM90,NMAXITER_MICRO,XMRSTEP,XTSTEP_TS, &
+ LADJ_BEFORE, LADJ_AFTER, LCRFLIMIT, &
+ XSPLIT_MAXCFL, LSEDIM_AFTER, LSNOW_T, &
+ LPACK_INTERP, LPACK_MICRO, NPROMICRO, CSUBG_RC_RR_ACCR, &
+ CSUBG_RR_EVAP, CSUBG_PR_PDF, CSUBG_AUCV_RC, CSUBG_AUCV_RI, &
+ LCRIAUTI, XCRIAUTI_NAM, XT0CRIAUTI_NAM, XBCRIAUTI_NAM, &
+ XACRIAUTI_NAM, XCRIAUTC_NAM, XRDEPSRED_NAM, XRDEPGRED_NAM, &
+ LOCND2, XFRMIN_NAM, CSUBG_MF_PDF
!
!-------------------------------------------------------------------------------
!
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
- LPACK_INTERP => PARAM_ICE%LPACK_INTERP
- LPACK_MICRO => PARAM_ICE%LPACK_MICRO
+SUBROUTINE PARAM_ICE_GOTO_MODEL(KFROM, KTO)
+!! This subroutine associate all the pointers to the right component of
+!! the right strucuture. A value can be accessed through the structure PARAM_ICEN
+!! or through the strucuture PARAM_ICE_MODEL(KTO) or directly through these pointers.
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+IF(.NOT. ASSOCIATED(PARAM_ICEN, PARAM_ICE_MODEL(KTO))) THEN
+ !
+ PARAM_ICEN => PARAM_ICE_MODEL(KTO)
!
- XVDEPOSC => PARAM_ICE%XVDEPOSC
- XFRACM90 => PARAM_ICE%XFRACM90
- XMRSTEP => PARAM_ICE%XMRSTEP
- XTSTEP_TS => PARAM_ICE%XTSTEP_TS
- XSPLIT_MAXCFL => PARAM_ICE%XSPLIT_MAXCFL
+ LWARM => PARAM_ICEN%LWARM
+ LSEDIC => PARAM_ICEN%LSEDIC
+ LDEPOSC => PARAM_ICEN%LDEPOSC
+ LRED => PARAM_ICEN%LRED
+ LFEEDBACKT => PARAM_ICEN%LFEEDBACKT
+ LEVLIMIT => PARAM_ICEN%LEVLIMIT
+ LNULLWETG => PARAM_ICEN%LNULLWETG
+ LWETGPOST => PARAM_ICEN%LWETGPOST
+ LNULLWETH => PARAM_ICEN%LNULLWETH
+ LWETHPOST => PARAM_ICEN%LWETHPOST
+ LCONVHG => PARAM_ICEN%LCONVHG
+ LCRFLIMIT => PARAM_ICEN%LCRFLIMIT
+ LADJ_BEFORE => PARAM_ICEN%LADJ_BEFORE
+ LADJ_AFTER => PARAM_ICEN%LADJ_AFTER
+ LSEDIM_AFTER => PARAM_ICEN%LSEDIM_AFTER
+ LSNOW_T => PARAM_ICEN%LSNOW_T
+ LPACK_INTERP => PARAM_ICEN%LPACK_INTERP
+ LPACK_MICRO => PARAM_ICEN%LPACK_MICRO
+ LCRIAUTI => PARAM_ICEN%LCRIAUTI
+ LOCND2 => PARAM_ICEN%LOCND2
!
- NMAXITER => PARAM_ICE%NMAXITER
+ XVDEPOSC => PARAM_ICEN%XVDEPOSC
+ XFRACM90 => PARAM_ICEN%XFRACM90
+ XMRSTEP => PARAM_ICEN%XMRSTEP
+ XTSTEP_TS => PARAM_ICEN%XTSTEP_TS
+ XSPLIT_MAXCFL => PARAM_ICEN%XSPLIT_MAXCFL
+ XCRIAUTI_NAM => PARAM_ICEN%XCRIAUTI_NAM
+ XT0CRIAUTI_NAM => PARAM_ICEN%XT0CRIAUTI_NAM
+ XBCRIAUTI_NAM => PARAM_ICEN%XBCRIAUTI_NAM
+ XACRIAUTI_NAM => PARAM_ICEN%XACRIAUTI_NAM
+ XCRIAUTC_NAM => PARAM_ICEN%XCRIAUTC_NAM
+ XRDEPSRED_NAM => PARAM_ICEN%XRDEPSRED_NAM
+ XRDEPGRED_NAM => PARAM_ICEN%XRDEPGRED_NAM
+ XFRMIN_NAM => PARAM_ICEN%XFRMIN_NAM
!
- 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
+ NMAXITER_MICRO => PARAM_ICEN%NMAXITER_MICRO
+ NPROMICRO => PARAM_ICEN%NPROMICRO
+ !
+ CPRISTINE_ICE => PARAM_ICEN%CPRISTINE_ICE
+ CSEDIM => PARAM_ICEN%CSEDIM
+ CSNOWRIMING => PARAM_ICEN%CSNOWRIMING
+ CSUBG_RC_RR_ACCR => PARAM_ICEN%CSUBG_RC_RR_ACCR
+ CSUBG_RR_EVAP => PARAM_ICEN%CSUBG_RR_EVAP
+ CSUBG_PR_PDF => PARAM_ICEN%CSUBG_PR_PDF
+ CSUBG_AUCV_RC=>PARAM_ICEN%CSUBG_AUCV_RC
+ CSUBG_AUCV_RI=>PARAM_ICEN%CSUBG_AUCV_RI
+ CSUBG_MF_PDF=>PARAM_ICEN%CSUBG_MF_PDF
+ENDIF
+END SUBROUTINE PARAM_ICE_GOTO_MODEL
+!
+SUBROUTINE PARAM_ICEN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ &LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
+!!*** *PARAM_ICEN_INIT* - Code needed to initialize the MODD_PARAM_ICE_n module
+!!
+!!* PURPOSE
+!! -------
+!! Sets the default values, reads the namelist, performs the checks and prints
+!!
+!!* METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Default values
+!! 2. Namelist
+!! 3. Checks
+!! 4. Prints
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Feb 2023
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR, CHECK_NAM_VAL_REAL, CHECK_NAM_VAL_INT
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
+INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
+INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
+LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDREADNAM !< Must we read the namelist (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDCHECK !< Must we perform some checks on values (defaults to .TRUE.)
+INTEGER, OPTIONAL, INTENT(IN) :: KPRINT !< Print level (defaults to 0): 0 for no print, 1 to safely print namelist,
+ !! 2 to print informative messages
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+LOGICAL :: LLDEFAULTVAL, LLREADNAM, LLCHECK, LLFOUND
+INTEGER :: IPRINT
+
+LLDEFAULTVAL=.TRUE.
+LLREADNAM=.TRUE.
+LLCHECK=.TRUE.
+IPRINT=0
+IF(PRESENT(LDDEFAULTVAL)) LLDEFAULTVAL=LDDEFAULTVAL
+IF(PRESENT(LDREADNAM )) LLREADNAM =LDREADNAM
+IF(PRESENT(LDCHECK )) LLCHECK =LDCHECK
+IF(PRESENT(KPRINT )) IPRINT =KPRINT
+!
+!* 1. DEFAULT VALUES
+! -----------------
+!
+IF(LLDEFAULTVAL) THEN
+ !NOTES ON GENERAL DEFAULTS AND MODEL-SPECIFIC DEFAULTS :
+ !- General default values *MUST* remain unchanged.
+ !- To change the default value for a given application,
+ ! an "IF(HPROGRAM=='...')" condition must be used.
+
+ LWARM=.TRUE.
+ LSEDIC=.TRUE.
+ LDEPOSC=.FALSE.
+ XVDEPOSC= 0.02 ! 2 cm/s
+ CPRISTINE_ICE='PLAT'
+ CSEDIM='SPLI'
+ LRED=.TRUE.
+ LFEEDBACKT=.TRUE.
+ LEVLIMIT=.TRUE.
+ LNULLWETG=.TRUE.
+ LWETGPOST=.TRUE.
+ LNULLWETH=.TRUE.
+ LWETHPOST=.TRUE.
+ CSNOWRIMING='M90'
+ XFRACM90=0.1
+ NMAXITER_MICRO=5
+ XMRSTEP=0.00005
+ LCONVHG=.FALSE.
+ LCRFLIMIT=.TRUE.
+ XTSTEP_TS=0.
+ CSUBG_RC_RR_ACCR='NONE'
+ CSUBG_RR_EVAP='NONE'
+ CSUBG_PR_PDF='SIGM'
+ CSUBG_AUCV_RC='NONE'
+ CSUBG_AUCV_RI='NONE'
+ CSUBG_MF_PDF='TRIANGLE'
+ LADJ_BEFORE=.TRUE.
+ LADJ_AFTER=.TRUE.
+ LSEDIM_AFTER=.FALSE.
+ XSPLIT_MAXCFL=0.8
+ LSNOW_T=.FALSE.
+ LPACK_INTERP=.TRUE.
+ LPACK_MICRO=.TRUE.
+ NPROMICRO=0
+ LCRIAUTI=.FALSE.
+ !!XCRIAUTIi_NAM = 0.25E-3 ! Critical ice content for the autoconversion to occur
+ XCRIAUTI_NAM = 0.2E-4 ! Revised value by Chaboureau et al. (2001)
+ XACRIAUTI_NAM=0.06
+ XBCRIAUTI_NAM=-3.5
+ XT0CRIAUTI_NAM=(LOG10(XCRIAUTI_NAM)-XBCRIAUTI_NAM)/0.06
+ XCRIAUTC_NAM=0.5E-3
+ XRDEPSRED_NAM=1.
+ XRDEPGRED_NAM=1.
+ LOCND2=.FALSE.
+ ! Tuning and modication of graupeln etc:
+ XFRMIN_NAM(1:6)=0.
+ XFRMIN_NAM(7:9)=1.
+ XFRMIN_NAM(10) =10.
+ XFRMIN_NAM(11) =1.
+ XFRMIN_NAM(12) =0.
+ XFRMIN_NAM(13) =1.0E-15
+ XFRMIN_NAM(14) =120.
+ XFRMIN_NAM(15) =1.0E-4
+ XFRMIN_NAM(16:20)=0.
+ XFRMIN_NAM(21:22)=1.
+ XFRMIN_NAM(23)=0.5
+ XFRMIN_NAM(24)=1.5
+ XFRMIN_NAM(25)=30.
+ XFRMIN_NAM(26:38)=0.
+ XFRMIN_NAM(39)=0.25
+ XFRMIN_NAM(40)=0.15
+
+ IF(HPROGRAM=='AROME') THEN
+ LCONVHG=.TRUE.
+ LADJ_BEFORE=.TRUE.
+ LADJ_AFTER=.FALSE.
+ LRED=.FALSE.
+ CSEDIM='STAT'
+ LSEDIC=.FALSE.
+ XMRSTEP=0.
+ CSUBG_AUCV_RC='PDF'
+ ELSEIF(HPROGRAM=='LMDZ') THEN
+ CSUBG_AUCV_RC='PDF'
+ CSEDIM='STAT'
+ NMAXITER_MICRO=1
+ LCRIAUTI=.TRUE.
+ XCRIAUTC_NAM=0.001
+ XCRIAUTI_NAM=0.0002
+ XT0CRIAUTI_NAM=-5.
+ LRED=.TRUE.
+ LCONVHG=.TRUE.
+ LADJ_BEFORE=.TRUE.
+ LADJ_AFTER=.FALSE.
+ ENDIF
+ENDIF
+!
+!* 2. NAMELIST
+! -----------
+!
+IF(LLREADNAM) THEN
+ CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_ICEN', LDNEEDNAM, LLFOUND, KLUOUT)
+ IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_ICEn)
+ENDIF
+!
+!* 3. CHECKS
+! ---------
+!
+IF(LLCHECK) THEN
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CPRISTINE_ICE', CPRISTINE_ICE, 'PLAT', 'COLU', 'BURO')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CSEDIM', CSEDIM, 'SPLI', 'STAT', 'NONE')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CSUBG_RC_RR_ACCR', CSUBG_RC_RR_ACCR, 'NONE', 'PRFR')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CSUBG_RR_EVAP', CSUBG_RR_EVAP, 'NONE', 'CLFR', 'PRFR')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CSUBG_PR_PDF', CSUBG_PR_PDF, 'SIGM', 'HLCRECTPD', 'HLCTRIANGPDF', &
+ 'HLCQUADRAPDF', 'HLCISOTRIPDF')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CSUBG_AUCV_RC', CSUBG_AUCV_RC, 'PDF ', 'CLFR', 'NONE', 'ADJU', 'SIGM')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CSUBG_AUCV_RI', CSUBG_AUCV_RI, 'NONE', 'CLFR', 'ADJU')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CSUBG_MF_PDF', CSUBG_MF_PDF, 'NONE', 'TRIANGLE')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CSNOWRIMING', CSNOWRIMING, 'OLD ', 'M90 ')
+ CALL CHECK_NAM_VAL_REAL(KLUOUT, 'XTSTEP_TS', XTSTEP_TS, '>=', 0.)
+ CALL CHECK_NAM_VAL_REAL(KLUOUT, 'XSPLIT_MAXCFL', XSPLIT_MAXCFL, '>', 0., '<=', 1.)
+ CALL CHECK_NAM_VAL_REAL(KLUOUT, 'XVDEPOSC', XVDEPOSC, '>=', 0.)
+ CALL CHECK_NAM_VAL_REAL(KLUOUT, 'XFRACM90', XFRACM90, '>=', 0., '<=', 1.)
+ CALL CHECK_NAM_VAL_REAL(KLUOUT, 'XMRSTEP', XMRSTEP, '>=', 0.)
+ CALL CHECK_NAM_VAL_INT(KLUOUT, 'NPROMICRO', NPROMICRO, '>=', 0)
+
+ IF (LOCND2 .AND. (XRDEPSRED_NAM /= 1 .OR. XRDEPGRED_NAM /= 1)) THEN
+ CALL ABOR1 ("XRDESRED_NAM and XRDEGRED_NAM must not be activated together with LOCND2")
+ ENDIF
+
+ IF(HPROGRAM=='AROME' .OR. HPROGRAM=='LMDZ') THEN
+ IF(.NOT. (LADJ_BEFORE .AND. .NOT. LADJ_AFTER)) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODD_PARAM_ICE_n', 'With AROME/LMDZ, LADJ_BEFORE must be .T. and LADJ_AFTER must be .F.')
+ ENDIF
+ ENDIF
+ENDIF
+!
+!* 3. PRINTS
+! ---------
+!
+IF(IPRINT>=1) THEN
+ WRITE(UNIT=KLUOUT,NML=NAM_PARAM_ICEn)
+ENDIF
+!
+END SUBROUTINE PARAM_ICEN_INIT
+!
+END MODULE MODD_PARAM_ICE_n
diff --git a/src/PHYEX/micro/modd_param_lima.f90 b/src/PHYEX/micro/modd_param_lima.f90
index 00af77b8569018404060bee7c6672e849b02f504..3565e1d9a705310dd2c37f73b2768b296fa88c53 100644
--- a/src/PHYEX/micro/modd_param_lima.f90
+++ b/src/PHYEX/micro/modd_param_lima.f90
@@ -6,8 +6,8 @@
! ######################
MODULE MODD_PARAM_LIMA
! ######################
-!
-!!**** *MODD_PARAM_LIMA* - declaration of the control parameters
+!> @file
+!! *MODD_PARAM_LIMA* - declaration of the control parameters
!! for use in the LIMA scheme.
!!
!! PURPOSE
@@ -18,7 +18,7 @@
!!
!!
!!
-!!** IMPLICIT ARGUMENTS
+!! IMPLICIT ARGUMENTS
!! ------------------
!! None
!!
@@ -39,89 +39,90 @@ USE MODD_PARAMETERS, ONLY : JPLIMACCNMAX, JPLIMAIFNMAX
!
IMPLICIT NONE
!
-LOGICAL, SAVE :: LLIMA_DIAG ! Compute diagnostics for concentration /m3
+TYPE PARAM_LIMA_t
+LOGICAL :: LLIMA_DIAG ! Compute diagnostics for concentration /m3
!
-LOGICAL, SAVE :: LPTSPLIT ! activate time-splitting technique by S. Riette
-LOGICAL, SAVE :: LFEEDBACKT ! recompute tendencies if T changes sign
-INTEGER, SAVE :: NMAXITER ! maximum number of iterations
-REAL, SAVE :: XMRSTEP ! maximum change in mixing ratio allowed before recomputing tedencies
-REAL, SAVE :: XTSTEP_TS ! maximum time for the sub-time-step
+LOGICAL :: LPTSPLIT ! activate time-splitting technique by S. Riette
+LOGICAL :: LFEEDBACKT ! recompute tendencies if T changes sign
+INTEGER :: NMAXITER ! maximum number of iterations
+REAL :: XMRSTEP ! maximum change in mixing ratio allowed before recomputing tedencies
+REAL :: XTSTEP_TS ! maximum time for the sub-time-step
!
!* 1. COLD SCHEME
! -----------
!
! 1.1 Cold scheme configuration
!
-LOGICAL, SAVE :: LNUCL ! TRUE to enable ice nucleation
-LOGICAL, SAVE :: LSEDI ! TRUE to enable pristine ice sedimentation
-LOGICAL, SAVE :: LHHONI ! TRUE to enable freezing of haze particules
-LOGICAL, SAVE :: LMEYERS ! TRUE to use Meyers nucleation
-LOGICAL, SAVE :: LCIBU ! TRUE to use collisional ice breakup
-LOGICAL, SAVE :: LRDSF ! TRUE to use rain drop shattering by freezing
-INTEGER, SAVE :: NMOM_I ! Number of moments for pristine ice
-INTEGER, SAVE :: NMOM_S ! Number of moments for snow
-INTEGER, SAVE :: NMOM_G ! Number of moments for graupel
-INTEGER, SAVE :: NMOM_H ! Number of moments for hail
+LOGICAL :: LNUCL ! TRUE to enable ice nucleation
+LOGICAL :: LSEDI ! TRUE to enable pristine ice sedimentation
+LOGICAL :: LHHONI ! TRUE to enable freezing of haze particules
+LOGICAL :: LMEYERS ! TRUE to use Meyers nucleation
+LOGICAL :: LCIBU ! TRUE to use collisional ice breakup
+LOGICAL :: LRDSF ! TRUE to use rain drop shattering by freezing
+INTEGER :: NMOM_I ! Number of moments for pristine ice
+INTEGER :: NMOM_S ! Number of moments for snow
+INTEGER :: NMOM_G ! Number of moments for graupel
+INTEGER :: NMOM_H ! Number of moments for hail
!
! 1.2 IFN initialisation
!
-INTEGER, SAVE :: NMOD_IFN ! Number of IFN modes
-REAL, DIMENSION(JPLIMAIFNMAX), SAVE :: XIFN_CONC ! Ref. concentration of IFN(#/L)
-LOGICAL, SAVE :: LIFN_HOM ! True for z-homogeneous IFN concentrations
-CHARACTER(LEN=8), SAVE :: CIFN_SPECIES ! Internal mixing species definitions
-CHARACTER(LEN=8), SAVE :: CINT_MIXING ! Internal mixing type selection (pure DM1 ...)
-INTEGER, SAVE :: NMOD_IMM ! Number of CCN modes acting by immersion
-INTEGER, SAVE :: NIND_SPECIE ! CCN acting by immersion are considered pure
- ! IFN of either DM = 1, BC = 2 or O = 3
-INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NIMM ! Link between CCN and IMM modes
-INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NINDICE_CCN_IMM ! ??????????
-INTEGER, SAVE :: NSPECIE ! Internal mixing number of species
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XMDIAM_IFN ! Mean diameter of IFN modes
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XSIGMA_IFN ! Sigma of IFN modes
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XRHO_IFN ! Density of IFN modes
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XFRAC ! Composition of each IFN mode
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XFRAC_REF ! AP compostion in Phillips 08
+INTEGER :: NMOD_IFN ! Number of IFN modes
+REAL, DIMENSION(JPLIMAIFNMAX) :: XIFN_CONC ! Ref. concentration of IFN(#/L)
+LOGICAL :: LIFN_HOM ! True for z-homogeneous IFN concentrations
+CHARACTER(LEN=8) :: CIFN_SPECIES ! Internal mixing species definitions
+CHARACTER(LEN=8) :: CINT_MIXING ! Internal mixing type selection (pure DM1 ...)
+INTEGER :: NMOD_IMM ! Number of CCN modes acting by immersion
+INTEGER :: NIND_SPECIE ! CCN acting by immersion are considered pure
+ ! IFN of either DM = 1, BC = 2 or O = 3
+INTEGER, DIMENSION(:), ALLOCATABLE :: NIMM ! Link between CCN and IMM modes
+INTEGER, DIMENSION(:), ALLOCATABLE :: NINDICE_CCN_IMM ! ??????????
+INTEGER :: NSPECIE ! Internal mixing number of species
+REAL, DIMENSION(:), ALLOCATABLE :: XMDIAM_IFN ! Mean diameter of IFN modes
+REAL, DIMENSION(:), ALLOCATABLE :: XSIGMA_IFN ! Sigma of IFN modes
+REAL, DIMENSION(:), ALLOCATABLE :: XRHO_IFN ! Density of IFN modes
+REAL, DIMENSION(:,:), ALLOCATABLE :: XFRAC ! Composition of each IFN mode
+REAL, DIMENSION(:), ALLOCATABLE :: XFRAC_REF ! AP compostion in Phillips 08
!
! 1.3 Ice characteristics
!
-LOGICAL, SAVE :: LSNOW_T ! TRUE to enable snow param. after Wurtz 2021
-LOGICAL, SAVE :: LMURAKAMI ! snow + liq -> graupel after Murakami (as in RAIN_ICE_RED)
-CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE_LIMA ! Pristine type PLAT, COLU or BURO
-CHARACTER(LEN=4), SAVE :: CHEVRIMED_ICE_LIMA ! Heavily rimed type GRAU or HAIL
-REAL,SAVE :: XALPHAI,XNUI, & ! Pristine ice distribution parameters
+LOGICAL :: LSNOW_T ! TRUE to enable snow param. after Wurtz 2021
+LOGICAL :: LMURAKAMI ! snow + liq -> graupel after Murakami (as in RAIN_ICE_RED)
+CHARACTER(LEN=4) :: CPRISTINE_ICE_LIMA ! Pristine type PLAT, COLU or BURO
+CHARACTER(LEN=4) :: CHEVRIMED_ICE_LIMA ! Heavily rimed type GRAU or HAIL
+REAL :: XALPHAI,XNUI, & ! Pristine ice distribution parameters
XALPHAS,XNUS, & ! Snow/aggregate distribution parameters
XALPHAG,XNUG ! Graupel distribution parameters
!
! 1.4 Phillips (2013) nucleation parameterization
!
-INTEGER, SAVE :: NPHILLIPS ! =8 for Phillips08, =13 for Phillips13
-!
-REAL, DIMENSION(4), SAVE :: XT0 ! Threshold of T in H_X for X={DM1,DM2,BC,O} [K]
-REAL, DIMENSION(4), SAVE :: XDT0 ! Range in T for transition of H_X near XT0 [K]
-REAL, DIMENSION(4), SAVE :: XDSI0 ! Range in Si for transition of H_X near XSI0
-REAL, SAVE :: XSW0 ! Threshold of Sw in H_X
-REAL, SAVE :: XRHO_CFDC ! Air density at which CFDC data were reported [kg m**3]
-REAL, DIMENSION(4), SAVE :: XH ! Fraction<<1 of aerosol for X={DM,BC,O}
-REAL, DIMENSION(4), SAVE :: XAREA1 ! Total surface of all aerosols in group X with
- ! diameters between 0.1 and 1 µm, for X={DM1,DM2,BC,O} [m**2 kg**-1]
-REAL, SAVE :: XGAMMA ! Factor boosting IN concentration due to
+INTEGER :: NPHILLIPS ! =8 for Phillips08, =13 for Phillips13
+!
+REAL, DIMENSION(4) :: XT0 ! Threshold of T in H_X for X={DM1,DM2,BC,O} [K]
+REAL, DIMENSION(4) :: XDT0 ! Range in T for transition of H_X near XT0 [K]
+REAL, DIMENSION(4) :: XDSI0 ! Range in Si for transition of H_X near XSI0
+REAL :: XSW0 ! Threshold of Sw in H_X
+REAL :: XRHO_CFDC ! Air density at which CFDC data were reported [kg m**3]
+REAL, DIMENSION(4) :: XH ! Fraction<<1 of aerosol for X={DM,BC,O}
+REAL, DIMENSION(4) :: XAREA1 ! Total surface of all aerosols in group X with
+ ! diameters between 0.1 and 1 µm, for X={DM1,DM2,BC,O} [m**2 kg**-1]
+REAL :: XGAMMA ! Factor boosting IN concentration due to
! bulk-liquid modes
!
-REAL, DIMENSION(4), SAVE :: XTX1 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
-REAL, DIMENSION(4), SAVE :: XTX2 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
+REAL, DIMENSION(4) :: XTX1 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
+REAL, DIMENSION(4) :: XTX2 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
!
-REAL,DIMENSION(:), SAVE, ALLOCATABLE :: XABSCISS, XWEIGHT ! Gauss quadrature method
-INTEGER, SAVE :: NDIAM ! Gauss quadrature accuracy
+REAL,DIMENSION(:), ALLOCATABLE :: XABSCISS, XWEIGHT ! Gauss quadrature method
+INTEGER :: NDIAM ! Gauss quadrature accuracy
!
! 1.5 Meyers (1992) nucleation parameterization
!
-REAL,SAVE :: XFACTNUC_DEP,XFACTNUC_CON ! Amplification factor for IN conc.
+REAL :: XFACTNUC_DEP,XFACTNUC_CON ! Amplification factor for IN conc.
! DEP refers to DEPosition mode
! CON refers to CONtact mode
!
! 1.6 Collisional Ice Break Up parameterization
!
-REAL,SAVE :: XNDEBRIS_CIBU ! Number of ice crystal debris produced
+REAL :: XNDEBRIS_CIBU ! Number of ice crystal debris produced
! by the break up of aggregate particles
!
!-------------------------------------------------------------------------------
@@ -132,54 +133,51 @@ REAL,SAVE :: XNDEBRIS_CIBU ! Number of ice crystal debris produced
!
! 2.1 Warm scheme configuration
!
-LOGICAL, SAVE :: LACTI ! TRUE to enable CCN activation
-LOGICAL, SAVE :: LSEDC ! TRUE to enable the droplet sedimentation
-LOGICAL, SAVE :: LACTIT ! TRUE to enable the usage of dT/dt in CCN activation
-LOGICAL, SAVE :: LBOUND ! TRUE to enable the continuously replenishing
- ! aerosol concentrations through the open
- ! lateral boundaries -> boundaries.f90
-LOGICAL, SAVE :: LDEPOC ! Deposition of rc at 1st level above ground
-LOGICAL, SAVE :: LACTTKE ! TRUE to take into account TKE in W for activation
-LOGICAL, SAVE :: LADJ ! TRUE for adjustment procedure + Smax (false for diagnostic supersaturation)
-LOGICAL, SAVE :: LSPRO ! TRUE for prognostic supersaturation
-LOGICAL, SAVE :: LKHKO ! TRUE for Scu simulation (replicates the previous KHKO scheme)
-LOGICAL, SAVE :: LKESSLERAC ! TRUE for Kessler autoconversion (if NMOM_C=1)
-!
-INTEGER, SAVE :: NMOM_C ! Number of moments for cloud droplets
-INTEGER, SAVE :: NMOM_R ! Number of moments for rain drops
+LOGICAL :: LACTI ! TRUE to enable CCN activation
+LOGICAL :: LSEDC ! TRUE to enable the droplet sedimentation
+LOGICAL :: LACTIT ! TRUE to enable the usage of dT/dt in CCN activation
+LOGICAL :: LDEPOC ! Deposition of rc at 1st level above ground
+LOGICAL :: LACTTKE ! TRUE to take into account TKE in W for activation
+LOGICAL :: LADJ ! TRUE for adjustment procedure + Smax (false for diagnostic supersaturation)
+LOGICAL :: LSPRO ! TRUE for prognostic supersaturation
+LOGICAL :: LKHKO ! TRUE for Scu simulation (replicates the previous KHKO scheme)
+LOGICAL :: LKESSLERAC ! TRUE for Kessler autoconversion (if NMOM_C=1)
+!
+INTEGER :: NMOM_C ! Number of moments for cloud droplets
+INTEGER :: NMOM_R ! Number of moments for rain drops
!
! 2.2 CCN initialisation
!
-INTEGER, SAVE :: NMOD_CCN ! Number of CCN modes
-REAL, DIMENSION(JPLIMACCNMAX), SAVE :: XCCN_CONC ! CCN conc. (#/cm3)
-LOGICAL, SAVE :: LCCN_HOM ! True for z-homogeneous CCN concentrations
-CHARACTER(LEN=8),SAVE :: CCCN_MODES ! CCN modes characteristics (Jungfraujoch ...)
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XR_MEAN_CCN, & ! Mean radius of CCN modes
- XLOGSIG_CCN, & ! Log of geometric dispersion of the CCN modes
- XRHO_CCN ! Density of the CCN modes
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XKHEN_MULTI, & ! Parameters defining the CCN activation
- XMUHEN_MULTI, & ! spectra for a multimodal aerosol distribution
- XBETAHEN_MULTI !
-REAL, DIMENSION(:,:,:) ,SAVE, ALLOCATABLE :: XCONC_CCN_TOT ! Total aerosol number concentration
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XLIMIT_FACTOR ! compute CHEN ????????????
+INTEGER :: NMOD_CCN ! Number of CCN modes
+REAL, DIMENSION(JPLIMACCNMAX) :: XCCN_CONC ! CCN conc. (#/cm3)
+LOGICAL :: LCCN_HOM ! True for z-homogeneous CCN concentrations
+CHARACTER(LEN=8) :: CCCN_MODES ! CCN modes characteristics (Jungfraujoch ...)
+REAL, DIMENSION(:), ALLOCATABLE :: XR_MEAN_CCN, & ! Mean radius of CCN modes
+ XLOGSIG_CCN, & ! Log of geometric dispersion of the CCN modes
+ XRHO_CCN ! Density of the CCN modes
+REAL, DIMENSION(:), ALLOCATABLE :: XKHEN_MULTI, & ! Parameters defining the CCN activation
+ XMUHEN_MULTI, & ! spectra for a multimodal aerosol distribution
+ XBETAHEN_MULTI !
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCONC_CCN_TOT ! Total aerosol number concentration
+REAL, DIMENSION(:), ALLOCATABLE :: XLIMIT_FACTOR ! compute CHEN ????????????
!
! 2.3 Water particles characteristics
!
-REAL,SAVE :: XALPHAR,XNUR, & ! Raindrop distribution parameters
+REAL :: XALPHAR,XNUR, & ! Raindrop distribution parameters
XALPHAC,XNUC ! Cloud droplet distribution parameters
!
! 2.4 CCN activation
!
-CHARACTER(LEN=3),SAVE :: HPARAM_CCN = 'CPB' ! Parameterization of the CCN activation
-CHARACTER(LEN=3),SAVE :: HINI_CCN ! Initialization type of CCN activation
-CHARACTER(LEN=10),DIMENSION(JPLIMACCNMAX),SAVE :: HTYPE_CCN ! 'M' or 'C' CCN type
-REAL,SAVE :: XFSOLUB_CCN, & ! Fractionnal solubility of the CCN
+CHARACTER(LEN=3) :: HPARAM_CCN = 'CPB' ! Parameterization of the CCN activation
+CHARACTER(LEN=3) :: HINI_CCN ! Initialization type of CCN activation
+CHARACTER(LEN=10), DIMENSION(JPLIMACCNMAX) :: HTYPE_CCN ! 'M' or 'C' CCN type
+REAL :: XFSOLUB_CCN, & ! Fractionnal solubility of the CCN
XACTEMP_CCN, & ! Expected temperature of CCN activation
XAERDIFF, XAERHEIGHT ! For the vertical gradient of aerosol distribution
!
! Cloud droplet deposition
!
-REAL, SAVE :: XVDEPOC
+REAL :: XVDEPOC
!
!-------------------------------------------------------------------------------
!
@@ -187,15 +185,15 @@ REAL, SAVE :: XVDEPOC
!* 3. BELOW CLOUD SCAVENGING
! ----------------------
!
-LOGICAL, SAVE :: LSCAV ! TRUE for aerosol scavenging by precipitations
-LOGICAL, SAVE :: LAERO_MASS ! TRUE to compute the total aerosol mass scavenging rate
+LOGICAL :: LSCAV ! TRUE for aerosol scavenging by precipitations
+LOGICAL :: LAERO_MASS ! TRUE to compute the total aerosol mass scavenging rate
!
-INTEGER :: NDIAMR = 20 ! Max Number of droplet for quadrature method
-INTEGER :: NDIAMP = 20 ! Max Number of aerosol particle for quadrature method
+INTEGER :: NDIAMR = 20 ! Max Number of droplet for quadrature method
+INTEGER :: NDIAMP = 20 ! Max Number of aerosol particle for quadrature method
!
-REAL, SAVE :: XT0SCAV = 293.15 ! [K]
-REAL, SAVE :: XTREF = 273.15 ! [K]
-REAL, SAVE :: XNDO = 8.*1.0E6 ! [/m**4]
+REAL :: XT0SCAV = 293.15 ! [K]
+REAL :: XTREF = 273.15 ! [K]
+REAL :: XNDO = 8.*1.0E6 ! [/m**4]
!
!-------------------------------------------------------------------------------
!
@@ -203,28 +201,558 @@ REAL, SAVE :: XNDO = 8.*1.0E6 ! [/m**4]
!* 4. ATMOSPHERIC & OTHER PARAMETERS
! ------------------------------
!
-REAL, SAVE :: XMUA0 = 1.711E-05 ![Pa.s] Air Viscosity at T=273.15K
-REAL, SAVE :: XT_SUTH_A = 110.4 ![K] Sutherland Temperature for Air
-REAL, SAVE :: XMFPA0 = 6.6E-08 ![m] Mean Free Path of Air under standard conditions
+REAL :: XMUA0 = 1.711E-05 ![Pa.s] Air Viscosity at T=273.15K
+REAL :: XT_SUTH_A = 110.4 ![K] Sutherland Temperature for Air
+REAL :: XMFPA0 = 6.6E-08 ![m] Mean Free Path of Air under standard conditions
!
-REAL, SAVE :: XVISCW = 1.0E-3 ![Pa.s] water viscosity at 20°C
+REAL :: XVISCW = 1.0E-3 ![Pa.s] water viscosity at 20°C
! Correction
-!REAL, SAVE :: XRHO00 = 1.292 !rho on the floor [Kg/m**3]
-REAL, SAVE :: XRHO00 = 1.2041 !rho at P=1013.25 and T=20°C
+!REAL :: XRHO00 = 1.292 !rho on the floor [Kg/m**3]
+REAL :: XRHO00 = 1.2041 !rho at P=1013.25 and T=20°C
!
-REAL,SAVE :: XCEXVT ! air density fall speed correction
+REAL :: XCEXVT ! air density fall speed correction
!
-REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values of the mixing ratios
-REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XCTMIN ! Min values of the drop concentrations
+REAL, DIMENSION(:), ALLOCATABLE :: XRTMIN ! Min values of the mixing ratios
+REAL, DIMENSION(:), ALLOCATABLE :: XCTMIN ! Min values of the drop concentrations
!
!
! Sedimentation variables
!
-INTEGER,DIMENSION(7),SAVE :: NSPLITSED
-REAL,DIMENSION(7),SAVE :: XLB
-REAL,DIMENSION(7),SAVE :: XLBEX
-REAL,DIMENSION(7),SAVE :: XD
-REAL,DIMENSION(7),SAVE :: XFSEDR
-REAL,DIMENSION(7),SAVE :: XFSEDC
+INTEGER,DIMENSION(7) :: NSPLITSED
+REAL,DIMENSION(7) :: XLB
+REAL,DIMENSION(7) :: XLBEX
+REAL,DIMENSION(7) :: XD
+REAL,DIMENSION(7) :: XFSEDR
+REAL,DIMENSION(7) :: XFSEDC
+END TYPE PARAM_LIMA_t
+!
+TYPE(PARAM_LIMA_t), TARGET, SAVE :: PARAM_LIMA
+!
+LOGICAL, POINTER :: LLIMA_DIAG => NULL(), &
+ LPTSPLIT => NULL(), &
+ LFEEDBACKT => NULL(), &
+ LNUCL => NULL(), &
+ LSEDI => NULL(), &
+ LHHONI => NULL(), &
+ LMEYERS => NULL(), &
+ LCIBU => NULL(), &
+ LRDSF => NULL(), &
+ LIFN_HOM => NULL(), &
+ LSNOW_T => NULL(), &
+ LMURAKAMI => NULL(), &
+ LACTI => NULL(), &
+ LSEDC => NULL(), &
+ LACTIT => NULL(), &
+ LDEPOC => NULL(), &
+ LACTTKE => NULL(), &
+ LADJ => NULL(), &
+ LSPRO => NULL(), &
+ LKHKO => NULL(), &
+ LKESSLERAC => NULL(), &
+ LCCN_HOM => NULL(), &
+ LSCAV => NULL(), &
+ LAERO_MASS => NULL()
+
+INTEGER, POINTER :: NMAXITER => NULL(), &
+ NMOM_I => NULL(), &
+ NMOM_S => NULL(), &
+ NMOM_G => NULL(), &
+ NMOM_H => NULL(), &
+ NMOD_IFN => NULL(), &
+ NMOD_IMM => NULL(), &
+ NIND_SPECIE => NULL(), &
+ NSPECIE => NULL(), &
+ NPHILLIPS => NULL(), &
+ NDIAM => NULL(), &
+ NMOM_C => NULL(), &
+ NMOM_R => NULL(), &
+ NMOD_CCN => NULL(), &
+ NDIAMR => NULL(), &
+ NDIAMP => NULL()
+
+REAL, POINTER :: XMRSTEP => NULL(), &
+ XTSTEP_TS => NULL(), &
+ XALPHAI => NULL(), &
+ XNUI => NULL(), &
+ XALPHAS => NULL(), &
+ XNUS => NULL(), &
+ XALPHAG => NULL(), &
+ XNUG => NULL(), &
+ XSW0 => NULL(), &
+ XRHO_CFDC => NULL(), &
+ XGAMMA => NULL(), &
+ XFACTNUC_DEP => NULL(), &
+ XFACTNUC_CON => NULL(), &
+ XNDEBRIS_CIBU => NULL(), &
+ XALPHAR => NULL(), &
+ XNUR => NULL(), &
+ XALPHAC => NULL(), &
+ XNUC => NULL(), &
+ XFSOLUB_CCN => NULL(), &
+ XACTEMP_CCN => NULL(), &
+ XAERDIFF => NULL(), &
+ XAERHEIGHT => NULL(), &
+ XVDEPOC => NULL(), &
+ XT0SCAV => NULL(), &
+ XTREF => NULL(), &
+ XNDO => NULL(), &
+ XMUA0 => NULL(), &
+ XT_SUTH_A => NULL(), &
+ XMFPA0 => NULL(), &
+ XVISCW => NULL(), &
+ XRHO00 => NULL(), &
+ XCEXVT => NULL()
+
+REAL, DIMENSION(:), POINTER :: XIFN_CONC => NULL(), &
+ XMDIAM_IFN => NULL(), &
+ XSIGMA_IFN => NULL(), &
+ XRHO_IFN => NULL(), &
+ XFRAC_REF => NULL(), &
+ XT0 => NULL(), &
+ XDT0 => NULL(), &
+ XDSI0 => NULL(), &
+ XH => NULL(), &
+ XAREA1 => NULL(), &
+ XTX1 => NULL(), &
+ XTX2 => NULL(), &
+ XABSCISS => NULL(), &
+ XWEIGHT => NULL(), &
+ XCCN_CONC => NULL(), &
+ XR_MEAN_CCN => NULL(), &
+ XLOGSIG_CCN => NULL(), &
+ XRHO_CCN => NULL(), &
+ XKHEN_MULTI => NULL(), &
+ XMUHEN_MULTI => NULL(), &
+ XBETAHEN_MULTI => NULL(), &
+ XLIMIT_FACTOR => NULL(), &
+ XRTMIN => NULL(), &
+ XCTMIN => NULL(), &
+ XLB => NULL(), &
+ XLBEX => NULL(), &
+ XD => NULL(), &
+ XFSEDR => NULL(), &
+ XFSEDC => NULL()
+
+REAL, DIMENSION(:,:), POINTER :: XFRAC => NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XCONC_CCN_TOT => NULL()
+
+INTEGER, DIMENSION(:), POINTER :: NIMM => NULL(), &
+ NINDICE_CCN_IMM => NULL(), &
+ NSPLITSED => NULL()
+
+CHARACTER(LEN=8), POINTER :: CIFN_SPECIES => NULL()
+CHARACTER(LEN=8), POINTER :: CINT_MIXING => NULL()
+CHARACTER(LEN=4), POINTER :: CPRISTINE_ICE_LIMA => NULL()
+CHARACTER(LEN=4), POINTER :: CHEVRIMED_ICE_LIMA => NULL()
+CHARACTER(LEN=8), POINTER :: CCCN_MODES => NULL()
+CHARACTER(LEN=3), POINTER :: HPARAM_CCN => NULL()
+CHARACTER(LEN=3), POINTER :: HINI_CCN => NULL()
+CHARACTER(LEN=10), DIMENSION(:), POINTER :: HTYPE_CCN
+
+NAMELIST/NAM_PARAM_LIMA/LNUCL, LSEDI, LHHONI, LMEYERS, &
+ NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, &
+ CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
+ LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ !XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
+ XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
+ LCIBU, XNDEBRIS_CIBU, LRDSF, LMURAKAMI, &
+ LACTI, LSEDC, LACTIT, LSPRO, &
+ LADJ, LKHKO, LKESSLERAC, NMOM_C, NMOM_R, &
+ NMOD_CCN, XCCN_CONC, &
+ LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
+ XALPHAC, XNUC, XALPHAR, XNUR, &
+ XFSOLUB_CCN, XACTEMP_CCN, XAERDIFF, XAERHEIGHT, &
+ LSCAV, LAERO_MASS, LDEPOC, XVDEPOC, LACTTKE, &
+ LPTSPLIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS
+
+CONTAINS
+SUBROUTINE PARAM_LIMA_ASSOCIATE()
+IMPLICIT NONE
+
+IF(.NOT. ASSOCIATED(LLIMA_DIAG)) THEN
+ LLIMA_DIAG => PARAM_LIMA%LLIMA_DIAG
+ LPTSPLIT => PARAM_LIMA%LPTSPLIT
+ LFEEDBACKT => PARAM_LIMA%LFEEDBACKT
+ LNUCL => PARAM_LIMA%LNUCL
+ LSEDI => PARAM_LIMA%LSEDI
+ LHHONI => PARAM_LIMA%LHHONI
+ LMEYERS => PARAM_LIMA%LMEYERS
+ LCIBU => PARAM_LIMA%LCIBU
+ LRDSF => PARAM_LIMA%LRDSF
+ LIFN_HOM => PARAM_LIMA%LIFN_HOM
+ LSNOW_T => PARAM_LIMA%LSNOW_T
+ LMURAKAMI => PARAM_LIMA%LMURAKAMI
+ LACTI => PARAM_LIMA%LACTI
+ LSEDC => PARAM_LIMA%LSEDC
+ LACTIT => PARAM_LIMA%LACTIT
+ LDEPOC => PARAM_LIMA%LDEPOC
+ LACTTKE => PARAM_LIMA%LACTTKE
+ LADJ => PARAM_LIMA%LADJ
+ LSPRO => PARAM_LIMA%LSPRO
+ LKHKO => PARAM_LIMA%LKHKO
+ LKESSLERAC => PARAM_LIMA%LKESSLERAC
+ LCCN_HOM => PARAM_LIMA%LCCN_HOM
+ LSCAV => PARAM_LIMA%LSCAV
+ LAERO_MASS => PARAM_LIMA%LAERO_MASS
+
+ NMAXITER => PARAM_LIMA%NMAXITER
+ NMOM_I => PARAM_LIMA%NMOM_I
+ NMOM_S => PARAM_LIMA%NMOM_S
+ NMOM_G => PARAM_LIMA%NMOM_G
+ NMOM_H => PARAM_LIMA%NMOM_H
+ NMOD_IFN => PARAM_LIMA%NMOD_IFN
+ NMOD_IMM => PARAM_LIMA%NMOD_IMM
+ NIND_SPECIE => PARAM_LIMA%NIND_SPECIE
+ NSPECIE => PARAM_LIMA%NSPECIE
+ NPHILLIPS => PARAM_LIMA%NPHILLIPS
+ NDIAM => PARAM_LIMA%NDIAM
+ NMOM_C => PARAM_LIMA%NMOM_C
+ NMOM_R => PARAM_LIMA%NMOM_R
+ NMOD_CCN => PARAM_LIMA%NMOD_CCN
+ NDIAMR => PARAM_LIMA%NDIAMR
+ NDIAMP => PARAM_LIMA%NDIAMP
+
+ XMRSTEP => PARAM_LIMA%XMRSTEP
+ XTSTEP_TS => PARAM_LIMA%XTSTEP_TS
+ XALPHAI => PARAM_LIMA%XALPHAI
+ XNUI => PARAM_LIMA%XNUI
+ XALPHAS => PARAM_LIMA%XALPHAS
+ XNUS => PARAM_LIMA%XNUS
+ XALPHAG => PARAM_LIMA%XALPHAG
+ XNUG => PARAM_LIMA%XNUG
+ XSW0 => PARAM_LIMA%XSW0
+ XRHO_CFDC => PARAM_LIMA%XRHO_CFDC
+ XGAMMA => PARAM_LIMA%XGAMMA
+ XFACTNUC_DEP => PARAM_LIMA%XFACTNUC_DEP
+ XFACTNUC_CON => PARAM_LIMA%XFACTNUC_CON
+ XNDEBRIS_CIBU => PARAM_LIMA%XNDEBRIS_CIBU
+ XALPHAR => PARAM_LIMA%XALPHAR
+ XNUR => PARAM_LIMA%XNUR
+ XALPHAC => PARAM_LIMA%XALPHAC
+ XNUC => PARAM_LIMA%XNUC
+ XFSOLUB_CCN => PARAM_LIMA%XFSOLUB_CCN
+ XACTEMP_CCN => PARAM_LIMA%XACTEMP_CCN
+ XAERDIFF => PARAM_LIMA%XAERDIFF
+ XAERHEIGHT => PARAM_LIMA%XAERHEIGHT
+ XVDEPOC => PARAM_LIMA%XVDEPOC
+ XT0SCAV => PARAM_LIMA%XT0SCAV
+ XTREF => PARAM_LIMA%XTREF
+ XNDO => PARAM_LIMA%XNDO
+ XMUA0 => PARAM_LIMA%XMUA0
+ XT_SUTH_A => PARAM_LIMA%XT_SUTH_A
+ XMFPA0 => PARAM_LIMA%XMFPA0
+ XVISCW => PARAM_LIMA%XVISCW
+ XRHO00 => PARAM_LIMA%XRHO00
+ XCEXVT => PARAM_LIMA%XCEXVT
+
+ XIFN_CONC => PARAM_LIMA%XIFN_CONC
+ XT0 => PARAM_LIMA%XT0
+ XDT0 => PARAM_LIMA%XDT0
+ XDSI0 => PARAM_LIMA%XDSI0
+ XH => PARAM_LIMA%XH
+ XAREA1 => PARAM_LIMA%XAREA1
+ XTX1 => PARAM_LIMA%XTX1
+ XTX2 => PARAM_LIMA%XTX2
+ XCCN_CONC => PARAM_LIMA%XCCN_CONC
+ XLB => PARAM_LIMA%XLB
+ XLBEX => PARAM_LIMA%XLBEX
+ XD => PARAM_LIMA%XD
+ XFSEDR => PARAM_LIMA%XFSEDR
+ XFSEDC => PARAM_LIMA%XFSEDC
+
+ NSPLITSED => PARAM_LIMA%NSPLITSED
+
+ CIFN_SPECIES => PARAM_LIMA%CIFN_SPECIES
+ CINT_MIXING => PARAM_LIMA%CINT_MIXING
+ CPRISTINE_ICE_LIMA => PARAM_LIMA%CPRISTINE_ICE_LIMA
+ CHEVRIMED_ICE_LIMA => PARAM_LIMA%CHEVRIMED_ICE_LIMA
+ CCCN_MODES => PARAM_LIMA%CCCN_MODES
+ HPARAM_CCN => PARAM_LIMA%HPARAM_CCN
+ HINI_CCN => PARAM_LIMA%HINI_CCN
+ HTYPE_CCN => PARAM_LIMA%HTYPE_CCN
+ENDIF
+END SUBROUTINE PARAM_LIMA_ASSOCIATE
+!
+SUBROUTINE PARAM_LIMA_DEALLOCATE(HNAME)
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ SELECT CASE(TRIM(HNAME))
+ CASE('NINDICE_CCN_IMM')
+ DEALLOCATE(PARAM_LIMA%NINDICE_CCN_IMM)
+ NINDICE_CCN_IMM => NULL()
+ END SELECT
+END SUBROUTINE PARAM_LIMA_DEALLOCATE
+!
+SUBROUTINE PARAM_LIMA_ALLOCATE(HNAME, KDIM1, KDIM2, KDIM3)
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ INTEGER, INTENT(IN) :: KDIM1
+ INTEGER, OPTIONAL, INTENT(IN) :: KDIM2
+ INTEGER, OPTIONAL, INTENT(IN) :: KDIM3
+
+ SELECT CASE(TRIM(HNAME))
+ !1D arrays
+ CASE('NIMM')
+ ALLOCATE(PARAM_LIMA%NIMM(KDIM1))
+ NIMM => PARAM_LIMA%NIMM
+ CASE('NINDICE_CCN_IMM')
+ ALLOCATE(PARAM_LIMA%NINDICE_CCN_IMM(KDIM1))
+ NINDICE_CCN_IMM => PARAM_LIMA%NINDICE_CCN_IMM
+ CASE('XMDIAM_IFN')
+ ALLOCATE(PARAM_LIMA%XMDIAM_IFN(KDIM1))
+ XMDIAM_IFN => PARAM_LIMA%XMDIAM_IFN
+ CASE('XSIGMA_IFN')
+ ALLOCATE(PARAM_LIMA%XSIGMA_IFN(KDIM1))
+ XSIGMA_IFN => PARAM_LIMA%XSIGMA_IFN
+ CASE('XRHO_IFN')
+ ALLOCATE(PARAM_LIMA%XRHO_IFN(KDIM1))
+ XRHO_IFN => PARAM_LIMA%XRHO_IFN
+ CASE('XFRAC_REF')
+ ALLOCATE(PARAM_LIMA%XFRAC_REF(KDIM1))
+ XFRAC_REF => PARAM_LIMA%XFRAC_REF
+ CASE('XABSCISS')
+ ALLOCATE(PARAM_LIMA%XABSCISS(KDIM1))
+ XABSCISS => PARAM_LIMA%XABSCISS
+ CASE('XWEIGHT')
+ ALLOCATE(PARAM_LIMA%XWEIGHT(KDIM1))
+ XWEIGHT => PARAM_LIMA%XWEIGHT
+ CASE('XR_MEAN_CCN')
+ ALLOCATE(PARAM_LIMA%XR_MEAN_CCN(KDIM1))
+ XR_MEAN_CCN => PARAM_LIMA%XR_MEAN_CCN
+ CASE('XLOGSIG_CCN')
+ ALLOCATE(PARAM_LIMA%XLOGSIG_CCN(KDIM1))
+ XLOGSIG_CCN => PARAM_LIMA%XLOGSIG_CCN
+ CASE('XRHO_CCN')
+ ALLOCATE(PARAM_LIMA%XRHO_CCN(KDIM1))
+ XRHO_CCN => PARAM_LIMA%XRHO_CCN
+ CASE('XKHEN_MULTI')
+ ALLOCATE(PARAM_LIMA%XKHEN_MULTI(KDIM1))
+ XKHEN_MULTI => PARAM_LIMA%XKHEN_MULTI
+ CASE('XMUHEN_MULTI')
+ ALLOCATE(PARAM_LIMA%XMUHEN_MULTI(KDIM1))
+ XMUHEN_MULTI => PARAM_LIMA%XMUHEN_MULTI
+ CASE('XBETAHEN_MULTI')
+ ALLOCATE(PARAM_LIMA%XBETAHEN_MULTI(KDIM1))
+ XBETAHEN_MULTI => PARAM_LIMA%XBETAHEN_MULTI
+ CASE('XLIMIT_FACTOR')
+ ALLOCATE(PARAM_LIMA%XLIMIT_FACTOR(KDIM1))
+ XLIMIT_FACTOR => PARAM_LIMA%XLIMIT_FACTOR
+ CASE('XRTMIN')
+ ALLOCATE(PARAM_LIMA%XRTMIN(KDIM1))
+ XRTMIN => PARAM_LIMA%XRTMIN
+ CASE('XCTMIN')
+ ALLOCATE(PARAM_LIMA%XCTMIN(KDIM1))
+ XCTMIN => PARAM_LIMA%XCTMIN
+ !
+ !2D arrays
+ CASE('XFRAC')
+ ALLOCATE(PARAM_LIMA%XFRAC(KDIM1, KDIM2))
+ XFRAC => PARAM_LIMA%XFRAC
+ !
+ !3D arrays
+! CASE('XCONC_CCN_TOT')
+! ALLOCATE(PARAM_LIMA%XCONC_CCN_TOT(KDIM1, KDIM2))
+! XCONC_CCN_TOT => PARAM_LIMA%XCONC_CCN_TOT
+ END SELECT
+END SUBROUTINE PARAM_LIMA_ALLOCATE
+!
+SUBROUTINE PARAM_LIMA_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ &LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
+!!*** *PARAM_ICEN_INIT* - Code needed to initialize the MODD_PARAM_LIMA module
+!!
+!!* PURPOSE
+!! -------
+!! Sets the default values, reads the namelist, performs the checks and prints
+!!
+!!* METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Default values
+!! 2. Namelist
+!! 3. Checks
+!! 4. Prints
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Apr 2023
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
+INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
+INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
+LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDREADNAM !< Must we read the namelist (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDCHECK !< Must we perform some checks on values (defaults to .TRUE.)
+INTEGER, OPTIONAL, INTENT(IN) :: KPRINT !< Print level (defaults to 0): 0 for no print, 1 to safely print namelist,
+ !! 2 to print informative messages
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+LOGICAL :: LLDEFAULTVAL, LLREADNAM, LLCHECK, LLFOUND
+INTEGER :: IPRINT
+
+LLDEFAULTVAL=.TRUE.
+LLREADNAM=.TRUE.
+LLCHECK=.TRUE.
+IPRINT=0
+IF(PRESENT(LDDEFAULTVAL)) LLDEFAULTVAL=LDDEFAULTVAL
+IF(PRESENT(LDREADNAM )) LLREADNAM =LDREADNAM
+IF(PRESENT(LDCHECK )) LLCHECK =LDCHECK
+IF(PRESENT(KPRINT )) IPRINT =KPRINT
+!
+!* 1. DEFAULT VALUES
+! -----------------
+!
+IF(LLDEFAULTVAL) THEN
+ !NOTES ON GENERAL DEFAULTS AND MODEL-SPECIFIC DEFAULTS :
+ !- General default values *MUST* remain unchanged.
+ !- To change the default value for a given application,
+ ! an "IF(HPROGRAM=='...')" condition must be used.
+
+ LNUCL=.TRUE.
+ LSEDI=.TRUE.
+ LHHONI = .FALSE.
+ LMEYERS = .FALSE.
+ NMOM_I = 2
+ NMOM_S = 1
+ NMOM_G = 1
+ NMOM_H = 0
+ NMOD_IFN = 1
+ XIFN_CONC(:) = 100.
+ LIFN_HOM = .TRUE.
+ CIFN_SPECIES = 'PHILLIPS'
+ CINT_MIXING = 'DM2'
+ NMOD_IMM = 0
+ NIND_SPECIE = 1
+ LSNOW_T = .FALSE.
+ CPRISTINE_ICE_LIMA = 'PLAT'
+ CHEVRIMED_ICE_LIMA = 'GRAU'
+ !XALPHAI=
+ !XNUI=
+ !XALPHAS=
+ !XNUS=
+ !XALPHAG=
+ !XNUG=
+ XFACTNUC_DEP = 1.0
+ XFACTNUC_CON = 1.0
+ NPHILLIPS=8
+ LCIBU = .FALSE.
+ XNDEBRIS_CIBU = 50.0
+ LRDSF = .FALSE.
+ LMURAKAMI=.TRUE.
+ LACTI = .TRUE.
+ LSEDC = .TRUE.
+ LACTIT = .FALSE.
+ LSPRO = .FALSE.
+ LADJ = .TRUE.
+ LKHKO = .FALSE.
+ LKESSLERAC = .FALSE.
+ NMOM_C = 2
+ NMOM_R = 2
+ NMOD_CCN = 1
+ XCCN_CONC(:)=300.
+ LCCN_HOM = .TRUE.
+ CCCN_MODES = 'COPT'
+ HINI_CCN = 'AER'
+ HTYPE_CCN(:) = 'M'
+ XALPHAC = 3.0
+ XNUC = 1.0
+ XALPHAR = 1.0
+ XNUR = 2.0
+ XFSOLUB_CCN = 1.0
+ XACTEMP_CCN = 280.
+ XAERDIFF = 0.0
+ XAERHEIGHT = 2000.
+ LSCAV = .FALSE.
+ LAERO_MASS = .FALSE.
+ LDEPOC = .TRUE.
+ XVDEPOC = 0.02 ! 2 cm/s
+ LACTTKE = .TRUE.
+ LPTSPLIT = .TRUE.
+ LFEEDBACKT = .TRUE.
+ NMAXITER = 5
+ XMRSTEP = 0.005
+ XTSTEP_TS = 20.
+ENDIF
+!
+!* 2. NAMELIST
+! -----------
+!
+IF(LLREADNAM) THEN
+ CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_LIMA', LDNEEDNAM, LLFOUND, KLUOUT)
+ IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_LIMA)
+ENDIF
+!
+!* 3. CHECKS
+! ---------
+!
+IF(LLCHECK) THEN
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CPRISTINE_ICE_LIMA', CPRISTINE_ICE_LIMA, &
+ 'PLAT', 'COLU', 'BURO')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CHEVRIMED_ICE_LIMA', CHEVRIMED_ICE_LIMA, &
+ 'GRAU', 'HAIL')
+
+ IF ((LACTI .AND. HINI_CCN == 'XXX')) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODD_PARAM_LIMA', &
+ &"YOU WANT TO USE A 2-MOMENT MICROPHYSICAL " // &
+ &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_LIMA" // &
+ &" YOU HAVE TO FILL HINI_CCN ")
+ END IF
+
+ IF(LACTI .AND. NMOD_CCN == 0) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODD_PARAM_LIMA', &
+ &"ACTIVATION OF AEROSOL PARTICLES IS NOT " // &
+ &"POSSIBLE IF NMOD_CCN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER " // &
+ &"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")
+ END IF
+
+ IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODD_PARAM_LIMA', &
+ &"NUCLEATION BY DEPOSITION AND CONTACT IS NOT " // &
+ &"POSSIBLE IF NMOD_IFN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER" // &
+ &"VALUE OF NMOD_IFN IN ORDER TO USE LIMA COLD NUCLEATION SCHEME.")
+ END IF
+
+ IF(HPROGRAM=='AROME' .OR. HPROGRAM=='PHYEX') THEN
+ IF(.NOT. LPTSPLIT) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODD_PARAM_LIMA', &
+ &"LPTSPLIT must be .TRUE. with this program: " // HPROGRAM)
+ ENDIF
+ IF(LSPRO) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODD_PARAM_LIMA', &
+ &"LSPRO must be .FALSE. with this program: " // HPROGRAM)
+ ENDIF
+ ENDIF
+ENDIF
+!
+!* 3. PRINTS
+! ---------
+!
+IF(IPRINT>=1) THEN
+ WRITE(UNIT=KLUOUT, NML=NAM_PARAM_LIMA)
+ENDIF
+!
+END SUBROUTINE PARAM_LIMA_INIT
!
END MODULE MODD_PARAM_LIMA
diff --git a/src/PHYEX/micro/modd_param_lima_cold.f90 b/src/PHYEX/micro/modd_param_lima_cold.f90
index 337480312280e054f1abdaabadfa4ca829fda3ae..3134e583f585419a5121808a9ac0fd302a1b9e89 100644
--- a/src/PHYEX/micro/modd_param_lima_cold.f90
+++ b/src/PHYEX/micro/modd_param_lima_cold.f90
@@ -6,9 +6,9 @@
! ###########################
MODULE MODD_PARAM_LIMA_COLD
! ###########################
-!
+!> @file
!!**** *MODD_PARAM_LIMA_COLD* - declaration of some descriptive parameters and
-!! microphysical factors extensively used in
+!! microphysical factors extensively used in
!! the LIMA cold scheme.
!! AUTHOR
!! ------
@@ -18,7 +18,7 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original ??/??/13
+!! Original ??/??/13
!! C. Barthe 14/03/2022 add CIBU and RDSF
! J. Wurtz 03/2022: new snow characteristics
! M. Taufour 07/2022: add concentration for snow, graupel, hail
@@ -26,13 +26,13 @@
!-------------------------------------------------------------------------------
USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
!
-IMPLICIT NONE
+IMPLICIT NONE
!
!* 1. DESCRIPTIVE PARAMETERS
! ----------------------
!
! Declaration of microphysical constants, including the descriptive
-! parameters for the raindrop and the ice crystal habits, and the
+! parameters for the raindrop and the ice crystal habits, and the
! parameters relevant of the dimensional distributions.
!
! m(D) = XAx * D**XBx : Mass-MaxDim relationship
@@ -43,109 +43,379 @@ IMPLICIT NONE
!
! 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
!
-REAL,SAVE :: XLBEXI,XLBI ! Prist. ice distribution parameters
-REAL,SAVE :: XLBEXS,XLBS,XNS ! Snow/agg. distribution parameters
+TYPE PARAM_LIMA_COLD_t
+REAL :: XLBEXI,XLBI ! Prist. ice distribution parameters
+REAL :: XLBEXS,XLBS,XNS ! Snow/agg. distribution parameters
!
-REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
-REAL,SAVE :: XF0IS,XF1IS ! (large Di vent. coef.)
-REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
+REAL :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
+REAL :: XF0IS,XF1IS ! (large Di vent. coef.)
+REAL :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
!
-REAL,SAVE :: XLBDAS_MIN, XLBDAS_MAX ! Max values allowed for the shape parameter of snow
-REAL,SAVE :: XFVELOS ! Wurtz - snow fall speed parameterizaed after Thompson 2008
-REAL,SAVE :: XTRANS_MP_GAMMAS ! Wurtz - change between lambda value for MP and gen. gamma
+REAL :: XLBDAS_MIN, XLBDAS_MAX ! Max values allowed for the shape parameter of snow
+REAL :: XFVELOS ! Wurtz - snow fall speed parameterizaed after Thompson 2008
+REAL :: XTRANS_MP_GAMMAS ! Wurtz - change between lambda value for MP and gen. gamma
!
-CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(8),PARAMETER &
- :: CLIMA_COLD_NAMES=(/'CICE ','CSNOW ','CGRAUPEL','CHAIL ',&
- 'CIFNFREE','CIFNNUCL', &
- 'CCNINIMM','CCCNNUCL'/)
- ! basenames of the SV articles stored
- ! in the binary files
- !with IF:Ice-nuclei Free (nonactivated IFN by Dep/Cond)
- ! IN:Ice-nuclei Nucleated (activated IFN by Dep/Cond)
- ! NI:Nuclei Immersed (activated IFN by Imm)
- ! HF:Homogeneous Freezing
-CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(8),PARAMETER &
- :: CLIMA_COLD_CONC=(/'NI ','NS ','NG ','NH ','NIF','NIN','NNI','NNH'/)!for DIAG
!
!-------------------------------------------------------------------------------
!
!* 2. MICROPHYSICAL FACTORS
! ---------------------
!
-REAL,SAVE :: XFSEDRI,XFSEDCI, & ! Constants for sedimentation
- XFSEDRS,XFSEDCS, & !
- XFSEDS, XEXSEDS ! fluxes of ice and snow
+REAL :: XFSEDRI,XFSEDCI, & ! Constants for sedimentation
+ XFSEDRS,XFSEDCS, & !
+ XFSEDS, XEXSEDS ! fluxes of ice and snow
!
-REAL,SAVE :: XNUC_DEP,XEXSI_DEP,XEX_DEP, & ! Constants for heterogeneous
+REAL :: XNUC_DEP,XEXSI_DEP,XEX_DEP, & ! Constants for heterogeneous
XNUC_CON,XEXTT_CON,XEX_CON, & ! ice nucleation : DEP et CON
XMNU0 ! mass of nucleated ice crystal
!
-REAL,SAVE :: XRHOI_HONH,XCEXP_DIFVAP_HONH, & ! Constants for homogeneous
+REAL :: XRHOI_HONH,XCEXP_DIFVAP_HONH, & ! Constants for homogeneous
XCOEF_DIFVAP_HONH,XRCOEF_HONH, & ! haze freezing : HHONI
XCRITSAT1_HONH,XCRITSAT2_HONH, &
XTMIN_HONH,XTMAX_HONH, &
XDLNJODT1_HONH,XDLNJODT2_HONH, &
XC1_HONH,XC2_HONH,XC3_HONH
!
-REAL,SAVE :: XC_HONC,XR_HONC, & ! Constants for homogeneous
+REAL :: XC_HONC,XR_HONC, & ! Constants for homogeneous
XTEXP1_HONC,XTEXP2_HONC, & ! droplet freezing : CHONI
XTEXP3_HONC,XTEXP4_HONC, &
XTEXP5_HONC
!
-REAL,SAVE :: XCSCNVI_MAX, XLBDASCNVI_MAX, &
+REAL :: XCSCNVI_MAX, XLBDASCNVI_MAX, &
XRHORSMIN, &
XDSCNVI_LIM, XLBDASCNVI_LIM, & ! Constants for snow
XC0DEPSI,XC1DEPSI, & ! sublimation conversion to
XR0DEPSI,XR1DEPSI ! pristine ice : SCNVI
!
-REAL,SAVE :: XSCFAC, & ! Constants for the Bergeron
+REAL :: XSCFAC, & ! Constants for the Bergeron
X0DEPI,X2DEPI, & ! Findeisen process and
X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS ! deposition
!
-REAL,SAVE :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice
+REAL :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice
XC0DEPIS,XC1DEPIS, & ! deposition conversion to
XR0DEPIS,XR1DEPIS ! snow : ICNVS
!
-REAL,SAVE :: XCOLEXIS, & ! Constants for snow
- XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG
+REAL :: XCOLEXIS, & ! Constants for snow
+ XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG
XAGGS_RLARGE1,XAGGS_RLARGE2, &
XFIAGGS,XEXIAGGS
!
-REAL,SAVE :: XACCS1, XSPONBUDS1, XSPONBUDS2, & ! Constant for snow
+REAL :: XACCS1, XSPONBUDS1, XSPONBUDS2, & ! Constant for snow
XSPONBUDS3, XSPONCOEFS2 ! spontaneous break-up
!
!??????????????????
-REAL,SAVE :: XKER_ZRNIC_A1,XKER_ZRNIC_A2 ! Long-Zrnic Kernels (ini_ice_coma)
+REAL :: XKER_ZRNIC_A1,XKER_ZRNIC_A2 ! Long-Zrnic Kernels (ini_ice_coma)
!
-REAL,SAVE :: XSELFI,XCOLEXII ! Constants for pristine ice
+REAL :: XSELFI,XCOLEXII ! Constants for pristine ice
! self-collection (ini_ice_coma)
!
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE :: XKER_N_SSCS
-REAL,SAVE :: XCOLSS,XCOLEXSS,XFNSSCS, & !
+REAL,DIMENSION(:,:), ALLOCATABLE :: XKER_N_SSCS
+REAL :: XCOLSS,XCOLEXSS,XFNSSCS, & !
XLBNSSCS1,XLBNSSCS2, & ! Constants for snow self collection
- XSCINTP1S,XSCINTP2S !
-INTEGER,SAVE :: NSCLBDAS !
+ XSCINTP1S,XSCINTP2S !
+INTEGER :: NSCLBDAS !
-REAL,SAVE :: XAUTO3, XAUTO4, & ! Constants for pristine ice
+REAL :: XAUTO3, XAUTO4, & ! Constants for pristine ice
XLAUTS, XLAUTS_THRESHOLD, & ! autoconversion : AUT
- XITAUTS, XITAUTS_THRESHOLD, & ! (ini_ice_com)
+ XITAUTS, XITAUTS_THRESHOLD, & ! (ini_ice_com)
XTEXAUTI
!
-REAL,SAVE :: XCONCI_MAX ! Limitation of the pristine
- ! ice concentration (init and grid-nesting)
-REAL,SAVE :: XFREFFI ! Factor to compute the cloud ice effective radius
+REAL :: XCONCI_MAX ! Limitation of the pristine
+ ! ice concentration (init and grid-nesting)
+REAL :: XFREFFI ! Factor to compute the cloud ice effective radius
!
! For ICE4 nucleation
-REAL, SAVE :: XALPHA1
-REAL, SAVE :: XALPHA2
-REAL, SAVE :: XBETA1
-REAL, SAVE :: XBETA2
-REAL, SAVE :: XNU10
-REAL, SAVE :: XNU20
+REAL :: XALPHA1
+REAL :: XALPHA2
+REAL :: XBETA1
+REAL :: XBETA2
+REAL :: XNU10
+REAL :: XNU20
+END TYPE PARAM_LIMA_COLD_t
+!
+TYPE(PARAM_LIMA_COLD_t), TARGET, SAVE :: PARAM_LIMA_COLD
+!
+REAL, POINTER :: XLBEXI => NULL(), &
+ XLBI => NULL(), &
+ XLBEXS => NULL(), &
+ XLBS => NULL(), &
+ XNS => NULL(), &
+ XAI => NULL(), &
+ XBI => NULL(), &
+ XC_I => NULL(), &
+ XDI => NULL(), &
+ XF0I => NULL(), &
+ XF2I => NULL(), &
+ XC1I => NULL(), &
+ XF0IS => NULL(), &
+ XF1IS => NULL(), &
+ XAS => NULL(), &
+ XBS => NULL(), &
+ XCS => NULL(), &
+ XDS => NULL(), &
+ XCCS => NULL(), &
+ XCXS => NULL(), &
+ XF0S => NULL(), &
+ XF1S => NULL(), &
+ XC1S => NULL(), &
+ XLBDAS_MIN => NULL(), &
+ XLBDAS_MAX => NULL(), &
+ XFVELOS => NULL(), &
+ XTRANS_MP_GAMMAS => NULL(), &
+ XFSEDRI => NULL(), &
+ XFSEDCI => NULL(), &
+ XFSEDRS => NULL(), &
+ XFSEDCS => NULL(), &
+ XFSEDS => NULL(), &
+ XEXSEDS => NULL(), &
+ XNUC_DEP => NULL(), &
+ XEXSI_DEP => NULL(), &
+ XEX_DEP => NULL(), &
+ XNUC_CON => NULL(), &
+ XEXTT_CON => NULL(), &
+ XEX_CON => NULL(), &
+ XMNU0 => NULL(), &
+ XRHOI_HONH => NULL(), &
+ XCEXP_DIFVAP_HONH => NULL(), &
+ XCOEF_DIFVAP_HONH => NULL(), &
+ XRCOEF_HONH => NULL(), &
+ XCRITSAT1_HONH => NULL(), &
+ XCRITSAT2_HONH => NULL(), &
+ XTMIN_HONH => NULL(), &
+ XTMAX_HONH => NULL(), &
+ XDLNJODT1_HONH => NULL(), &
+ XDLNJODT2_HONH => NULL(), &
+ XC1_HONH => NULL(), &
+ XC2_HONH => NULL(), &
+ XC3_HONH => NULL(), &
+ XC_HONC => NULL(), &
+ XR_HONC => NULL(), &
+ XTEXP1_HONC => NULL(), &
+ XTEXP2_HONC => NULL(), &
+ XTEXP3_HONC => NULL(), &
+ XTEXP4_HONC => NULL(), &
+ XTEXP5_HONC => NULL(), &
+ XCSCNVI_MAX => NULL(), &
+ XLBDASCNVI_MAX => NULL(), &
+ XRHORSMIN => NULL(), &
+ XDSCNVI_LIM => NULL(), &
+ XLBDASCNVI_LIM => NULL(), &
+ XC0DEPSI => NULL(), &
+ XC1DEPSI => NULL(), &
+ XR0DEPSI => NULL(), &
+ XR1DEPSI => NULL(), &
+ XSCFAC => NULL(), &
+ X0DEPI => NULL(), &
+ X2DEPI => NULL(), &
+ X0DEPS => NULL(), &
+ X1DEPS => NULL(), &
+ XEX0DEPS => NULL(), &
+ XEX1DEPS => NULL(), &
+ XDICNVS_LIM => NULL(), &
+ XLBDAICNVS_LIM => NULL(), &
+ XC0DEPIS => NULL(), &
+ XC1DEPIS => NULL(), &
+ XR0DEPIS => NULL(), &
+ XR1DEPIS => NULL(), &
+ XCOLEXIS => NULL(), &
+ XAGGS_CLARGE1 => NULL(), &
+ XAGGS_CLARGE2 => NULL(), &
+ XAGGS_RLARGE1 => NULL(), &
+ XAGGS_RLARGE2 => NULL(), &
+ XFIAGGS => NULL(), &
+ XEXIAGGS => NULL(), &
+ XACCS1 => NULL(), &
+ XSPONBUDS1 => NULL(), &
+ XSPONBUDS2 => NULL(), &
+ XSPONBUDS3 => NULL(), &
+ XSPONCOEFS2 => NULL(), &
+ XKER_ZRNIC_A1 => NULL(), &
+ XKER_ZRNIC_A2 => NULL(), &
+ XSELFI => NULL(), &
+ XCOLEXII => NULL(), &
+ XCOLSS => NULL(), &
+ XCOLEXSS => NULL(), &
+ XFNSSCS => NULL(), &
+ XLBNSSCS1 => NULL(), &
+ XLBNSSCS2 => NULL(), &
+ XSCINTP1S => NULL(), &
+ XSCINTP2S => NULL(), &
+ XAUTO3 => NULL(), &
+ XAUTO4 => NULL(), &
+ XLAUTS => NULL(), &
+ XLAUTS_THRESHOLD => NULL(), &
+ XITAUTS => NULL(), &
+ XITAUTS_THRESHOLD => NULL(), &
+ XTEXAUTI => NULL(), &
+ XCONCI_MAX => NULL(), &
+ XFREFFI => NULL(), &
+ XALPHA1 => NULL(), &
+ XALPHA2 => NULL(), &
+ XBETA1 => NULL(), &
+ XBETA2 => NULL(), &
+ XNU10 => NULL(), &
+ XNU20 => NULL()
+INTEGER, POINTER :: NSCLBDAS => NULL()
+REAL,DIMENSION(:,:),POINTER :: XKER_N_SSCS => NULL()
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(8),PARAMETER &
+ :: CLIMA_COLD_NAMES=(/'CICE ','CSNOW ','CGRAUPEL','CHAIL ',&
+ 'CIFNFREE','CIFNNUCL', &
+ 'CCNINIMM','CCCNNUCL'/)
+ ! basenames of the SV articles stored
+ ! in the binary files
+ !with IF:Ice-nuclei Free (nonactivated IFN by Dep/Cond)
+ ! IN:Ice-nuclei Nucleated (activated IFN by Dep/Cond)
+ ! NI:Nuclei Immersed (activated IFN by Imm)
+ ! HF:Homogeneous Freezing
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(8),PARAMETER &
+ :: CLIMA_COLD_CONC=(/'NI ','NS ','NG ','NH ','NIF','NIN','NNI','NNH'/)!for DIAG
+
+!
+CONTAINS
+SUBROUTINE PARAM_LIMA_COLD_ASSOCIATE()
+IMPLICIT NONE
+IF(.NOT. ASSOCIATED(XLBEXI)) THEN
+ XLBEXI => PARAM_LIMA_COLD%XLBEXI
+ XLBI => PARAM_LIMA_COLD%XLBI
+ XLBEXS => PARAM_LIMA_COLD%XLBEXS
+ XLBS => PARAM_LIMA_COLD%XLBS
+ XNS => PARAM_LIMA_COLD%XNS
+ XAI => PARAM_LIMA_COLD%XAI
+ XBI => PARAM_LIMA_COLD%XBI
+ XC_I => PARAM_LIMA_COLD%XC_I
+ XDI => PARAM_LIMA_COLD%XDI
+ XF0I => PARAM_LIMA_COLD%XF0I
+ XF2I => PARAM_LIMA_COLD%XF2I
+ XC1I => PARAM_LIMA_COLD%XC1I
+ XF0IS => PARAM_LIMA_COLD%XF0IS
+ XF1IS => PARAM_LIMA_COLD%XF1IS
+ XAS => PARAM_LIMA_COLD%XAS
+ XBS => PARAM_LIMA_COLD%XBS
+ XCS => PARAM_LIMA_COLD%XCS
+ XDS => PARAM_LIMA_COLD%XDS
+ XCCS => PARAM_LIMA_COLD%XCCS
+ XCXS => PARAM_LIMA_COLD%XCXS
+ XF0S => PARAM_LIMA_COLD%XF0S
+ XF1S => PARAM_LIMA_COLD%XF1S
+ XC1S => PARAM_LIMA_COLD%XC1S
+ XLBDAS_MIN => PARAM_LIMA_COLD%XLBDAS_MIN
+ XLBDAS_MAX => PARAM_LIMA_COLD%XLBDAS_MAX
+ XFVELOS => PARAM_LIMA_COLD%XFVELOS
+ XTRANS_MP_GAMMAS => PARAM_LIMA_COLD%XTRANS_MP_GAMMAS
+ XFSEDRI => PARAM_LIMA_COLD%XFSEDRI
+ XFSEDCI => PARAM_LIMA_COLD%XFSEDCI
+ XFSEDRS => PARAM_LIMA_COLD%XFSEDRS
+ XFSEDCS => PARAM_LIMA_COLD%XFSEDCS
+ XFSEDS => PARAM_LIMA_COLD%XFSEDS
+ XEXSEDS => PARAM_LIMA_COLD%XEXSEDS
+ XNUC_DEP => PARAM_LIMA_COLD%XNUC_DEP
+ XEXSI_DEP => PARAM_LIMA_COLD%XEXSI_DEP
+ XEX_DEP => PARAM_LIMA_COLD%XEX_DEP
+ XNUC_CON => PARAM_LIMA_COLD%XNUC_CON
+ XEXTT_CON => PARAM_LIMA_COLD%XEXTT_CON
+ XEX_CON => PARAM_LIMA_COLD%XEX_CON
+ XMNU0 => PARAM_LIMA_COLD%XMNU0
+ XRHOI_HONH => PARAM_LIMA_COLD%XRHOI_HONH
+ XCEXP_DIFVAP_HONH => PARAM_LIMA_COLD%XCEXP_DIFVAP_HONH
+ XCOEF_DIFVAP_HONH => PARAM_LIMA_COLD%XCOEF_DIFVAP_HONH
+ XRCOEF_HONH => PARAM_LIMA_COLD%XRCOEF_HONH
+ XCRITSAT1_HONH => PARAM_LIMA_COLD%XCRITSAT1_HONH
+ XCRITSAT2_HONH => PARAM_LIMA_COLD%XCRITSAT2_HONH
+ XTMIN_HONH => PARAM_LIMA_COLD%XTMIN_HONH
+ XTMAX_HONH => PARAM_LIMA_COLD%XTMAX_HONH
+ XDLNJODT1_HONH => PARAM_LIMA_COLD%XDLNJODT1_HONH
+ XDLNJODT2_HONH => PARAM_LIMA_COLD%XDLNJODT2_HONH
+ XC1_HONH => PARAM_LIMA_COLD%XC1_HONH
+ XC2_HONH => PARAM_LIMA_COLD%XC2_HONH
+ XC3_HONH => PARAM_LIMA_COLD%XC3_HONH
+ XC_HONC => PARAM_LIMA_COLD%XC_HONC
+ XR_HONC => PARAM_LIMA_COLD%XR_HONC
+ XTEXP1_HONC => PARAM_LIMA_COLD%XTEXP1_HONC
+ XTEXP2_HONC => PARAM_LIMA_COLD%XTEXP2_HONC
+ XTEXP3_HONC => PARAM_LIMA_COLD%XTEXP3_HONC
+ XTEXP4_HONC => PARAM_LIMA_COLD%XTEXP4_HONC
+ XTEXP5_HONC => PARAM_LIMA_COLD%XTEXP5_HONC
+ XCSCNVI_MAX => PARAM_LIMA_COLD%XCSCNVI_MAX
+ XLBDASCNVI_MAX => PARAM_LIMA_COLD%XLBDASCNVI_MAX
+ XRHORSMIN => PARAM_LIMA_COLD%XRHORSMIN
+ XDSCNVI_LIM => PARAM_LIMA_COLD%XDSCNVI_LIM
+ XLBDASCNVI_LIM => PARAM_LIMA_COLD%XLBDASCNVI_LIM
+ XC0DEPSI => PARAM_LIMA_COLD%XC0DEPSI
+ XC1DEPSI => PARAM_LIMA_COLD%XC1DEPSI
+ XR0DEPSI => PARAM_LIMA_COLD%XR0DEPSI
+ XR1DEPSI => PARAM_LIMA_COLD%XR1DEPSI
+ XSCFAC => PARAM_LIMA_COLD%XSCFAC
+ X0DEPI => PARAM_LIMA_COLD%X0DEPI
+ X2DEPI => PARAM_LIMA_COLD%X2DEPI
+ X0DEPS => PARAM_LIMA_COLD%X0DEPS
+ X1DEPS => PARAM_LIMA_COLD%X1DEPS
+ XEX0DEPS => PARAM_LIMA_COLD%XEX0DEPS
+ XEX1DEPS => PARAM_LIMA_COLD%XEX1DEPS
+ XDICNVS_LIM => PARAM_LIMA_COLD%XDICNVS_LIM
+ XLBDAICNVS_LIM => PARAM_LIMA_COLD%XLBDAICNVS_LIM
+ XC0DEPIS => PARAM_LIMA_COLD%XC0DEPIS
+ XC1DEPIS => PARAM_LIMA_COLD%XC1DEPIS
+ XR0DEPIS => PARAM_LIMA_COLD%XR0DEPIS
+ XR1DEPIS => PARAM_LIMA_COLD%XR1DEPIS
+ XCOLEXIS => PARAM_LIMA_COLD%XCOLEXIS
+ XAGGS_CLARGE1 => PARAM_LIMA_COLD%XAGGS_CLARGE1
+ XAGGS_CLARGE2 => PARAM_LIMA_COLD%XAGGS_CLARGE2
+ XAGGS_RLARGE1 => PARAM_LIMA_COLD%XAGGS_RLARGE1
+ XAGGS_RLARGE2 => PARAM_LIMA_COLD%XAGGS_RLARGE2
+ XFIAGGS => PARAM_LIMA_COLD%XFIAGGS
+ XEXIAGGS => PARAM_LIMA_COLD%XEXIAGGS
+ XACCS1 => PARAM_LIMA_COLD%XACCS1
+ XSPONBUDS1 => PARAM_LIMA_COLD%XSPONBUDS1
+ XSPONBUDS2 => PARAM_LIMA_COLD%XSPONBUDS2
+ XSPONBUDS3 => PARAM_LIMA_COLD%XSPONBUDS3
+ XSPONCOEFS2 => PARAM_LIMA_COLD%XSPONCOEFS2
+ XKER_ZRNIC_A1 => PARAM_LIMA_COLD%XKER_ZRNIC_A1
+ XKER_ZRNIC_A2 => PARAM_LIMA_COLD%XKER_ZRNIC_A2
+ XSELFI => PARAM_LIMA_COLD%XSELFI
+ XCOLEXII => PARAM_LIMA_COLD%XCOLEXII
+ XCOLSS => PARAM_LIMA_COLD%XCOLSS
+ XCOLEXSS => PARAM_LIMA_COLD%XCOLEXSS
+ XFNSSCS => PARAM_LIMA_COLD%XFNSSCS
+ XLBNSSCS1 => PARAM_LIMA_COLD%XLBNSSCS1
+ XLBNSSCS2 => PARAM_LIMA_COLD%XLBNSSCS2
+ XSCINTP1S => PARAM_LIMA_COLD%XSCINTP1S
+ XSCINTP2S => PARAM_LIMA_COLD%XSCINTP2S
+ XAUTO3 => PARAM_LIMA_COLD%XAUTO3
+ XAUTO4 => PARAM_LIMA_COLD%XAUTO4
+ XLAUTS => PARAM_LIMA_COLD%XLAUTS
+ XLAUTS_THRESHOLD => PARAM_LIMA_COLD%XLAUTS_THRESHOLD
+ XITAUTS => PARAM_LIMA_COLD%XITAUTS
+ XITAUTS_THRESHOLD => PARAM_LIMA_COLD%XITAUTS_THRESHOLD
+ XTEXAUTI => PARAM_LIMA_COLD%XTEXAUTI
+ XCONCI_MAX => PARAM_LIMA_COLD%XCONCI_MAX
+ XFREFFI => PARAM_LIMA_COLD%XFREFFI
+ XALPHA1 => PARAM_LIMA_COLD%XALPHA1
+ XALPHA2 => PARAM_LIMA_COLD%XALPHA2
+ XBETA1 => PARAM_LIMA_COLD%XBETA1
+ XBETA2 => PARAM_LIMA_COLD%XBETA2
+ XNU10 => PARAM_LIMA_COLD%XNU10
+ XNU20 => PARAM_LIMA_COLD%XNU20
+
+ NSCLBDAS => PARAM_LIMA_COLD%NSCLBDAS
+ENDIF
+END SUBROUTINE PARAM_LIMA_COLD_ASSOCIATE
+!
+SUBROUTINE PARAM_LIMA_COLD_ALLOCATE(HNAME, KDIM1, KDIM2)
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ INTEGER, INTENT(IN) :: KDIM1
+ INTEGER, INTENT(IN) :: KDIM2
+
+ SELECT CASE(TRIM(HNAME))
+ CASE('XKER_N_SSCS')
+ ALLOCATE(PARAM_LIMA_COLD%XKER_N_SSCS(KDIM1, KDIM2))
+ XKER_N_SSCS => PARAM_LIMA_COLD%XKER_N_SSCS
+ END SELECT
+END SUBROUTINE PARAM_LIMA_COLD_ALLOCATE
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/modd_param_lima_mixed.f90 b/src/PHYEX/micro/modd_param_lima_mixed.f90
index 6a9c763dc3fef2905f7767731bfb151e6356bfe6..66b0d047876808d415b4530583aa19feb576eaf0 100644
--- a/src/PHYEX/micro/modd_param_lima_mixed.f90
+++ b/src/PHYEX/micro/modd_param_lima_mixed.f90
@@ -3,17 +3,17 @@
! ###########################{
!
!!**** *MODD_PARAM_LIMA_MIXED* - declaration of some descriptive parameters and
-!! microphysical factors extensively used in
+!! microphysical factors extensively used in
!! the LIMA mixed scheme.
!! AUTHOR
!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! J.-P. Pinty *Laboratoire d'Aerologie*
!! S. Berthet * Laboratoire d'Aerologie*
!! B. Vié * Laboratoire d'Aerologie*
!!
!! MODIFICATIONS
!! -------------
-!! Original ??/??/13
+!! Original ??/??/13
!! C. Barthe 14/03/2022 add CIBU and RDSF
! J. Wurtz 03/2022: new snow characteristics
! M. Taufour 07/2022: add concentration for snow, graupel, hail
@@ -21,12 +21,13 @@
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
+TYPE PARAM_LIMA_MIXED_t
!
!* 1. DESCRIPTIVE PARAMETERS
! ----------------------
!
! Declaration of microphysical constants, including the descriptive
-! parameters for the raindrop and the ice crystal habits, and the
+! parameters for the raindrop and the ice crystal habits, and the
! parameters relevant of the dimensional distributions.
!
! m(D) = XAx * D**XBx : Mass-MaxDim relationship
@@ -37,17 +38,17 @@ IMPLICIT NONE
!
! 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
!
-REAL,SAVE :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
-REAL,SAVE :: XLBEXG,XLBG,XNG ! Graupel distribution parameters
-REAL,SAVE :: XLBDAG_MAX ! Max values allowed for the shape
+REAL :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
+REAL :: XLBEXG,XLBG,XNG ! Graupel distribution parameters
+REAL :: XLBDAG_MAX ! Max values allowed for the shape
! parameter of graupeln
!
-REAL,SAVE :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
-REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
+REAL :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
+REAL :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
!
!-------------------------------------------------------------------------------
!
@@ -56,7 +57,7 @@ REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
!
! Constants for ice-ice collision : CIBU
!
-REAL, SAVE :: XDCSLIM_CIBU_MIN, & ! aggregates min diam. : 0.2 mm
+REAL :: XDCSLIM_CIBU_MIN, & ! aggregates min diam. : 0.2 mm
XDCSLIM_CIBU_MAX, & ! aggregates max diam. : 1.0 mm
XDCGLIM_CIBU_MIN, & ! graupel min diam. : 2 mm
XGAMINC_BOUND_CIBU_SMIN, & ! Min val. of Lbda_s*dlim
@@ -71,136 +72,136 @@ REAL, SAVE :: XDCSLIM_CIBU_MIN, & ! aggregates min diam. : 0.2 mm
XMOMGS_CIBU_1,XMOMGS_CIBU_2, &
XMOMGS_CIBU_3
!
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL, DIMENSION(:,:) , ALLOCATABLE &
:: XGAMINC_CIBU_S, & ! Tab.incomplete Gamma function
XGAMINC_CIBU_G ! Tab.incomplete Gamma function
!
! Constants for raindrop shattering : RDSF
!
-REAL, SAVE :: XDCRLIM_RDSF_MIN, & ! Raindrops min diam. : 0.2 mm
+REAL :: XDCRLIM_RDSF_MIN, & ! Raindrops min diam. : 0.2 mm
XGAMINC_BOUND_RDSF_RMIN, & ! Min val. of Lbda_r*dlim
XGAMINC_BOUND_RDSF_RMAX, & ! Max val. of Lbda_r*dlim
XRDSFINTP_R,XRDSFINTP1_R, & !
XFACTOR_RDSF_NI, & ! Factor for final RDSF Eq.
XMOMGR_RDSF
!
-REAL, DIMENSION(:), SAVE, ALLOCATABLE &
+REAL, DIMENSION(:) , ALLOCATABLE &
:: XGAMINC_RDSF_R ! Tab.incomplete Gamma function
!
!
!* 3. MICROPHYSICAL FACTORS - Graupel
! -------------------------------
!
-REAL,SAVE :: XFSEDG, XEXSEDG, XFSEDRG, XFSEDCG ! Sedimentation fluxes of Graupel
+REAL :: XFSEDG, XEXSEDG, XFSEDRG, XFSEDCG ! Sedimentation fluxes of Graupel
!
-REAL,SAVE :: X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! Deposition on graupel
+REAL :: X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! Deposition on graupel
!
-REAL,SAVE :: XHMTMIN,XHMTMAX,XHM1,XHM2, & ! Constants for the
+REAL :: XHMTMIN,XHMTMAX,XHM1,XHM2, & ! Constants for the
XHM_YIELD,XHM_COLLCS,XHM_FACTS, & ! revised
XHM_COLLCG,XHM_FACTG, & ! Hallett-Mossop process
- XGAMINC_HMC_BOUND_MIN, & ! Min val. of Lbda_c for HMC
- XGAMINC_HMC_BOUND_MAX, & ! Max val. of Lbda_c for HMC
+ XGAMINC_HMC_BOUND_MIN, & ! Min val. of Lbda_c for HMC
+ XGAMINC_HMC_BOUND_MAX, & ! Max val. of Lbda_c for HMC
XHMSINTP1,XHMSINTP2, & ! (this is no more used !)
XHMLINTP1,XHMLINTP2
!
-REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
- XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
- XEXCRIMSG,XCRIMSG, & !
- XEXSRIMCG,XSRIMCG, & !
+REAL :: XDCSLIM,XCOLCS, & ! Constants for the riming of
+ XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
+ XEXCRIMSG,XCRIMSG, & !
+ XEXSRIMCG,XSRIMCG, & !
XSRIMCG2, XSRIMCG3, XEXSRIMCG2, & ! Murakami 1990
- XGAMINC_BOUND_MIN, & ! Min val. of Lbda_s for RIM
- XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM
- XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of
+ XGAMINC_BOUND_MIN, & ! Min val. of Lbda_s for RIM
+ 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, & ! Murakami
XGAMINC_HMC ! and for the HM process
!
-REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
- XFNRACCSS, & ! Constants for the accretion
+REAL :: XFRACCSS, & ! Constants for the accretion
+ XFNRACCSS, & ! Constants for the accretion
XLBRACCS1,XLBRACCS2,XLBRACCS3, & ! raindrops onto the aggregates
- XLBNRACCS1,XLBNRACCS2,XLBNRACCS3, & ! raindrops onto the aggregates
+ XLBNRACCS1,XLBNRACCS2,XLBNRACCS3, & ! raindrops onto the aggregates
XFSACCRG, & ! ACC (processes RACCSS and
- XFNSACCRG, & ! ACC (processes RACCSS and
+ XFNSACCRG, & ! ACC (processes RACCSS and
XLBSACCR1,XLBSACCR2,XLBSACCR3, & ! SACCRG)
- XLBNSACCR1,XLBNSACCR2,XLBNSACCR3, & ! SACCRG)
+ XLBNSACCR1,XLBNSACCR2,XLBNSACCR3, & ! SACCRG)
XSCLBDAS_MIN, & ! Min val. of Lbda_s for ACC
- XSCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
- XACCLBDAS_MIN, & ! Min val. of Lbda_s for ACC
- XACCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
- XACCLBDAR_MIN, & ! Min val. of Lbda_r for ACC
- XACCLBDAR_MAX, & ! Max val. of Lbda_r for ACC
- XACCINTP1S,XACCINTP2S, & ! Csts for bilin. interpol. of
- XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
- ! XKER_RACCSS and XKER_SACCRG
- ! tables
-INTEGER,SAVE :: NACCLBDAS, & ! Number of Lbda_s values and
- NACCLBDAR ! of Lbda_r values in the
- ! XKER_RACCSS and XKER_SACCRG
- ! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
- :: XKER_RACCSS, & ! Normalized kernel for RACCSS
- XKER_RACCS, & ! Normalized kernel for RACCS
- XKER_SACCRG, & ! Normalized kernel for SACCRG
- XKER_N_RACCSS, & ! Normalized kernel for RACCSS
- XKER_N_RACCS, & ! Normalized kernel for RACCS
- XKER_N_SACCRG ! Normalized kernel for SACCRG
-REAL,SAVE :: XFSCVMG ! Melting-conversion factor of
+ XSCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
+ XACCLBDAS_MIN, & ! Min val. of Lbda_s for ACC
+ XACCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
+ XACCLBDAR_MIN, & ! Min val. of Lbda_r for ACC
+ XACCLBDAR_MAX, & ! Max val. of Lbda_r for ACC
+ XACCINTP1S,XACCINTP2S, & ! Csts for bilin. interpol. of
+ XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
+ ! XKER_RACCSS and XKER_SACCRG
+ ! tables
+INTEGER :: NACCLBDAS, & ! Number of Lbda_s values and
+ NACCLBDAR ! of Lbda_r values in the
+ ! XKER_RACCSS and XKER_SACCRG
+ ! tables
+REAL,DIMENSION(:,:) , ALLOCATABLE &
+ :: XKER_RACCSS, & ! Normalized kernel for RACCSS
+ XKER_RACCS, & ! Normalized kernel for RACCS
+ XKER_SACCRG, & ! Normalized kernel for SACCRG
+ XKER_N_RACCSS, & ! Normalized kernel for RACCSS
+ XKER_N_RACCS, & ! Normalized kernel for RACCS
+ XKER_N_SACCRG ! Normalized kernel for SACCRG
+REAL :: XFSCVMG ! Melting-conversion factor of
! the aggregates
!
-REAL,SAVE :: XCOLIR, & ! Constants for rain contact
- XEXRCFRI,XRCFRI, & ! freezing : CFR
- XEXICFRR,XICFRR !
+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
XCOLCG, & ! of the graupeln :
- XCOLIG,XCOLEXIG,XFIDRYG, & !
+ XCOLIG,XCOLEXIG,XFIDRYG, & !
XCOLSG,XCOLEXSG,XFSDRYG,XFNSDRYG, & ! RCDRYG
XLBSDRYG1,XLBSDRYG2,XLBSDRYG3, & ! RIDRYG
- XLBNSDRYG1,XLBNSDRYG2,XLBNSDRYG3, & ! RIDRYG
+ XLBNSDRYG1,XLBNSDRYG2,XLBNSDRYG3, & ! RIDRYG
XFRDRYG,XFNRDRYG, & ! RSDRYG
XLBRDRYG1,XLBRDRYG2,XLBRDRYG3, & ! RRDRYG
- XLBNRDRYG1,XLBNRDRYG2,XLBNRDRYG3, & ! RRDRYG
+ XLBNRDRYG1,XLBNRDRYG2,XLBNRDRYG3, & ! RRDRYG
XDRYLBDAR_MIN, & ! Min val. of Lbda_r for DRY
- XDRYLBDAR_MAX, & ! Max val. of Lbda_r for DRY
+ XDRYLBDAR_MAX, & ! Max val. of Lbda_r for DRY
XDRYLBDAS_MIN, & ! Min val. of Lbda_s for DRY
- XDRYLBDAS_MAX, & ! Max val. of Lbda_s for DRY
- XDRYLBDAG_MIN, & ! Min val. of Lbda_g for DRY
- XDRYLBDAG_MAX, & ! Max val. of Lbda_g for DRY
- XDRYINTP1R,XDRYINTP2R, & ! Csts for bilin. interpol. of
- XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
- XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
+ XDRYLBDAS_MAX, & ! Max val. of Lbda_s for DRY
+ XDRYLBDAG_MIN, & ! Min val. of Lbda_g for DRY
+ XDRYLBDAG_MAX, & ! Max val. of Lbda_g for DRY
+ XDRYINTP1R,XDRYINTP2R, & ! Csts for bilin. interpol. of
+ XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
+ XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
+ ! tables
+INTEGER :: NDRYLBDAR, & ! Number of Lbda_r,
+ NDRYLBDAS, & ! of Lbda_s and
+ NDRYLBDAG ! of Lbda_g values in
+ ! the XKER_SDRYG and XKER_RDRYG
! tables
-INTEGER,SAVE :: 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
- XKER_N_SDRYG, & ! Normalized kernel for RDRYG
- XKER_N_RDRYG ! Normalized kernel for RDRYG
+ XKER_RDRYG, & ! Normalized kernel for RDRYG
+ XKER_N_SDRYG, & ! Normalized kernel for RDRYG
+ XKER_N_RDRYG ! Normalized kernel for RDRYG
!
!-------------------------------------------------------------------------------
!
!* 4. MICROPHYSICAL FACTORS - Hail
! ----------------------------
!
-REAL,SAVE :: XFSEDH,XEXSEDH,XFSEDRH,XFSEDCH ! Constants for sedimentation
+REAL :: XFSEDH,XEXSEDH,XFSEDRH,XFSEDCH ! Constants for sedimentation
!
!
-REAL,SAVE :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
+REAL :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
!
-REAL,SAVE :: XFWETH,XFSWETH,XFNSWETH, & ! Constants for the wet growth
+REAL :: XFWETH,XFSWETH,XFNSWETH, & ! Constants for the wet growth
XLBSWETH1,XLBSWETH2,XLBSWETH3, & ! of the hailstones : WET
- XLBNSWETH1,XLBNSWETH2,XLBNSWETH3, & ! of the hailstones : WET
+ XLBNSWETH1,XLBNSWETH2,XLBNSWETH3, & ! of the hailstones : WET
XFGWETH, XFNGWETH, & ! processes RSWETH
XLBGWETH1,XLBGWETH2,XLBGWETH3, & ! RGWETH
- XLBNGWETH1,XLBNGWETH2,XLBNGWETH3, & ! RGWETH
+ XLBNGWETH1,XLBNGWETH2,XLBNGWETH3, & ! RGWETH
XWETLBDAS_MIN, & ! Min val. of Lbda_s for WET
XWETLBDAS_MAX, & ! Max val. of Lbda_s for WET
XWETLBDAG_MIN, & ! Min val. of Lbda_g for WET
@@ -211,17 +212,530 @@ REAL,SAVE :: XFWETH,XFSWETH,XFNSWETH, & ! Constants for the wet growth
XWETINTP1G,XWETINTP2G, & ! Lbda_r, Lbda_s and Lbda_g in
XWETINTP1H,XWETINTP2H ! the XKER_SWETH and XKER_GWETH
! tables
-INTEGER,SAVE :: NWETLBDAS, & ! Number of Lbda_s,
+INTEGER :: NWETLBDAS, & ! Number of Lbda_s,
NWETLBDAG, & ! of Lbda_g and
NWETLBDAH ! of Lbda_h values in
! the XKER_SWETH and XKER_GWETH
! tables
-REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+REAL,DIMENSION(:,:), ALLOCATABLE &
:: XKER_SWETH, & ! Normalized kernel for SWETH
XKER_GWETH, & ! Normalized kernel for GWETH
- XKER_N_SWETH, & ! Normalized kernel for GWETH
+ XKER_N_SWETH, & ! Normalized kernel for GWETH
XKER_N_GWETH ! Normalized kernel for GWETH
+END TYPE PARAM_LIMA_MIXED_t
+!
+TYPE(PARAM_LIMA_MIXED_t), TARGET :: PARAM_LIMA_MIXED
+!
+REAL, POINTER :: XAG => NULL(), &
+ XBG => NULL(), &
+ XCG => NULL(), &
+ XDG => NULL(), &
+ XCCG => NULL(), &
+ XCXG => NULL(), &
+ XF0G => NULL(), &
+ XF1G => NULL(), &
+ XC1G => NULL(), &
+ XLBEXG => NULL(), &
+ XLBG => NULL(), &
+ XNG => NULL(), &
+ XLBDAG_MAX => NULL(), &
+ XAH => NULL(), &
+ XBH => NULL(), &
+ XCH => NULL(), &
+ XDH => NULL(), &
+ XCCH => NULL(), &
+ XCXH => NULL(), &
+ XF0H => NULL(), &
+ XF1H => NULL(), &
+ XC1H => NULL(), &
+ XALPHAH => NULL(), &
+ XNUH => NULL(), &
+ XLBEXH => NULL(), &
+ XLBH => NULL(), &
+ XDCSLIM_CIBU_MIN => NULL(), &
+ XDCSLIM_CIBU_MAX => NULL(), &
+ XDCGLIM_CIBU_MIN => NULL(), &
+ XGAMINC_BOUND_CIBU_SMIN => NULL(), &
+ XGAMINC_BOUND_CIBU_SMAX => NULL(), &
+ XGAMINC_BOUND_CIBU_GMIN => NULL(), &
+ XGAMINC_BOUND_CIBU_GMAX => NULL(), &
+ XCIBUINTP_S => NULL(), &
+ XCIBUINTP1_S => NULL(), &
+ XCIBUINTP2_S => NULL(), &
+ XCIBUINTP_G => NULL(), &
+ XCIBUINTP1_G => NULL(), &
+ XFACTOR_CIBU_NI => NULL(), &
+ XFACTOR_CIBU_RI => NULL(), &
+ XMOMGG_CIBU_1 => NULL(), &
+ XMOMGG_CIBU_2 => NULL(), &
+ XMOMGS_CIBU_1 => NULL(), &
+ XMOMGS_CIBU_2 => NULL(), &
+ XMOMGS_CIBU_3 => NULL(), &
+ XDCRLIM_RDSF_MIN => NULL(), &
+ XGAMINC_BOUND_RDSF_RMIN => NULL(), &
+ XGAMINC_BOUND_RDSF_RMAX => NULL(), &
+ XRDSFINTP_R => NULL(), &
+ XRDSFINTP1_R => NULL(), &
+ XFACTOR_RDSF_NI => NULL(), &
+ XMOMGR_RDSF => NULL(), &
+ XFSEDG => NULL(), &
+ XEXSEDG => NULL(), &
+ XFSEDRG => NULL(), &
+ XFSEDCG => NULL(), &
+ X0DEPG => NULL(), &
+ X1DEPG => NULL(), &
+ XEX0DEPG => NULL(), &
+ XEX1DEPG => NULL(), &
+ XHMTMIN => NULL(), &
+ XHMTMAX => NULL(), &
+ XHM1 => NULL(), &
+ XHM2 => NULL(), &
+ XHM_YIELD => NULL(), &
+ XHM_COLLCS => NULL(), &
+ XHM_FACTS => NULL(), &
+ XHM_COLLCG => NULL(), &
+ XHM_FACTG => NULL(), &
+ XGAMINC_HMC_BOUND_MIN => NULL(), &
+ XGAMINC_HMC_BOUND_MAX => NULL(), &
+ XHMSINTP1 => NULL(), &
+ XHMSINTP2 => NULL(), &
+ XHMLINTP1 => NULL(), &
+ XHMLINTP2 => NULL(), &
+ XDCSLIM => NULL(), &
+ XCOLCS => NULL(), &
+ XEXCRIMSS => NULL(), &
+ XCRIMSS => NULL(), &
+ XEXCRIMSG => NULL(), &
+ XCRIMSG => NULL(), &
+ XEXSRIMCG => NULL(), &
+ XSRIMCG => NULL(), &
+ XSRIMCG2 => NULL(), &
+ XSRIMCG3 => NULL(), &
+ XEXSRIMCG2 => NULL(), &
+ XGAMINC_BOUND_MIN => NULL(), &
+ XGAMINC_BOUND_MAX => NULL(), &
+ XRIMINTP1 => NULL(), &
+ XRIMINTP2 => NULL(), &
+ XFRACCSS => NULL(), &
+ XFNRACCSS => NULL(), &
+ XLBRACCS1 => NULL(), &
+ XLBRACCS2 => NULL(), &
+ XLBRACCS3 => NULL(), &
+ XLBNRACCS1 => NULL(), &
+ XLBNRACCS2 => NULL(), &
+ XLBNRACCS3 => NULL(), &
+ XFSACCRG => NULL(), &
+ XFNSACCRG => NULL(), &
+ XLBSACCR1 => NULL(), &
+ XLBSACCR2 => NULL(), &
+ XLBSACCR3 => NULL(), &
+ XLBNSACCR1 => NULL(), &
+ XLBNSACCR2 => NULL(), &
+ XLBNSACCR3 => NULL(), &
+ XSCLBDAS_MIN => NULL(), &
+ XSCLBDAS_MAX => 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(), &
+ XCOLCG => NULL(), &
+ XCOLIG => NULL(), &
+ XCOLEXIG => NULL(), &
+ XFIDRYG => NULL(), &
+ XCOLSG => NULL(), &
+ XCOLEXSG => NULL(), &
+ XFSDRYG => NULL(), &
+ XFNSDRYG => NULL(), &
+ XLBSDRYG1 => NULL(), &
+ XLBSDRYG2 => NULL(), &
+ XLBSDRYG3 => NULL(), &
+ XLBNSDRYG1 => NULL(), &
+ XLBNSDRYG2 => NULL(), &
+ XLBNSDRYG3 => NULL(), &
+ XFRDRYG => NULL(), &
+ XFNRDRYG => NULL(), &
+ XLBRDRYG1 => NULL(), &
+ XLBRDRYG2 => NULL(), &
+ XLBRDRYG3 => NULL(), &
+ XLBNRDRYG1 => NULL(), &
+ XLBNRDRYG2 => NULL(), &
+ XLBNRDRYG3 => 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(), &
+ XFSEDRH => NULL(), &
+ XFSEDCH => NULL(), &
+ X0DEPH => NULL(), &
+ X1DEPH => NULL(), &
+ XEX0DEPH => NULL(), &
+ XEX1DEPH => NULL(), &
+ XFWETH => NULL(), &
+ XFSWETH => NULL(), &
+ XFNSWETH => NULL(), &
+ XLBSWETH1 => NULL(), &
+ XLBSWETH2 => NULL(), &
+ XLBSWETH3 => NULL(), &
+ XLBNSWETH1 => NULL(), &
+ XLBNSWETH2 => NULL(), &
+ XLBNSWETH3 => NULL(), &
+ XFGWETH => NULL(), &
+ XFNGWETH => NULL(), &
+ XLBGWETH1 => NULL(), &
+ XLBGWETH2 => NULL(), &
+ XLBGWETH3 => NULL(), &
+ XLBNGWETH1 => NULL(), &
+ XLBNGWETH2 => NULL(), &
+ XLBNGWETH3 => NULL(), &
+ XWETLBDAS_MIN => NULL(), &
+ XWETLBDAS_MAX => NULL(), &
+ XWETLBDAG_MIN => NULL(), &
+ XWETLBDAG_MAX => NULL(), &
+ XWETLBDAH_MIN => NULL(), &
+ XWETLBDAH_MAX => NULL(), &
+ XWETINTP1S => NULL(), &
+ XWETINTP2S => NULL(), &
+ XWETINTP1G => NULL(), &
+ XWETINTP2G => NULL(), &
+ XWETINTP1H => NULL(), &
+ XWETINTP2H => NULL()
+
+INTEGER, POINTER :: NGAMINC => NULL(), &
+ NACCLBDAS => NULL(), &
+ NACCLBDAR => NULL(), &
+ NDRYLBDAR => NULL(), &
+ NDRYLBDAS => NULL(), &
+ NDRYLBDAG => NULL(), &
+ NWETLBDAS => NULL(), &
+ NWETLBDAG => NULL(), &
+ NWETLBDAH => NULL()
+
+REAL, DIMENSION(:), POINTER :: XGAMINC_RDSF_R => NULL(), &
+ XGAMINC_RIM1 => NULL(), &
+ XGAMINC_RIM2 => NULL(), &
+ XGAMINC_RIM4 => NULL(), &
+ XGAMINC_HMC => NULL()
+REAL, DIMENSION(:,:), POINTER :: XGAMINC_CIBU_S => NULL(), &
+ XGAMINC_CIBU_G => NULL(), &
+ XKER_RACCSS => NULL(), &
+ XKER_RACCS => NULL(), &
+ XKER_SACCRG => NULL(), &
+ XKER_N_RACCSS => NULL(), &
+ XKER_N_RACCS => NULL(), &
+ XKER_N_SACCRG => NULL(), &
+ XKER_SDRYG => NULL(), &
+ XKER_RDRYG => NULL(), &
+ XKER_N_SDRYG => NULL(), &
+ XKER_N_RDRYG => NULL(), &
+ XKER_SWETH => NULL(), &
+ XKER_GWETH => NULL(), &
+ XKER_N_SWETH => NULL(), &
+ XKER_N_GWETH => NULL()
+CONTAINS
+SUBROUTINE PARAM_LIMA_MIXED_ASSOCIATE()
+IF(.NOT. ASSOCIATED(XAG)) THEN
+ XAG => PARAM_LIMA_MIXED%XAG
+ XBG => PARAM_LIMA_MIXED%XBG
+ XCG => PARAM_LIMA_MIXED%XCG
+ XDG => PARAM_LIMA_MIXED%XDG
+ XCCG => PARAM_LIMA_MIXED%XCCG
+ XCXG => PARAM_LIMA_MIXED%XCXG
+ XF0G => PARAM_LIMA_MIXED%XF0G
+ XF1G => PARAM_LIMA_MIXED%XF1G
+ XC1G => PARAM_LIMA_MIXED%XC1G
+ XLBEXG => PARAM_LIMA_MIXED%XLBEXG
+ XLBG => PARAM_LIMA_MIXED%XLBG
+ XNG => PARAM_LIMA_MIXED%XNG
+ XLBDAG_MAX => PARAM_LIMA_MIXED%XLBDAG_MAX
+ XAH => PARAM_LIMA_MIXED%XAH
+ XBH => PARAM_LIMA_MIXED%XBH
+ XCH => PARAM_LIMA_MIXED%XCH
+ XDH => PARAM_LIMA_MIXED%XDH
+ XCCH => PARAM_LIMA_MIXED%XCCH
+ XCXH => PARAM_LIMA_MIXED%XCXH
+ XF0H => PARAM_LIMA_MIXED%XF0H
+ XF1H => PARAM_LIMA_MIXED%XF1H
+ XC1H => PARAM_LIMA_MIXED%XC1H
+ XALPHAH => PARAM_LIMA_MIXED%XALPHAH
+ XNUH => PARAM_LIMA_MIXED%XNUH
+ XLBEXH => PARAM_LIMA_MIXED%XLBEXH
+ XLBH => PARAM_LIMA_MIXED%XLBH
+ XDCSLIM_CIBU_MIN => PARAM_LIMA_MIXED%XDCSLIM_CIBU_MIN
+ XDCSLIM_CIBU_MAX => PARAM_LIMA_MIXED%XDCSLIM_CIBU_MAX
+ XDCGLIM_CIBU_MIN => PARAM_LIMA_MIXED%XDCGLIM_CIBU_MIN
+ XGAMINC_BOUND_CIBU_SMIN => PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_SMIN
+ XGAMINC_BOUND_CIBU_SMAX => PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_SMAX
+ XGAMINC_BOUND_CIBU_GMIN => PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_GMIN
+ XGAMINC_BOUND_CIBU_GMAX => PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_GMAX
+ XCIBUINTP_S => PARAM_LIMA_MIXED%XCIBUINTP_S
+ XCIBUINTP1_S => PARAM_LIMA_MIXED%XCIBUINTP1_S
+ XCIBUINTP2_S => PARAM_LIMA_MIXED%XCIBUINTP2_S
+ XCIBUINTP_G => PARAM_LIMA_MIXED%XCIBUINTP_G
+ XCIBUINTP1_G => PARAM_LIMA_MIXED%XCIBUINTP1_G
+ XFACTOR_CIBU_NI => PARAM_LIMA_MIXED%XFACTOR_CIBU_NI
+ XFACTOR_CIBU_RI => PARAM_LIMA_MIXED%XFACTOR_CIBU_RI
+ XMOMGG_CIBU_1 => PARAM_LIMA_MIXED%XMOMGG_CIBU_1
+ XMOMGG_CIBU_2 => PARAM_LIMA_MIXED%XMOMGG_CIBU_2
+ XMOMGS_CIBU_1 => PARAM_LIMA_MIXED%XMOMGS_CIBU_1
+ XMOMGS_CIBU_2 => PARAM_LIMA_MIXED%XMOMGS_CIBU_2
+ XMOMGS_CIBU_3 => PARAM_LIMA_MIXED%XMOMGS_CIBU_3
+ XDCRLIM_RDSF_MIN => PARAM_LIMA_MIXED%XDCRLIM_RDSF_MIN
+ XGAMINC_BOUND_RDSF_RMIN => PARAM_LIMA_MIXED%XGAMINC_BOUND_RDSF_RMIN
+ XGAMINC_BOUND_RDSF_RMAX => PARAM_LIMA_MIXED%XGAMINC_BOUND_RDSF_RMAX
+ XRDSFINTP_R => PARAM_LIMA_MIXED%XRDSFINTP_R
+ XRDSFINTP1_R => PARAM_LIMA_MIXED%XRDSFINTP1_R
+ XFACTOR_RDSF_NI => PARAM_LIMA_MIXED%XFACTOR_RDSF_NI
+ XMOMGR_RDSF => PARAM_LIMA_MIXED%XMOMGR_RDSF
+ XFSEDG => PARAM_LIMA_MIXED%XFSEDG
+ XEXSEDG => PARAM_LIMA_MIXED%XEXSEDG
+ XFSEDRG => PARAM_LIMA_MIXED%XFSEDRG
+ XFSEDCG => PARAM_LIMA_MIXED%XFSEDCG
+ X0DEPG => PARAM_LIMA_MIXED%X0DEPG
+ X1DEPG => PARAM_LIMA_MIXED%X1DEPG
+ XEX0DEPG => PARAM_LIMA_MIXED%XEX0DEPG
+ XEX1DEPG => PARAM_LIMA_MIXED%XEX1DEPG
+ XHMTMIN => PARAM_LIMA_MIXED%XHMTMIN
+ XHMTMAX => PARAM_LIMA_MIXED%XHMTMAX
+ XHM1 => PARAM_LIMA_MIXED%XHM1
+ XHM2 => PARAM_LIMA_MIXED%XHM2
+ XHM_YIELD => PARAM_LIMA_MIXED%XHM_YIELD
+ XHM_COLLCS => PARAM_LIMA_MIXED%XHM_COLLCS
+ XHM_FACTS => PARAM_LIMA_MIXED%XHM_FACTS
+ XHM_COLLCG => PARAM_LIMA_MIXED%XHM_COLLCG
+ XHM_FACTG => PARAM_LIMA_MIXED%XHM_FACTG
+ XGAMINC_HMC_BOUND_MIN => PARAM_LIMA_MIXED%XGAMINC_HMC_BOUND_MIN
+ XGAMINC_HMC_BOUND_MAX => PARAM_LIMA_MIXED%XGAMINC_HMC_BOUND_MAX
+ XHMSINTP1 => PARAM_LIMA_MIXED%XHMSINTP1
+ XHMSINTP2 => PARAM_LIMA_MIXED%XHMSINTP2
+ XHMLINTP1 => PARAM_LIMA_MIXED%XHMLINTP1
+ XHMLINTP2 => PARAM_LIMA_MIXED%XHMLINTP2
+ XDCSLIM => PARAM_LIMA_MIXED%XDCSLIM
+ XCOLCS => PARAM_LIMA_MIXED%XCOLCS
+ XEXCRIMSS => PARAM_LIMA_MIXED%XEXCRIMSS
+ XCRIMSS => PARAM_LIMA_MIXED%XCRIMSS
+ XEXCRIMSG => PARAM_LIMA_MIXED%XEXCRIMSG
+ XCRIMSG => PARAM_LIMA_MIXED%XCRIMSG
+ XEXSRIMCG => PARAM_LIMA_MIXED%XEXSRIMCG
+ XSRIMCG => PARAM_LIMA_MIXED%XSRIMCG
+ XSRIMCG2 => PARAM_LIMA_MIXED%XSRIMCG2
+ XSRIMCG3 => PARAM_LIMA_MIXED%XSRIMCG3
+ XEXSRIMCG2 => PARAM_LIMA_MIXED%XEXSRIMCG2
+ XGAMINC_BOUND_MIN => PARAM_LIMA_MIXED%XGAMINC_BOUND_MIN
+ XGAMINC_BOUND_MAX => PARAM_LIMA_MIXED%XGAMINC_BOUND_MAX
+ XRIMINTP1 => PARAM_LIMA_MIXED%XRIMINTP1
+ XRIMINTP2 => PARAM_LIMA_MIXED%XRIMINTP2
+ XFRACCSS => PARAM_LIMA_MIXED%XFRACCSS
+ XFNRACCSS => PARAM_LIMA_MIXED%XFNRACCSS
+ XLBRACCS1 => PARAM_LIMA_MIXED%XLBRACCS1
+ XLBRACCS2 => PARAM_LIMA_MIXED%XLBRACCS2
+ XLBRACCS3 => PARAM_LIMA_MIXED%XLBRACCS3
+ XLBNRACCS1 => PARAM_LIMA_MIXED%XLBNRACCS1
+ XLBNRACCS2 => PARAM_LIMA_MIXED%XLBNRACCS2
+ XLBNRACCS3 => PARAM_LIMA_MIXED%XLBNRACCS3
+ XFSACCRG => PARAM_LIMA_MIXED%XFSACCRG
+ XFNSACCRG => PARAM_LIMA_MIXED%XFNSACCRG
+ XLBSACCR1 => PARAM_LIMA_MIXED%XLBSACCR1
+ XLBSACCR2 => PARAM_LIMA_MIXED%XLBSACCR2
+ XLBSACCR3 => PARAM_LIMA_MIXED%XLBSACCR3
+ XLBNSACCR1 => PARAM_LIMA_MIXED%XLBNSACCR1
+ XLBNSACCR2 => PARAM_LIMA_MIXED%XLBNSACCR2
+ XLBNSACCR3 => PARAM_LIMA_MIXED%XLBNSACCR3
+ XSCLBDAS_MIN => PARAM_LIMA_MIXED%XSCLBDAS_MIN
+ XSCLBDAS_MAX => PARAM_LIMA_MIXED%XSCLBDAS_MAX
+ XACCLBDAS_MIN => PARAM_LIMA_MIXED%XACCLBDAS_MIN
+ XACCLBDAS_MAX => PARAM_LIMA_MIXED%XACCLBDAS_MAX
+ XACCLBDAR_MIN => PARAM_LIMA_MIXED%XACCLBDAR_MIN
+ XACCLBDAR_MAX => PARAM_LIMA_MIXED%XACCLBDAR_MAX
+ XACCINTP1S => PARAM_LIMA_MIXED%XACCINTP1S
+ XACCINTP2S => PARAM_LIMA_MIXED%XACCINTP2S
+ XACCINTP1R => PARAM_LIMA_MIXED%XACCINTP1R
+ XACCINTP2R => PARAM_LIMA_MIXED%XACCINTP2R
+ XFSCVMG => PARAM_LIMA_MIXED%XFSCVMG
+ XCOLIR => PARAM_LIMA_MIXED%XCOLIR
+ XEXRCFRI => PARAM_LIMA_MIXED%XEXRCFRI
+ XRCFRI => PARAM_LIMA_MIXED%XRCFRI
+ XEXICFRR => PARAM_LIMA_MIXED%XEXICFRR
+ XICFRR => PARAM_LIMA_MIXED%XICFRR
+ XFCDRYG => PARAM_LIMA_MIXED%XFCDRYG
+ XCOLCG => PARAM_LIMA_MIXED%XCOLCG
+ XCOLIG => PARAM_LIMA_MIXED%XCOLIG
+ XCOLEXIG => PARAM_LIMA_MIXED%XCOLEXIG
+ XFIDRYG => PARAM_LIMA_MIXED%XFIDRYG
+ XCOLSG => PARAM_LIMA_MIXED%XCOLSG
+ XCOLEXSG => PARAM_LIMA_MIXED%XCOLEXSG
+ XFSDRYG => PARAM_LIMA_MIXED%XFSDRYG
+ XFNSDRYG => PARAM_LIMA_MIXED%XFNSDRYG
+ XLBSDRYG1 => PARAM_LIMA_MIXED%XLBSDRYG1
+ XLBSDRYG2 => PARAM_LIMA_MIXED%XLBSDRYG2
+ XLBSDRYG3 => PARAM_LIMA_MIXED%XLBSDRYG3
+ XLBNSDRYG1 => PARAM_LIMA_MIXED%XLBNSDRYG1
+ XLBNSDRYG2 => PARAM_LIMA_MIXED%XLBNSDRYG2
+ XLBNSDRYG3 => PARAM_LIMA_MIXED%XLBNSDRYG3
+ XFRDRYG => PARAM_LIMA_MIXED%XFRDRYG
+ XFNRDRYG => PARAM_LIMA_MIXED%XFNRDRYG
+ XLBRDRYG1 => PARAM_LIMA_MIXED%XLBRDRYG1
+ XLBRDRYG2 => PARAM_LIMA_MIXED%XLBRDRYG2
+ XLBRDRYG3 => PARAM_LIMA_MIXED%XLBRDRYG3
+ XLBNRDRYG1 => PARAM_LIMA_MIXED%XLBNRDRYG1
+ XLBNRDRYG2 => PARAM_LIMA_MIXED%XLBNRDRYG2
+ XLBNRDRYG3 => PARAM_LIMA_MIXED%XLBNRDRYG3
+ XDRYLBDAR_MIN => PARAM_LIMA_MIXED%XDRYLBDAR_MIN
+ XDRYLBDAR_MAX => PARAM_LIMA_MIXED%XDRYLBDAR_MAX
+ XDRYLBDAS_MIN => PARAM_LIMA_MIXED%XDRYLBDAS_MIN
+ XDRYLBDAS_MAX => PARAM_LIMA_MIXED%XDRYLBDAS_MAX
+ XDRYLBDAG_MIN => PARAM_LIMA_MIXED%XDRYLBDAG_MIN
+ XDRYLBDAG_MAX => PARAM_LIMA_MIXED%XDRYLBDAG_MAX
+ XDRYINTP1R => PARAM_LIMA_MIXED%XDRYINTP1R
+ XDRYINTP2R => PARAM_LIMA_MIXED%XDRYINTP2R
+ XDRYINTP1S => PARAM_LIMA_MIXED%XDRYINTP1S
+ XDRYINTP2S => PARAM_LIMA_MIXED%XDRYINTP2S
+ XDRYINTP1G => PARAM_LIMA_MIXED%XDRYINTP1G
+ XDRYINTP2G => PARAM_LIMA_MIXED%XDRYINTP2G
+ XFSEDH => PARAM_LIMA_MIXED%XFSEDH
+ XEXSEDH => PARAM_LIMA_MIXED%XEXSEDH
+ XFSEDRH => PARAM_LIMA_MIXED%XFSEDRH
+ XFSEDCH => PARAM_LIMA_MIXED%XFSEDCH
+ X0DEPH => PARAM_LIMA_MIXED%X0DEPH
+ X1DEPH => PARAM_LIMA_MIXED%X1DEPH
+ XEX0DEPH => PARAM_LIMA_MIXED%XEX0DEPH
+ XEX1DEPH => PARAM_LIMA_MIXED%XEX1DEPH
+ XFWETH => PARAM_LIMA_MIXED%XFWETH
+ XFSWETH => PARAM_LIMA_MIXED%XFSWETH
+ XFNSWETH => PARAM_LIMA_MIXED%XFNSWETH
+ XLBSWETH1 => PARAM_LIMA_MIXED%XLBSWETH1
+ XLBSWETH2 => PARAM_LIMA_MIXED%XLBSWETH2
+ XLBSWETH3 => PARAM_LIMA_MIXED%XLBSWETH3
+ XLBNSWETH1 => PARAM_LIMA_MIXED%XLBNSWETH1
+ XLBNSWETH2 => PARAM_LIMA_MIXED%XLBNSWETH2
+ XLBNSWETH3 => PARAM_LIMA_MIXED%XLBNSWETH3
+ XFGWETH => PARAM_LIMA_MIXED%XFGWETH
+ XFNGWETH => PARAM_LIMA_MIXED%XFNGWETH
+ XLBGWETH1 => PARAM_LIMA_MIXED%XLBGWETH1
+ XLBGWETH2 => PARAM_LIMA_MIXED%XLBGWETH2
+ XLBGWETH3 => PARAM_LIMA_MIXED%XLBGWETH3
+ XLBNGWETH1 => PARAM_LIMA_MIXED%XLBNGWETH1
+ XLBNGWETH2 => PARAM_LIMA_MIXED%XLBNGWETH2
+ XLBNGWETH3 => PARAM_LIMA_MIXED%XLBNGWETH3
+ XWETLBDAS_MIN => PARAM_LIMA_MIXED%XWETLBDAS_MIN
+ XWETLBDAS_MAX => PARAM_LIMA_MIXED%XWETLBDAS_MAX
+ XWETLBDAG_MIN => PARAM_LIMA_MIXED%XWETLBDAG_MIN
+ XWETLBDAG_MAX => PARAM_LIMA_MIXED%XWETLBDAG_MAX
+ XWETLBDAH_MIN => PARAM_LIMA_MIXED%XWETLBDAH_MIN
+ XWETLBDAH_MAX => PARAM_LIMA_MIXED%XWETLBDAH_MAX
+ XWETINTP1S => PARAM_LIMA_MIXED%XWETINTP1S
+ XWETINTP2S => PARAM_LIMA_MIXED%XWETINTP2S
+ XWETINTP1G => PARAM_LIMA_MIXED%XWETINTP1G
+ XWETINTP2G => PARAM_LIMA_MIXED%XWETINTP2G
+ XWETINTP1H => PARAM_LIMA_MIXED%XWETINTP1H
+ XWETINTP2H => PARAM_LIMA_MIXED%XWETINTP2H
+
+ NGAMINC => PARAM_LIMA_MIXED%NGAMINC
+ NACCLBDAS => PARAM_LIMA_MIXED%NACCLBDAS
+ NACCLBDAR => PARAM_LIMA_MIXED%NACCLBDAR
+ NDRYLBDAR => PARAM_LIMA_MIXED%NDRYLBDAR
+ NDRYLBDAS => PARAM_LIMA_MIXED%NDRYLBDAS
+ NDRYLBDAG => PARAM_LIMA_MIXED%NDRYLBDAG
+ NWETLBDAS => PARAM_LIMA_MIXED%NWETLBDAS
+ NWETLBDAG => PARAM_LIMA_MIXED%NWETLBDAG
+ NWETLBDAH => PARAM_LIMA_MIXED%NWETLBDAH
+ENDIF
+END SUBROUTINE PARAM_LIMA_MIXED_ASSOCIATE
+!
+SUBROUTINE PARAM_LIMA_MIXED_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
+ CASE('XGAMINC_RDSF_R')
+ ALLOCATE(PARAM_LIMA_MIXED%XGAMINC_RDSF_R(KDIM1))
+ XGAMINC_RDSF_R => PARAM_LIMA_MIXED%XGAMINC_RDSF_R
+ CASE('XGAMINC_RIM1')
+ ALLOCATE(PARAM_LIMA_MIXED%XGAMINC_RIM1(KDIM1))
+ XGAMINC_RIM1 => PARAM_LIMA_MIXED%XGAMINC_RIM1
+ CASE('XGAMINC_RIM2')
+ ALLOCATE(PARAM_LIMA_MIXED%XGAMINC_RIM2(KDIM1))
+ XGAMINC_RIM2 => PARAM_LIMA_MIXED%XGAMINC_RIM2
+ CASE('XGAMINC_RIM4')
+ ALLOCATE(PARAM_LIMA_MIXED%XGAMINC_RIM4(KDIM1))
+ XGAMINC_RIM4 => PARAM_LIMA_MIXED%XGAMINC_RIM4
+ CASE('XGAMINC_HMC')
+ ALLOCATE(PARAM_LIMA_MIXED%XGAMINC_HMC(KDIM1))
+ XGAMINC_HMC => PARAM_LIMA_MIXED%XGAMINC_HMC
+ !2d
+ CASE('XGAMINC_CIBU_S')
+ ALLOCATE(PARAM_LIMA_MIXED%XGAMINC_CIBU_S(KDIM1, KDIM2))
+ XGAMINC_CIBU_S => PARAM_LIMA_MIXED%XGAMINC_CIBU_S
+ CASE('XGAMINC_CIBU_G')
+ ALLOCATE(PARAM_LIMA_MIXED%XGAMINC_CIBU_G(KDIM1, KDIM2))
+ XGAMINC_CIBU_G => PARAM_LIMA_MIXED%XGAMINC_CIBU_G
+ CASE('XKER_RACCSS')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_RACCSS(KDIM1, KDIM2))
+ XKER_RACCSS => PARAM_LIMA_MIXED%XKER_RACCSS
+ CASE('XKER_RACCS')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_RACCS(KDIM1, KDIM2))
+ XKER_RACCS => PARAM_LIMA_MIXED%XKER_RACCS
+ CASE('XKER_SACCRG')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_SACCRG(KDIM1, KDIM2))
+ XKER_SACCRG => PARAM_LIMA_MIXED%XKER_SACCRG
+ CASE('XKER_N_RACCSS')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_N_RACCSS(KDIM1, KDIM2))
+ XKER_N_RACCSS => PARAM_LIMA_MIXED%XKER_N_RACCSS
+ CASE('XKER_N_RACCS')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_N_RACCS(KDIM1, KDIM2))
+ XKER_N_RACCS => PARAM_LIMA_MIXED%XKER_N_RACCS
+ CASE('XKER_N_SACCRG')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_N_SACCRG(KDIM1, KDIM2))
+ XKER_N_SACCRG => PARAM_LIMA_MIXED%XKER_N_SACCRG
+ CASE('XKER_SDRYG')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_SDRYG(KDIM1, KDIM2))
+ XKER_SDRYG => PARAM_LIMA_MIXED%XKER_SDRYG
+ CASE('XKER_RDRYG')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_RDRYG(KDIM1, KDIM2))
+ XKER_RDRYG => PARAM_LIMA_MIXED%XKER_RDRYG
+ CASE('XKER_N_SDRYG')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_N_SDRYG(KDIM1, KDIM2))
+ XKER_N_SDRYG => PARAM_LIMA_MIXED%XKER_N_SDRYG
+ CASE('XKER_N_RDRYG')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_N_RDRYG(KDIM1, KDIM2))
+ XKER_N_RDRYG => PARAM_LIMA_MIXED%XKER_N_RDRYG
+ CASE('XKER_SWETH')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_SWETH(KDIM1, KDIM2))
+ XKER_SWETH => PARAM_LIMA_MIXED%XKER_SWETH
+ CASE('XKER_GWETH')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_GWETH(KDIM1, KDIM2))
+ XKER_GWETH => PARAM_LIMA_MIXED%XKER_GWETH
+ CASE('XKER_N_SWETH')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_N_SWETH(KDIM1, KDIM2))
+ XKER_N_SWETH => PARAM_LIMA_MIXED%XKER_N_SWETH
+ CASE('XKER_N_GWETH')
+ ALLOCATE(PARAM_LIMA_MIXED%XKER_N_GWETH(KDIM1, KDIM2))
+ XKER_N_GWETH => PARAM_LIMA_MIXED%XKER_N_GWETH
+ END SELECT
+END SUBROUTINE PARAM_LIMA_MIXED_ALLOCATE
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/modd_param_lima_warm.f90 b/src/PHYEX/micro/modd_param_lima_warm.f90
index cf555286d5cf4f3b6a402abb08dd2276d9c5a988..dceef01470aa8824b0edb130585b766ab956fad9 100644
--- a/src/PHYEX/micro/modd_param_lima_warm.f90
+++ b/src/PHYEX/micro/modd_param_lima_warm.f90
@@ -8,119 +8,369 @@
! ###########################
!
!!**** *MODD_PARAM_LIMA_WARM* - declaration of some descriptive parameters and
-!! microphysical factors extensively used in
+!! microphysical factors extensively used in
!! the LIMA warm scheme.
!! AUTHOR
!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
!! S. Berthet * Laboratoire d'Aerologie*
!! B. Vié * Laboratoire d'Aerologie*
!!
!! MODIFICATIONS
!! -------------
-!! Original ??/??/13
+!! Original ??/??/13
!!
!-------------------------------------------------------------------------------
USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
!
-IMPLICIT NONE
+IMPLICIT NONE
!
!* 1. DESCRIPTIVE PARAMETERS
! ----------------------
!
-REAL,SAVE :: XLBC, XLBEXC, & ! shape parameters of the cloud droplets
+TYPE PARAM_LIMA_WARM_t
+REAL :: XLBC, XLBEXC, & ! shape parameters of the cloud droplets
XLBR, XLBEXR, XNR ! shape parameters of the raindrops
!
-REAL,SAVE :: XAR,XBR,XCR,XDR,XF0R,XF1R, & ! Raindrop charact.
+REAL :: XAR,XBR,XCR,XDR,XF0R,XF1R, & ! Raindrop charact.
XCCR,XCXR, & !For diagnostics
XAC,XBC,XCC,XDC,XF0C,XF2C,XC1C ! Cloud droplet charact.
!
!
-CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
- :: CLIMA_WARM_NAMES=(/'CCLOUD ','CRAIN ','CCCNFREE','CCCNACTI','SPRO '/)
- ! basenames of the SV articles stored
- ! in the binary files
-CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
- :: CLIMA_WARM_CONC=(/'NC ','NR ','NFREE','NCCN ','SS '/)
-! ! basenames of the SV articles stored
-! ! in the binary files for DIAG
-!
-!* Special issue for Below-Cloud SCAVenging of Aerosol particles
-CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(2) :: CAERO_MASS =(/'MASSAP', 'MAP '/)
!
!-------------------------------------------------------------------------------
!
!* 2. MICROPHYSICAL FACTORS
! ---------------------
!
-REAL,SAVE :: XFSEDRR,XFSEDCR, & ! Constants for sedimentation
+REAL :: XFSEDRR,XFSEDCR, & ! Constants for sedimentation
XFSEDRC,XFSEDCC ! fluxes of R, C
!
!
-REAL,SAVE :: XDIVA, & ! Diffusivity of water vapor
- XTHCO ! Thermal conductivity
-REAL,SAVE :: XWMIN ! Min value of updraft velocity
- ! to enable nucleation process
-REAL,SAVE :: XTMIN ! Min value of
+REAL :: XDIVA, & ! Diffusivity of water vapor
+ XTHCO ! Thermal conductivity
+REAL :: XWMIN ! Min value of updraft velocity
+ ! to enable nucleation process
+REAL :: XTMIN ! Min value of
! temperature evolution
- ! to enable nucleation process
-REAL,SAVE :: XCSTHEN,XCSTDCRIT ! Cst for HEN precalculations
-INTEGER, SAVE :: NHYP ! Number of value of the HYP
- ! functions
-REAL,SAVE :: XHYPINTP1, XHYPINTP2 ! Factors defining the
- ! supersaturation log scale
-REAL, DIMENSION(:,:), SAVE, ALLOCATABLE & ! Tabulated HYPgeometric
- :: XHYPF12, XHYPF32 ! functions used in HEN
-INTEGER, SAVE :: NAHEN ! Number of value of the AHEN
- ! functions
-REAL,SAVE :: XAHENINTP1, XAHENINTP2 ! Factors defining the
- ! temperatures in lin scale
-REAL, DIMENSION(:), SAVE, ALLOCATABLE & !
+ ! to enable nucleation process
+REAL :: XCSTHEN,XCSTDCRIT ! Cst for HEN precalculations
+INTEGER :: NHYP ! Number of value of the HYP
+ ! functions
+REAL :: XHYPINTP1, XHYPINTP2 ! Factors defining the
+ ! supersaturation log scale
+REAL, DIMENSION(:,:), ALLOCATABLE & ! Tabulated HYPgeometric
+ :: XHYPF12, XHYPF32 ! functions used in HEN
+INTEGER :: NAHEN ! Number of value of the AHEN
+ ! functions
+REAL :: XAHENINTP1, XAHENINTP2 ! Factors defining the
+ ! temperatures in lin scale
+REAL, DIMENSION(:), ALLOCATABLE & !
:: XAHENG,XAHENG2,XAHENG3,XPSI1, XPSI3, & ! Twomey-CPB98 and
- XAHENF,XAHENY ! Feingold-Heymsfield
- ! parameterization to compute Smax
-REAL,SAVE :: XWCOEF_F1, XWCOEF_F2, XWCOEF_F3, & ! COEF_F of the polynomial temp.
+ XAHENF,XAHENY ! Feingold-Heymsfield
+ ! parameterization to compute Smax
+REAL :: XWCOEF_F1, XWCOEF_F2, XWCOEF_F3, & ! COEF_F of the polynomial temp.
XWCOEF_Y1, XWCOEF_Y2, XWCOEF_Y3 ! COEF_Y of the polynomial temp.
- ! function powering W
+ ! function powering W
!
!
-REAL,SAVE :: XKERA1, XKERA2 ! Constants to define the lin
- ! and parabolic kernel param.
-REAL,SAVE :: XSELFC ! Constants for cloud droplet
+REAL :: XKERA1, XKERA2 ! Constants to define the lin
+ ! and parabolic kernel param.
+REAL :: XSELFC ! Constants for cloud droplet
! selfcollection : SELF
!
-REAL,SAVE :: XAUTO1, XAUTO2, XCAUTR, & ! Constants for cloud droplet
- XLAUTR, XLAUTR_THRESHOLD, & ! autoconversion : AUT
- XITAUTR, XITAUTR_THRESHOLD, XR0 ! XR0 for KHKO autoconversion
+REAL :: XAUTO1, XAUTO2, XCAUTR, & ! Constants for cloud droplet
+ XLAUTR, XLAUTR_THRESHOLD, & ! autoconversion : AUT
+ XITAUTR, XITAUTR_THRESHOLD, XR0 ! XR0 for KHKO autoconversion
!
-REAL,SAVE :: XACCR1, XACCR2, XACCR3, & ! Constants for the accretion
- XACCR4, XACCR5, XACCR6, & ! process
+REAL :: XACCR1, XACCR2, XACCR3, & ! Constants for the accretion
+ XACCR4, XACCR5, XACCR6, & ! process
XACCR_CLARGE1, XACCR_CLARGE2, XACCR_RLARGE1, XACCR_RLARGE2, &
XACCR_CSMALL1, XACCR_CSMALL2, XACCR_RSMALL1, XACCR_RSMALL2, &
XFCACCR, XEXCACCR
!
-REAL,SAVE :: XSCBU2, XSCBU3, & ! Constants for the raindrop
+REAL :: XSCBU2, XSCBU3, & ! Constants for the raindrop
XSCBU_EFF1, XSCBU_EFF2, XSCBUEXP1 ! breakup-selfcollection: SCBU
!
-REAL,SAVE :: XSPONBUD1,XSPONBUD2,XSPONBUD3, & ! Spontaneous Break-up
+REAL :: XSPONBUD1,XSPONBUD2,XSPONBUD3, & ! Spontaneous Break-up
XSPONCOEF2 ! (drop size limiter)
!
-REAL,SAVE :: X0EVAR, X1EVAR, & ! Constants for raindrop
- XEX0EVAR, XEX1EVAR, XEX2EVAR, & ! evaporation: EVA
+REAL :: X0EVAR, X1EVAR, & ! Constants for raindrop
+ XEX0EVAR, XEX1EVAR, XEX2EVAR, & ! evaporation: EVA
XCEVAP ! for KHKO
!
-REAL,DIMENSION(:,:,:,:), SAVE, ALLOCATABLE :: XCONCC_INI
-REAL,SAVE :: XCONCR_PARAM_INI
- ! Used to initialize the
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XCONCC_INI
+REAL :: XCONCR_PARAM_INI
+ ! Used to initialize the
! concentrations from mixing ratios
! (init and grid-nesting from Kessler)
!
-REAL,SAVE :: X0CNDC, X2CNDC ! Constants for cloud droplet
+REAL :: X0CNDC, X2CNDC ! Constants for cloud droplet
! condensation/evaporation
-REAL,SAVE :: XFREFFC ! Factor to compute the cloud droplet effective radius
-REAL,SAVE :: XFREFFR ! Factor to compute the rain drop effective radius
-REAL,SAVE :: XCREC, XCRER
+REAL :: XFREFFC ! Factor to compute the cloud droplet effective radius
+REAL :: XFREFFR ! Factor to compute the rain drop effective radius
+REAL :: XCREC, XCRER
! Factors to compute reff when cloud and rain are present
+END TYPE PARAM_LIMA_WARM_t
+!
+TYPE(PARAM_LIMA_WARM_t), TARGET, SAVE :: PARAM_LIMA_WARM
+!
+REAL, POINTER :: XLBC => NULL(), &
+ XLBEXC => NULL(), &
+ XLBR => NULL(), &
+ XLBEXR => NULL(), &
+ XNR => NULL(), &
+ XAR => NULL(), &
+ XBR => NULL(), &
+ XCR => NULL(), &
+ XDR => NULL(), &
+ XF0R => NULL(), &
+ XF1R => NULL(), &
+ XCCR => NULL(), &
+ XCXR => NULL(), &
+ XAC => NULL(), &
+ XBC => NULL(), &
+ XCC => NULL(), &
+ XDC => NULL(), &
+ XF0C => NULL(), &
+ XF2C => NULL(), &
+ XC1C => NULL(), &
+ XFSEDRR => NULL(), &
+ XFSEDCR => NULL(), &
+ XFSEDRC => NULL(), &
+ XFSEDCC => NULL(), &
+ XDIVA => NULL(), &
+ XTHCO => NULL(), &
+ XWMIN => NULL(), &
+ XTMIN => NULL(), &
+ XCSTHEN => NULL(), &
+ XCSTDCRIT => NULL(), &
+ XHYPINTP1 => NULL(), &
+ XHYPINTP2 => NULL(), &
+ XAHENINTP1 => NULL(), &
+ XAHENINTP2 => NULL(), &
+ XWCOEF_F1 => NULL(), &
+ XWCOEF_F2 => NULL(), &
+ XWCOEF_F3 => NULL(), &
+ XWCOEF_Y1 => NULL(), &
+ XWCOEF_Y2 => NULL(), &
+ XWCOEF_Y3 => NULL(), &
+ XKERA1 => NULL(), &
+ XKERA2 => NULL(), &
+ XSELFC => NULL(), &
+ XAUTO1 => NULL(), &
+ XAUTO2 => NULL(), &
+ XCAUTR => NULL(), &
+ XLAUTR => NULL(), &
+ XLAUTR_THRESHOLD => NULL(), &
+ XITAUTR => NULL(), &
+ XITAUTR_THRESHOLD => NULL(), &
+ XR0 => NULL(), &
+ XACCR1 => NULL(), &
+ XACCR2 => NULL(), &
+ XACCR3 => NULL(), &
+ XACCR4 => NULL(), &
+ XACCR5 => NULL(), &
+ XACCR6 => NULL(), &
+ XACCR_CLARGE1 => NULL(), &
+ XACCR_CLARGE2 => NULL(), &
+ XACCR_RLARGE1 => NULL(), &
+ XACCR_RLARGE2 => NULL(), &
+ XACCR_CSMALL1 => NULL(), &
+ XACCR_CSMALL2 => NULL(), &
+ XACCR_RSMALL1 => NULL(), &
+ XACCR_RSMALL2 => NULL(), &
+ XFCACCR => NULL(), &
+ XEXCACCR => NULL(), &
+ XSCBU2 => NULL(), &
+ XSCBU3 => NULL(), &
+ XSCBU_EFF1 => NULL(), &
+ XSCBU_EFF2 => NULL(), &
+ XSCBUEXP1 => NULL(), &
+ XSPONBUD1 => NULL(), &
+ XSPONBUD2 => NULL(), &
+ XSPONBUD3 => NULL(), &
+ XSPONCOEF2 => NULL(), &
+ X0EVAR => NULL(), &
+ X1EVAR => NULL(), &
+ XEX0EVAR => NULL(), &
+ XEX1EVAR => NULL(), &
+ XEX2EVAR => NULL(), &
+ XCEVAP => NULL(), &
+ XCONCR_PARAM_INI => NULL(), &
+ X0CNDC => NULL(), &
+ X2CNDC => NULL(), &
+ XFREFFC => NULL(), &
+ XFREFFR => NULL(), &
+ XCREC => NULL(), &
+ XCRER => NULL()
+
+INTEGER, POINTER :: NHYP => NULL(), &
+ NAHEN => NULL()
+
+REAL, DIMENSION(:,:), POINTER :: XHYPF12 => NULL(), &
+ XHYPF32 => NULL()
+REAL, DIMENSION(:), POINTER :: XAHENG => NULL(), &
+ XAHENG2 => NULL(), &
+ XAHENG3 => NULL(), &
+ XPSI1 => NULL(), &
+ XPSI3 => NULL(), &
+ XAHENF => NULL(), &
+ XAHENY => NULL()
+REAL,DIMENSION(:,:,:,:), POINTER :: XCONCC_INI => NULL()
+!
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
+ :: CLIMA_WARM_NAMES=(/'CCLOUD ','CRAIN ','CCCNFREE','CCCNACTI','SPRO '/)
+ ! basenames of the SV articles stored
+ ! in the binary files
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
+ :: CLIMA_WARM_CONC=(/'NC ','NR ','NFREE','NCCN ','SS '/)
+! ! basenames of the SV articles stored
+! ! in the binary files for DIAG
+!
+!* Special issue for Below-Cloud SCAVenging of Aerosol particles
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(2),PARAMETER :: CAERO_MASS =(/'MASSAP', 'MAP '/)
+!
+CONTAINS
+SUBROUTINE PARAM_LIMA_WARM_ASSOCIATE()
+IMPLICIT NONE
+IF(.NOT. ASSOCIATED(XLBC)) THEN
+ XLBC => PARAM_LIMA_WARM%XLBC
+ XLBEXC => PARAM_LIMA_WARM%XLBEXC
+ XLBR => PARAM_LIMA_WARM%XLBR
+ XLBEXR => PARAM_LIMA_WARM%XLBEXR
+ XNR => PARAM_LIMA_WARM%XNR
+ XAR => PARAM_LIMA_WARM%XAR
+ XBR => PARAM_LIMA_WARM%XBR
+ XCR => PARAM_LIMA_WARM%XCR
+ XDR => PARAM_LIMA_WARM%XDR
+ XF0R => PARAM_LIMA_WARM%XF0R
+ XF1R => PARAM_LIMA_WARM%XF1R
+ XCCR => PARAM_LIMA_WARM%XCCR
+ XCXR => PARAM_LIMA_WARM%XCXR
+ XAC => PARAM_LIMA_WARM%XAC
+ XBC => PARAM_LIMA_WARM%XBC
+ XCC => PARAM_LIMA_WARM%XCC
+ XDC => PARAM_LIMA_WARM%XDC
+ XF0C => PARAM_LIMA_WARM%XF0C
+ XF2C => PARAM_LIMA_WARM%XF2C
+ XC1C => PARAM_LIMA_WARM%XC1C
+ XFSEDRR => PARAM_LIMA_WARM%XFSEDRR
+ XFSEDCR => PARAM_LIMA_WARM%XFSEDCR
+ XFSEDRC => PARAM_LIMA_WARM%XFSEDRC
+ XFSEDCC => PARAM_LIMA_WARM%XFSEDCC
+ XDIVA => PARAM_LIMA_WARM%XDIVA
+ XTHCO => PARAM_LIMA_WARM%XTHCO
+ XWMIN => PARAM_LIMA_WARM%XWMIN
+ XTMIN => PARAM_LIMA_WARM%XTMIN
+ XCSTHEN => PARAM_LIMA_WARM%XCSTHEN
+ XCSTDCRIT => PARAM_LIMA_WARM%XCSTDCRIT
+ XHYPINTP1 => PARAM_LIMA_WARM%XHYPINTP1
+ XHYPINTP2 => PARAM_LIMA_WARM%XHYPINTP2
+ XAHENINTP1 => PARAM_LIMA_WARM%XAHENINTP1
+ XAHENINTP2 => PARAM_LIMA_WARM%XAHENINTP2
+ XWCOEF_F1 => PARAM_LIMA_WARM%XWCOEF_F1
+ XWCOEF_F2 => PARAM_LIMA_WARM%XWCOEF_F2
+ XWCOEF_F3 => PARAM_LIMA_WARM%XWCOEF_F3
+ XWCOEF_Y1 => PARAM_LIMA_WARM%XWCOEF_Y1
+ XWCOEF_Y2 => PARAM_LIMA_WARM%XWCOEF_Y2
+ XWCOEF_Y3 => PARAM_LIMA_WARM%XWCOEF_Y3
+ XKERA1 => PARAM_LIMA_WARM%XKERA1
+ XKERA2 => PARAM_LIMA_WARM%XKERA2
+ XSELFC => PARAM_LIMA_WARM%XSELFC
+ XAUTO1 => PARAM_LIMA_WARM%XAUTO1
+ XAUTO2 => PARAM_LIMA_WARM%XAUTO2
+ XCAUTR => PARAM_LIMA_WARM%XCAUTR
+ XLAUTR => PARAM_LIMA_WARM%XLAUTR
+ XLAUTR_THRESHOLD => PARAM_LIMA_WARM%XLAUTR_THRESHOLD
+ XITAUTR => PARAM_LIMA_WARM%XITAUTR
+ XITAUTR_THRESHOLD => PARAM_LIMA_WARM%XITAUTR_THRESHOLD
+ XR0 => PARAM_LIMA_WARM%XR0
+ XACCR1 => PARAM_LIMA_WARM%XACCR1
+ XACCR2 => PARAM_LIMA_WARM%XACCR2
+ XACCR3 => PARAM_LIMA_WARM%XACCR3
+ XACCR4 => PARAM_LIMA_WARM%XACCR4
+ XACCR5 => PARAM_LIMA_WARM%XACCR5
+ XACCR6 => PARAM_LIMA_WARM%XACCR6
+ XACCR_CLARGE1 => PARAM_LIMA_WARM%XACCR_CLARGE1
+ XACCR_CLARGE2 => PARAM_LIMA_WARM%XACCR_CLARGE2
+ XACCR_RLARGE1 => PARAM_LIMA_WARM%XACCR_RLARGE1
+ XACCR_RLARGE2 => PARAM_LIMA_WARM%XACCR_RLARGE2
+ XACCR_CSMALL1 => PARAM_LIMA_WARM%XACCR_CSMALL1
+ XACCR_CSMALL2 => PARAM_LIMA_WARM%XACCR_CSMALL2
+ XACCR_RSMALL1 => PARAM_LIMA_WARM%XACCR_RSMALL1
+ XACCR_RSMALL2 => PARAM_LIMA_WARM%XACCR_RSMALL2
+ XFCACCR => PARAM_LIMA_WARM%XFCACCR
+ XEXCACCR => PARAM_LIMA_WARM%XEXCACCR
+ XSCBU2 => PARAM_LIMA_WARM%XSCBU2
+ XSCBU3 => PARAM_LIMA_WARM%XSCBU3
+ XSCBU_EFF1 => PARAM_LIMA_WARM%XSCBU_EFF1
+ XSCBU_EFF2 => PARAM_LIMA_WARM%XSCBU_EFF2
+ XSCBUEXP1 => PARAM_LIMA_WARM%XSCBUEXP1
+ XSPONBUD1 => PARAM_LIMA_WARM%XSPONBUD1
+ XSPONBUD2 => PARAM_LIMA_WARM%XSPONBUD2
+ XSPONBUD3 => PARAM_LIMA_WARM%XSPONBUD3
+ XSPONCOEF2 => PARAM_LIMA_WARM%XSPONCOEF2
+ X0EVAR => PARAM_LIMA_WARM%X0EVAR
+ X1EVAR => PARAM_LIMA_WARM%X1EVAR
+ XEX0EVAR => PARAM_LIMA_WARM%XEX0EVAR
+ XEX1EVAR => PARAM_LIMA_WARM%XEX1EVAR
+ XEX2EVAR => PARAM_LIMA_WARM%XEX2EVAR
+ XCEVAP => PARAM_LIMA_WARM%XCEVAP
+ XCONCR_PARAM_INI => PARAM_LIMA_WARM%XCONCR_PARAM_INI
+ X0CNDC => PARAM_LIMA_WARM%X0CNDC
+ X2CNDC => PARAM_LIMA_WARM%X2CNDC
+ XFREFFC => PARAM_LIMA_WARM%XFREFFC
+ XFREFFR => PARAM_LIMA_WARM%XFREFFR
+ XCREC => PARAM_LIMA_WARM%XCREC
+ XCRER => PARAM_LIMA_WARM%XCRER
+
+ NHYP => PARAM_LIMA_WARM%NHYP
+ NAHEN => PARAM_LIMA_WARM%NAHEN
+ENDIF
+END SUBROUTINE PARAM_LIMA_WARM_ASSOCIATE
+!
+SUBROUTINE PARAM_LIMA_WARM_ALLOCATE(HNAME, KDIM1, KDIM2, KDIM3, KDIM4)
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ INTEGER, INTENT(IN) :: KDIM1
+ INTEGER, OPTIONAL, INTENT(IN):: KDIM2
+ INTEGER, OPTIONAL, INTENT(IN):: KDIM3
+ INTEGER, OPTIONAL, INTENT(IN):: KDIM4
+
+ SELECT CASE(TRIM(HNAME))
+ CASE('XHYPF12')
+ ALLOCATE(PARAM_LIMA_WARM%XHYPF12(KDIM1, KDIM2))
+ XHYPF12 => PARAM_LIMA_WARM%XHYPF12
+ CASE('XHYPF32')
+ ALLOCATE(PARAM_LIMA_WARM%XHYPF32(KDIM1, KDIM2))
+ XHYPF32 => PARAM_LIMA_WARM%XHYPF32
+ CASE('XAHENG')
+ ALLOCATE(PARAM_LIMA_WARM%XAHENG(KDIM1))
+ XAHENG => PARAM_LIMA_WARM%XAHENG
+ CASE('XAHENG2')
+ ALLOCATE(PARAM_LIMA_WARM%XAHENG2(KDIM1))
+ XAHENG2 => PARAM_LIMA_WARM%XAHENG2
+ CASE('XAHENG3')
+ ALLOCATE(PARAM_LIMA_WARM%XAHENG3(KDIM1))
+ XAHENG3 => PARAM_LIMA_WARM%XAHENG3
+ CASE('XPSI1')
+ ALLOCATE(PARAM_LIMA_WARM%XPSI1(KDIM1))
+ XPSI1 => PARAM_LIMA_WARM%XPSI1
+ CASE('XPSI3')
+ ALLOCATE(PARAM_LIMA_WARM%XPSI3(KDIM1))
+ XPSI3 => PARAM_LIMA_WARM%XPSI3
+ CASE('XAHENF')
+ ALLOCATE(PARAM_LIMA_WARM%XAHENF(KDIM1))
+ XAHENF => PARAM_LIMA_WARM%XAHENF
+ CASE('XAHENY')
+ ALLOCATE(PARAM_LIMA_WARM%XAHENY(KDIM1))
+ XAHENY => PARAM_LIMA_WARM%XAHENY
+ CASE('XCONCC_INI')
+ ALLOCATE(PARAM_LIMA_WARM%XCONCC_INI(KDIM1,KDIM2,KDIM3,KDIM4))
+ XCONCC_INI => PARAM_LIMA_WARM%XCONCC_INI
+ END SELECT
+END SUBROUTINE PARAM_LIMA_WARM_ALLOCATE
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/modd_rain_c2r2_descr.f90 b/src/PHYEX/micro/modd_rain_c2r2_descr.f90
index 82146aac4fbb15f11b6e90534fec2dab76af9772..cabbebbd7f02b319e10869d5efa4bcfdc44772f4 100644
--- a/src/PHYEX/micro/modd_rain_c2r2_descr.f90
+++ b/src/PHYEX/micro/modd_rain_c2r2_descr.f90
@@ -46,6 +46,7 @@
!!
!-------------------------------------------------------------------------------
USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
+IMPLICIT NONE
!
!* 0. DECLARATIONS
! ------------
diff --git a/src/PHYEX/micro/modd_rain_ice_descrn.f90 b/src/PHYEX/micro/modd_rain_ice_descrn.f90
index a7b8113de349c3a565fde4d35868393d618d8890..c34d41fa90ebd451f8c3536550803086a4893445 100644
--- a/src/PHYEX/micro/modd_rain_ice_descrn.f90
+++ b/src/PHYEX/micro/modd_rain_ice_descrn.f90
@@ -3,11 +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 MODD_RAIN_ICE_DESCR
+ MODULE MODD_RAIN_ICE_DESCR_n
! ##########################
-!
-!!**** *MODD_RAIN_ICE_DESCR* - declaration of the microphysical descriptive
-!! constants for use in the warm and cold schemes.
+!> @file
+!!**** *MODD_RAIN_ICE_DESCR_n* - declaration of the microphysical descriptive
+!! constants for use in the warm and cold schemes.
!!
!! PURPOSE
!! -------
@@ -52,6 +52,7 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
TYPE RAIN_ICE_DESCR_t
REAL :: XCEXVT ! air density fall speed correction
@@ -82,7 +83,8 @@ 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
+TYPE(RAIN_ICE_DESCR_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: RAIN_ICE_DESCR_MODEL
+TYPE(RAIN_ICE_DESCR_t), POINTER, SAVE :: RAIN_ICE_DESCRN => NULL()
!
REAL,DIMENSION(:),POINTER :: XLBC=>NULL(), XRTMIN=>NULL()
REAL, POINTER :: XCEXVT => NULL(), &
@@ -169,104 +171,114 @@ REAL, POINTER :: XCEXVT => 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_GOTO_MODEL(KFROM, KTO)
+!! This subroutine associate all the pointers to the right component of
+!! the right strucuture. A value can be accessed through the structure RAIN_ICE_DESCRN
+!! or through the strucuture RAIN_ICE_DESCR_MODEL(KTO) or directly through these pointers.
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+IF(.NOT. ASSOCIATED(RAIN_ICE_DESCRN, RAIN_ICE_DESCR_MODEL(KTO))) THEN
+ !
+ RAIN_ICE_DESCRN => RAIN_ICE_DESCR_MODEL(KTO)
+ !
+ XCEXVT => RAIN_ICE_DESCRN%XCEXVT
+ XAC => RAIN_ICE_DESCRN%XAC
+ XBC => RAIN_ICE_DESCRN%XBC
+ XCC => RAIN_ICE_DESCRN%XCC
+ XDC => RAIN_ICE_DESCRN%XDC
+ XAR => RAIN_ICE_DESCRN%XAR
+ XBR => RAIN_ICE_DESCRN%XBR
+ XCR => RAIN_ICE_DESCRN%XCR
+ XDR => RAIN_ICE_DESCRN%XDR
+ XCCR => RAIN_ICE_DESCRN%XCCR
+ XF0R => RAIN_ICE_DESCRN%XF0R
+ XF1R => RAIN_ICE_DESCRN%XF1R
+ XC1R => RAIN_ICE_DESCRN%XC1R
+ XAI => RAIN_ICE_DESCRN%XAI
+ XBI => RAIN_ICE_DESCRN%XBI
+ XC_I => RAIN_ICE_DESCRN%XC_I
+ XDI => RAIN_ICE_DESCRN%XDI
+ XF0I => RAIN_ICE_DESCRN%XF0I
+ XF2I => RAIN_ICE_DESCRN%XF2I
+ XC1I => RAIN_ICE_DESCRN%XC1I
+ XAS => RAIN_ICE_DESCRN%XAS
+ XBS => RAIN_ICE_DESCRN%XBS
+ XCS => RAIN_ICE_DESCRN%XCS
+ XDS => RAIN_ICE_DESCRN%XDS
+ XCCS => RAIN_ICE_DESCRN%XCCS
+ XCXS => RAIN_ICE_DESCRN%XCXS
+ XF0S => RAIN_ICE_DESCRN%XF0S
+ XF1S => RAIN_ICE_DESCRN%XF1S
+ XC1S => RAIN_ICE_DESCRN%XC1S
+ XAG => RAIN_ICE_DESCRN%XAG
+ XBG => RAIN_ICE_DESCRN%XBG
+ XCG => RAIN_ICE_DESCRN%XCG
+ XDG => RAIN_ICE_DESCRN%XDG
+ XCCG => RAIN_ICE_DESCRN%XCCG
+ XCXG => RAIN_ICE_DESCRN%XCXG
+ XF0G => RAIN_ICE_DESCRN%XF0G
+ XF1G => RAIN_ICE_DESCRN%XF1G
+ XC1G => RAIN_ICE_DESCRN%XC1G
+ XAH => RAIN_ICE_DESCRN%XAH
+ XBH => RAIN_ICE_DESCRN%XBH
+ XCH => RAIN_ICE_DESCRN%XCH
+ XDH => RAIN_ICE_DESCRN%XDH
+ XCCH => RAIN_ICE_DESCRN%XCCH
+ XCXH => RAIN_ICE_DESCRN%XCXH
+ XF0H => RAIN_ICE_DESCRN%XF0H
+ XF1H => RAIN_ICE_DESCRN%XF1H
+ XC1H => RAIN_ICE_DESCRN%XC1H
+ XALPHAC => RAIN_ICE_DESCRN%XALPHAC
+ XNUC => RAIN_ICE_DESCRN%XNUC
+ XALPHAC2 => RAIN_ICE_DESCRN%XALPHAC2
+ XNUC2 => RAIN_ICE_DESCRN%XNUC2
+ XLBEXC => RAIN_ICE_DESCRN%XLBEXC
+ XALPHAR => RAIN_ICE_DESCRN%XALPHAR
+ XNUR => RAIN_ICE_DESCRN%XNUR
+ XLBEXR => RAIN_ICE_DESCRN%XLBEXR
+ XLBR => RAIN_ICE_DESCRN%XLBR
+ XALPHAI => RAIN_ICE_DESCRN%XALPHAI
+ XNUI => RAIN_ICE_DESCRN%XNUI
+ XLBEXI => RAIN_ICE_DESCRN%XLBEXI
+ XLBI => RAIN_ICE_DESCRN%XLBI
+ XALPHAS => RAIN_ICE_DESCRN%XALPHAS
+ XNUS => RAIN_ICE_DESCRN%XNUS
+ XLBEXS => RAIN_ICE_DESCRN%XLBEXS
+ XLBS => RAIN_ICE_DESCRN%XLBS
+ XALPHAG => RAIN_ICE_DESCRN%XALPHAG
+ XNUG => RAIN_ICE_DESCRN%XNUG
+ XLBEXG => RAIN_ICE_DESCRN%XLBEXG
+ XLBG => RAIN_ICE_DESCRN%XLBG
+ XALPHAH => RAIN_ICE_DESCRN%XALPHAH
+ XNUH => RAIN_ICE_DESCRN%XNUH
+ XLBEXH => RAIN_ICE_DESCRN%XLBEXH
+ XLBH => RAIN_ICE_DESCRN%XLBH
+ XLBDAR_MAX => RAIN_ICE_DESCRN%XLBDAR_MAX
+ XLBDAS_MAX => RAIN_ICE_DESCRN%XLBDAS_MAX
+ XLBDAG_MAX => RAIN_ICE_DESCRN%XLBDAG_MAX
+ XCONC_SEA => RAIN_ICE_DESCRN%XCONC_SEA
+ XCONC_LAND => RAIN_ICE_DESCRN%XCONC_LAND
+ XCONC_URBAN => RAIN_ICE_DESCRN%XCONC_URBAN
+ XNS => RAIN_ICE_DESCRN%XNS
+ XFVELOS => RAIN_ICE_DESCRN%XFVELOS
+ XTRANS_MP_GAMMAS => RAIN_ICE_DESCRN%XTRANS_MP_GAMMAS
+ XLBDAS_MIN => RAIN_ICE_DESCRN%XLBDAS_MIN
+ENDIF
+END SUBROUTINE RAIN_ICE_DESCR_GOTO_MODEL
!
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
+ ALLOCATE(RAIN_ICE_DESCRN%XRTMIN(KRR))
+ XRTMIN=>RAIN_ICE_DESCRN%XRTMIN
+ XLBC=>RAIN_ICE_DESCRN%XLBC
END SUBROUTINE RAIN_ICE_DESCR_ALLOCATE
!
SUBROUTINE RAIN_ICE_DESCR_DEALLOCATE()
IMPLICIT NONE
XRTMIN=>NULL()
- DEALLOCATE(RAIN_ICE_DESCR%XRTMIN)
+ DEALLOCATE(RAIN_ICE_DESCRN%XRTMIN)
END SUBROUTINE RAIN_ICE_DESCR_DEALLOCATE
!
-END MODULE MODD_RAIN_ICE_DESCR
+END MODULE MODD_RAIN_ICE_DESCR_n
diff --git a/src/PHYEX/micro/modd_rain_ice_paramn.f90 b/src/PHYEX/micro/modd_rain_ice_paramn.f90
index 40acb8f56888d5193c2fc09e7acc36993814beb2..c3919cf7d4b44a015bcc86ed55fb38b6d849ce62 100644
--- a/src/PHYEX/micro/modd_rain_ice_paramn.f90
+++ b/src/PHYEX/micro/modd_rain_ice_paramn.f90
@@ -3,11 +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.
! ######spl
- MODULE MODD_RAIN_ICE_PARAM
+ MODULE MODD_RAIN_ICE_PARAM_n
! ##########################
-!
-!!**** *MODD_RAIN_ICE_PARAM* - declaration of some microphysical factors
-!! extensively used in the warm and cold schemes.
+!> @file
+!!**** *MODD_RAIN_ICE_PARAM_n* - declaration of some microphysical factors
+!! extensively used in the warm and cold schemes.
!!
!! PURPOSE
!! -------
@@ -38,6 +38,7 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
!
TYPE RAIN_ICE_PARAM_t
@@ -187,7 +188,8 @@ REAL,DIMENSION(:,:), ALLOCATABLE &
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
+TYPE(RAIN_ICE_PARAM_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: RAIN_ICE_PARAM_MODEL
+TYPE(RAIN_ICE_PARAM_t), POINTER, SAVE :: RAIN_ICE_PARAMN => NULL()
!
REAL,DIMENSION(:),POINTER :: XFSEDC => NULL()
REAL,DIMENSION(:),POINTER :: XFRMIN => NULL()
@@ -373,179 +375,224 @@ REAL,DIMENSION(:,:), POINTER :: XKER_RACCSS => 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
+SUBROUTINE RAIN_ICE_PARAM_GOTO_MODEL(KFROM, KTO)
+!! This subroutine associate all the pointers to the right component of
+!! the right strucuture. A value can be accessed through the structure RAIN_ICE_PARAMN
+!! or through the strucuture RAIN_ICE_PARAM_MODEL(KTO) or directly through these pointers.
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+IF(.NOT. ASSOCIATED(RAIN_ICE_PARAMN, RAIN_ICE_PARAM_MODEL(KTO))) THEN
+ !
+ RAIN_ICE_PARAMN => RAIN_ICE_PARAM_MODEL(KTO)
+ !
+ XFSEDC => RAIN_ICE_PARAMN%XFSEDC
+ XFRMIN => RAIN_ICE_PARAMN%XFRMIN
+ !
+ XFSEDR => RAIN_ICE_PARAMN%XFSEDR
+ XEXSEDR => RAIN_ICE_PARAMN%XEXSEDR
+ XFSEDI => RAIN_ICE_PARAMN%XFSEDI
+ XEXCSEDI => RAIN_ICE_PARAMN%XEXCSEDI
+ XEXRSEDI => RAIN_ICE_PARAMN%XEXRSEDI
+ XFSEDS => RAIN_ICE_PARAMN%XFSEDS
+ XEXSEDS => RAIN_ICE_PARAMN%XEXSEDS
+ XFSEDG => RAIN_ICE_PARAMN%XFSEDG
+ XEXSEDG => RAIN_ICE_PARAMN%XEXSEDG
+ XNU10 => RAIN_ICE_PARAMN%XNU10
+ XALPHA1 => RAIN_ICE_PARAMN%XALPHA1
+ XBETA1 => RAIN_ICE_PARAMN%XBETA1
+ XNU20 => RAIN_ICE_PARAMN%XNU20
+ XALPHA2 => RAIN_ICE_PARAMN%XALPHA2
+ XBETA2 => RAIN_ICE_PARAMN%XBETA2
+ XMNU0 => RAIN_ICE_PARAMN%XMNU0
+ XALPHA3 => RAIN_ICE_PARAMN%XALPHA3
+ XBETA3 => RAIN_ICE_PARAMN%XBETA3
+ XHON => RAIN_ICE_PARAMN%XHON
+ XSCFAC => RAIN_ICE_PARAMN%XSCFAC
+ X0EVAR => RAIN_ICE_PARAMN%X0EVAR
+ X1EVAR => RAIN_ICE_PARAMN%X1EVAR
+ XEX0EVAR => RAIN_ICE_PARAMN%XEX0EVAR
+ XEX1EVAR => RAIN_ICE_PARAMN%XEX1EVAR
+ X0DEPI => RAIN_ICE_PARAMN%X0DEPI
+ X2DEPI => RAIN_ICE_PARAMN%X2DEPI
+ X0DEPS => RAIN_ICE_PARAMN%X0DEPS
+ X1DEPS => RAIN_ICE_PARAMN%X1DEPS
+ XEX0DEPS => RAIN_ICE_PARAMN%XEX0DEPS
+ XEX1DEPS => RAIN_ICE_PARAMN%XEX1DEPS
+ XRDEPSRED => RAIN_ICE_PARAMN%XRDEPSRED
+ X0DEPG => RAIN_ICE_PARAMN%X0DEPG
+ X1DEPG => RAIN_ICE_PARAMN%X1DEPG
+ XEX0DEPG => RAIN_ICE_PARAMN%XEX0DEPG
+ XEX1DEPG => RAIN_ICE_PARAMN%XEX1DEPG
+ XRDEPGRED => RAIN_ICE_PARAMN%XRDEPGRED
+ XTIMAUTI => RAIN_ICE_PARAMN%XTIMAUTI
+ XTEXAUTI => RAIN_ICE_PARAMN%XTEXAUTI
+ XCRIAUTI => RAIN_ICE_PARAMN%XCRIAUTI
+ XT0CRIAUTI => RAIN_ICE_PARAMN%XT0CRIAUTI
+ XACRIAUTI => RAIN_ICE_PARAMN%XACRIAUTI
+ XBCRIAUTI => RAIN_ICE_PARAMN%XBCRIAUTI
+ XCOLIS => RAIN_ICE_PARAMN%XCOLIS
+ XCOLEXIS => RAIN_ICE_PARAMN%XCOLEXIS
+ XFIAGGS => RAIN_ICE_PARAMN%XFIAGGS
+ XEXIAGGS => RAIN_ICE_PARAMN%XEXIAGGS
+ XTIMAUTC => RAIN_ICE_PARAMN%XTIMAUTC
+ XCRIAUTC => RAIN_ICE_PARAMN%XCRIAUTC
+ XFCACCR => RAIN_ICE_PARAMN%XFCACCR
+ XEXCACCR => RAIN_ICE_PARAMN%XEXCACCR
+ XDCSLIM => RAIN_ICE_PARAMN%XDCSLIM
+ XCOLCS => RAIN_ICE_PARAMN%XCOLCS
+ XEXCRIMSS => RAIN_ICE_PARAMN%XEXCRIMSS
+ XCRIMSS => RAIN_ICE_PARAMN%XCRIMSS
+ XEXCRIMSG => RAIN_ICE_PARAMN%XEXCRIMSG
+ XCRIMSG => RAIN_ICE_PARAMN%XCRIMSG
+ XEXSRIMCG => RAIN_ICE_PARAMN%XEXSRIMCG
+ XSRIMCG => RAIN_ICE_PARAMN%XSRIMCG
+ XEXSRIMCG2 => RAIN_ICE_PARAMN%XEXSRIMCG2
+ XSRIMCG2 => RAIN_ICE_PARAMN%XSRIMCG2
+ XSRIMCG3 => RAIN_ICE_PARAMN%XSRIMCG3
+ XGAMINC_BOUND_MIN => RAIN_ICE_PARAMN%XGAMINC_BOUND_MIN
+ XGAMINC_BOUND_MAX => RAIN_ICE_PARAMN%XGAMINC_BOUND_MAX
+ XRIMINTP1 => RAIN_ICE_PARAMN%XRIMINTP1
+ XRIMINTP2 => RAIN_ICE_PARAMN%XRIMINTP2
+ XFRACCSS => RAIN_ICE_PARAMN%XFRACCSS
+ XLBRACCS1 => RAIN_ICE_PARAMN%XLBRACCS1
+ XLBRACCS2 => RAIN_ICE_PARAMN%XLBRACCS2
+ XLBRACCS3 => RAIN_ICE_PARAMN%XLBRACCS3
+ XFSACCRG => RAIN_ICE_PARAMN%XFSACCRG
+ XLBSACCR1 => RAIN_ICE_PARAMN%XLBSACCR1
+ XLBSACCR2 => RAIN_ICE_PARAMN%XLBSACCR2
+ XLBSACCR3 => RAIN_ICE_PARAMN%XLBSACCR3
+ XACCLBDAS_MIN => RAIN_ICE_PARAMN%XACCLBDAS_MIN
+ XACCLBDAS_MAX => RAIN_ICE_PARAMN%XACCLBDAS_MAX
+ XACCLBDAR_MIN => RAIN_ICE_PARAMN%XACCLBDAR_MIN
+ XACCLBDAR_MAX => RAIN_ICE_PARAMN%XACCLBDAR_MAX
+ XACCINTP1S => RAIN_ICE_PARAMN%XACCINTP1S
+ XACCINTP2S => RAIN_ICE_PARAMN%XACCINTP2S
+ XACCINTP1R => RAIN_ICE_PARAMN%XACCINTP1R
+ XACCINTP2R => RAIN_ICE_PARAMN%XACCINTP2R
+ XFSCVMG => RAIN_ICE_PARAMN%XFSCVMG
+ XCOLIR => RAIN_ICE_PARAMN%XCOLIR
+ XEXRCFRI => RAIN_ICE_PARAMN%XEXRCFRI
+ XRCFRI => RAIN_ICE_PARAMN%XRCFRI
+ XEXICFRR => RAIN_ICE_PARAMN%XEXICFRR
+ XICFRR => RAIN_ICE_PARAMN%XICFRR
+ XFCDRYG => RAIN_ICE_PARAMN%XFCDRYG
+ XCOLIG => RAIN_ICE_PARAMN%XCOLIG
+ XCOLEXIG => RAIN_ICE_PARAMN%XCOLEXIG
+ XFIDRYG => RAIN_ICE_PARAMN%XFIDRYG
+ XFIDRYG2 => RAIN_ICE_PARAMN%XFIDRYG2
+ XEXFIDRYG => RAIN_ICE_PARAMN%XEXFIDRYG
+ XCOLSG => RAIN_ICE_PARAMN%XCOLSG
+ XCOLEXSG => RAIN_ICE_PARAMN%XCOLEXSG
+ XFSDRYG => RAIN_ICE_PARAMN%XFSDRYG
+ XLBSDRYG1 => RAIN_ICE_PARAMN%XLBSDRYG1
+ XLBSDRYG2 => RAIN_ICE_PARAMN%XLBSDRYG2
+ XLBSDRYG3 => RAIN_ICE_PARAMN%XLBSDRYG3
+ XFRDRYG => RAIN_ICE_PARAMN%XFRDRYG
+ XLBRDRYG1 => RAIN_ICE_PARAMN%XLBRDRYG1
+ XLBRDRYG2 => RAIN_ICE_PARAMN%XLBRDRYG2
+ XLBRDRYG3 => RAIN_ICE_PARAMN%XLBRDRYG3
+ XDRYLBDAR_MIN => RAIN_ICE_PARAMN%XDRYLBDAR_MIN
+ XDRYLBDAR_MAX => RAIN_ICE_PARAMN%XDRYLBDAR_MAX
+ XDRYLBDAS_MIN => RAIN_ICE_PARAMN%XDRYLBDAS_MIN
+ XDRYLBDAS_MAX => RAIN_ICE_PARAMN%XDRYLBDAS_MAX
+ XDRYLBDAG_MIN => RAIN_ICE_PARAMN%XDRYLBDAG_MIN
+ XDRYLBDAG_MAX => RAIN_ICE_PARAMN%XDRYLBDAG_MAX
+ XDRYINTP1R => RAIN_ICE_PARAMN%XDRYINTP1R
+ XDRYINTP2R => RAIN_ICE_PARAMN%XDRYINTP2R
+ XDRYINTP1S => RAIN_ICE_PARAMN%XDRYINTP1S
+ XDRYINTP2S => RAIN_ICE_PARAMN%XDRYINTP2S
+ XDRYINTP1G => RAIN_ICE_PARAMN%XDRYINTP1G
+ XDRYINTP2G => RAIN_ICE_PARAMN%XDRYINTP2G
+ XFSEDH => RAIN_ICE_PARAMN%XFSEDH
+ XEXSEDH => RAIN_ICE_PARAMN%XEXSEDH
+ X0DEPH => RAIN_ICE_PARAMN%X0DEPH
+ X1DEPH => RAIN_ICE_PARAMN%X1DEPH
+ XEX0DEPH => RAIN_ICE_PARAMN%XEX0DEPH
+ XEX1DEPH => RAIN_ICE_PARAMN%XEX1DEPH
+ XCOLIH => RAIN_ICE_PARAMN%XCOLIH
+ XCOLEXIH => RAIN_ICE_PARAMN%XCOLEXIH
+ XCOLSH => RAIN_ICE_PARAMN%XCOLSH
+ XCOLEXSH => RAIN_ICE_PARAMN%XCOLEXSH
+ XCOLGH => RAIN_ICE_PARAMN%XCOLGH
+ XCOLEXGH => RAIN_ICE_PARAMN%XCOLEXGH
+ XFWETH => RAIN_ICE_PARAMN%XFWETH
+ XFSWETH => RAIN_ICE_PARAMN%XFSWETH
+ XLBSWETH1 => RAIN_ICE_PARAMN%XLBSWETH1
+ XLBSWETH2 => RAIN_ICE_PARAMN%XLBSWETH2
+ XLBSWETH3 => RAIN_ICE_PARAMN%XLBSWETH3
+ XFGWETH => RAIN_ICE_PARAMN%XFGWETH
+ XLBGWETH1 => RAIN_ICE_PARAMN%XLBGWETH1
+ XLBGWETH2 => RAIN_ICE_PARAMN%XLBGWETH2
+ XLBGWETH3 => RAIN_ICE_PARAMN%XLBGWETH3
+ XFRWETH => RAIN_ICE_PARAMN%XFRWETH
+ XLBRWETH1 => RAIN_ICE_PARAMN%XLBRWETH1
+ XLBRWETH2 => RAIN_ICE_PARAMN%XLBRWETH2
+ XLBRWETH3 => RAIN_ICE_PARAMN%XLBRWETH3
+ XWETLBDAS_MIN => RAIN_ICE_PARAMN%XWETLBDAS_MIN
+ XWETLBDAS_MAX => RAIN_ICE_PARAMN%XWETLBDAS_MAX
+ XWETLBDAG_MIN => RAIN_ICE_PARAMN%XWETLBDAG_MIN
+ XWETLBDAG_MAX => RAIN_ICE_PARAMN%XWETLBDAG_MAX
+ XWETLBDAR_MIN => RAIN_ICE_PARAMN%XWETLBDAR_MIN
+ XWETLBDAR_MAX => RAIN_ICE_PARAMN%XWETLBDAR_MAX
+ XWETLBDAH_MIN => RAIN_ICE_PARAMN%XWETLBDAH_MIN
+ XWETLBDAH_MAX => RAIN_ICE_PARAMN%XWETLBDAH_MAX
+ XWETINTP1S => RAIN_ICE_PARAMN%XWETINTP1S
+ XWETINTP2S => RAIN_ICE_PARAMN%XWETINTP2S
+ XWETINTP1G => RAIN_ICE_PARAMN%XWETINTP1G
+ XWETINTP2G => RAIN_ICE_PARAMN%XWETINTP2G
+ XWETINTP1R => RAIN_ICE_PARAMN%XWETINTP1R
+ XWETINTP2R => RAIN_ICE_PARAMN%XWETINTP2R
+ XWETINTP1H => RAIN_ICE_PARAMN%XWETINTP1H
+ XWETINTP2H => RAIN_ICE_PARAMN%XWETINTP2H
!
- 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_PARAMN%NGAMINC
+ NACCLBDAS => RAIN_ICE_PARAMN%NACCLBDAS
+ NACCLBDAR => RAIN_ICE_PARAMN%NACCLBDAR
+ NDRYLBDAR => RAIN_ICE_PARAMN%NDRYLBDAR
+ NDRYLBDAS => RAIN_ICE_PARAMN%NDRYLBDAS
+ NDRYLBDAG => RAIN_ICE_PARAMN%NDRYLBDAG
+ NWETLBDAS => RAIN_ICE_PARAMN%NWETLBDAS
+ NWETLBDAG => RAIN_ICE_PARAMN%NWETLBDAG
+ NWETLBDAR => RAIN_ICE_PARAMN%NWETLBDAR
+ NWETLBDAH => RAIN_ICE_PARAMN%NWETLBDAH
!
- 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
+ CALL HELPER1(XGAMINC_RIM1, RAIN_ICE_PARAMN%XGAMINC_RIM1)
+ CALL HELPER1(XGAMINC_RIM2, RAIN_ICE_PARAMN%XGAMINC_RIM2)
+ CALL HELPER1(XGAMINC_RIM4, RAIN_ICE_PARAMN%XGAMINC_RIM4)
+ CALL HELPER2(XKER_RACCSS, RAIN_ICE_PARAMN%XKER_RACCSS)
+ CALL HELPER2(XKER_RACCS, RAIN_ICE_PARAMN%XKER_RACCS)
+ CALL HELPER2(XKER_SACCRG, RAIN_ICE_PARAMN%XKER_SACCRG)
+ CALL HELPER2(XKER_SDRYG, RAIN_ICE_PARAMN%XKER_SDRYG)
+ CALL HELPER2(XKER_RDRYG, RAIN_ICE_PARAMN%XKER_RDRYG)
+ CALL HELPER2(XKER_SWETH, RAIN_ICE_PARAMN%XKER_SWETH)
+ CALL HELPER2(XKER_GWETH, RAIN_ICE_PARAMN%XKER_GWETH)
+ CALL HELPER2(XKER_RWETH, RAIN_ICE_PARAMN%XKER_RWETH)
+
+ENDIF
+END SUBROUTINE RAIN_ICE_PARAM_GOTO_MODEL
+!
+SUBROUTINE HELPER1(XPT, XARR)
+ IMPLICIT NONE
+ REAL, POINTER, DIMENSION(:), INTENT(INOUT) :: XPT
+ REAL, DIMENSION(:), ALLOCATABLE, TARGET, INTENT(INOUT) :: XARR
+ IF(ALLOCATED(XARR)) THEN
+ XPT => XARR
+ ELSE
+ XPT => NULL()
+ ENDIF
+END SUBROUTINE HELPER1
+!
+SUBROUTINE HELPER2(XPT, XARR)
+ IMPLICIT NONE
+ REAL, POINTER, DIMENSION(:,:), INTENT(INOUT) :: XPT
+ REAL, DIMENSION(:,:), ALLOCATABLE, TARGET, INTENT(INOUT) :: XARR
+ IF(ALLOCATED(XARR)) THEN
+ XPT => XARR
+ ELSE
+ XPT => NULL()
+ ENDIF
+END SUBROUTINE HELPER2
!
SUBROUTINE RAIN_ICE_PARAM_ALLOCATE(HNAME, KDIM1, KDIM2)
IMPLICIT NONE
@@ -556,57 +603,59 @@ SUBROUTINE RAIN_ICE_PARAM_ALLOCATE(HNAME, KDIM1, KDIM2)
SELECT CASE(TRIM(HNAME))
!1D arrays
CASE('XGAMINC_RIM1')
- ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM1(KDIM1))
- XGAMINC_RIM1 => RAIN_ICE_PARAM%XGAMINC_RIM1
+ ALLOCATE(RAIN_ICE_PARAMN%XGAMINC_RIM1(KDIM1))
+ XGAMINC_RIM1 => RAIN_ICE_PARAMN%XGAMINC_RIM1
CASE('XGAMINC_RIM2')
- ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM2(KDIM1))
- XGAMINC_RIM2 => RAIN_ICE_PARAM%XGAMINC_RIM2
+ ALLOCATE(RAIN_ICE_PARAMN%XGAMINC_RIM2(KDIM1))
+ XGAMINC_RIM2 => RAIN_ICE_PARAMN%XGAMINC_RIM2
CASE('XGAMINC_RIM4')
- ALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM4(KDIM1))
- XGAMINC_RIM4 => RAIN_ICE_PARAM%XGAMINC_RIM4
+ ALLOCATE(RAIN_ICE_PARAMN%XGAMINC_RIM4(KDIM1))
+ XGAMINC_RIM4 => RAIN_ICE_PARAMN%XGAMINC_RIM4
!
!2D arrays
CASE('XKER_RACCSS')
- ALLOCATE(RAIN_ICE_PARAM%XKER_RACCSS(KDIM1, KDIM2))
- XKER_RACCSS=> RAIN_ICE_PARAM%XKER_RACCSS
+ ALLOCATE(RAIN_ICE_PARAMN%XKER_RACCSS(KDIM1, KDIM2))
+ XKER_RACCSS=> RAIN_ICE_PARAMN%XKER_RACCSS
CASE('XKER_RACCS')
- ALLOCATE(RAIN_ICE_PARAM%XKER_RACCS(KDIM1, KDIM2))
- XKER_RACCS=> RAIN_ICE_PARAM%XKER_RACCS
+ ALLOCATE(RAIN_ICE_PARAMN%XKER_RACCS(KDIM1, KDIM2))
+ XKER_RACCS=> RAIN_ICE_PARAMN%XKER_RACCS
CASE('XKER_SACCRG')
- ALLOCATE(RAIN_ICE_PARAM%XKER_SACCRG(KDIM1, KDIM2))
- XKER_SACCRG=> RAIN_ICE_PARAM%XKER_SACCRG
+ ALLOCATE(RAIN_ICE_PARAMN%XKER_SACCRG(KDIM1, KDIM2))
+ XKER_SACCRG=> RAIN_ICE_PARAMN%XKER_SACCRG
CASE('XKER_SDRYG')
- ALLOCATE(RAIN_ICE_PARAM%XKER_SDRYG(KDIM1, KDIM2))
- XKER_SDRYG=> RAIN_ICE_PARAM%XKER_SDRYG
+ ALLOCATE(RAIN_ICE_PARAMN%XKER_SDRYG(KDIM1, KDIM2))
+ XKER_SDRYG=> RAIN_ICE_PARAMN%XKER_SDRYG
CASE('XKER_RDRYG')
- ALLOCATE(RAIN_ICE_PARAM%XKER_RDRYG(KDIM1, KDIM2))
- XKER_RDRYG=> RAIN_ICE_PARAM%XKER_RDRYG
+ ALLOCATE(RAIN_ICE_PARAMN%XKER_RDRYG(KDIM1, KDIM2))
+ XKER_RDRYG=> RAIN_ICE_PARAMN%XKER_RDRYG
CASE('XKER_SWETH')
- ALLOCATE(RAIN_ICE_PARAM%XKER_SWETH(KDIM1, KDIM2))
- XKER_SWETH=> RAIN_ICE_PARAM%XKER_SWETH
+ ALLOCATE(RAIN_ICE_PARAMN%XKER_SWETH(KDIM1, KDIM2))
+ XKER_SWETH=> RAIN_ICE_PARAMN%XKER_SWETH
CASE('XKER_GWETH')
- ALLOCATE(RAIN_ICE_PARAM%XKER_GWETH(KDIM1, KDIM2))
- XKER_GWETH=> RAIN_ICE_PARAM%XKER_GWETH
+ ALLOCATE(RAIN_ICE_PARAMN%XKER_GWETH(KDIM1, KDIM2))
+ XKER_GWETH=> RAIN_ICE_PARAMN%XKER_GWETH
CASE('XKER_RWETH')
- ALLOCATE(RAIN_ICE_PARAM%XKER_RWETH(KDIM1, KDIM2))
- XKER_RWETH=> RAIN_ICE_PARAM%XKER_RWETH
+ ALLOCATE(RAIN_ICE_PARAMN%XKER_RWETH(KDIM1, KDIM2))
+ XKER_RWETH=> RAIN_ICE_PARAMN%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)
+ DEALLOCATE(RAIN_ICE_PARAMN%XGAMINC_RIM1)
XGAMINC_RIM2=>NULL()
- DEALLOCATE(RAIN_ICE_PARAM%XGAMINC_RIM2)
+ DEALLOCATE(RAIN_ICE_PARAMN%XGAMINC_RIM2)
XKER_RACCSS=>NULL()
- DEALLOCATE(RAIN_ICE_PARAM%XKER_RACCSS)
+ DEALLOCATE(RAIN_ICE_PARAMN%XKER_RACCSS)
XKER_RACCS=>NULL()
- DEALLOCATE(RAIN_ICE_PARAM%XKER_RACCS)
+ DEALLOCATE(RAIN_ICE_PARAMN%XKER_RACCS)
XKER_SACCRG=>NULL()
- DEALLOCATE(RAIN_ICE_PARAM%XKER_SACCRG)
+ DEALLOCATE(RAIN_ICE_PARAMN%XKER_SACCRG)
XKER_SDRYG=>NULL()
- DEALLOCATE(RAIN_ICE_PARAM%XKER_SDRYG)
+ DEALLOCATE(RAIN_ICE_PARAMN%XKER_SDRYG)
XKER_RDRYG=>NULL()
- DEALLOCATE(RAIN_ICE_PARAM%XKER_RDRYG)
+ DEALLOCATE(RAIN_ICE_PARAMN%XKER_RDRYG)
END SUBROUTINE RAIN_ICE_PARAM_DEALLOCATE
-END MODULE MODD_RAIN_ICE_PARAM
+!
+END MODULE MODD_RAIN_ICE_PARAM_n
diff --git a/src/PHYEX/micro/mode_ice4_budgets.f90 b/src/PHYEX/micro/mode_ice4_budgets.f90
index a33b0acf7fca490a07caaa8b10bdb4fb70a89924..64ccbefc4edd50cbe922d1eeaaed8785b2ce297e 100644
--- a/src/PHYEX/micro/mode_ice4_budgets.f90
+++ b/src/PHYEX/micro/mode_ice4_budgets.f90
@@ -17,17 +17,16 @@ SUBROUTINE ICE4_BUDGETS(D, PARAMI, BUCONF, KSIZE, PTSTEP, KRR, K1, K2, &
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
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_PARAM_ICE, ONLY: PARAM_ICE_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
!
USE MODD_FIELDS_ADDRESS ! index number for prognostic (theta and mixing ratios) and budgets
!
-USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY
!
!
IMPLICIT NONE
@@ -56,11 +55,11 @@ INTEGER, INTENT(IN) :: KBUDGETS
!
!* 0.2 Declarations of local variables :
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
INTEGER :: JIJ, JK, JL
INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE
-REAL, DIMENSION(D%NIJT, D%NKT) :: ZW1, ZW2, ZW3, ZW4, ZW5, ZW6 ! work array
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZW1, ZW2, ZW3, ZW4, ZW5 ! work array
REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_DIFF, ZZ_LVFACT, ZZ_LSFACT
REAL :: ZINV_TSTEP
!
@@ -96,15 +95,9 @@ DO JK = IKTB, IKTE
ZW1(JIJ,JK)=ZW1(JIJ,JK)+PRVHENI(JIJ,JK)
ENDDO
ENDDO
-#ifdef REPRO48
-IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
-IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HENU', -ZW1(:, :) *PRHODJ(:, :))
-IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HENU', ZW1(:, :) *PRHODJ(:, :))
-#else
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIN', ZW1(:, :)*ZZ_LSFACT(:, :)*PRHODJ(:, :))
IF (BUCONF%LBUDGET_RV) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIN', -ZW1(:, :) *PRHODJ(:, :))
IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIN', ZW1(:, :) *PRHODJ(:, :))
-#endif
ZW1(:,:) = 0.
DO JL=1, KSIZE
ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCHONI) * ZINV_TSTEP
@@ -336,26 +329,10 @@ IF(KRR==7) THEN
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)
- ZW1(:,:) = 0.
- DO JL=1, KSIZE
- ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRGWETH) * ZINV_TSTEP
- END DO
-#endif
-#ifdef REPRO48
- IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', (-ZW5(:, :)-ZW1(:, :))*PRHODJ(:, :))
-#endif
-#if defined(REPRO48)
- IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW1(:, :)*PRHODJ(:, :))
-#endif
-
ZW1(:,:) = 0.
DO JL=1, KSIZE
ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRCDRYH) * ZINV_TSTEP
@@ -376,34 +353,23 @@ IF(KRR==7) THEN
DO JL=1, KSIZE
ZW5(K1(JL), K2(JL)) = PBU_PACK(JL, IRGDRYH) * ZINV_TSTEP
END DO
- ZW6(:,:) = 0.
-#if defined(REPRO48)
- !ZW6 must be removed when REPRO* will be suppressed
- DO JL=1, KSIZE
- ZW6(K1(JL), K2(JL)) = PBU_PACK(JL, IRDRYHG) * ZINV_TSTEP
- END DO
-#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_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DRYH', -ZW5(:, :) *PRHODJ(:, :))
IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'DRYH', (ZW1(:, :)+ZW2(:, :)+ZW3(:, :)+ &
- &ZW4(:, :)+ZW5(:, :)-ZW6(:, :)) &
+ &ZW4(:, :)+ZW5(:, :)) &
& *PRHODJ(:, :))
-#if defined(REPRO48)
-#else
- !When REPRO48 will be suppressed, ZW6 must be removed
ZW1(:,:) = 0.
DO JL=1, KSIZE
ZW1(K1(JL), K2(JL)) = PBU_PACK(JL, IRDRYHG) * ZINV_TSTEP
END DO
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HGCV', -ZW1(:, :)*PRHODJ(:, :))
IF (BUCONF%LBUDGET_RH) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RH), 'HGCV', ZW1(:, :)*PRHODJ(:, :))
-#endif
ZW1(:,:) = 0.
DO JL=1, KSIZE
diff --git a/src/PHYEX/micro/mode_ice4_compute_pdf.f90 b/src/PHYEX/micro/mode_ice4_compute_pdf.f90
index 7ccb88c1274867edbcff476743ebf920ea8dc2cc..771d42c94ca8e72087891d2fcaf21ad5b222bfab 100644
--- a/src/PHYEX/micro/mode_ice4_compute_pdf.f90
+++ b/src/PHYEX/micro/mode_ice4_compute_pdf.f90
@@ -29,10 +29,9 @@ SUBROUTINE ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI
!
!
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 MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
USE MODE_MSG
!
@@ -77,7 +76,7 @@ REAL, DIMENSION(KSIZE) :: ZRCRAUTC, & !RC value to begin rain formation =XC
! = PHLC_HRC/HCF+ PHLC_LRC/LCF
ZSUMRC, ZSUMRI
REAL :: ZCOEFFRCM
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JI
!-------------------------------------------------------------------------------
!
@@ -319,11 +318,7 @@ ELSE
ENDIF
!
!$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)
diff --git a/src/PHYEX/micro/mode_ice4_correct_negativities.f90 b/src/PHYEX/micro/mode_ice4_correct_negativities.f90
index 12f8b08aa4eed8fc9565d2fc7462d48cf92eabff..cf569687e9cf6ddaac782d09e9f869eb0c5dde51 100644
--- a/src/PHYEX/micro/mode_ice4_correct_negativities.f90
+++ b/src/PHYEX/micro/mode_ice4_correct_negativities.f90
@@ -10,10 +10,9 @@ SUBROUTINE ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
&PTH, PLVFACT, PLSFACT, PRH)
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_RAIN_ICE_DESCR, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
!
IMPLICIT NONE
!
@@ -27,7 +26,7 @@ REAL, DIMENSION(D%NIJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PRH
REAL :: ZW
INTEGER :: JIJ, JK, IKTB, IKTE, IIJB, IIJE
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ICE4_CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE)
!
diff --git a/src/PHYEX/micro/mode_ice4_fast_rg.f90 b/src/PHYEX/micro/mode_ice4_fast_rg.f90
index 0b7a6ef508cdf6b5677b49a01a0b47ea731e62cc..e51bd4a7aba794b5b05c52394a994bcd87a4ce10 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rg.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rg.f90
@@ -37,11 +37,10 @@ SUBROUTINE ICE4_FAST_RG(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUT
! ------------
!
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
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -106,7 +105,7 @@ REAL, DIMENSION(KPROMA) :: ZZW, &
REAL :: ZZW0D
INTEGER :: JL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RG', 0, ZHOOK_HANDLE)
@@ -189,18 +188,23 @@ IF(.NOT. LDSOFT) THEN
IF(IGDRY>0)THEN
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GDRY(1:KSIZE))
+#ifdef REPRO48
PRG_TEND(1:KSIZE, IRSWETG)=ICEP%XFSDRYG*ZZW(1:KSIZE) & ! RSDRYG
/ ICEP%XCOLSG &
-#if defined(REPRO48)
*(PLBDAS(1:KSIZE)**(ICED%XCXS-ICED%XBS))*( PLBDAG(1:KSIZE)**ICED%XCXG ) &
*(PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.)) &
+ *( ICEP%XLBSDRYG1/( PLBDAG(1:KSIZE)**2 ) + &
+ ICEP%XLBSDRYG2/( PLBDAG(1:KSIZE) * PLBDAS(1:KSIZE) ) + &
+ ICEP%XLBSDRYG3/( PLBDAS(1:KSIZE)**2))
#else
+ PRG_TEND(1:KSIZE, IRSWETG)=ICEP%XFSDRYG*ZZW(1:KSIZE) & ! RSDRYG
+ / ICEP%XCOLSG &
*(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))
+#endif
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)
@@ -278,11 +282,7 @@ DO JL=1, KSIZE
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
diff --git a/src/PHYEX/micro/mode_ice4_fast_rh.f90 b/src/PHYEX/micro/mode_ice4_fast_rh.f90
index 8ac5a7b7e13ffb73eca7f232b86e679d2868936d..ecb8d0c0a206de4b23a3012d86638149a43b5892 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rh.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rh.f90
@@ -35,12 +35,11 @@ SUBROUTINE ICE4_FAST_RH(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUT
! ------------
!
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_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -98,8 +97,8 @@ INTEGER, DIMENSION(KPROMA) :: IBUF1, IBUF2, IBUF3
REAL, DIMENSION(KPROMA) :: ZZW, &
ZRDRYH_INIT, ZRWETH_INIT, &
ZRDRYHG
-INTEGER :: JJ, JL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: JL
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
LOGICAL, DIMENSION(KPROMA) :: LLWETH, LLDRYH
!
!-------------------------------------------------------------------------------
@@ -151,17 +150,21 @@ IF(.NOT. LDSOFT) THEN
IF(IGWET>0)THEN
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GWET(1:KSIZE))
+#ifdef REPRO48
PRH_TEND(1:KSIZE, IRSWETH)=ICEP%XFSWETH*ZZW(1:KSIZE) & ! RSWETH
-#if defined(REPRO48)
*( PLBDAS(1:KSIZE)**(ICED%XCXS-ICED%XBS) )*( PLBDAH(1:KSIZE)**ICED%XCXH ) &
*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+ *( ICEP%XLBSWETH1/( PLBDAH(1:KSIZE)**2 ) + &
+ ICEP%XLBSWETH2/( PLBDAH(1:KSIZE) * PLBDAS(1:KSIZE) ) + &
+ ICEP%XLBSWETH3/( PLBDAS(1:KSIZE)**2) )
#else
+ PRH_TEND(1:KSIZE, IRSWETH)=ICEP%XFSWETH*ZZW(1:KSIZE) & ! RSWETH
*( PRST(1:KSIZE))*( PLBDAH(1:KSIZE)**ICED%XCXH ) &
*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT) ) &
-#endif
- *( ICEP%XLBSWETH1/( PLBDAH(1:KSIZE)**2 ) + &
+ *( ICEP%XLBSWETH1/( PLBDAH(1:KSIZE)**2 ) + &
ICEP%XLBSWETH2/( PLBDAH(1:KSIZE) * PLBDAS(1:KSIZE) ) + &
ICEP%XLBSWETH3/( PLBDAS(1:KSIZE)**2) )
+#endif
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)
@@ -278,11 +281,7 @@ DO JL=1, KSIZE
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))
diff --git a/src/PHYEX/micro/mode_ice4_fast_ri.f90 b/src/PHYEX/micro/mode_ice4_fast_ri.f90
index abd41bdce2a1db4fef6343c43eaf4612020537e7..836fe99387096e55bb6407d886b0b34f632a6ca8 100644
--- a/src/PHYEX/micro/mode_ice4_fast_ri.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_ri.f90
@@ -30,10 +30,9 @@ SUBROUTINE ICE4_FAST_RI(ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-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 MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -57,7 +56,7 @@ REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCBERI ! Bergeron-Findeisen eff
!
!* 0.2 declaration of local variables
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JL
!
!-------------------------------------------------------------------------------
@@ -69,11 +68,7 @@ IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RI',0,ZHOOK_HANDLE)
!
DO JL=1, KSIZE
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) * &
diff --git a/src/PHYEX/micro/mode_ice4_fast_rs.f90 b/src/PHYEX/micro/mode_ice4_fast_rs.f90
index 8d6109f9b47e3dfee988da65dfbd986d56227d13..89828f3446054c8fe2c3801864f76edcd30f0b58 100644
--- a/src/PHYEX/micro/mode_ice4_fast_rs.f90
+++ b/src/PHYEX/micro/mode_ice4_fast_rs.f90
@@ -38,11 +38,10 @@ SUBROUTINE ICE4_FAST_RS(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUT
! ------------
!
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
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -89,9 +88,9 @@ INTEGER :: IGRIM, IGACC
INTEGER, DIMENSION(KPROMA) :: IBUF1, IBUF2, IBUF3
REAL, DIMENSION(KPROMA) :: ZBUF1, ZBUF2, ZBUF3
REAL, DIMENSION(KPROMA) :: ZZW, ZZW1, ZZW2, ZZW3, ZFREEZ_RATE
-INTEGER :: JJ, JL
+INTEGER :: JL
REAL :: ZZW0D
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RS', 0, ZHOOK_HANDLE)
@@ -112,15 +111,16 @@ DO JL=1, KSIZE
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)
+#ifdef REPRO48
PRS_TEND(JL, IFREEZ1)=PRS_TEND(JL, IFREEZ1)* (ICEP%X0DEPS* PLBDAS(JL)**ICEP%XEX0DEPS + &
& ICEP%X1DEPS*PCJ(JL)*PLBDAS(JL)**ICEP%XEX1DEPS )/ &
+ &(PRHODREF(JL)*(CST%XLMTT-CST%XCL*(CST%XTT-PT(JL))))
#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))))
+#endif
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
@@ -140,7 +140,7 @@ ENDDO
!
DO JL=1, KSIZE
IF (PRCT(JL)>ICED%XRTMIN(2) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
-#if defined(REPRO48)
+#ifdef REPRO48
ZZW(JL) = PLBDAS(JL)
#else
ZZW(JL) = (PLBDAS(JL)**ICED%XALPHAS + ICED%XFVELOS**ICED%XALPHAS)**(1./ICED%XALPHAS)
@@ -166,11 +166,12 @@ IF(.NOT. LDSOFT) THEN
!
!$mnh_expand_where(JL=1:KSIZE)
WHERE (GRIM(1:KSIZE))
+#ifdef REPRO48
PRS_TEND(1:KSIZE, IRCRIMSS) = ICEP%XCRIMSS * ZZW1(1:KSIZE) * PRCT(1:KSIZE) & ! RCRIMSS
-#if defined(REPRO48)
* PLBDAS(1:KSIZE)**ICEP%XEXCRIMSS &
* PRHODREF(1:KSIZE)**(-ICED%XCEXVT)
#else
+ PRS_TEND(1:KSIZE, IRCRIMSS) = ICEP%XCRIMSS * ZZW1(1:KSIZE) * PRCT(1:KSIZE) & ! RCRIMSS
* PRST(1:KSIZE)*(1+(ICED%XFVELOS/PLBDAS(1:KSIZE))**ICED%XALPHAS) &
**(-ICED%XNUS+ICEP%XEXCRIMSS/ICED%XALPHAS) &
* PRHODREF(1:KSIZE)**(-ICED%XCEXVT+1.) &
@@ -184,11 +185,12 @@ IF(.NOT. LDSOFT) THEN
!
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GRIM(1:KSIZE))
+#ifdef REPRO48
PRS_TEND(1:KSIZE, IRCRIMS)=ICEP%XCRIMSG * PRCT(1:KSIZE) & ! RCRIMS
-#if defined(REPRO48)
* PLBDAS(1:KSIZE)**ICEP%XEXCRIMSG &
* PRHODREF(1:KSIZE)**(-ICED%XCEXVT)
#else
+ PRS_TEND(1:KSIZE, IRCRIMS)=ICEP%XCRIMSG * PRCT(1:KSIZE) & ! RCRIMS
* PRST(1:KSIZE)*(1+(ICED%XFVELOS/PLBDAS(1:KSIZE))**(ICED%XALPHAS)) &
**(-ICED%XNUS+ICEP%XEXCRIMSG/ICED%XALPHAS) &
* PRHODREF(1:KSIZE)**(-ICED%XCEXVT+1.) &
@@ -202,21 +204,24 @@ IF(.NOT. LDSOFT) THEN
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GRIM(1:KSIZE))
ZZW(1:KSIZE) = PRS_TEND(1:KSIZE, IRCRIMS) - PRS_TEND(1:KSIZE, IRCRIMSS) ! RCRIMSG
-#if defined(REPRO48)
+#ifdef REPRO48
PRS_TEND(1:KSIZE, IRSRIMCG)=ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG*(1.0-ZZW2(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-ZZW2(1:KSIZE))
#endif
+#ifdef REPRO48
PRS_TEND(1:KSIZE, IRSRIMCG)=ZZW(1:KSIZE)*PRS_TEND(1:KSIZE, IRSRIMCG)/ &
MAX(1.E-20, &
-#if defined(REPRO48)
ICEP%XSRIMCG3*ICEP%XSRIMCG2*PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG2*(1.-ZZW3(1:KSIZE)) - &
+ ICEP%XSRIMCG3*PRS_TEND(1:KSIZE, IRSRIMCG))
#else
+ PRS_TEND(1:KSIZE, IRSRIMCG)=ZZW(1:KSIZE)*PRS_TEND(1:KSIZE, IRSRIMCG)/ &
+ MAX(1.E-20, &
ICEP%XSRIMCG3*ICEP%XSRIMCG2*PRST(1:KSIZE)*PRHODREF(1:KSIZE) &
*PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG2*(1.-ZZW3(1:KSIZE)) - &
-#endif
ICEP%XSRIMCG3*PRS_TEND(1:KSIZE, IRSRIMCG))
+#endif
END WHERE
!$mnh_end_expand_where(JL=1:KSIZE)
ELSE
@@ -270,15 +275,19 @@ IF(.NOT. LDSOFT) THEN
!
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GACC(1:KSIZE))
+#ifdef REPRO48
ZZW(1:KSIZE) = & !! coef of RRACCS
-#if defined(REPRO48)
ICEP%XFRACCSS*( PLBDAS(1:KSIZE)**ICED%XCXS )*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+ *( ICEP%XLBRACCS1/((PLBDAS(1:KSIZE)**2) ) + &
+ ICEP%XLBRACCS2/( PLBDAS(1:KSIZE) * PLBDAR(1:KSIZE) ) + &
+ ICEP%XLBRACCS3/( (PLBDAR(1:KSIZE)**2)) )/PLBDAR(1:KSIZE)**4
#else
+ ZZW(1:KSIZE) = & !! coef of RRACCS
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
+#endif
PRS_TEND(1:KSIZE, IRRACCSS) =ZZW1(1:KSIZE)*ZZW(1:KSIZE)
END WHERE
!$mnh_end_expand_where(JL=1:KSIZE)
@@ -294,15 +303,19 @@ IF(.NOT. LDSOFT) THEN
!
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GACC(1:KSIZE))
+#ifdef REPRO48
PRS_TEND(1:KSIZE, IRSACCRG) = ICEP%XFSACCRG*ZZW3(1:KSIZE)* & ! RSACCRG
-#if defined(REPRO48)
( PLBDAS(1:KSIZE)**(ICED%XCXS-ICED%XBS) )*( PRHODREF(1:KSIZE)**(-ICED%XCEXVT-1.) ) &
+ *( ICEP%XLBSACCR1/((PLBDAR(1:KSIZE)**2) ) + &
+ ICEP%XLBSACCR2/( PLBDAR(1:KSIZE) * PLBDAS(1:KSIZE) ) + &
+ ICEP%XLBSACCR3/( (PLBDAS(1:KSIZE)**2)) )/PLBDAR(1:KSIZE)
#else
+ PRS_TEND(1:KSIZE, IRSACCRG) = ICEP%XFSACCRG*ZZW3(1:KSIZE)* & ! RSACCRG
( 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)
+#endif
END WHERE
!$mnh_end_expand_where(JL=1:KSIZE)
ENDIF
@@ -343,19 +356,23 @@ DO JL=1, KSIZE
!
! compute RSMLT
!
+#ifdef REPRO48
PRSMLTG(JL) = ICEP%XFSCVMG*MAX(0., (-PRSMLTG(JL) * &
-#if defined(REPRO48)
(ICEP%X0DEPS* PLBDAS(JL)**ICEP%XEX0DEPS + &
ICEP%X1DEPS*PCJ(JL)*PLBDAS(JL)**ICEP%XEX1DEPS) &
+ -(PRS_TEND(JL, IRCRIMS) + PRS_TEND(JL, IRRACCS)) * &
+ (PRHODREF(JL)*CST%XCL*(CST%XTT-PT(JL))) &
+ ) / (PRHODREF(JL)*CST%XLMTT))
#else
+ PRSMLTG(JL) = ICEP%XFSCVMG*MAX(0., (-PRSMLTG(JL) * &
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))
+#endif
!
! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
! because the graupeln produced by this process are still icy!!!
diff --git a/src/PHYEX/micro/mode_ice4_nucleation.f90 b/src/PHYEX/micro/mode_ice4_nucleation.f90
index 3135a3a67a5588859110b0d52e796029b25e9e56..90a3fbba33b64d05decc1d75b8593f759ed98b83 100644
--- a/src/PHYEX/micro/mode_ice4_nucleation.f90
+++ b/src/PHYEX/micro/mode_ice4_nucleation.f90
@@ -29,11 +29,10 @@ SUBROUTINE ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, KSIZE, ODCOMPUTE, &
! ------------
!
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
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -58,7 +57,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due
!* 0.2 declaration of local variables
!
REAL, DIMENSION(KSIZE) :: ZW ! work array
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
ZUSW, & ! Undersaturation over water
diff --git a/src/PHYEX/micro/mode_ice4_pack.f90 b/src/PHYEX/micro/mode_ice4_pack.f90
index 3300125dcc0c1f05da394f72953ac77e6fa3bfb9..558f0ab52a7b1da958a7f4f89a8a0aabc022d474 100644
--- a/src/PHYEX/micro/mode_ice4_pack.f90
+++ b/src/PHYEX/micro/mode_ice4_pack.f90
@@ -8,7 +8,6 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
KPROMA, KSIZE, KSIZE2, &
- HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
PTSTEP, KRR, ODMICRO, PEXN, &
PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -19,20 +18,37 @@ SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
PWR, &
TBUDGETS, KBUDGETS, &
PRHS )
+! ######################################################################
+!
+!!**** * - compute the explicit microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to pack arrays to compute
+!! the microphysics tendencies
+!!
+!!
+!! METHOD
+!! ------
+!! Pack arrays by chuncks
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! R. El Khatib 28-Apr-2023 Fix (and re-enable) the cache-blocking mechanism on top of phyex
! -----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
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_DESCR, ONLY: RAIN_ICE_DESCR_t
-USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& ITH, & ! Potential temperature
& IRV, & ! Water vapor
@@ -82,8 +98,6 @@ TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
INTEGER, INTENT(IN) :: KSIZE
INTEGER, INTENT(IN) :: KSIZE2
-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
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
@@ -109,13 +123,13 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. so
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,D%NKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRAINFR !Precipitation fraction
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVHENI ! heterogeneous nucleation
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLVFACT
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(D%NIJT,D%NKT,0:7), INTENT(OUT) :: PWR
+REAL, DIMENSION(D%NIJT,D%NKT,0:7), INTENT(INOUT) :: PWR
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
@@ -123,10 +137,10 @@ REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. s
!
!* 0.2 Declarations of local variables :
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
INTEGER :: JIJ, JK
-INTEGER :: IKTB, IKTE, IIJB, IIJE
+INTEGER :: IKT, IKTB, IKTE, IIJT, IIJB, IIJE
INTEGER :: ISTIJ, ISTK
!
LOGICAL :: GEXT_TEND
@@ -170,19 +184,21 @@ IF (LHOOK) CALL DR_HOOK('ICE4_PACK', 0, ZHOOK_HANDLE)
!* 1. GENERALITIES
! ------------
!
+IKT=D%NKT
IKTB=D%NKTB
IKTE=D%NKTE
+IIJT=D%NIJT
IIJB=D%NIJB
IIJE=D%NIJE
GEXT_TEND=.TRUE.
-LLSIGMA_RC=(HSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM')
-LL_AUCV_ADJU=(HSUBG_AUCV_RC=='ADJU' .OR. HSUBG_AUCV_RI=='ADJU')
+LLSIGMA_RC=(PARAMI%CSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM')
+LL_AUCV_ADJU=(PARAMI%CSUBG_AUCV_RC=='ADJU' .OR. PARAMI%CSUBG_AUCV_RI=='ADJU')
!
IF(PARAMI%LPACK_MICRO) THEN
- IF(KPROMA /= KSIZE) THEN
+ IF(KPROMA /= KSIZE .AND. (PARAMI%CSUBG_RR_EVAP=='PRFR' .OR. PARAMI%CSUBG_RC_RR_ACCR=='PRFR')) THEN
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'For now, KPROMA must be equal to KSIZE, see comments in 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
+ ! Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphysical 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?
@@ -272,8 +288,10 @@ IF(PARAMI%LPACK_MICRO) THEN
! Save indices for later usages:
I1(IC) = JIJ
I2(IC) = JK
- I1TOT(JMICRO+IC-1)=JIJ
- I2TOT(JMICRO+IC-1)=JK
+ IF(BUCONF%LBU_ENABLE) THEN
+ I1TOT(JMICRO+IC-1)=JIJ
+ I2TOT(JMICRO+IC-1)=JK
+ ENDIF
IF (IC==IMICRO) THEN
! the end of the chunk has been reached, then reset the starting index :
ISTIJ=JIJ+1
@@ -281,6 +299,7 @@ IF(PARAMI%LPACK_MICRO) THEN
ISTK=JK
ELSE
! end of line, restart from 1 and increment upper loop
+ ISTIJ=D%NIJB
ISTK=JK+1
IF (ISTK > IKTE) THEN
! end of line, restart from 1
@@ -305,7 +324,6 @@ IF(PARAMI%LPACK_MICRO) THEN
&LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
&KPROMA, IMICRO, LLMICRO, PTSTEP, &
&KRR, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
&ZEXN, ZRHODREF, I1, I2, &
&ZPRES, ZCF, ZSIGMA_RC, &
&ZCIT, &
@@ -345,13 +363,20 @@ IF(PARAMI%LPACK_MICRO) THEN
ENDIF ! KSIZE > 0
ELSE ! PARAMI%LPACK_MICRO
+ !We assume, here, that points outside the physical domain of the model (extral levels,
+ !horizontal points in the halo) contain valid values, sufficiently valid to be used in tests
+ !such as "PTHT(JL)>ZTHRESHOLD .AND. LLMICRO(JL)". In these tests, LLMICRO(JL) will be evaluated
+ !to .FALSE. on these kind of points but valid values for PTHT are needed to prevent crash.
+ !
IF (KSIZE /= D%NIJT*D%NKT) THEN
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'ICE4_PACK', 'ICE4_PACK : KSIZE /= NIJT*NKT')
ENDIF
+ !Some arrays must be copied. In order not to waste memory, we re-use temporary arrays
+ !declared for the pack case.
IC=0
- DO JK = IKTB, IKTE
- DO JIJ = IIJB, IIJE
+ DO JK = 1, IKT
+ DO JIJ = 1, IIJT
IC=IC+1
I1TOT(IC)=JIJ
I2TOT(IC)=JK
@@ -367,13 +392,40 @@ ELSE ! PARAMI%LPACK_MICRO
IF (KRR==7) THEN
ZEXTPK(IC, IRH)=PRHS(JIJ, JK)
ENDIF
- IF(LLSIGMA_RC) THEN
- ZSIGMA_RC(IC)=PSIGS(JIJ, JK)
- ENDIF
+ ENDIF
+ IF(LLSIGMA_RC) THEN
+ !Copy needed because sigma is modified in ice4_stepping
+ ZSIGMA_RC(IC)=PSIGS(JIJ, JK)
ENDIF
ENDDO
ENDDO
!
+ !When PARAMI%LPACK_MICRO=T, values on the extra levels are not given to ice4_stepping,
+ !so there was not filled in rain_ice.
+ !When PARAMI%LPACK_MICRO=F, we need to complement the work done in rain_ice to provide
+ !valid values on these levels.
+ !The same applies for the first points and last points on the horizontal dimension.
+ IF (IKTB /= 1) THEN
+ DO JK=1, IKTB-1
+ PWR(:, JK, :)=PWR(:, IKTB, :)
+ ENDDO
+ ENDIF
+ IF (IKTE /= IKT) THEN
+ DO JK=IKTE+1, IKT
+ PWR(:, JK, :)=PWR(:, IKTE, :)
+ ENDDO
+ ENDIF
+ IF (IIJB /= 1) THEN
+ DO JIJ=1, IIJB-1
+ PWR(JIJ, :, :)=PWR(IIJB, :, :)
+ ENDDO
+ ENDIF
+ IF (IIJE /= IIJT) THEN
+ DO JIJ=IIJE+1, IIJT
+ PWR(JIJ, :, :)=PWR(IIJE, :, :)
+ ENDDO
+ ENDIF
+ !
!* 5bis. TENDENCIES COMPUTATION
! ----------------------
!
@@ -381,7 +433,6 @@ ELSE ! PARAMI%LPACK_MICRO
&LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
&KSIZE, KSIZE, ODMICRO, PTSTEP, &
&KRR, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
&PEXN, PRHODREF, I1TOT, I2TOT, &
&PPABST, PCLDFR, ZSIGMA_RC, &
&PCIT, &
diff --git a/src/PHYEX/micro/mode_ice4_rainfr_vert.f90 b/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
index e432813b1424aad05eb1261d89cce1eb707da6fe..43d8410c8399c909602dc320f6479bf76ef6584a 100644
--- a/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
+++ b/src/PHYEX/micro/mode_ice4_rainfr_vert.f90
@@ -25,10 +25,9 @@ SUBROUTINE ICE4_RAINFR_VERT(D, ICED, PPRFR, PRR, PRS, PRG, PRH)
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_RAIN_ICE_DESCR, ONLY : RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY : RAIN_ICE_DESCR_t
!
IMPLICIT NONE
!
@@ -45,7 +44,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JI, JJ, JK
LOGICAL :: MASK
!
diff --git a/src/PHYEX/micro/mode_ice4_rimltc.f90 b/src/PHYEX/micro/mode_ice4_rimltc.f90
index 012add3b46b1313eda451dc2b12103694eaf7e63..8eae95bf67409630fcc29e599bac3e90628608b5 100644
--- a/src/PHYEX/micro/mode_ice4_rimltc.f90
+++ b/src/PHYEX/micro/mode_ice4_rimltc.f90
@@ -30,9 +30,8 @@ SUBROUTINE ICE4_RIMLTC(CST, PARAMI, KPROMA, KSIZE, LDCOMPUTE, &
! ------------
!
USE MODD_CST, ONLY: CST_t
-USE MODD_PARAM_ICE, ONLY: PARAM_ICE_t
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -52,7 +51,7 @@ REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIMLTC_MR ! Mixing ratio change
!
!* 0.2 declaration of local variables
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JL
!
!-------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/mode_ice4_rrhong.f90 b/src/PHYEX/micro/mode_ice4_rrhong.f90
index ba318d1d69b7d5f1a11df9afed41818e92d57781..bdc95727d996905f907ee793d0a2b2c317bee806 100644
--- a/src/PHYEX/micro/mode_ice4_rrhong.f90
+++ b/src/PHYEX/micro/mode_ice4_rrhong.f90
@@ -29,10 +29,9 @@ SUBROUTINE ICE4_RRHONG(CST, PARAMI, ICED, KPROMA, KSIZE, LDCOMPUTE, &
! ------------
!
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
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -53,7 +52,7 @@ REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRHONG_MR ! Mixing ratio change
!
!* 0.2 declaration of local variables
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JL
!
!-------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90 b/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
index a273dbd9441c356db8b744d40778a8a12945bd56..76728b648736dfd29bf343db093221a65c0f3af3 100644
--- a/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
+++ b/src/PHYEX/micro/mode_ice4_rsrimcg_old.f90
@@ -31,11 +31,10 @@ SUBROUTINE ICE4_RSRIMCG_OLD(CST, PARAMI, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCO
! ------------
!
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
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -63,7 +62,7 @@ REAL, DIMENSION(KPROMA) :: ZBUF1, ZBUF2
INTEGER, DIMENSION(KPROMA) :: IBUF1, IBUF2
REAL, DIMENSION(KPROMA) :: ZZW
INTEGER :: JL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_RSRIMCG_OLD', 0, ZHOOK_HANDLE)
@@ -86,10 +85,11 @@ IF(.NOT. LDSOFT) THEN
IF(IGRIM>0) THEN
!$mnh_expand_where(JL=1:KSIZE)
WHERE(GRIM(1:KSIZE))
+#ifdef REPRO48
PRSRIMCG_MR(1:KSIZE) = ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG & ! RSRIMCG
-#if defined(REPRO48)
* (1.0 - ZZW(1:KSIZE) )/PRHODREF(1:KSIZE)
#else
+ PRSRIMCG_MR(1:KSIZE) = ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG & ! RSRIMCG
* (1.0 - ZZW(1:KSIZE) )*PRST(1:KSIZE)
#endif
PRSRIMCG_MR(1:KSIZE)=MIN(PRST(1:KSIZE), PRSRIMCG_MR(1:KSIZE))
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation.f90 b/src/PHYEX/micro/mode_ice4_sedimentation.f90
index 7b73ed5492a7c877159ea7a3524b940529161946..0a59d64e3d9c0407b4738743b36e99728933bb1a 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation.f90
@@ -31,15 +31,14 @@ SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_RC, &
NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
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 MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
!
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
@@ -99,7 +98,7 @@ REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-ai
REAL, DIMENSION(D%NIJT,D%NKT) :: ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT
REAL, DIMENSION(D%NIJT) :: ZINPRI
INTEGER :: JK, JIJ, IKTB, IKTE, IIJB, IIJE
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION', 0, ZHOOK_HANDLE)
IKTB=D%NKTB
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
index 1fcaf9244b1a4981080e445f34fb113216bd8844..b2ef8d05bda3cadc3cca8095a718c98e4f880adc 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_split.f90
@@ -33,13 +33,12 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
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 MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
!
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
!
@@ -88,7 +87,7 @@ REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-ai
!
!
INTEGER :: JIJ, JK
-INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
+INTEGER :: IKTB, IKTE, IIJE, IIJB
INTEGER :: IRR !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
@@ -106,7 +105,7 @@ REAL, DIMENSION(D%NIJT, D%NKT) :: ZCONC3D,
& ZRST, &
& ZRGT, &
& ZRHT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 0, ZHOOK_HANDLE)
@@ -279,9 +278,9 @@ SUBROUTINE INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
! ------------
!
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 MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
!
IMPLICIT NONE
!
@@ -311,7 +310,7 @@ REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-ai
!* 0.2 declaration of local variables
!
CHARACTER(LEN=10) :: YSPE ! String for error message
-INTEGER :: JIJ, JK, JL
+INTEGER :: JIJ, JK
LOGICAL :: GPRESENT_PFPR
REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
@@ -323,7 +322,7 @@ REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN
REAL, DIMENSION(D%NIJT) :: ZREMAINT ! Remaining time until the timestep end
REAL, DIMENSION(D%NIJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, ZHOOK_HANDLE)
!
IKTB=D%NKTB
@@ -387,7 +386,7 @@ DO WHILE (ANY(ZREMAINT>0.))
ENDIF
ENDDO
ENDDO
-#if defined(REPRO48)
+#ifdef REPRO48
#else
ELSEIF(KSPE==5) THEN
! ******* for snow
@@ -418,7 +417,7 @@ DO WHILE (ANY(ZREMAINT>0.))
CASE(3)
ZFSED=ICEP%XFSEDR
ZEXSED=ICEP%XEXSEDR
-#if defined(REPRO48)
+#ifdef REPRO48
CASE(5)
ZFSED=ICEP%XFSEDS
ZEXSED=ICEP%XEXSEDS
diff --git a/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90 b/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
index bf5a71b554dca4a76a0df8c346eb36cc865e6420..60c599a483638c4ae09548075ad1248d20b51fc0 100644
--- a/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
+++ b/src/PHYEX/micro/mode_ice4_sedimentation_stat.f90
@@ -38,13 +38,12 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(D, CST, ICEP, ICED, PARAMI, &
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
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 MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
USE MODI_GAMMA, ONLY: GAMMA
!
IMPLICIT NONE
@@ -91,22 +90,15 @@ REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-ai
LOGICAL :: LLSEA_AND_TOWN
INTEGER :: JRR, JIJ, JK, IKB, IKE,IKL, IIJB, IIJE, IKTB, IKTE
INTEGER :: ISHIFT, IK, IKPLUS
-REAL :: ZQP, ZP1, ZINVTSTEP, ZGAC, ZGC, ZGAC2, ZGC2, ZRAYDEFO, ZLBDAS
+REAL :: ZQP, ZINVTSTEP, ZGAC, ZGC, ZGAC2, ZGC2, ZRAYDEFO, ZLBDAS
REAL, DIMENSION(D%NIJT) :: ZWSEDW1, ZWSEDW2 ! sedimentation speed
REAL, DIMENSION(D%NIJT) :: ZTSORHODZ ! TimeStep Over (Rhodref times delta Z)
REAL, DIMENSION(D%NIJT,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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
-#if defined(REPRO48)
-! 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
!-------------------------------------------------------------------------------
@@ -253,7 +245,7 @@ CONTAINS
REAL :: ZRAY ! Cloud Mean radius
REAL :: ZZWLBDA, ZZWLBDC, ZZCC
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ !!REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:CLOUD',0,ZHOOK_HANDLE)
@@ -312,7 +304,7 @@ CONTAINS
REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ !!REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:PRISTINE_ICE',0,ZHOOK_HANDLE)
@@ -359,7 +351,7 @@ CONTAINS
REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ !!REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:SNOW',0,ZHOOK_HANDLE)
@@ -418,7 +410,7 @@ CONTAINS
REAL, INTENT(IN) :: PEXSED
REAL, INTENT(IN) :: PRXT(D%NIJT) ! mr of specy X
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ !!REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:OTHER_SPECIES',0,ZHOOK_HANDLE)
diff --git a/src/PHYEX/micro/mode_ice4_slow.f90 b/src/PHYEX/micro/mode_ice4_slow.f90
index 78aa35289b34904b586917b3c80d8428469cf587..e05c784fae93f11baa945c7859f61084cd5ccbcc 100644
--- a/src/PHYEX/micro/mode_ice4_slow.f90
+++ b/src/PHYEX/micro/mode_ice4_slow.f90
@@ -31,10 +31,9 @@ SUBROUTINE ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, PRHODREF
! ------------
!
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 MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -71,9 +70,8 @@ REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
!* 0.2 declaration of local variables
!
REAL, DIMENSION(KPROMA) :: ZCRIAUTI
-REAL :: ZTIMAUTIC
INTEGER :: JL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_SLOW', 0, ZHOOK_HANDLE)
@@ -113,7 +111,7 @@ ENDDO
DO JL=1, KSIZE
IF(PRVT(JL)>ICED%XRTMIN(1) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
IF(.NOT. LDSOFT) THEN
-#if defined(REPRO48)
+#ifdef REPRO48
PRVDEPS(JL) = ( PSSI(JL)/(PRHODREF(JL)*PAI(JL)) ) * &
( ICEP%X0DEPS*PLBDAS(JL)**ICEP%XEX0DEPS + ICEP%X1DEPS*PCJ(JL)*PLBDAS(JL)**ICEP%XEX1DEPS )
#else
@@ -133,12 +131,14 @@ ENDDO
DO JL=1, KSIZE
IF(PRIT(JL)>ICED%XRTMIN(4) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL)) THEN
IF(.NOT. LDSOFT) THEN
+#ifdef REPRO48
PRIAGGS(JL) = ICEP%XFIAGGS * EXP( ICEP%XCOLEXIS*(PT(JL)-CST%XTT) ) &
* PRIT(JL) &
-#if defined(REPRO48)
* PLBDAS(JL)**ICEP%XEXIAGGS &
* PRHODREF(JL)**(-ICED%XCEXVT)
#else
+ PRIAGGS(JL) = ICEP%XFIAGGS * EXP( ICEP%XCOLEXIS*(PT(JL)-CST%XTT) ) &
+ * PRIT(JL) &
* PRST(JL) * (1+(ICED%XFVELOS/PLBDAS(JL))**ICED%XALPHAS)**&
(-ICED%XNUS+ICEP%XEXIAGGS/ICED%XALPHAS) &
* PRHODREF(JL)**(-ICED%XCEXVT+1.) &
@@ -153,13 +153,7 @@ ENDDO
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
DO JL=1, KSIZE
-#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))
diff --git a/src/PHYEX/micro/mode_ice4_stepping.f90 b/src/PHYEX/micro/mode_ice4_stepping.f90
index b4879faa523564249664c799dee5384d6bf26c9c..43604d778dd49d7da69518fc55b4ad0b608e4165 100644
--- a/src/PHYEX/micro/mode_ice4_stepping.f90
+++ b/src/PHYEX/micro/mode_ice4_stepping.f90
@@ -10,7 +10,6 @@ SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&LDSIGMA_RC, LDAUCV_ADJU, LDEXT_TEND, &
&KPROMA, KMICRO, LDMICRO, PTSTEP, &
&KRR, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
&PEXN, PRHODREF, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
@@ -18,21 +17,37 @@ SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&PHLC_HCF, PHLC_HRC, &
&PHLI_HCF, PHLI_HRI, PRAINFR, &
&PEXTPK, PBU_SUM, PRREVAV)
-
+! ######################################################################
+!
+!!**** * - compute the explicit microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to pack arrays to compute
+!! the microphysics tendencies
+!!
+!!
+!! METHOD
+!! ------
+!! Pack arrays by chuncks
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! R. El Khatib 03-May-2023 Replace OMP SIMD loops by explicit loops : more portable and even slightly faster
! -----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_BUDGET, ONLY: TBUDGETCONF_t
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_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& ITH, & ! Potential temperature
& IRV, & ! Water vapor
@@ -45,8 +60,6 @@ USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& IRREVAV, & ! Index for the evaporation tendency
& IBUEXTRAIND ! Index indirection
-USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
-
USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
!
IMPLICIT NONE
@@ -69,8 +82,6 @@ INTEGER, INTENT(IN) :: KMICRO ! Case r_x>0 locations
LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDMICRO
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-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
!
REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF! Reference density
@@ -87,12 +98,12 @@ REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRAINFR
REAL, DIMENSION(KPROMA,0:7), INTENT(INOUT) :: PEXTPK !To take into acount external tendencies inside the splitting
REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA),INTENT(OUT) :: PBU_SUM
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRREVAV
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV
!
!
!* 0.2 Declarations of local variables :
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
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)
@@ -153,11 +164,11 @@ ENDIF
!Maximum number of iterations
!We only count real iterations (those for which we *compute* tendencies)
-INB_ITER_MAX=PARAMI%NMAXITER
+INB_ITER_MAX=PARAMI%NMAXITER_MICRO
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
+ INB_ITER_MAX=MAX(PARAMI%NMAXITER_MICRO, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
ENDIF
IF (LDEXT_TEND) THEN
@@ -223,9 +234,11 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
LSOFT=.FALSE. ! We *really* compute the tendencies
DO WHILE(ANY(LLCOMPUTE(1:KMICRO))) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
-!$OMP SIMD
- DO JL=1, KMICRO
- ZSUM2(JL)=SUM(PVART(JL,IRI:KRR))
+ ZSUM2(1:KMICRO)=PVART(1:KMICRO, IRI)
+ DO JV=IRI+1,KRR
+ DO JL=1, KMICRO
+ ZSUM2(JL)=ZSUM2(JL)+PVART(JL, JV)
+ ENDDO
ENDDO
DO JL=1, KMICRO
ZDEVIDE=(CST%XCPD + CST%XCPV*PVART(JL, IRV) + CST%XCL*(PVART(JL, IRC)+PVART(JL, IRR)) + CST%XCI*ZSUM2(JL)) * PEXN(JL)
@@ -242,7 +255,6 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
CALL ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&KPROMA, KMICRO, &
&KRR, LSOFT, LLCOMPUTE, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
&PEXN, PRHODREF, ZLVFACT, ZLSFACT, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
@@ -328,7 +340,9 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute 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 PVART into Z0RT
DO JV=1,KRR
- IF (LLCPZ0RT) Z0RT(1:KMICRO, JV)=PVART(1:KMICRO, JV)
+ IF (LLCPZ0RT) THEN
+ Z0RT(1:KMICRO, JV)=PVART(1:KMICRO, JV)
+ ENDIF
DO JL=1, KMICRO
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+ &
@@ -344,12 +358,17 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
LLCOMPUTE(JL)=.FALSE.
ENDIF
ENDDO
+ IF (JV == 1) THEN
+ DO JL=1, KMICRO
+ ZMAXB(JL)=ABS(ZB(JL, JV))
+ ENDDO
+ ELSE
+ DO JL=1, KMICRO
+ ZMAXB(JL)=MAX(ZMAXB(JL), ABS(ZB(JL, JV)))
+ ENDDO
+ ENDIF
ENDDO
LLCPZ0RT=.FALSE.
-!$OMP SIMD
- DO JL=1,KMICRO
- ZMAXB(JL)=MAXVAL(ABS(ZB(JL,1:KRR)))
- ENDDO
DO JL=1, KMICRO
IF (IITER(JL)<INB_ITER_MAX .AND. ZMAXB(JL)>PARAMI%XMRSTEP) THEN
ZMAXTIME(JL)=0.
diff --git a/src/PHYEX/micro/mode_ice4_tendencies.f90 b/src/PHYEX/micro/mode_ice4_tendencies.f90
index c2f59e5e198e902ebdf9fd1e71179780c60b5ed4..0883b6c8fa9fc2e7bceb0216b00f48c84382b1f5 100644
--- a/src/PHYEX/micro/mode_ice4_tendencies.f90
+++ b/src/PHYEX/micro/mode_ice4_tendencies.f90
@@ -8,7 +8,6 @@ IMPLICIT NONE
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, &
@@ -40,11 +39,10 @@ SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
!
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_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
!
USE MODD_FIELDS_ADDRESS
USE MODE_ICE4_RRHONG, ONLY: ICE4_RRHONG
@@ -60,8 +58,7 @@ 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -77,8 +74,6 @@ INTEGER, INTENT(IN) :: KPROMA, KSIZE
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
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
@@ -121,7 +116,7 @@ LOGICAL, DIMENSION(KPROMA) :: LLWETG ! .TRUE. if graupel growths in wet mode
REAL :: ZZW
LOGICAL :: LLRFR
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ICE4_TENDENCIES', 0, ZHOOK_HANDLE)
@@ -214,7 +209,7 @@ ELSE
ELSE
PBU_INST(:, IRSRIMCG_MR) = 0.
ENDIF
-
+
DO JL=1, KSIZE
PB(JL, ITH)=PB(JL, ITH) + PBU_INST(JL, IRVHENI_MR)*PLSFACT(JL)
PB(JL, ITH)=PB(JL, ITH) + PBU_INST(JL, IRRHONG_MR)*(PLSFACT(JL)-PLVFACT(JL))
@@ -250,7 +245,7 @@ ELSE
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,&
+CALL ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, PARAMI%CSUBG_AUCV_RC, PARAMI%CSUBG_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)
@@ -265,13 +260,11 @@ IF (LLRFR) THEN
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
+ DO JL=1,KSIZE
ZRHT3D (K1(JL), K2(JL)) = ZVART(JL,IRH)
ENDDO
CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR(:,:), &
@@ -309,9 +302,9 @@ DO JL=1, KSIZE
ENDIF
IF (PARAMI%LSNOW_T) THEN
IF (ZVART(JL,IRS)>0. .AND. ZT(JL)>263.15) THEN
- ZLBDAS(:) = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*ZT(JL))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ZLBDAS(JL) = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*ZT(JL))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
ELSE IF (ZVART(JL,IRS)>0. .AND. ZT(JL)<=263.15) THEN
- ZLBDAS(:) = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226-0.0106*ZT(JL))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ZLBDAS(JL) = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226-0.0106*ZT(JL))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
ELSE
ZLBDAS(JL)=0.
END IF
diff --git a/src/PHYEX/micro/mode_ice4_warm.f90 b/src/PHYEX/micro/mode_ice4_warm.f90
index 317b57839b7f503e05bbde975eedec0c74713d54..edcb2e465f5c8470b0aafddc8a80d19dd77de3c1 100644
--- a/src/PHYEX/micro/mode_ice4_warm.f90
+++ b/src/PHYEX/micro/mode_ice4_warm.f90
@@ -32,12 +32,11 @@ SUBROUTINE ICE4_WARM(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC
! ------------
!
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_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
!
USE MODE_MSG
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -79,7 +78,7 @@ REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
REAL :: ZZW2, ZZW3, ZZW4
REAL, DIMENSION(KPROMA) :: ZUSW ! Undersaturation over water
REAL, DIMENSION(KPROMA) :: ZTHLT ! Liquid potential temperature
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JL
LOGICAL :: LMASK, LMASK1, LMASK2
!-------------------------------------------------------------------------------
@@ -94,13 +93,8 @@ IF (LHOOK) CALL DR_HOOK('ICE4_WARM', 0, ZHOOK_HANDLE)
DO JL=1, KSIZE
IF(PHLC_HRC(JL)>ICED%XRTMIN(2) .AND. PHLC_HCF(JL)>0. .AND. LDCOMPUTE(JL)) THEN
IF(.NOT. LDSOFT) THEN
-#if defined(REPRO48)
- 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.
@@ -135,26 +129,15 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
DO JL=1, KSIZE
LMASK = PRCT(JL)>ICED%XRTMIN(2) .AND. PRRT(JL)>ICED%XRTMIN(3) .AND. LDCOMPUTE(JL)
LMASK1 = LMASK .AND. PHLC_HRC(JL)>ICED%XRTMIN(2) .AND. PHLC_HCF(JL)>0.
-#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)
- 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
diff --git a/src/PHYEX/micro/mode_icecloud.f90 b/src/PHYEX/micro/mode_icecloud.f90
index e05effa6e2f66def26ffba530cc9601c3348b921..5f44bf9a07a50a38d50f8df88cba054496f40e19 100644
--- a/src/PHYEX/micro/mode_icecloud.f90
+++ b/src/PHYEX/micro/mode_icecloud.f90
@@ -7,10 +7,9 @@ SUBROUTINE ICECLOUD &
! Output :
& SIFRC,SSIO,SSIU,W2D,RSI)
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
- USE MODD_CST,ONLY : XCPD,XCPV,XLVTT,XLSTT,XG,XRD,XEPSILO
+ USE MODD_CST,ONLY : XCPD,XLVTT,XG,XRD,XEPSILO
USE MODE_TIWMX, ONLY: ESATW, ESATI
USE MODE_QSATMX_TAB, ONLY: QSATMX_TAB
IMPLICIT NONE
@@ -73,11 +72,11 @@ REAL, INTENT(OUT) :: RSI(D%NIJT)
! Working variables:
REAL :: ZSIGMAX,ZSIGMAY,ZSIGMAZ,ZXDIST,ZYDIST,&
- & ZRSW,ZRHW,ZRHIN,ZDRHDZ,ZZ,ZRHDIST,ZRHLIM, &
+ & ZRHW,ZRHIN,ZDRHDZ,ZZ,ZRHDIST,ZRHLIM, &
& ZRHDIF,ZWCLD,ZI2W,ZRHLIMICE,ZRHLIMINV,ZA,ZRHI,ZR
INTEGER :: JIJ, IIJB, IIJE
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ICECLOUD',0,ZHOOK_HANDLE)
!
IIJB=D%NIJB
diff --git a/src/PHYEX/micro/mode_ini_lima.f90 b/src/PHYEX/micro/mode_ini_lima.f90
index 6f4bdcd0015f42e8c770bac6981c0542eb09ee4a..3fba2eaabb5078c0426457590e71941afb8e1e3b 100644
--- a/src/PHYEX/micro/mode_ini_lima.f90
+++ b/src/PHYEX/micro/mode_ini_lima.f90
@@ -4,26 +4,11 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
- MODULE MODI_INI_LIMA
+ MODULE MODE_INI_LIMA
! ####################
!
-INTERFACE
- SUBROUTINE INI_LIMA (PTSTEP, PDZMIN, KSPLITR, KSPLITG)
-!
-INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
- ! integration for rain
- ! sedimendation
-INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
- ! integration for graupel
- ! sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-END SUBROUTINE INI_LIMA
-!
-END INTERFACE
-!
-END MODULE MODI_INI_LIMA
+IMPLICIT NONE
+CONTAINS
! ######################################################
SUBROUTINE INI_LIMA (PTSTEP, PDZMIN, KSPLITR, KSPLITG)
! ######################################################
@@ -52,9 +37,10 @@ END MODULE MODI_INI_LIMA
! ------------
!
USE MODD_CST
-USE MODD_REF
USE MODD_PARAM_LIMA
USE MODD_PARAMETERS
+USE MODE_INI_LIMA_WARM, ONLY: INI_LIMA_WARM
+USE MODE_INI_LIMA_COLD_MIXED, ONLY: INI_LIMA_COLD_MIXED
!USE MODD_LUNIT, ONLY : TLUOUT0
!
IMPLICIT NONE
@@ -77,8 +63,6 @@ REAL :: ZT ! Work variable
REAL, DIMENSION(7) :: ZVTRMAX
!
INTEGER :: JI
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM-routines
!
!-------------------------------------------------------------------------------
!
@@ -130,12 +114,12 @@ END DO SPLITG
!
!
!
-IF (ALLOCATED(XRTMIN)) RETURN ! In case of nesting microphysics, constants of
- ! MODD_RAIN_C2R2_PARAM are computed only once.
+IF (ASSOCIATED(XRTMIN)) RETURN ! In case of nesting microphysics, constants of
+ ! MODD_RAIN_C2R2_PARAM are computed only once.
!
!
! Set bounds for mixing ratios and concentrations
-ALLOCATE( XRTMIN(7) )
+CALL PARAM_LIMA_ALLOCATE('XRTMIN', 7)
XRTMIN(1) = 1.0E-10 ! rv
XRTMIN(2) = 1.0E-10 ! rc
XRTMIN(3) = 1.0E-10 ! rr
@@ -143,7 +127,7 @@ XRTMIN(4) = 1.0E-10 ! ri
XRTMIN(5) = 1.0E-10 ! rs
XRTMIN(6) = 1.0E-10 ! rg
XRTMIN(7) = 1.0E-10 ! rh
-ALLOCATE( XCTMIN(7) )
+CALL PARAM_LIMA_ALLOCATE('XCTMIN', 7)
XCTMIN(1) = 1.0 ! Not used
XCTMIN(2) = 1.0E-3 ! Nc
XCTMIN(3) = 1.0E-3 ! Nr
@@ -171,3 +155,5 @@ CALL INI_LIMA_COLD_MIXED(PTSTEP, PDZMIN)
!------------------------------------------------------------------------------
!
END SUBROUTINE INI_LIMA
+!
+END MODULE MODE_INI_LIMA
diff --git a/src/PHYEX/micro/mode_ini_lima_cold_mixed.f90 b/src/PHYEX/micro/mode_ini_lima_cold_mixed.f90
index 55303431f6c033e1ae31ab923f02f13b7570af5a..e8774847097e970a599f89335616b835b54b3c94 100644
--- a/src/PHYEX/micro/mode_ini_lima_cold_mixed.f90
+++ b/src/PHYEX/micro/mode_ini_lima_cold_mixed.f90
@@ -4,20 +4,13 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###############################
- MODULE MODI_INI_LIMA_COLD_MIXED
+ MODULE MODE_INI_LIMA_COLD_MIXED
! ###############################
!
-INTERFACE
- SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN)
-!
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-END SUBROUTINE INI_LIMA_COLD_MIXED
+IMPLICIT NONE
!
-END INTERFACE
+CONTAINS
!
-END MODULE MODI_INI_LIMA_COLD_MIXED
! ###############################################
SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN)
! ###############################################
@@ -57,7 +50,6 @@ USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
-USE MODD_REF
!
use mode_msg
!
@@ -88,13 +80,11 @@ REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
character(len=13) :: yval ! String for error message
INTEGER :: IKB ! Coordinates of the first physical
! points along z
-INTEGER :: J1,J2 ! Internal loop indexes
+INTEGER :: J1 ! Internal loop indexes
!
REAL, DIMENSION(8) :: ZGAMI ! parameters involving various moments
REAL, DIMENSION(2) :: ZGAMS ! of the generalized gamma law
!
-REAL :: ZT ! Work variable
-REAL :: ZVTRMAX ! Raindrop maximal fall velocity
REAL :: ZRHO00 ! Surface reference air density
REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
! functions and kernels
@@ -117,7 +107,7 @@ INTEGER :: KND
INTEGER :: KACCLBDAS,KACCLBDAR,KDRYLBDAG,KDRYLBDAS,KDRYLBDAR
REAL :: PALPHAR,PALPHAS,PALPHAG,PALPHAH
REAL :: PNUR,PNUS,PNUG,PNUH
-REAL :: PBR,PBS,PBG,PBH
+REAL :: PBR,PBS,PBG
REAL :: PCR,PCS,PCG,PCH
REAL :: PDR,PDS,PFVELOS,PDG,PDH
REAL :: PESR,PEGS,PEGR,PEHS,PEHG
@@ -131,24 +121,21 @@ INTEGER :: KWETLBDAS,KWETLBDAG,KWETLBDAH
!
REAL :: ZFAC_ZRNIC ! Zrnic factor used to decrease Long Kernels
!
-REAL :: ZBOUND_CIBU_SMIN ! XDCSLIM*Lbda_s : lower & upper bound used
-REAL :: ZBOUND_CIBU_SMAX ! in the tabulated function
-REAL :: ZBOUND_CIBU_GMIN ! XDCGLIM*Lbda_g : lower & upper bound used
-REAL :: ZBOUND_CIBU_GMAX ! in the tabulated function
+REAL :: ZBOUND_CIBU_SMIN ! XDCSLIM*Lbda_s : lower bound used in the tabulated function
+REAL :: ZBOUND_CIBU_GMIN ! XDCGLIM*Lbda_g : lower bound used in the tabulated function
REAL :: ZRATE_S ! Geometrical growth of Lbda_s in the tabulated function
REAL :: ZRATE_G ! Geometrical growth of Lbda_g in the tabulated function
!
-REAL :: ZBOUND_RDSF_RMIN ! XDCRLIM*Lbda_r : lower & upper bound used
-REAL :: ZBOUND_RDSF_RMAX ! in the tabulated function
+REAL :: ZBOUND_RDSF_RMIN ! XDCRLIM*Lbda_r : lower bound used in the tabulated function
REAL :: ZRATE_R ! Geometrical growth of Lbda_r in the tabulated function
REAL :: ZKHI_LWM ! Coefficient of Lawson et al. (2015)
!
-REAL :: ZRHOIW ! ice density
-!
!-------------------------------------------------------------------------------
!
!
!ILUOUT0 = TLUOUT0%NLU
+CALL PARAM_LIMA_COLD_ASSOCIATE()
+CALL PARAM_LIMA_MIXED_ASSOCIATE()
!
!
!* 1. CHARACTERISTICS OF THE SPECIES
@@ -568,8 +555,8 @@ END IF
!
NDIAM = 70
!
-ALLOCATE(XABSCISS(NDIAM))
-ALLOCATE(XWEIGHT (NDIAM))
+CALL PARAM_LIMA_ALLOCATE('XABSCISS', NDIAM)
+CALL PARAM_LIMA_ALLOCATE('XWEIGHT', NDIAM)
!
CALL GAUHER(XABSCISS, XWEIGHT, NDIAM)
!
@@ -814,17 +801,17 @@ XEXSRIMCG2=XBG
!!$ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
!!$END IF
!!$!
-NGAMINC = 80
-XGAMINC_BOUND_MIN = (1000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
-XGAMINC_BOUND_MAX = (50000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
-ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/FLOAT(NGAMINC-1))
+PARAM_LIMA_MIXED%NGAMINC = 80
+PARAM_LIMA_MIXED%XGAMINC_BOUND_MIN = (1000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
+PARAM_LIMA_MIXED%XGAMINC_BOUND_MAX = (50000.*XTRANS_MP_GAMMAS*XDCSLIM)**XALPHAS !1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
+ZRATE = EXP(LOG(PARAM_LIMA_MIXED%XGAMINC_BOUND_MAX/PARAM_LIMA_MIXED%XGAMINC_BOUND_MIN)/FLOAT(PARAM_LIMA_MIXED%NGAMINC-1))
!
-ALLOCATE( XGAMINC_RIM1(NGAMINC) )
-ALLOCATE( XGAMINC_RIM2(NGAMINC) )
-ALLOCATE( XGAMINC_RIM4(NGAMINC) )
+CALL PARAM_LIMA_MIXED_ALLOCATE('XGAMINC_RIM1', NGAMINC)
+CALL PARAM_LIMA_MIXED_ALLOCATE('XGAMINC_RIM2', NGAMINC)
+CALL PARAM_LIMA_MIXED_ALLOCATE('XGAMINC_RIM4', NGAMINC)
!
DO J1=1,NGAMINC
- ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
+ ZBOUND = PARAM_LIMA_MIXED%XGAMINC_BOUND_MIN*ZRATE**(J1-1)
XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND)
XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND)
XGAMINC_RIM4(J1) = GAMMA_INC(XNUS+XBG/XALPHAS ,ZBOUND) ! Pour Murakami 1990
@@ -846,14 +833,14 @@ XHM_FACTS = XHM_YIELD*(XHM_COLLCS/XCOLCS)
!
! Notice: One magnitude of lambda discretized over 10 points for the droplets
!
-XGAMINC_HMC_BOUND_MIN = 1.0E-3 ! Min value of (Lbda * (12,25) microns)**alpha
-XGAMINC_HMC_BOUND_MAX = 1.0E5 ! Max value of (Lbda * (12,25) microns)**alpha
-ZRATE = EXP(LOG(XGAMINC_HMC_BOUND_MAX/XGAMINC_HMC_BOUND_MIN)/REAL(NGAMINC-1))
+PARAM_LIMA_MIXED%XGAMINC_HMC_BOUND_MIN = 1.0E-3 ! Min value of (Lbda * (12,25) microns)**alpha
+PARAM_LIMA_MIXED%XGAMINC_HMC_BOUND_MAX = 1.0E5 ! Max value of (Lbda * (12,25) microns)**alpha
+ZRATE = EXP(LOG(PARAM_LIMA_MIXED%XGAMINC_HMC_BOUND_MAX/PARAM_LIMA_MIXED%XGAMINC_HMC_BOUND_MIN)/REAL(PARAM_LIMA_MIXED%NGAMINC-1))
!
-ALLOCATE( XGAMINC_HMC(NGAMINC) )
+CALL PARAM_LIMA_MIXED_ALLOCATE('XGAMINC_HMC', NGAMINC)
!
DO J1=1,NGAMINC
- ZBOUND = XGAMINC_HMC_BOUND_MIN*ZRATE**(J1-1)
+ ZBOUND = PARAM_LIMA_MIXED%XGAMINC_HMC_BOUND_MIN*ZRATE**(J1-1)
XGAMINC_HMC(J1) = GAMMA_INC(XNUC,ZBOUND)
END DO
!
@@ -890,18 +877,18 @@ XLBNSACCR3 = MOMG(XALPHAS,XNUS,2.)
! Notice: One magnitude of lambda discretized over 10 points for rain
! Notice: One magnitude of lambda discretized over 10 points for snow
!
-NACCLBDAS = 40
-XACCLBDAS_MIN = 5.0E1*XTRANS_MP_GAMMAS !5.0E1*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_RACCS
-XACCLBDAS_MAX = 5.0E5*XTRANS_MP_GAMMAS !5.0E5*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_RACCS
+PARAM_LIMA_MIXED%NACCLBDAS = 40
+PARAM_LIMA_MIXED%XACCLBDAS_MIN = 5.0E1*XTRANS_MP_GAMMAS !5.0E1*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_RACCS
+PARAM_LIMA_MIXED%XACCLBDAS_MAX = 5.0E5*XTRANS_MP_GAMMAS !5.0E5*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_RACCS
ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/FLOAT(NACCLBDAS-1)
-XACCINTP1S = 1.0 / ZRATE
-XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
-NACCLBDAR = 40
-XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
-XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
-ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/REAL(NACCLBDAR-1)
+PARAM_LIMA_MIXED%XACCINTP1S = 1.0 / ZRATE
+PARAM_LIMA_MIXED%XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
+PARAM_LIMA_MIXED%NACCLBDAR = 40
+PARAM_LIMA_MIXED%XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
+PARAM_LIMA_MIXED%XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
+ZRATE = LOG(PARAM_LIMA_MIXED%XACCLBDAR_MAX/PARAM_LIMA_MIXED%XACCLBDAR_MIN)/REAL(NACCLBDAR-1)
XACCINTP1R = 1.0 / ZRATE
-XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
+XACCINTP2R = 1.0 - LOG( PARAM_LIMA_MIXED%XACCLBDAR_MIN ) / ZRATE
!
!* 7.2.2 Computations of the tabulated normalized kernels
!
@@ -909,12 +896,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
!
-ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
-ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
-ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
-ALLOCATE( XKER_N_RACCSS(NACCLBDAS,NACCLBDAR) )
-ALLOCATE( XKER_N_RACCS (NACCLBDAS,NACCLBDAR) )
-ALLOCATE( XKER_N_SACCRG(NACCLBDAR,NACCLBDAS) )
+CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_RACCSS', NACCLBDAS,NACCLBDAR)
+CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_RACCS', NACCLBDAS,NACCLBDAR)
+CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_SACCRG', NACCLBDAR,NACCLBDAS)
+CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_N_RACCSS', NACCLBDAS,NACCLBDAR)
+CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_N_RACCS', NACCLBDAS,NACCLBDAR)
+CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_N_SACCRG', NACCLBDAR,NACCLBDAS)
CALL NRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
ZESR, XCS, XDS, XFVELOS, XCR, XDR, &
XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
@@ -1062,10 +1049,10 @@ END IF
!
! Notice: One magnitude of lambda discretized over 10 points for snow
!
-NSCLBDAS = 80
-XSCLBDAS_MIN = 1.0E0*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_RSCS
-XSCLBDAS_MAX = 5.0E10*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_RSCS
-ZRATE = LOG(XSCLBDAS_MAX/XSCLBDAS_MIN)/FLOAT(NSCLBDAS-1)
+PARAM_LIMA_COLD%NSCLBDAS = 80
+PARAM_LIMA_MIXED%XSCLBDAS_MIN = 1.0E0*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_RSCS
+PARAM_LIMA_MIXED%XSCLBDAS_MAX = 5.0E10*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_RSCS
+ZRATE = LOG(PARAM_LIMA_MIXED%XSCLBDAS_MAX/PARAM_LIMA_MIXED%XSCLBDAS_MIN)/FLOAT(PARAM_LIMA_COLD%NSCLBDAS-1)
XSCINTP1S = 1.0 / ZRATE
XSCINTP2S = 1.0 - LOG( XSCLBDAS_MIN ) / ZRATE
!
@@ -1074,7 +1061,7 @@ XSCINTP2S = 1.0 - LOG( XSCLBDAS_MIN ) / ZRATE
ZESS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SSCSS
!
- ALLOCATE( XKER_N_SSCS(NSCLBDAS,NSCLBDAS) )
+ CALL PARAM_LIMA_COLD_ALLOCATE('XKER_N_SSCS', NSCLBDAS,NSCLBDAS)
!
CALL NZCOLX ( IND, XALPHAS, XNUS, XALPHAS, XNUS, &
ZESS, XCS, XDS, XFVELOS, XCS, XDS, XFVELOS, &
@@ -1141,23 +1128,25 @@ XDCGLIM_CIBU_MIN = 2.0E-3 ! D_cg lim min
!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cg^lim min =",E13.6)') XDCGLIM_CIBU_MIN
!!$END IF
!
-NGAMINC = 80
+PARAM_LIMA_MIXED%NGAMINC = 80
!
!Note : Boundaries are rounded at 5.0 or 1.0 (down for Bound_min and up for Bound_max)
-XGAMINC_BOUND_CIBU_SMIN = 1.0E-5 * XTRANS_MP_GAMMAS**XALPHAS ! Minimal value of (Lbda_s * D_cs^lim)**alpha) 0.2 mm
-XGAMINC_BOUND_CIBU_SMAX = 5.0E+2 * XTRANS_MP_GAMMAS**XALPHAS ! Maximal value of (Lbda_s * D_cs^lim)**alpha) 1 mm
-ZRATE_S = EXP(LOG(XGAMINC_BOUND_CIBU_SMAX/XGAMINC_BOUND_CIBU_SMIN)/FLOAT(NGAMINC-1))
+PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_SMIN = 1.0E-5 * XTRANS_MP_GAMMAS**XALPHAS ! Minimal value of (Lbda_s * D_cs^lim)**alpha) 0.2 mm
+PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_SMAX = 5.0E+2 * XTRANS_MP_GAMMAS**XALPHAS ! Maximal value of (Lbda_s * D_cs^lim)**alpha) 1 mm
+ZRATE_S = EXP(LOG(PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_SMAX/PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_SMIN)/&
+ FLOAT(PARAM_LIMA_MIXED%NGAMINC-1))
!
-XGAMINC_BOUND_CIBU_GMIN = 1.0E-1 ! Minimal value of (Lbda_g * D_cg^lim)**alpha) 2 mm
-XGAMINC_BOUND_CIBU_GMAX = 5.0E+1 ! Maximal value of (Lbda_g * D_cg^lim)**alpha) 2 mm
-ZRATE_G = EXP(LOG(XGAMINC_BOUND_CIBU_GMAX/XGAMINC_BOUND_CIBU_GMIN)/FLOAT(NGAMINC-1))
+PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_GMIN = 1.0E-1 ! Minimal value of (Lbda_g * D_cg^lim)**alpha) 2 mm
+PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_GMAX = 5.0E+1 ! Maximal value of (Lbda_g * D_cg^lim)**alpha) 2 mm
+ZRATE_G = EXP(LOG(PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_GMAX/PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_GMIN)/&
+ FLOAT(PARAM_LIMA_MIXED%NGAMINC-1))
!
-ALLOCATE( XGAMINC_CIBU_S(4,NGAMINC) )
-ALLOCATE( XGAMINC_CIBU_G(2,NGAMINC) )
+CALL PARAM_LIMA_MIXED_ALLOCATE('XGAMINC_CIBU_S', 4,PARAM_LIMA_MIXED%NGAMINC)
+CALL PARAM_LIMA_MIXED_ALLOCATE('XGAMINC_CIBU_G', 2,PARAM_LIMA_MIXED%NGAMINC)
!
DO J1 = 1, NGAMINC
- ZBOUND_CIBU_SMIN = XGAMINC_BOUND_CIBU_SMIN * ZRATE_S**(J1-1)
- ZBOUND_CIBU_GMIN = XGAMINC_BOUND_CIBU_GMIN * ZRATE_G**(J1-1)
+ ZBOUND_CIBU_SMIN = PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_SMIN * ZRATE_S**(J1-1)
+ ZBOUND_CIBU_GMIN = PARAM_LIMA_MIXED%XGAMINC_BOUND_CIBU_GMIN * ZRATE_G**(J1-1)
!
! For ZNI_CIBU
XGAMINC_CIBU_S(1,J1) = GAMMA_INC(XNUS,ZBOUND_CIBU_SMIN)
@@ -1200,16 +1189,17 @@ XDCRLIM_RDSF_MIN = 0.1E-3 ! D_cr lim min
!!$ WRITE(UNIT=ILUOUT0,FMT='(" D_cr^lim min =",E13.6)') XDCRLIM_RDSF_MIN
!!$END IF
!
-NGAMINC = 80
+PARAM_LIMA_MIXED%NGAMINC = 80
!
-XGAMINC_BOUND_RDSF_RMIN = 1.0E-5 ! Minimal value of (Lbda_r * D_cr^lim)**alpha) 0.1 mm
-XGAMINC_BOUND_RDSF_RMAX = 5.0E-3 ! Maximal value of (Lbda_r * D_cr^lim)**alpha) 1 mm
-ZRATE_R = EXP(LOG(XGAMINC_BOUND_RDSF_RMAX/XGAMINC_BOUND_RDSF_RMIN)/FLOAT(NGAMINC-1))
+PARAM_LIMA_MIXED%XGAMINC_BOUND_RDSF_RMIN = 1.0E-5 ! Minimal value of (Lbda_r * D_cr^lim)**alpha) 0.1 mm
+PARAM_LIMA_MIXED%XGAMINC_BOUND_RDSF_RMAX = 5.0E-3 ! Maximal value of (Lbda_r * D_cr^lim)**alpha) 1 mm
+ZRATE_R = EXP(LOG(PARAM_LIMA_MIXED%XGAMINC_BOUND_RDSF_RMAX/PARAM_LIMA_MIXED%XGAMINC_BOUND_RDSF_RMIN)/&
+ FLOAT(PARAM_LIMA_MIXED%NGAMINC-1))
!
-ALLOCATE( XGAMINC_RDSF_R(NGAMINC) )
+CALL PARAM_LIMA_MIXED_ALLOCATE('XGAMINC_RDSF_R', NGAMINC)
!
DO J1 = 1, NGAMINC
- ZBOUND_RDSF_RMIN = XGAMINC_BOUND_RDSF_RMIN * ZRATE_R**(J1-1)
+ ZBOUND_RDSF_RMIN = PARAM_LIMA_MIXED%XGAMINC_BOUND_RDSF_RMIN * ZRATE_R**(J1-1)
!
! For ZNI_RDSF
XGAMINC_RDSF_R(J1) = GAMMA_INC(XNUR+((6.0+XDR)/XALPHAR),ZBOUND_RDSF_RMIN)
@@ -1318,24 +1308,24 @@ XLBNRDRYG3 = MOMG(XALPHAR,XNUR,2.)
!
! Notice: One magnitude of lambda discretized over 10 points
!
-NDRYLBDAR = 40
-XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
-XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
-ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/REAL(NDRYLBDAR-1)
+PARAM_LIMA_MIXED%NDRYLBDAR = 40
+PARAM_LIMA_MIXED%XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
+PARAM_LIMA_MIXED%XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
+ZRATE = LOG(PARAM_LIMA_MIXED%XDRYLBDAR_MAX/PARAM_LIMA_MIXED%XDRYLBDAR_MIN)/REAL(PARAM_LIMA_MIXED%NDRYLBDAR-1)
XDRYINTP1R = 1.0 / ZRATE
XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
-NDRYLBDAS = 80
-XDRYLBDAS_MIN = 5.0E1*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_SDRYG
-XDRYLBDAS_MAX = 5.0E8*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_SDRYG
-ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/REAL(NDRYLBDAS-1)
+PARAM_LIMA_MIXED%NDRYLBDAS = 80
+PARAM_LIMA_MIXED%XDRYLBDAS_MIN = 5.0E1*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_SDRYG
+PARAM_LIMA_MIXED%XDRYLBDAS_MAX = 5.0E8*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_SDRYG
+ZRATE = LOG(PARAM_LIMA_MIXED%XDRYLBDAS_MAX/PARAM_LIMA_MIXED%XDRYLBDAS_MIN)/REAL(PARAM_LIMA_MIXED%NDRYLBDAS-1)
XDRYINTP1S = 1.0 / ZRATE
XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
-NDRYLBDAG = 40
-XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
-XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
-ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/REAL(NDRYLBDAG-1)
+PARAM_LIMA_MIXED%NDRYLBDAG = 40
+PARAM_LIMA_MIXED%XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+PARAM_LIMA_MIXED%XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+ZRATE = LOG(PARAM_LIMA_MIXED%XDRYLBDAG_MAX/PARAM_LIMA_MIXED%XDRYLBDAG_MIN)/REAL(PARAM_LIMA_MIXED%NDRYLBDAG-1)
XDRYINTP1G = 1.0 / ZRATE
-XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
+XDRYINTP2G = 1.0 - LOG( PARAM_LIMA_MIXED%XDRYLBDAG_MIN ) / ZRATE
!
!* 8.2.5 Computations of the tabulated normalized kernels
!
@@ -1343,9 +1333,9 @@ 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
!
-ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_SDRYG', NDRYLBDAG,NDRYLBDAS)
!if (NMOM_S.GE.2) then
- ALLOCATE( XKER_N_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+ CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_N_SDRYG', NDRYLBDAG,NDRYLBDAS)
CALL NZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, &
ZEGS, XCG, XDG, 0., XCS, XDS, XFVELOS, &
XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
@@ -1426,9 +1416,9 @@ IND = 50 ! Number of interval used to integrate the dimensional
ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
ZFDINFTY = 20.0
!
-ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_RDRYG', NDRYLBDAG,NDRYLBDAR)
!if ( NMOM_R.GE.2 ) then
- ALLOCATE( XKER_N_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+ CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_N_RDRYG', NDRYLBDAG,NDRYLBDAR)
CALL NZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
ZEGR, XCG, XDG, 0., XCR, XDR, 0., &
XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
@@ -1542,24 +1532,24 @@ XLBNGWETH3 = MOMG(XALPHAG,XNUG,2.)
!
! Notice: One magnitude of lambda discretized over 10 points
!
-NWETLBDAS = 80
-XWETLBDAS_MIN = 5.0E1*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_SWETH
-XWETLBDAS_MAX = 5.0E8*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_SWETH
-ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/REAL(NWETLBDAS-1)
+PARAM_LIMA_MIXED%NWETLBDAS = 80
+PARAM_LIMA_MIXED%XWETLBDAS_MIN = 5.0E1*XTRANS_MP_GAMMAS ! Minimal value of Lbda_s to tabulate XKER_SWETH
+PARAM_LIMA_MIXED%XWETLBDAS_MAX = 5.0E8*XTRANS_MP_GAMMAS ! Maximal value of Lbda_s to tabulate XKER_SWETH
+ZRATE = LOG(PARAM_LIMA_MIXED%XWETLBDAS_MAX/PARAM_LIMA_MIXED%XWETLBDAS_MIN)/REAL(PARAM_LIMA_MIXED%NWETLBDAS-1)
XWETINTP1S = 1.0 / ZRATE
-XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE
-NWETLBDAG = 40
-XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
-XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
-ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/REAL(NWETLBDAG-1)
+XWETINTP2S = 1.0 - LOG( PARAM_LIMA_MIXED%XWETLBDAS_MIN ) / ZRATE
+PARAM_LIMA_MIXED%NWETLBDAG = 40
+PARAM_LIMA_MIXED%XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
+PARAM_LIMA_MIXED%XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
+ZRATE = LOG(PARAM_LIMA_MIXED%XWETLBDAG_MAX/PARAM_LIMA_MIXED%XWETLBDAG_MIN)/REAL(PARAM_LIMA_MIXED%NWETLBDAG-1)
XWETINTP1G = 1.0 / ZRATE
XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE
-NWETLBDAH = 40
-XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
-XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
-ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/REAL(NWETLBDAH-1)
+PARAM_LIMA_MIXED%NWETLBDAH = 40
+PARAM_LIMA_MIXED%XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
+PARAM_LIMA_MIXED%XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
+ZRATE = LOG(PARAM_LIMA_MIXED%XWETLBDAH_MAX/PARAM_LIMA_MIXED%XWETLBDAH_MIN)/REAL(PARAM_LIMA_MIXED%NWETLBDAH-1)
XWETINTP1H = 1.0 / ZRATE
-XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE
+XWETINTP2H = 1.0 - LOG( PARAM_LIMA_MIXED%XWETLBDAH_MIN ) / ZRATE
!
!* 9.2.4 Computations of the tabulated normalized kernels
!
@@ -1568,7 +1558,7 @@ ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
!
!if ( NMOM_S.GE.2 ) then
- IF( .NOT.ALLOCATED(XKER_N_SWETH) ) ALLOCATE( XKER_N_SWETH(NWETLBDAH,NWETLBDAS) )
+ IF( .NOT.ASSOCIATED(XKER_N_SWETH) ) CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_N_SWETH', NWETLBDAH,NWETLBDAS)
CALL NZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, &
ZEHS, XCH, XDH, 0., XCS, XDS, XFVELOS, & !
XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, & !
@@ -1583,7 +1573,7 @@ ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
!!$ END DO
!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
-IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+IF( .NOT.ASSOCIATED(XKER_SWETH) ) CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_SWETH', NWETLBDAH,NWETLBDAS)
!
CALL LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS,PFVELOS, &
@@ -1651,7 +1641,7 @@ ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
ZFDINFTY = 20.0
!
!if ( NMOM_G.GE.2 ) then
- IF( .NOT.ALLOCATED(XKER_N_GWETH) ) ALLOCATE( XKER_N_GWETH(NWETLBDAH,NWETLBDAG) )
+ IF( .NOT.ASSOCIATED(XKER_N_GWETH) ) CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_N_GWETH', NWETLBDAH,NWETLBDAG)
CALL NZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, &
ZEHG, XCH, XDH, 0., XCG, XDG, 0., &
XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
@@ -1666,7 +1656,7 @@ ZFDINFTY = 20.0
!!$ END DO
!!$ WRITE(UNIT=ILUOUT0,FMT='("!")')
!end if
-IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+IF( .NOT.ASSOCIATED(XKER_GWETH) ) CALL PARAM_LIMA_MIXED_ALLOCATE('XKER_GWETH', NWETLBDAH,NWETLBDAG)
!
CALL LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
@@ -1779,3 +1769,5 @@ XFREFFI = 0.5 * ZGAMI(8) * (1.0/XLBI)**XLBEXI
!------------------------------------------------------------------------------
!
END SUBROUTINE INI_LIMA_COLD_MIXED
+!
+END MODULE MODE_INI_LIMA_COLD_MIXED
diff --git a/src/PHYEX/micro/mode_ini_lima_warm.f90 b/src/PHYEX/micro/mode_ini_lima_warm.f90
index 8ae14ed0fe38348f4a761530db6ec43c75b2238d..f3f8d60c1c12bee4bdaac51849dc01d9fa834d22 100644
--- a/src/PHYEX/micro/mode_ini_lima_warm.f90
+++ b/src/PHYEX/micro/mode_ini_lima_warm.f90
@@ -4,20 +4,12 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #########################
- MODULE MODI_INI_LIMA_WARM
+ MODULE MODE_INI_LIMA_WARM
! #########################
!
-INTERFACE
- SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
-!
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-!
-END SUBROUTINE INI_LIMA_WARM
-!
-END INTERFACE
+IMPLICIT NONE
!
-END MODULE MODI_INI_LIMA_WARM
+CONTAINS
! #########################################
SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
! #########################################
@@ -46,7 +38,6 @@ END MODULE MODI_INI_LIMA_WARM
! ------------
!
USE MODD_CST
-USE MODD_REF
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
USE MODD_PARAMETERS
@@ -76,9 +67,7 @@ REAL, DIMENSION(6) :: ZGAMC, ZGAMR ! parameters involving various moments of
REAL :: ZTT ! Temperature in Celsius
REAL :: ZLV ! Latent heat of vaporization
REAL :: ZSS ! Supersaturation
-REAL :: ZPSI1, ZG ! Psi1 and G functions
-REAL :: ZAHENR ! r_star (FH92)
-REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZG ! G function
REAL :: ZRHO00 ! Surface reference air density
REAL :: ZSURF_TEN ! Water drop surface tension
REAL :: ZSMIN, ZSMAX ! Minimal and maximal supersaturation used to
@@ -92,6 +81,7 @@ REAL :: ZSMIN, ZSMAX ! Minimal and maximal supersaturation used to
!
!-------------------------------------------------------------------------------
!
+CALL PARAM_LIMA_WARM_ASSOCIATE()
!
!* 1. CHARACTERISTICS OF THE SPECIES
! ------------------------------
@@ -249,8 +239,8 @@ XCSTDCRIT = (XPI/6.)*XRHOLW*( (8.0*ZSURF_TEN )/( 3.0*XRV*XRHOLW ) )**3
! using a logarithmic scale for S
!
NHYP = 500 ! Number of points for the tabulation
-ALLOCATE (XHYPF12( NHYP, NMOD_CCN ))
-ALLOCATE (XHYPF32( NHYP, NMOD_CCN ))
+CALL PARAM_LIMA_WARM_ALLOCATE('XHYPF12', NHYP, NMOD_CCN)
+CALL PARAM_LIMA_WARM_ALLOCATE('XHYPF32', NHYP, NMOD_CCN)
!
ZSMIN = 1.0E-5 ! Minimum supersaturation set at 0.001 %
ZSMAX = 5.0E-2 ! Maximum supersaturation set at 5 %
@@ -285,11 +275,11 @@ XAHENINTP2 = 0.5*REAL(NAHEN-1) - XTT
! Lv
! G
!
-ALLOCATE (XAHENG(NAHEN))
-ALLOCATE (XAHENG2(NAHEN))
-ALLOCATE (XAHENG3(NAHEN))
-ALLOCATE (XPSI1(NAHEN))
-ALLOCATE (XPSI3(NAHEN))
+CALL PARAM_LIMA_WARM_ALLOCATE('XAHENG', NAHEN)
+CALL PARAM_LIMA_WARM_ALLOCATE('XAHENG2', NAHEN)
+CALL PARAM_LIMA_WARM_ALLOCATE('XAHENG3', NAHEN)
+CALL PARAM_LIMA_WARM_ALLOCATE('XPSI1', NAHEN)
+CALL PARAM_LIMA_WARM_ALLOCATE('XPSI3', NAHEN)
XCSTHEN = 1.0 / ( XRHOLW*2.0*XPI )
DO J1 = 1,NAHEN
ZTT = XTT + REAL(J1-(NAHEN-1)/2) ! T
@@ -475,3 +465,5 @@ XCRER = 1.0/ (ZGAMR(6) * XAR**(2.0/3.0))
!------------------------------------------------------------------------------
!
END SUBROUTINE INI_LIMA_WARM
+!
+END MODULE MODE_INI_LIMA_WARM
diff --git a/src/PHYEX/micro/mode_ini_rain_ice.f90 b/src/PHYEX/micro/mode_ini_rain_ice.f90
index 1118b9aaf7e47dd2a7ee37fcbab2dc17f9afbda5..3f4ac2ad27ea2d182de387ad6988eca1dc597547 100644
--- a/src/PHYEX/micro/mode_ini_rain_ice.f90
+++ b/src/PHYEX/micro/mode_ini_rain_ice.f90
@@ -4,6 +4,9 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
+MODULE MODE_INI_RAIN_ICE
+IMPLICIT NONE
+CONTAINS
SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
! ###########################################################
!
@@ -79,6 +82,10 @@
!! S. Riette 2016-11: new ICE3/ICE4 options
!! P. Wautelet 22/01/2019 bug correction: incorrect write
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!! S. Riette 2022-03: use of RAIN_ICE_PARAM structure for some variables
+!! to reproduce results on belenos. The reason why
+!! those variables must have a specifi treatment was
+!! not understood
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
!
!-------------------------------------------------------------------------------
@@ -87,12 +94,11 @@
! ------------
!
USE MODD_CST
-USE MODD_LUNIT
-USE MODD_PARAMETERS
-USE MODD_PARAM_ICE
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
-USE MODD_REF
+USE MODD_PARAM_ICE_n, ONLY: LSNOW_T, CSEDIM, LRED, CPRISTINE_ICE, &
+ & LCRIAUTI, XACRIAUTI_NAM, XBCRIAUTI_NAM, XCRIAUTC_NAM, XCRIAUTI_NAM, XT0CRIAUTI_NAM, &
+ & XFRACM90, XFRMIN_NAM, XRDEPGRED_NAM, XRDEPSRED_NAM
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_PARAM_n
!
USE MODI_GAMMA
USE MODI_GAMMA_INC
@@ -106,8 +112,7 @@ 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -129,8 +134,6 @@ CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Indicator of the cloud scheme
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: IKB ! Coordinates of the first physical
- ! points along z
INTEGER :: J1,J2 ! Internal loop indexes
REAL :: ZT ! Work variable
REAL :: ZVTRMAX ! Raindrop maximal fall velocity
@@ -147,6 +150,8 @@ INTEGER :: IND ! Number of interval to integrate the kernels
REAL :: ZESR ! Mean efficiency of rain-aggregate collection
REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
!
+REAL :: ZCRI0, ZTCRI0 ! Second point to determine 10**(aT+b) law of ri->rs autoconversion
+!
!
!
LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
@@ -173,12 +178,10 @@ 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
+REAL(KIND=JPHOOK) :: 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
@@ -194,8 +197,8 @@ IF(.NOT.ASSOCIATED(XFSEDC)) CALL RAIN_ICE_PARAM_ASSOCIATE()
!
!* 1.1 Set the hailstones maximum fall velocity
!
-IF (CSEDIM == 'SPLI' .AND. .NOT. LRED ) THEN
- IF (HCLOUD == 'ICE4') THEN
+IF (CSEDIM == 'SPLI' .AND. .NOT. LRED) THEN
+ IF (HCLOUD == 'ICE4' .OR. HCLOUD=='LIMA') THEN
ZVTRMAX = 40.
ELSE IF (HCLOUD == 'ICE3') THEN
ZVTRMAX = 10.
@@ -205,7 +208,7 @@ END IF
!* 1.2 Compute the number of small time step integration
!
KSPLITR = 1
-IF (CSEDIM == 'SPLI' .AND. .NOT. LRED ) THEN
+IF (CSEDIM == 'SPLI' .AND. .NOT. LRED) THEN
SPLIT : DO
ZT = PTSTEP / REAL(KSPLITR)
IF ( ZT * ZVTRMAX / PDZMIN .LT. 1.) EXIT SPLIT
@@ -213,14 +216,7 @@ IF (CSEDIM == 'SPLI' .AND. .NOT. LRED ) THEN
END DO SPLIT
END IF
!
-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.
- CALL RAIN_ICE_DESCR_DEALLOCATE()
-END IF
-!
-IF (HCLOUD == 'ICE4') THEN
+IF (HCLOUD == 'ICE4' .OR. HCLOUD=='LIMA') THEN
CALL RAIN_ICE_DESCR_ALLOCATE(7)
ELSE IF (HCLOUD == 'ICE3') THEN
CALL RAIN_ICE_DESCR_ALLOCATE(6)
@@ -232,7 +228,7 @@ 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
+IF (HCLOUD == 'ICE4' .OR. HCLOUD=='LIMA') XRTMIN(7) = 1.0E-15
!
!-------------------------------------------------------------------------------
!
@@ -424,7 +420,7 @@ XLBR = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR)
XLBEXI = 1.0/(-XBI)
XLBI = ( XAI*MOMG(XALPHAI,XNUI,XBI) )**(-XLBEXI)
!
-#if defined(REPRO48)
+#ifdef REPRO48
#else
XNS = 1.0/(XAS*MOMG(XALPHAS,XNUS,XBS))
#endif
@@ -439,11 +435,13 @@ XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH)
!
!* 3.5 Minimal values allowed for the mixing ratios
!
+XLBDAR_MAX = 100000.0
XLBDAS_MAX = 100000.0
+XLBDAG_MAX = 100000.0
!
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)
-#if defined(REPRO48)
+#ifdef REPRO48
#else
IF (LSNOW_T) XLBDAS_MAX = 1.E6
XLBDAS_MIN = 1.E-10
@@ -463,8 +461,7 @@ XCONC_URBAN=5E8 ! 500/cm3
!
XCEXVT = 0.4
!
-IKB = 1 + JPVEXT
-!ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+!ZRHO00 = XP00/(XRD*XTHVREFZ(1+JPVEXT))
!According to Foote and Du Toit (1969) and List (1958), ZRHO00 must be computed for Hu=50%, P=101325Pa and T=293.15K
ZE = (50./100.) * EXP(XALPW-XBETAW/293.15-XGAMW*LOG(293.15))
ZRV = (XRD/XRV) * ZE / (101325.-ZE)
@@ -500,7 +497,7 @@ XEXCSEDI =-0.9324*3.0
WRITE (KLUOUT,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI =',XFSEDI
!
!
-#if defined(REPRO48)
+#ifdef REPRO48
XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
(XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
@@ -587,24 +584,24 @@ 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)
+#ifdef REPRO48
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
+XRDEPSRED = XRDEPSRED_NAM
!
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
+XRDEPGRED = XRDEPGRED_NAM
!
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)
@@ -623,13 +620,20 @@ END IF
!
XTIMAUTI = 1.E-3 ! Time constant at T=T_t
XTEXAUTI = 0.015 ! Temperature factor of the I+I collection efficiency
-!!XCRIAUTI = 0.25E-3 ! Critical ice content for the autoconversion to occur
-XCRIAUTI = 0.2E-4 ! Critical ice content for the autoconversion to occur
- ! Revised value by Chaboureau et al. (2001)
-XACRIAUTI=0.06
-XBCRIAUTI=-3.5
-XT0CRIAUTI=(LOG10(XCRIAUTI)-XBCRIAUTI)/0.06
-
+XCRIAUTI = XCRIAUTI_NAM
+IF(LCRIAUTI) THEN
+ XT0CRIAUTI = XT0CRIAUTI_NAM
+ !second point to determine 10**(aT+b) law
+ ZTCRI0=-40.0
+ ZCRI0=1.25E-6
+ XBCRIAUTI=-( LOG10(XCRIAUTI) - LOG10(ZCRI0)*XT0CRIAUTI/ZTCRI0 )&
+ *ZTCRI0/(XT0CRIAUTI-ZTCRI0)
+ XACRIAUTI=(LOG10(ZCRI0)-XBCRIAUTI)/ZTCRI0
+ELSE
+ XACRIAUTI=XACRIAUTI_NAM
+ XBCRIAUTI=XBCRIAUTI_NAM
+ XT0CRIAUTI=(LOG10(XCRIAUTI)-XBCRIAUTI)/0.06
+ENDIF
!
GFLAG = .TRUE.
IF (GFLAG) THEN
@@ -647,7 +651,7 @@ END IF
!
XCOLIS = 0.25 ! Collection efficiency of I+S
XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency
-#if defined(REPRO48)
+#ifdef REPRO48
XFIAGGS = (XPI/4.0)*XCOLIS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
XEXIAGGS = XCXS-XDS-2.0
#else
@@ -672,7 +676,7 @@ END IF
!* 6.1 Constants for the cloud droplets autoconversion
!
XTIMAUTC = 1.E-3
-XCRIAUTC = 0.5E-3
+XCRIAUTC = XCRIAUTC_NAM
!
GFLAG = .TRUE.
IF (GFLAG) THEN
@@ -704,7 +708,7 @@ 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)
+#ifdef REPRO48
XEXCRIMSS= XCXS-XDS-2.0
XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
#else
@@ -713,7 +717,7 @@ XCRIMSS = XNS * (XPI/4.0)*XCOLCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0
#endif
XEXCRIMSG= XEXCRIMSS
XCRIMSG = XCRIMSS
-#if defined(REPRO48)
+#ifdef REPRO48
XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS)
XEXSRIMCG= XCXS-XBS
XSRIMCG2 = XCCS*XAG*MOMG(XALPHAS,XNUS,XBG)
@@ -734,28 +738,28 @@ IF (GFLAG) THEN
WRITE(UNIT=KLUOUT,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
END IF
!
-NGAMINC = 80
-XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
-XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
-ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
+RAIN_ICE_PARAMN%NGAMINC = 80
+RAIN_ICE_PARAMN%XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
+RAIN_ICE_PARAMN%XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
+ZRATE = EXP(LOG(RAIN_ICE_PARAMN%XGAMINC_BOUND_MAX/RAIN_ICE_PARAMN%XGAMINC_BOUND_MIN)/REAL(RAIN_ICE_PARAMN%NGAMINC-1))
!
-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)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM1) ) CALL RAIN_ICE_PARAM_ALLOCATE('XGAMINC_RIM1', RAIN_ICE_PARAMN%NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM2) ) CALL RAIN_ICE_PARAM_ALLOCATE('XGAMINC_RIM2', RAIN_ICE_PARAMN%NGAMINC)
+IF( .NOT.ASSOCIATED(XGAMINC_RIM4) ) CALL RAIN_ICE_PARAM_ALLOCATE('XGAMINC_RIM4', RAIN_ICE_PARAMN%NGAMINC)
!
-DO J1=1,NGAMINC
- ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
+DO J1=1,RAIN_ICE_PARAMN%NGAMINC
+ ZBOUND = RAIN_ICE_PARAMN%XGAMINC_BOUND_MIN*ZRATE**(J1-1)
XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND)
XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND)
XGAMINC_RIM4(J1) = GAMMA_INC(XNUS+XBG/XALPHAS ,ZBOUND)
END DO
!
-XRIMINTP1 = XALPHAS / LOG(ZRATE)
-XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) )
+RAIN_ICE_PARAMN%XRIMINTP1 = XALPHAS / LOG(ZRATE)
+RAIN_ICE_PARAMN%XRIMINTP2 = 1.0 + RAIN_ICE_PARAMN%XRIMINTP1*LOG( XDCSLIM/(RAIN_ICE_PARAMN%XGAMINC_BOUND_MIN)**(1.0/XALPHAS) )
!
!* 7.2 Constants for the accretion of raindrops onto aggregates
!
-#if defined(REPRO48)
+#ifdef REPRO48
XFRACCSS = ((XPI**2)/24.0)*XCCS*XCCR*XRHOLW*(ZRHO00**XCEXVT)
#else
XFRACCSS = XNS*((XPI**2)/24.0)*XCCR*XRHOLW*(ZRHO00**XCEXVT)
@@ -765,7 +769,7 @@ 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)
+#ifdef REPRO48
XFSACCRG = (XPI/4.0)*XAS*XCCS*XCCR*(ZRHO00**XCEXVT)
#else
XFSACCRG = XNS*(XPI/4.0)*XAS*XCCR*(ZRHO00**XCEXVT)
@@ -780,18 +784,18 @@ XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.)
! Notice: One magnitude of lambda discretized over 10 points for rain
! Notice: One magnitude of lambda discretized over 10 points for snow
!
-NACCLBDAS = 40
-XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
-XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
-ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/REAL(NACCLBDAS-1)
-XACCINTP1S = 1.0 / ZRATE
-XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
-NACCLBDAR = 40
-XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
-XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
-ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/REAL(NACCLBDAR-1)
-XACCINTP1R = 1.0 / ZRATE
-XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NACCLBDAS = 40
+RAIN_ICE_PARAMN%XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
+RAIN_ICE_PARAMN%XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
+ZRATE = LOG(RAIN_ICE_PARAMN%XACCLBDAS_MAX/RAIN_ICE_PARAMN%XACCLBDAS_MIN)/REAL(RAIN_ICE_PARAMN%NACCLBDAS-1)
+RAIN_ICE_PARAMN%XACCINTP1S = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XACCINTP2S = 1.0 - LOG( RAIN_ICE_PARAMN%XACCLBDAS_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NACCLBDAR = 40
+RAIN_ICE_PARAMN%XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
+RAIN_ICE_PARAMN%XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
+ZRATE = LOG(RAIN_ICE_PARAMN%XACCLBDAR_MAX/RAIN_ICE_PARAMN%XACCLBDAR_MIN)/REAL(RAIN_ICE_PARAMN%NACCLBDAR-1)
+RAIN_ICE_PARAMN%XACCINTP1R = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XACCINTP2R = 1.0 - LOG( RAIN_ICE_PARAMN%XACCLBDAR_MIN ) / ZRATE
!
!* 7.2.2 Computations of the tabulated normalized kernels
!
@@ -799,33 +803,36 @@ 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.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)
+IF( .NOT.ASSOCIATED(XKER_RACCSS) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RACCSS', RAIN_ICE_PARAMN%NACCLBDAS,RAIN_ICE_PARAMN%NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_RACCS ) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RACCS', RAIN_ICE_PARAMN%NACCLBDAS,RAIN_ICE_PARAMN%NACCLBDAR)
+IF( .NOT.ASSOCIATED(XKER_SACCRG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SACCRG', RAIN_ICE_PARAMN%NACCLBDAR,RAIN_ICE_PARAMN%NACCLBDAS)
!
CALL 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 )
-IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
+IF( (KACCLBDAS/=RAIN_ICE_PARAMN%NACCLBDAS) .OR. (KACCLBDAR/=RAIN_ICE_PARAMN%NACCLBDAR) .OR. (KND/=IND) .OR. &
(PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
(PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
(PESR/=ZESR) .OR. (PBS/=XBS) .OR. (PBR/=XBR) .OR. &
(PCS/=XCS) .OR. (PDS/=XDS) .OR. (PFVELOS/=XFVELOS) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
- (PACCLBDAS_MAX/=XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=XACCLBDAR_MAX) .OR. &
- (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. &
+ (PACCLBDAS_MAX/=RAIN_ICE_PARAMN%XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=RAIN_ICE_PARAMN%XACCLBDAR_MAX) .OR. &
+ (PACCLBDAS_MIN/=RAIN_ICE_PARAMN%XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=RAIN_ICE_PARAMN%XACCLBDAR_MIN) .OR. &
(PFDINFTY/=ZFDINFTY) ) THEN
CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, &
+ RAIN_ICE_PARAMN%XACCLBDAS_MAX, RAIN_ICE_PARAMN%XACCLBDAR_MAX, &
+ RAIN_ICE_PARAMN%XACCLBDAS_MIN, RAIN_ICE_PARAMN%XACCLBDAR_MIN, &
ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS )
CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, 0., &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZESR, XBR, XCS, XDS, XFVELOS, XCR, XDR, 0., &
+ RAIN_ICE_PARAMN%XACCLBDAS_MAX, RAIN_ICE_PARAMN%XACCLBDAR_MAX, &
+ RAIN_ICE_PARAMN%XACCLBDAS_MIN, RAIN_ICE_PARAMN%XACCLBDAR_MIN, &
ZFDINFTY, XKER_RACCS )
CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
ZESR, XBS, XCS, XDS, XFVELOS, XCR, XDR, &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ RAIN_ICE_PARAMN%XACCLBDAS_MAX, RAIN_ICE_PARAMN%XACCLBDAR_MAX, &
+ RAIN_ICE_PARAMN%XACCLBDAS_MIN, RAIN_ICE_PARAMN%XACCLBDAR_MIN, &
ZFDINFTY, XKER_SACCRG, XAG, XBS, XAS )
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
@@ -834,8 +841,8 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KLUOUT,FMT='("KACCLBDAS=",I3)') NACCLBDAS
- WRITE(UNIT=KLUOUT,FMT='("KACCLBDAR=",I3)') NACCLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("KACCLBDAS=",I3)') RAIN_ICE_PARAMN%NACCLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("KACCLBDAR=",I3)') RAIN_ICE_PARAMN%NACCLBDAR
WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
WRITE(UNIT=KLUOUT,FMT='("PNUS=",E13.6)') XNUS
WRITE(UNIT=KLUOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
@@ -849,18 +856,18 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("PCR=",E13.6)') XCR
WRITE(UNIT=KLUOUT,FMT='("PDR=",E13.6)') XDR
WRITE(UNIT=KLUOUT,FMT='("PACCLBDAS_MAX=",E13.6)') &
- XACCLBDAS_MAX
+ RAIN_ICE_PARAMN%XACCLBDAS_MAX
WRITE(UNIT=KLUOUT,FMT='("PACCLBDAR_MAX=",E13.6)') &
- XACCLBDAR_MAX
+ RAIN_ICE_PARAMN%XACCLBDAR_MAX
WRITE(UNIT=KLUOUT,FMT='("PACCLBDAS_MIN=",E13.6)') &
- XACCLBDAS_MIN
+ RAIN_ICE_PARAMN%XACCLBDAS_MIN
WRITE(UNIT=KLUOUT,FMT='("PACCLBDAR_MIN=",E13.6)') &
- XACCLBDAR_MIN
+ RAIN_ICE_PARAMN%XACCLBDAR_MIN
WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
- DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
+ DO J1 = 1 , RAIN_ICE_PARAMN%NACCLBDAS
+ DO J2 = 1 , RAIN_ICE_PARAMN%NACCLBDAR
WRITE(UNIT=KLUOUT,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
J1,J2,XKER_RACCSS(J1,J2)
END DO
@@ -868,8 +875,8 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("END IF")')
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
- DO J1 = 1 , NACCLBDAS
- DO J2 = 1 , NACCLBDAR
+ DO J1 = 1 , RAIN_ICE_PARAMN%NACCLBDAS
+ DO J2 = 1 , RAIN_ICE_PARAMN%NACCLBDAR
WRITE(UNIT=KLUOUT,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
J1,J2,XKER_RACCS (J1,J2)
END DO
@@ -877,8 +884,8 @@ IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("END IF")')
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
- DO J1 = 1 , NACCLBDAR
- DO J2 = 1 , NACCLBDAS
+ DO J1 = 1 , RAIN_ICE_PARAMN%NACCLBDAR
+ DO J2 = 1 , RAIN_ICE_PARAMN%NACCLBDAS
WRITE(UNIT=KLUOUT,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
J1,J2,XKER_SACCRG(J1,J2)
END DO
@@ -962,7 +969,7 @@ 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)
+#ifdef REPRO48
XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT)
#else
XFSDRYG = XNS*(XPI/4.0)*XCOLSG*XCCG*XAS*(ZRHO00**XCEXVT)
@@ -989,24 +996,24 @@ XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.)
!
! Notice: One magnitude of lambda discretized over 10 points
!
-NDRYLBDAR = 40
-XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
-XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
-ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/REAL(NDRYLBDAR-1)
-XDRYINTP1R = 1.0 / ZRATE
-XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
-NDRYLBDAS = 80
-XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
-XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
-ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/REAL(NDRYLBDAS-1)
-XDRYINTP1S = 1.0 / ZRATE
-XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
-NDRYLBDAG = 40
-XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
-XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
-ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/REAL(NDRYLBDAG-1)
-XDRYINTP1G = 1.0 / ZRATE
-XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NDRYLBDAR = 40
+RAIN_ICE_PARAMN%XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
+RAIN_ICE_PARAMN%XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
+ZRATE = LOG(RAIN_ICE_PARAMN%XDRYLBDAR_MAX/RAIN_ICE_PARAMN%XDRYLBDAR_MIN)/REAL(RAIN_ICE_PARAMN%NDRYLBDAR-1)
+RAIN_ICE_PARAMN%XDRYINTP1R = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XDRYINTP2R = 1.0 - LOG( RAIN_ICE_PARAMN%XDRYLBDAR_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NDRYLBDAS = 80
+RAIN_ICE_PARAMN%XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
+RAIN_ICE_PARAMN%XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
+ZRATE = LOG(RAIN_ICE_PARAMN%XDRYLBDAS_MAX/RAIN_ICE_PARAMN%XDRYLBDAS_MIN)/REAL(RAIN_ICE_PARAMN%NDRYLBDAS-1)
+RAIN_ICE_PARAMN%XDRYINTP1S = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XDRYINTP2S = 1.0 - LOG( RAIN_ICE_PARAMN%XDRYLBDAS_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NDRYLBDAG = 40
+RAIN_ICE_PARAMN%XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+RAIN_ICE_PARAMN%XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+ZRATE = LOG(RAIN_ICE_PARAMN%XDRYLBDAG_MAX/RAIN_ICE_PARAMN%XDRYLBDAG_MIN)/REAL(RAIN_ICE_PARAMN%NDRYLBDAG-1)
+RAIN_ICE_PARAMN%XDRYINTP1G = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XDRYINTP2G = 1.0 - LOG( RAIN_ICE_PARAMN%XDRYLBDAG_MIN ) / ZRATE
!
!* 8.2.5 Computations of the tabulated normalized kernels
!
@@ -1014,31 +1021,32 @@ 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.ASSOCIATED(XKER_SDRYG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SDRYG', NDRYLBDAG,NDRYLBDAS)
+IF( .NOT.ASSOCIATED(XKER_SDRYG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SDRYG', RAIN_ICE_PARAMN%NDRYLBDAG,RAIN_ICE_PARAMN%NDRYLBDAS)
!
CALL 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 )
-IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
+IF( (KDRYLBDAG/=RAIN_ICE_PARAMN%NDRYLBDAG) .OR. (KDRYLBDAS/=RAIN_ICE_PARAMN%NDRYLBDAS) .OR. (KND/=IND) .OR. &
(PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
(PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
(PEGS/=ZEGS) .OR. (PBS/=XBS) .OR. &
(PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PFVELOS/=XFVELOS) .OR. &
- (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=XDRYLBDAS_MAX) .OR. &
- (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. &
+ (PDRYLBDAG_MAX/=RAIN_ICE_PARAMN%XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=RAIN_ICE_PARAMN%XDRYLBDAS_MAX) .OR. &
+ (PDRYLBDAG_MIN/=RAIN_ICE_PARAMN%XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=RAIN_ICE_PARAMN%XDRYLBDAS_MIN) .OR. &
(PFDINFTY/=ZFDINFTY) ) THEN
CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, &
ZEGS, XBS, XCG, XDG, 0., XCS, XDS, XFVELOS, &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ RAIN_ICE_PARAMN%XDRYLBDAG_MAX, RAIN_ICE_PARAMN%XDRYLBDAS_MAX, &
+ RAIN_ICE_PARAMN%XDRYLBDAG_MIN, RAIN_ICE_PARAMN%XDRYLBDAS_MIN, &
ZFDINFTY, XKER_SDRYG )
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
- WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAG=",I3)') RAIN_ICE_PARAMN%NDRYLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAS=",I3)') RAIN_ICE_PARAMN%NDRYLBDAS
WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
WRITE(UNIT=KLUOUT,FMT='("PNUG=",E13.6)') XNUG
WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
@@ -1051,18 +1059,18 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("PDS=",E13.6)') XDS
WRITE(UNIT=KLUOUT,FMT='("PFVELOS=",E13.6)') XFVELOS
WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MAX=",E13.6)') &
- XDRYLBDAG_MAX
+ RAIN_ICE_PARAMN%XDRYLBDAG_MAX
WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAS_MAX=",E13.6)') &
- XDRYLBDAS_MAX
+ RAIN_ICE_PARAMN%XDRYLBDAS_MAX
WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MIN=",E13.6)') &
- XDRYLBDAG_MIN
+ RAIN_ICE_PARAMN%XDRYLBDAG_MIN
WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAS_MIN=",E13.6)') &
- XDRYLBDAS_MIN
+ RAIN_ICE_PARAMN%XDRYLBDAS_MIN
WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAS
+ DO J1 = 1 , RAIN_ICE_PARAMN%NDRYLBDAG
+ DO J2 = 1 , RAIN_ICE_PARAMN%NDRYLBDAS
WRITE(UNIT=KLUOUT,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
J1,J2,XKER_SDRYG(J1,J2)
END DO
@@ -1081,31 +1089,32 @@ 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.ASSOCIATED(XKER_RDRYG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RDRYG', NDRYLBDAG,NDRYLBDAR)
+IF( .NOT.ASSOCIATED(XKER_RDRYG) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RDRYG', RAIN_ICE_PARAMN%NDRYLBDAG,RAIN_ICE_PARAMN%NDRYLBDAR)
!
CALL 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 )
-IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
+IF( (KDRYLBDAG/=RAIN_ICE_PARAMN%NDRYLBDAG) .OR. (KDRYLBDAR/=RAIN_ICE_PARAMN%NDRYLBDAR) .OR. (KND/=IND) .OR. &
(PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
(PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
(PEGR/=ZEGR) .OR. (PBR/=XBR) .OR. &
(PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
- (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=XDRYLBDAR_MAX) .OR. &
- (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. &
+ (PDRYLBDAG_MAX/=RAIN_ICE_PARAMN%XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=RAIN_ICE_PARAMN%XDRYLBDAR_MAX) .OR. &
+ (PDRYLBDAG_MIN/=RAIN_ICE_PARAMN%XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=RAIN_ICE_PARAMN%XDRYLBDAR_MIN) .OR. &
(PFDINFTY/=ZFDINFTY) ) THEN
CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, &
ZEGR, XBR, XCG, XDG, 0., XCR, XDR, 0., &
- XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
+ RAIN_ICE_PARAMN%XDRYLBDAG_MAX, RAIN_ICE_PARAMN%XDRYLBDAR_MAX, &
+ RAIN_ICE_PARAMN%XDRYLBDAG_MIN, RAIN_ICE_PARAMN%XDRYLBDAR_MIN, &
ZFDINFTY, XKER_RDRYG )
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
- WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAG=",I3)') RAIN_ICE_PARAMN%NDRYLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("KDRYLBDAR=",I3)') RAIN_ICE_PARAMN%NDRYLBDAR
WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
WRITE(UNIT=KLUOUT,FMT='("PNUG=",E13.6)') XNUG
WRITE(UNIT=KLUOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
@@ -1117,18 +1126,18 @@ IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("PCR=",E13.6)') XCR
WRITE(UNIT=KLUOUT,FMT='("PDR=",E13.6)') XDR
WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MAX=",E13.6)') &
- XDRYLBDAG_MAX
+ RAIN_ICE_PARAMN%XDRYLBDAG_MAX
WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAR_MAX=",E13.6)') &
- XDRYLBDAR_MAX
+ RAIN_ICE_PARAMN%XDRYLBDAR_MAX
WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAG_MIN=",E13.6)') &
- XDRYLBDAG_MIN
+ RAIN_ICE_PARAMN%XDRYLBDAG_MIN
WRITE(UNIT=KLUOUT,FMT='("PDRYLBDAR_MIN=",E13.6)') &
- XDRYLBDAR_MIN
+ RAIN_ICE_PARAMN%XDRYLBDAR_MIN
WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
- DO J1 = 1 , NDRYLBDAG
- DO J2 = 1 , NDRYLBDAR
+ DO J1 = 1 , RAIN_ICE_PARAMN%NDRYLBDAG
+ DO J2 = 1 , RAIN_ICE_PARAMN%NDRYLBDAR
WRITE(UNIT=KLUOUT,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
J1,J2,XKER_RDRYG(J1,J2)
END DO
@@ -1145,22 +1154,7 @@ 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
+ XFRMIN=XFRMIN_NAM
!
!
!-------------------------------------------------------------------------------
@@ -1182,7 +1176,7 @@ 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
-#if defined(REPRO48)
+#ifdef REPRO48
XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT)
#else
XFSWETH = XNS*(XPI/4.0)*XCCH*XAS*(ZRHO00**XCEXVT) ! Wurtz
@@ -1212,30 +1206,30 @@ XLBRWETH3 = MOMG(XALPHAR,XNUR,XBR+2.)
!
! Notice: One magnitude of lambda discretized over 10 points
!
-NWETLBDAS = 80
-XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH
-XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH
-ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/REAL(NWETLBDAS-1)
-XWETINTP1S = 1.0 / ZRATE
-XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE
-NWETLBDAG = 40
-XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
-XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
-ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/REAL(NWETLBDAG-1)
-XWETINTP1G = 1.0 / ZRATE
-XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE
-NWETLBDAR = 40
-XWETLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RWETH
-XWETLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RWETH
-ZRATE = LOG(XWETLBDAR_MAX/XWETLBDAR_MIN)/REAL(NWETLBDAR-1)
-XWETINTP1R = 1.0 / ZRATE
-XWETINTP2R = 1.0 - LOG( XWETLBDAR_MIN ) / ZRATE
-NWETLBDAH = 40
-XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH,XKER_RWETH
-XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH,XKER_RWETH
-ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/REAL(NWETLBDAH-1)
-XWETINTP1H = 1.0 / ZRATE
-XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NWETLBDAS = 80
+RAIN_ICE_PARAMN%XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH
+RAIN_ICE_PARAMN%XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH
+ZRATE = LOG(RAIN_ICE_PARAMN%XWETLBDAS_MAX/RAIN_ICE_PARAMN%XWETLBDAS_MIN)/REAL(RAIN_ICE_PARAMN%NWETLBDAS-1)
+RAIN_ICE_PARAMN%XWETINTP1S = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XWETINTP2S = 1.0 - LOG( RAIN_ICE_PARAMN%XWETLBDAS_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NWETLBDAG = 40
+RAIN_ICE_PARAMN%XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
+RAIN_ICE_PARAMN%XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
+ZRATE = LOG(RAIN_ICE_PARAMN%XWETLBDAG_MAX/RAIN_ICE_PARAMN%XWETLBDAG_MIN)/REAL(RAIN_ICE_PARAMN%NWETLBDAG-1)
+RAIN_ICE_PARAMN%XWETINTP1G = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XWETINTP2G = 1.0 - LOG( RAIN_ICE_PARAMN%XWETLBDAG_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NWETLBDAR = 40
+RAIN_ICE_PARAMN%XWETLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RWETH
+RAIN_ICE_PARAMN%XWETLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RWETH
+ZRATE = LOG(RAIN_ICE_PARAMN%XWETLBDAR_MAX/RAIN_ICE_PARAMN%XWETLBDAR_MIN)/REAL(RAIN_ICE_PARAMN%NWETLBDAR-1)
+RAIN_ICE_PARAMN%XWETINTP1R = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XWETINTP2R = 1.0 - LOG( RAIN_ICE_PARAMN%XWETLBDAR_MIN ) / ZRATE
+RAIN_ICE_PARAMN%NWETLBDAH = 40
+RAIN_ICE_PARAMN%XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH,XKER_RWETH
+RAIN_ICE_PARAMN%XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH,XKER_RWETH
+ZRATE = LOG(RAIN_ICE_PARAMN%XWETLBDAH_MAX/RAIN_ICE_PARAMN%XWETLBDAH_MIN)/REAL(RAIN_ICE_PARAMN%NWETLBDAH-1)
+RAIN_ICE_PARAMN%XWETINTP1H = 1.0 / ZRATE
+RAIN_ICE_PARAMN%XWETINTP2H = 1.0 - LOG( RAIN_ICE_PARAMN%XWETLBDAH_MIN ) / ZRATE
!
!* 9.2.4 Computations of the tabulated normalized kernels
!
@@ -1243,31 +1237,32 @@ 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.ASSOCIATED(XKER_SWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SWETH', NWETLBDAH,NWETLBDAS)
+IF( .NOT.ASSOCIATED(XKER_SWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_SWETH', RAIN_ICE_PARAMN%NWETLBDAH,RAIN_ICE_PARAMN%NWETLBDAS)
!
CALL 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 )
-IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
+IF( (KWETLBDAH/=RAIN_ICE_PARAMN%NWETLBDAH) .OR. (KWETLBDAS/=RAIN_ICE_PARAMN%NWETLBDAS) .OR. (KND/=IND) .OR. &
(PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
(PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
(PEHS/=ZEHS) .OR. (PBS/=XBS) .OR. &
(PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PFVELOS/=XFVELOS) .OR. &
- (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAS_MAX/=XWETLBDAS_MAX) .OR. &
- (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. &
+ (PWETLBDAH_MAX/=RAIN_ICE_PARAMN%XWETLBDAH_MAX) .OR. (PWETLBDAS_MAX/=RAIN_ICE_PARAMN%XWETLBDAS_MAX) .OR. &
+ (PWETLBDAH_MIN/=RAIN_ICE_PARAMN%XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=RAIN_ICE_PARAMN%XWETLBDAS_MIN) .OR. &
(PFDINFTY/=ZFDINFTY) ) THEN
CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, &
ZEHS, XBS, XCH, XDH, 0., XCS, XDS, XFVELOS, &
- XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, &
+ RAIN_ICE_PARAMN%XWETLBDAH_MAX, RAIN_ICE_PARAMN%XWETLBDAS_MAX, &
+ RAIN_ICE_PARAMN%XWETLBDAH_MIN, RAIN_ICE_PARAMN%XWETLBDAS_MIN, &
ZFDINFTY, XKER_SWETH )
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=KLUOUT,FMT='("KWETLBDAS=",I3)') NWETLBDAS
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') RAIN_ICE_PARAMN%NWETLBDAH
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAS=",I3)') RAIN_ICE_PARAMN%NWETLBDAS
WRITE(UNIT=KLUOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
WRITE(UNIT=KLUOUT,FMT='("PNUH=",E13.6)') XNUH
WRITE(UNIT=KLUOUT,FMT='("PALPHAS=",E13.6)') XALPHAS
@@ -1280,18 +1275,18 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("PDS=",E13.6)') XDS
WRITE(UNIT=KLUOUT,FMT='("PFVELOS=",E13.6)') XFVELOS
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
+ RAIN_ICE_PARAMN%XWETLBDAH_MAX
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAS_MAX=",E13.6)') &
- XWETLBDAS_MAX
+ RAIN_ICE_PARAMN%XWETLBDAS_MAX
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
+ RAIN_ICE_PARAMN%XWETLBDAH_MIN
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAS_MIN=",E13.6)') &
- XWETLBDAS_MIN
+ RAIN_ICE_PARAMN%XWETLBDAS_MIN
WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAS
+ DO J1 = 1 , RAIN_ICE_PARAMN%NWETLBDAH
+ DO J2 = 1 , RAIN_ICE_PARAMN%NWETLBDAS
WRITE(UNIT=KLUOUT,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
J1,J2,XKER_SWETH(J1,J2)
END DO
@@ -1310,31 +1305,32 @@ 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.ASSOCIATED(XKER_GWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_GWETH', NWETLBDAH,NWETLBDAG)
+IF( .NOT.ASSOCIATED(XKER_GWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_GWETH', RAIN_ICE_PARAMN%NWETLBDAH,RAIN_ICE_PARAMN%NWETLBDAG)
!
CALL 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 )
-IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
+IF( (KWETLBDAH/=RAIN_ICE_PARAMN%NWETLBDAH) .OR. (KWETLBDAG/=RAIN_ICE_PARAMN%NWETLBDAG) .OR. (KND/=IND) .OR. &
(PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
(PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
(PEHG/=ZEHG) .OR. (PBG/=XBG) .OR. &
(PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCG/=XCG) .OR. (PDG/=XDG) .OR. &
- (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAG_MAX/=XWETLBDAG_MAX) .OR. &
- (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. &
+ (PWETLBDAH_MAX/=RAIN_ICE_PARAMN%XWETLBDAH_MAX) .OR. (PWETLBDAG_MAX/=RAIN_ICE_PARAMN%XWETLBDAG_MAX) .OR. &
+ (PWETLBDAH_MIN/=RAIN_ICE_PARAMN%XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=RAIN_ICE_PARAMN%XWETLBDAG_MIN) .OR. &
(PFDINFTY/=ZFDINFTY) ) THEN
CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, &
ZEHG, XBG, XCH, XDH, 0., XCG, XDG, 0., &
- XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
+ RAIN_ICE_PARAMN%XWETLBDAH_MAX, RAIN_ICE_PARAMN%XWETLBDAG_MAX, &
+ RAIN_ICE_PARAMN%XWETLBDAH_MIN, RAIN_ICE_PARAMN%XWETLBDAG_MIN, &
ZFDINFTY, XKER_GWETH )
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=KLUOUT,FMT='("KWETLBDAG=",I3)') NWETLBDAG
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') RAIN_ICE_PARAMN%NWETLBDAH
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAG=",I3)') RAIN_ICE_PARAMN%NWETLBDAG
WRITE(UNIT=KLUOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
WRITE(UNIT=KLUOUT,FMT='("PNUH=",E13.6)') XNUH
WRITE(UNIT=KLUOUT,FMT='("PALPHAG=",E13.6)') XALPHAG
@@ -1346,18 +1342,18 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("PCG=",E13.6)') XCG
WRITE(UNIT=KLUOUT,FMT='("PDG=",E13.6)') XDG
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
+ RAIN_ICE_PARAMN%XWETLBDAH_MAX
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAG_MAX=",E13.6)') &
- XWETLBDAG_MAX
+ RAIN_ICE_PARAMN%XWETLBDAG_MAX
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
+ RAIN_ICE_PARAMN%XWETLBDAH_MIN
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAG_MIN=",E13.6)') &
- XWETLBDAG_MIN
+ RAIN_ICE_PARAMN%XWETLBDAG_MIN
WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAG
+ DO J1 = 1 , RAIN_ICE_PARAMN%NWETLBDAH
+ DO J2 = 1 , RAIN_ICE_PARAMN%NWETLBDAG
WRITE(UNIT=KLUOUT,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
J1,J2,XKER_GWETH(J1,J2)
END DO
@@ -1376,31 +1372,32 @@ 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.ASSOCIATED(XKER_RWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RWETH', NWETLBDAH,NWETLBDAR)
+IF( .NOT.ASSOCIATED(XKER_RWETH) ) CALL RAIN_ICE_PARAM_ALLOCATE('XKER_RWETH', RAIN_ICE_PARAMN%NWETLBDAH,RAIN_ICE_PARAMN%NWETLBDAR)
!
CALL 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 )
-IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAR/=NWETLBDAR) .OR. (KND/=IND) .OR. &
+IF( (KWETLBDAH/=RAIN_ICE_PARAMN%NWETLBDAH) .OR. (KWETLBDAR/=RAIN_ICE_PARAMN%NWETLBDAR) .OR. (KND/=IND) .OR. &
(PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
(PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
(PEHR/=ZEHR) .OR. (PBR/=XBR) .OR. &
(PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
- (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAR_MAX/=XWETLBDAR_MAX) .OR. &
- (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAR_MIN/=XWETLBDAR_MIN) .OR. &
+ (PWETLBDAH_MAX/=RAIN_ICE_PARAMN%XWETLBDAH_MAX) .OR. (PWETLBDAR_MAX/=RAIN_ICE_PARAMN%XWETLBDAR_MAX) .OR. &
+ (PWETLBDAH_MIN/=RAIN_ICE_PARAMN%XWETLBDAH_MIN) .OR. (PWETLBDAR_MIN/=RAIN_ICE_PARAMN%XWETLBDAR_MIN) .OR. &
(PFDINFTY/=ZFDINFTY) ) THEN
CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAR, XNUR, &
ZEHR, XBR, XCH, XDH, 0., XCR, XDR, 0., &
- XWETLBDAH_MAX, XWETLBDAR_MAX, XWETLBDAH_MIN, XWETLBDAR_MIN, &
+ RAIN_ICE_PARAMN%XWETLBDAH_MAX, RAIN_ICE_PARAMN%XWETLBDAR_MAX, &
+ RAIN_ICE_PARAMN%XWETLBDAH_MIN, RAIN_ICE_PARAMN%XWETLBDAR_MIN, &
ZFDINFTY, XKER_RWETH )
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("**** UPDATE NEW SET OF RWETH KERNELS ****")')
WRITE(UNIT=KLUOUT,FMT='("*****************************************")')
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("KND=",I3)') IND
- WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') NWETLBDAH
- WRITE(UNIT=KLUOUT,FMT='("KWETLBDAR=",I3)') NWETLBDAR
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAH=",I3)') RAIN_ICE_PARAMN%NWETLBDAH
+ WRITE(UNIT=KLUOUT,FMT='("KWETLBDAR=",I3)') RAIN_ICE_PARAMN%NWETLBDAR
WRITE(UNIT=KLUOUT,FMT='("PALPHAH=",E13.6)') XALPHAH
WRITE(UNIT=KLUOUT,FMT='("PNUH=",E13.6)') XNUH
WRITE(UNIT=KLUOUT,FMT='("PALPHAR=",E13.6)') XALPHAR
@@ -1412,18 +1409,18 @@ IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAR/=NWETLBDAR) .OR. (KND/=IND) .OR. &
WRITE(UNIT=KLUOUT,FMT='("PCR=",E13.6)') XCR
WRITE(UNIT=KLUOUT,FMT='("PDR=",E13.6)') XDR
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MAX=",E13.6)') &
- XWETLBDAH_MAX
+ RAIN_ICE_PARAMN%XWETLBDAH_MAX
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAR_MAX=",E13.6)') &
- XWETLBDAR_MAX
+ RAIN_ICE_PARAMN%XWETLBDAR_MAX
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAH_MIN=",E13.6)') &
- XWETLBDAH_MIN
+ RAIN_ICE_PARAMN%XWETLBDAH_MIN
WRITE(UNIT=KLUOUT,FMT='("PWETLBDAR_MIN=",E13.6)') &
- XWETLBDAR_MIN
+ RAIN_ICE_PARAMN%XWETLBDAR_MIN
WRITE(UNIT=KLUOUT,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
WRITE(UNIT=KLUOUT,FMT='("!")')
WRITE(UNIT=KLUOUT,FMT='("IF( PRESENT(PKER_RWETH) ) THEN")')
- DO J1 = 1 , NWETLBDAH
- DO J2 = 1 , NWETLBDAR
+ DO J1 = 1 , RAIN_ICE_PARAMN%NWETLBDAH
+ DO J2 = 1 , RAIN_ICE_PARAMN%NWETLBDAR
WRITE(UNIT=KLUOUT,FMT='("PKER_RWETH(",I3,",",I3,") = ",E13.6)') &
J1,J2,XKER_RWETH(J1,J2)
END DO
@@ -1496,9 +1493,9 @@ CONTAINS
!
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, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PP ! order of the moment
REAL :: PMOMG ! result: moment of order ZP
!
!------------------------------------------------------------------------------
@@ -1512,3 +1509,4 @@ CONTAINS
!
!
END SUBROUTINE INI_RAIN_ICE
+END MODULE MODE_INI_RAIN_ICE
diff --git a/src/PHYEX/micro/mode_ini_snow.f90 b/src/PHYEX/micro/mode_ini_snow.f90
index c61f54a0d762adf2110157acc003e05d11335e4f..313659cb48675e0b94dbbc55f1b026f0ca1bcddd 100644
--- a/src/PHYEX/micro/mode_ini_snow.f90
+++ b/src/PHYEX/micro/mode_ini_snow.f90
@@ -1,7 +1,9 @@
! ######spl
+MODULE MODE_INI_SNOW
+IMPLICIT NONE
+CONTAINS
SUBROUTINE INI_SNOW ( KLUOUT )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ###########################################################
!
!!**** *INI_SNOW * - re-initialize the constants based on snow-size distubutio
@@ -47,9 +49,9 @@
!
USE MODD_CST
USE MODD_PARAMETERS
-USE MODD_PARAM_ICE
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
+USE MODD_PARAM_ICE_n
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_PARAM_n
!
USE MODI_GAMMA
USE MODI_GAMMA_INC
@@ -76,7 +78,7 @@ REAL :: ZRHO00 ! Surface reference air density
REAL :: ZCONC_MAX ! Maximal concentration for snow
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
@@ -145,9 +147,9 @@ CONTAINS
!
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, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PP ! order of the moment
REAL :: PMOMG ! result: moment of order ZP
!
!------------------------------------------------------------------------------
@@ -161,3 +163,4 @@ CONTAINS
!
!
END SUBROUTINE INI_SNOW
+END MODULE MODE_INI_SNOW
diff --git a/src/PHYEX/micro/mode_ini_tiwmx.f90 b/src/PHYEX/micro/mode_ini_tiwmx.f90
index 2e3209a38d5bd88f21ac0fa68d98172da3692d99..1d0ab80f6b5c883ec63f8568cad9368a7867e5fc 100644
--- a/src/PHYEX/micro/mode_ini_tiwmx.f90
+++ b/src/PHYEX/micro/mode_ini_tiwmx.f90
@@ -1,19 +1,19 @@
+MODULE MODE_INI_TIWMX
+IMPLICIT NONE
+CONTAINS
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
+ USE YOMHOOK, ONLY : LHOOK, DR_HOOK, JPHOOK
IMPLICIT NONE
INTEGER :: JK
REAL :: ZTEMP
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('INI_TIWMX',0,ZHOOK_HANDLE)
@@ -53,3 +53,4 @@ SUBROUTINE INI_TIWMX
IF (LHOOK) CALL DR_HOOK('INI_TIWMX',1,ZHOOK_HANDLE)
END SUBROUTINE INI_TIWMX
+END MODULE MODE_INI_TIWMX
diff --git a/src/PHYEX/micro/mode_init_aerosol_properties.f90 b/src/PHYEX/micro/mode_init_aerosol_properties.f90
index f7ea0bad7052595e6ba6b0b7560a40f7205280fa..8664af9f3519e53e54e1edbeb3684d05e92dda1a 100644
--- a/src/PHYEX/micro/mode_init_aerosol_properties.f90
+++ b/src/PHYEX/micro/mode_init_aerosol_properties.f90
@@ -4,13 +4,10 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
- MODULE MODI_INIT_AEROSOL_PROPERTIES
-INTERFACE
- SUBROUTINE INIT_AEROSOL_PROPERTIES
- END SUBROUTINE INIT_AEROSOL_PROPERTIES
-END INTERFACE
-END MODULE MODI_INIT_AEROSOL_PROPERTIES
+ MODULE MODE_INIT_AEROSOL_PROPERTIES
! ####################
+IMPLICIT NONE
+CONTAINS
!
! #############################################################
SUBROUTINE INIT_AEROSOL_PROPERTIES
@@ -52,7 +49,8 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, HINI_CCN, HTYPE_CCN, &
NMOD_IFN, NSPECIE, CIFN_SPECIES, &
XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, XFRAC, XFRAC_REF, &
CINT_MIXING, NPHILLIPS, &
- NIMM, NMOD_IMM, NINDICE_CCN_IMM
+ NIMM, NMOD_IMM, NINDICE_CCN_IMM, &
+ PARAM_LIMA_ALLOCATE, PARAM_LIMA_DEALLOCATE
!
USE MODD_CH_AEROSOL
USE MODD_SALT
@@ -107,9 +105,9 @@ INTEGER :: II, IJ, IK
!
IF ( NMOD_CCN .GE. 1 ) THEN
!
- IF (.NOT.(ALLOCATED(XR_MEAN_CCN))) ALLOCATE(XR_MEAN_CCN(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XLOGSIG_CCN))) ALLOCATE(XLOGSIG_CCN(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XRHO_CCN))) ALLOCATE(XRHO_CCN(NMOD_CCN))
+ IF (.NOT.(ASSOCIATED(XR_MEAN_CCN))) CALL PARAM_LIMA_ALLOCATE('XR_MEAN_CCN', NMOD_CCN)
+ IF (.NOT.(ASSOCIATED(XLOGSIG_CCN))) CALL PARAM_LIMA_ALLOCATE('XLOGSIG_CCN', NMOD_CCN)
+ IF (.NOT.(ASSOCIATED(XRHO_CCN))) CALL PARAM_LIMA_ALLOCATE('XRHO_CCN', NMOD_CCN)
!
SELECT CASE (CCCN_MODES)
CASE ('JUNGFRAU')
@@ -222,10 +220,10 @@ END IF
!* INPUT : XBETAHEN_TEST is in 'percent' and XBETAHEN_MULTI in 'no units',
! XK... and XMU... are invariant
!
- IF (.NOT.(ALLOCATED(XKHEN_MULTI))) ALLOCATE(XKHEN_MULTI(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XMUHEN_MULTI))) ALLOCATE(XMUHEN_MULTI(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XBETAHEN_MULTI))) ALLOCATE(XBETAHEN_MULTI(NMOD_CCN))
- IF (.NOT.(ALLOCATED(XLIMIT_FACTOR))) ALLOCATE(XLIMIT_FACTOR(NMOD_CCN))
+ IF (.NOT.(ASSOCIATED(XKHEN_MULTI))) CALL PARAM_LIMA_ALLOCATE('XKHEN_MULTI', NMOD_CCN)
+ IF (.NOT.(ASSOCIATED(XMUHEN_MULTI))) CALL PARAM_LIMA_ALLOCATE('XMUHEN_MULTI', NMOD_CCN)
+ IF (.NOT.(ASSOCIATED(XBETAHEN_MULTI))) CALL PARAM_LIMA_ALLOCATE('XBETAHEN_MULTI', NMOD_CCN)
+ IF (.NOT.(ASSOCIATED(XLIMIT_FACTOR))) CALL PARAM_LIMA_ALLOCATE('XLIMIT_FACTOR', NMOD_CCN)
!
IF (HINI_CCN == 'CCN') THEN
!!$ IF (LSCAV) THEN
@@ -336,9 +334,9 @@ IF ( NMOD_IFN .GE. 1 ) THEN
SELECT CASE (CIFN_SPECIES)
CASE ('MOCAGE')
NSPECIE = 4
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF (.NOT.(ASSOCIATED(XMDIAM_IFN))) CALL PARAM_LIMA_ALLOCATE('XMDIAM_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XSIGMA_IFN))) CALL PARAM_LIMA_ALLOCATE('XSIGMA_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XRHO_IFN))) CALL PARAM_LIMA_ALLOCATE('XRHO_IFN', NSPECIE)
XMDIAM_IFN = (/ 0.05E-6 , 3.E-6 , 0.016E-6 , 0.016E-6 /)
XSIGMA_IFN = (/ 2.4 , 1.6 , 2.5 , 2.5 /)
XRHO_IFN = (/ 2650. , 2650. , 1000. , 1000. /)
@@ -347,9 +345,9 @@ IF ( NMOD_IFN .GE. 1 ) THEN
! 2 species, dust-metallic and hydrophobic (as BC)
! (Phillips et al. 2013 and GADS data)
NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF (.NOT.(ASSOCIATED(XMDIAM_IFN))) CALL PARAM_LIMA_ALLOCATE('XMDIAM_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XSIGMA_IFN))) CALL PARAM_LIMA_ALLOCATE('XSIGMA_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XRHO_IFN))) CALL PARAM_LIMA_ALLOCATE('XRHO_IFN', NSPECIE)
XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.025E-6, 0.2E-6/)
XSIGMA_IFN = (/2.0, 2.15, 2.0, 1.6 /)
XRHO_IFN = (/2600., 2600., 1000., 1500./)
@@ -358,9 +356,9 @@ IF ( NMOD_IFN .GE. 1 ) THEN
! 2 species, dust-metallic and hydrophobic (as BC)
! (Phillips et al. 2013 and GADS data)
NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF (.NOT.(ASSOCIATED(XMDIAM_IFN))) CALL PARAM_LIMA_ALLOCATE('XMDIAM_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XSIGMA_IFN))) CALL PARAM_LIMA_ALLOCATE('XSIGMA_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XRHO_IFN))) CALL PARAM_LIMA_ALLOCATE('XRHO_IFN', NSPECIE)
XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.8E-6 /)
XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
XRHO_IFN = (/2600., 2600., 1000., 2000. /)
@@ -369,9 +367,9 @@ IF ( NMOD_IFN .GE. 1 ) THEN
! 2 species, dust-metallic and hydrophobic (as BC)
! (Phillips et al. 2013 and GADS data)
NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF (.NOT.(ASSOCIATED(XMDIAM_IFN))) CALL PARAM_LIMA_ALLOCATE('XMDIAM_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XSIGMA_IFN))) CALL PARAM_LIMA_ALLOCATE('XSIGMA_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XRHO_IFN))) CALL PARAM_LIMA_ALLOCATE('XRHO_IFN', NSPECIE)
XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.04E-6/)
XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
XRHO_IFN = (/2600., 2600., 1000., 1800./)
@@ -379,18 +377,18 @@ IF ( NMOD_IFN .GE. 1 ) THEN
IF (NPHILLIPS == 8) THEN
! 4 species, according to Phillips et al. 2008
NSPECIE = 4
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF (.NOT.(ASSOCIATED(XMDIAM_IFN))) CALL PARAM_LIMA_ALLOCATE('XMDIAM_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XSIGMA_IFN))) CALL PARAM_LIMA_ALLOCATE('XSIGMA_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XRHO_IFN))) CALL PARAM_LIMA_ALLOCATE('XRHO_IFN', NSPECIE)
XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.2E-6, 0.2E-6/)
XSIGMA_IFN = (/1.9, 1.6, 1.6, 1.6 /)
XRHO_IFN = (/2300., 2300., 1860., 1500./)
ELSE IF (NPHILLIPS == 13) THEN
! 4 species, according to Phillips et al. 2013
NSPECIE = 4
- IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
- IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF (.NOT.(ASSOCIATED(XMDIAM_IFN))) CALL PARAM_LIMA_ALLOCATE('XMDIAM_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XSIGMA_IFN))) CALL PARAM_LIMA_ALLOCATE('XSIGMA_IFN', NSPECIE)
+ IF (.NOT.(ASSOCIATED(XRHO_IFN))) CALL PARAM_LIMA_ALLOCATE('XRHO_IFN', NSPECIE)
XMDIAM_IFN = (/0.8E-6, 3.0E-6, 90.E-9, 0.163E-6/)
XSIGMA_IFN = (/1.9, 1.6, 1.6, 2.54 /)
XRHO_IFN = (/2300., 2300., 1860., 1000./)
@@ -427,7 +425,7 @@ END IF
!
! internal mixing
!
- IF (.NOT.(ALLOCATED(XFRAC))) ALLOCATE(XFRAC(NSPECIE,NMOD_IFN))
+ IF (.NOT.(ASSOCIATED(XFRAC))) CALL PARAM_LIMA_ALLOCATE('XFRAC', NSPECIE,NMOD_IFN)
XFRAC(:,:)=0.
SELECT CASE (CINT_MIXING)
CASE ('DM1')
@@ -491,7 +489,7 @@ END IF
ENDSELECT
!
! Phillips 08 alpha (table 1)
- IF (.NOT.(ALLOCATED(XFRAC_REF))) ALLOCATE(XFRAC_REF(4))
+ IF (.NOT.(ASSOCIATED(XFRAC_REF))) CALL PARAM_LIMA_ALLOCATE('XFRAC_REF', 4)
IF (NPHILLIPS == 13) THEN
XFRAC_REF(1)=0.66
XFRAC_REF(2)=0.66
@@ -507,3 +505,5 @@ END IF
END IF ! NMOD_IFN > 0
!
END SUBROUTINE INIT_AEROSOL_PROPERTIES
+!
+END MODULE MODE_INIT_AEROSOL_PROPERTIES
diff --git a/src/PHYEX/micro/mode_lima_ccn_activation.f90 b/src/PHYEX/micro/mode_lima_ccn_activation.f90
index 36a2d7384f87d78995a0a580a5dcc07bbb88d1be..38732eee869583c4958e6624ee743a1e322a847f 100644
--- a/src/PHYEX/micro/mode_lima_ccn_activation.f90
+++ b/src/PHYEX/micro/mode_lima_ccn_activation.f90
@@ -74,7 +74,7 @@ USE MODD_PARAM_LIMA, ONLY: LADJ, LACTIT, NMOD_CCN, XCTMIN, XKHEN_MULTI, XRT
USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCSTDCRIT, XHYPF12, &
XHYPINTP1, XHYPINTP2, XTMIN, XHYPF32, XPSI3, XAHENG, XAHENG2, XPSI1, &
XLBC, XLBEXC
-USE MODD_TURB_n, ONLY: LSUBG_COND
+USE MODD_NEB_n, ONLY: LSUBG_COND
!USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_tools, only: Countjv
@@ -136,7 +136,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, &
REAL, DIMENSION(:,:), ALLOCATABLE :: ZTMP, ZCHEN_MULTI
!
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZTDT, ZDRC, ZRVSAT, ZW, ZW2, ZCLDFR
+ :: ZTDT, ZRVSAT, ZW, ZW2, ZCLDFR
REAL, DIMENSION(SIZE(PNFT,1),SIZE(PNFT,2),SIZE(PNFT,3)) &
:: ZCONC_TOT ! total CCN C. available
!
diff --git a/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90 b/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
index 25744d42abb867dfca9935a86bb924329e49ee8e..38f760fc59473f3cad1d4d5ef76083cf52a7bd16 100644
--- a/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
+++ b/src/PHYEX/micro/mode_lima_ccn_hom_freezing.f90
@@ -38,14 +38,11 @@ CONTAINS
USE MODD_CST, ONLY: CST_t
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN
USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
- XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
- XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
- XTEXP4_HONC, XTEXP5_HONC
-USE MODD_PARAM_LIMA_WARM, ONLY: XLBC
+ XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH
!
use mode_tools, only: Countjv
!
@@ -99,11 +96,10 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZNHT ! Nucleated Ice nuclei conc. source
! by Homogeneous freezing of haze
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW, ZT ! work arrays
+ :: ZT ! work arrays
!
REAL, DIMENSION(:), ALLOCATABLE &
:: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
ZZT, & ! Temperature
ZPRES, & ! Pressure
ZEXNREF, & ! EXNer Pressure REFerence
@@ -125,11 +121,11 @@ REAL, DIMENSION(:), ALLOCATABLE &
ZCCNFROZEN
!
INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
-INTEGER :: JL, JMOD_CCN, JMOD_IMM ! Loop index
+INTEGER :: JL, JMOD_CCN ! Loop index
!
INTEGER :: INEGT ! Case number of hom. nucleation
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GNEGT ! Test where to compute the hom. nucleation
+ :: GNEGT ! Test where to compute the hom. nucleation
INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
!
REAL :: ZEPS ! molar mass ratio
diff --git a/src/PHYEX/micro/mode_lima_collisional_ice_breakup.f90 b/src/PHYEX/micro/mode_lima_collisional_ice_breakup.f90
index 58a040f5af64a6c7b1b780d32a0b6ea0a448709a..35542d9c2ccdd6c56aa86219a830cf8a127824d1 100644
--- a/src/PHYEX/micro/mode_lima_collisional_ice_breakup.f90
+++ b/src/PHYEX/micro/mode_lima_collisional_ice_breakup.f90
@@ -36,7 +36,7 @@ CONTAINS
USE MODD_PARAM_LIMA, ONLY : LCIBU, XRTMIN, XCTMIN, XCEXVT, XALPHAS, XNUS, XNDEBRIS_CIBU
USE MODD_PARAM_LIMA_COLD, ONLY : XBS, XCS, XDS, XFVELOS, XMNU0
-USE MODD_PARAM_LIMA_MIXED, ONLY : XCG, XDG, XCXG, &
+USE MODD_PARAM_LIMA_MIXED, ONLY : XCG, XDG, &
XCIBUINTP_S, XCIBUINTP1_S, XCIBUINTP2_S, &
XCIBUINTP_G, XCIBUINTP1_G, &
XFACTOR_CIBU_NI, XFACTOR_CIBU_RI, &
diff --git a/src/PHYEX/micro/mode_lima_compute_cloud_fractions.f90 b/src/PHYEX/micro/mode_lima_compute_cloud_fractions.f90
index 98ac4ae517cd8b246674fd551efabd46b21cd441..325e04864aa96085cebf933f563936ab68cde7cd 100644
--- a/src/PHYEX/micro/mode_lima_compute_cloud_fractions.f90
+++ b/src/PHYEX/micro/mode_lima_compute_cloud_fractions.f90
@@ -69,7 +69,6 @@ REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PPRCFR !
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: JI, JJ, JK
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/mode_lima_conversion_melting_snow.f90 b/src/PHYEX/micro/mode_lima_conversion_melting_snow.f90
index 0921e3f73188b680251bbae80789d0f74870c35c..32537b585e8663dafafcc2499113e27100a67722 100644
--- a/src/PHYEX/micro/mode_lima_conversion_melting_snow.f90
+++ b/src/PHYEX/micro/mode_lima_conversion_melting_snow.f90
@@ -38,7 +38,7 @@ CONTAINS
USE MODD_CST, ONLY : XTT, XMV, XMD, XLVTT, XCPV, XCL, XESTT, XRV
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XNUS, XALPHAS
USE MODD_PARAM_LIMA_MIXED, ONLY : XFSCVMG
-USE MODD_PARAM_LIMA_COLD, ONLY : X0DEPS, XEX0DEPS, X1DEPS, XEX1DEPS, XBS, XFVELOS
+USE MODD_PARAM_LIMA_COLD, ONLY : X0DEPS, XEX0DEPS, X1DEPS, XEX1DEPS, XFVELOS
!
IMPLICIT NONE
!
diff --git a/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90 b/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
index 70ab95d4787ed23f3b4e12fb544d6c25f3edcf40..9974166a1111a0ed9f0815781a6333b6eac5661e 100644
--- a/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
+++ b/src/PHYEX/micro/mode_lima_droplets_riming_snow.f90
@@ -42,7 +42,7 @@ USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, XNUS, XALPHAS, LMURAKA
USE MODD_PARAM_LIMA_MIXED, ONLY : NGAMINC, XRIMINTP1, XRIMINTP2, XGAMINC_RIM1, XGAMINC_RIM2, XGAMINC_RIM4, &
XCRIMSS, XEXCRIMSS, XSRIMCG, XEXSRIMCG, XSRIMCG2, XSRIMCG3, XEXSRIMCG2, &
XHMLINTP1, XHMLINTP2, XGAMINC_HMC, XHM_FACTS, XHMTMIN, XHMTMAX
-USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0, XBS, XFVELOS
+USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0, XFVELOS
!
IMPLICIT NONE
!
@@ -78,7 +78,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
!
REAL, DIMENSION(SIZE(PRCT)) :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5
!
-INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC1,IVEC2 ! Vectors of indices
+INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC2 ! Vector of indices
REAL, DIMENSION(SIZE(PRCT)) :: ZVEC1,ZVEC2,ZVEC1W ! Work vectors
INTEGER :: JI
!
diff --git a/src/PHYEX/micro/mode_lima_drops_break_up.f90 b/src/PHYEX/micro/mode_lima_drops_break_up.f90
index e2b36c2ab18e6bfa233bd9c9e27f5c40bbb62927..67f119b54563f20013621a6fa30afb911a43185e 100644
--- a/src/PHYEX/micro/mode_lima_drops_break_up.f90
+++ b/src/PHYEX/micro/mode_lima_drops_break_up.f90
@@ -52,7 +52,6 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_CR ! Cumulated concentrati
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(SIZE(PCRT)) :: ZWLBDR,ZWLBDR3
-INTEGER :: JL
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/mode_lima_drops_to_droplets_conv.f90 b/src/PHYEX/micro/mode_lima_drops_to_droplets_conv.f90
index 808bed2403a360d48509250e1925cea5d12a25ca..daaf68b457e58724983dc01d88d162d60ab56bbf 100644
--- a/src/PHYEX/micro/mode_lima_drops_to_droplets_conv.f90
+++ b/src/PHYEX/micro/mode_lima_drops_to_droplets_conv.f90
@@ -33,8 +33,6 @@ CONTAINS
!
USE MODD_CST, ONLY : CST_t
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBR, XLBEXR, XLBC, XLBEXC, &
- XACCR1, XACCR3, XACCR4, XACCR5
!
IMPLICIT NONE
!
@@ -58,7 +56,6 @@ REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) :: ZDR
!
LOGICAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) :: ZMASKR, ZMASKC
!
-REAL :: ZFACT
!
!
!
diff --git a/src/PHYEX/micro/mode_lima_functions.f90 b/src/PHYEX/micro/mode_lima_functions.f90
index c65e6e23cbca066c1e02102e150f1284118134eb..59e1896d96293e6843fa11bb3942c45e7a19128b 100644
--- a/src/PHYEX/micro/mode_lima_functions.f90
+++ b/src/PHYEX/micro/mode_lima_functions.f90
@@ -19,9 +19,9 @@ CONTAINS
! 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, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PP ! order of the moment
REAL :: PMOMG ! result: moment of order ZP
PMOMG = GAMMA_X0D(PNU+PP/PALPHA)/GAMMA_X0D(PNU)
END FUNCTION MOMG
@@ -103,8 +103,10 @@ CONTAINS
!
SUBROUTINE gaulag(x,w,n,alf)
use modd_precision, only: MNHREAL64
- INTEGER n,MAXIT
- REAL alf,w(n),x(n)
+ INTEGER, intent(in) :: n
+ INTEGER MAXIT
+ REAL, intent(IN) :: alf
+ REAL, intent(out) :: w(n),x(n)
REAL(kind=MNHREAL64) :: EPS
PARAMETER (EPS=3.D-14,MAXIT=10)
INTEGER i,its,j
@@ -155,8 +157,9 @@ END SUBROUTINE gaulag
!
SUBROUTINE gauher(x,w,n)
use modd_precision, only: MNHREAL64
- INTEGER n,MAXIT
- REAL w(n),x(n)
+ INTEGER, intent(in) :: n
+ INTEGER MAXIT
+ REAL, intent(out) :: w(n),x(n)
REAL(kind=MNHREAL64) :: EPS,PIM4
PARAMETER (EPS=3.D-14,PIM4=.7511255444649425D0,MAXIT=10)
INTEGER i,its,j,m
diff --git a/src/PHYEX/micro/mode_lima_graupel.f90 b/src/PHYEX/micro/mode_lima_graupel.f90
index 42dfa71fbae577e18dab94b672e7be2cb42dae02..84f56e43dc2e839cde629f0c423da950d8b6064c 100644
--- a/src/PHYEX/micro/mode_lima_graupel.f90
+++ b/src/PHYEX/micro/mode_lima_graupel.f90
@@ -46,9 +46,9 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XTT, XMD, XMV, XRD, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
+USE MODD_CST, ONLY : XTT, XMD, XMV, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, NMOM_H
-USE MODD_PARAM_LIMA_MIXED, ONLY : XCXG, XDG, X0DEPG, X1DEPG, NGAMINC, &
+USE MODD_PARAM_LIMA_MIXED, ONLY : XDG, X0DEPG, X1DEPG, NGAMINC, &
XFCDRYG, XFIDRYG, XCOLIG, XCOLSG, XCOLEXIG, XCOLEXSG, &
XFSDRYG, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XKER_SDRYG, &
XFNSDRYG, XLBNSDRYG1, XLBNSDRYG2, XLBNSDRYG3, XKER_N_SDRYG, &
@@ -59,7 +59,7 @@ USE MODD_PARAM_LIMA_MIXED, ONLY : XCXG, XDG, X0DEPG, X1DEPG, NGAMINC,
XDRYINTP1R, XDRYINTP1S, XDRYINTP1G, &
XDRYINTP2R, XDRYINTP2S, XDRYINTP2G, &
NDRYLBDAR, NDRYLBDAS, NDRYLBDAG
-USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0, XCXS, XBS
+USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
!
IMPLICIT NONE
!
@@ -146,8 +146,6 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_CH
!* 0.2 Declarations of local variables :
!
LOGICAL, DIMENSION(SIZE(PRCT)) :: GDRY
-INTEGER :: IGDRY
-INTEGER :: JJ
!
REAL, DIMENSION(SIZE(PRCT)) :: Z1, Z2, Z3, Z4
REAL, DIMENSION(SIZE(PRCT)) :: ZZX, ZZW, ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, ZZW7
@@ -513,8 +511,8 @@ PA_TH(:) = PA_TH(:) + P_TH_WETG(:) + P_TH_DRYG(:) + P_TH_GMLT(:)
!
CONTAINS
FUNCTION GET_XKER_SDRYG(GRAUPEL,SNOW) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: SNOW
+ INTEGER, DIMENSION(:), INTENT(IN) :: GRAUPEL
+ INTEGER, DIMENSION(:), INTENT(IN) :: SNOW
REAL, DIMENSION(SIZE(SNOW)) :: RET
!
INTEGER I
@@ -527,8 +525,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_N_SDRYG(GRAUPEL,SNOW) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: SNOW
+ INTEGER, DIMENSION(:), INTENT(IN) :: GRAUPEL
+ INTEGER, DIMENSION(:), INTENT(IN) :: SNOW
REAL, DIMENSION(SIZE(SNOW)) :: RET
!
INTEGER I
@@ -541,8 +539,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_RDRYG(GRAUPEL,RAIN) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: RAIN
+ INTEGER, DIMENSION(:), INTENT(IN) :: GRAUPEL
+ INTEGER, DIMENSION(:), INTENT(IN) :: RAIN
REAL, DIMENSION(SIZE(RAIN)) :: RET
!
INTEGER I
@@ -555,8 +553,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_N_RDRYG(GRAUPEL,RAIN) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: RAIN
+ INTEGER, DIMENSION(:), INTENT(IN) :: GRAUPEL
+ INTEGER, DIMENSION(:), INTENT(IN) :: RAIN
REAL, DIMENSION(SIZE(RAIN)) :: RET
!
INTEGER I
diff --git a/src/PHYEX/micro/mode_lima_hail.f90 b/src/PHYEX/micro/mode_lima_hail.f90
index 4d1fef9038708a7578e9491e8cccc2b215d2fb65..7c0231d89ae203c89aaedf4e014bb86e85b232ce 100644
--- a/src/PHYEX/micro/mode_lima_hail.f90
+++ b/src/PHYEX/micro/mode_lima_hail.f90
@@ -44,7 +44,7 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XTT, XMD, XMV, XRD, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
+USE MODD_CST, ONLY : XTT, XMD, XMV, XRV, XLVTT, XLMTT, XESTT, XCL, XCI, XCPV
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT
USE MODD_PARAM_LIMA_MIXED, ONLY : NWETLBDAG, XWETINTP1G, XWETINTP2G, &
NWETLBDAH, X0DEPH, X1DEPH, XDH, XEX0DEPH, XEX1DEPH, &
@@ -56,7 +56,6 @@ USE MODD_PARAM_LIMA_MIXED, ONLY : NWETLBDAG, XWETINTP1G, XWETINTP2G, &
XFGWETH, XLBGWETH1, XLBGWETH2, XLBGWETH3, &
XFNGWETH, XLBNGWETH1, XLBNGWETH2, XLBNGWETH3
-USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0, XCXS, XBS
!
IMPLICIT NONE
!
@@ -134,17 +133,15 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_CH
!* 0.2 Declarations of local variables :
!
LOGICAL, DIMENSION(SIZE(PRCT)) :: GWET
-INTEGER :: JJ
!
REAL, DIMENSION(SIZE(PRCT)) :: Z1, Z2, Z3, Z4
-REAL, DIMENSION(SIZE(PRCT)) :: ZZX, ZZW, ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6
-REAL, DIMENSION(SIZE(PRCT)) :: ZZW3N, ZZW4N, ZZW6N
+REAL, DIMENSION(SIZE(PRCT)) :: ZZW, ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6
+REAL, DIMENSION(SIZE(PRCT)) :: ZZW3N, ZZW4N
REAL, DIMENSION(SIZE(PRCT)) :: ZRWETH
!
INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC1,IVEC2 ! Vectors of indices
REAL, DIMENSION(SIZE(PRCT)) :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors
!
-INTEGER :: NHAIL
REAL :: ZTHRH, ZTHRC
!
!-------------------------------------------------------------------------------
@@ -430,8 +427,8 @@ PA_TH(:) = PA_TH(:) + P_TH_WETH(:) + P_TH_HMLT(:)
!
CONTAINS
FUNCTION GET_XKER_SWETH(GRAUPEL,SNOW) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: SNOW
+ INTEGER, DIMENSION(:), INTENT(IN) :: GRAUPEL
+ INTEGER, DIMENSION(:), INTENT(IN) :: SNOW
REAL, DIMENSION(SIZE(SNOW)) :: RET
!
INTEGER I
@@ -444,8 +441,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_N_SWETH(GRAUPEL,SNOW) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: SNOW
+ INTEGER, DIMENSION(:), INTENT(IN) :: GRAUPEL
+ INTEGER, DIMENSION(:), INTENT(IN) :: SNOW
REAL, DIMENSION(SIZE(SNOW)) :: RET
!
INTEGER I
@@ -458,8 +455,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_GWETH(GRAUPEL,SNOW) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: SNOW
+ INTEGER, DIMENSION(:), INTENT(IN) :: GRAUPEL
+ INTEGER, DIMENSION(:), INTENT(IN) :: SNOW
REAL, DIMENSION(SIZE(SNOW)) :: RET
!
INTEGER I
@@ -472,8 +469,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_N_GWETH(GRAUPEL,SNOW) RESULT(RET)
- INTEGER, DIMENSION(:) :: GRAUPEL
- INTEGER, DIMENSION(:) :: SNOW
+ INTEGER, DIMENSION(:), INTENT(IN) :: GRAUPEL
+ INTEGER, DIMENSION(:), INTENT(IN) :: SNOW
REAL, DIMENSION(SIZE(SNOW)) :: RET
!
INTEGER I
diff --git a/src/PHYEX/micro/mode_lima_ice4_nucleation.f90 b/src/PHYEX/micro/mode_lima_ice4_nucleation.f90
index 082b3c3e5f86ba5343e2bf2a243c58feb3a98253..387280c4b13619ef2d9e1cdbd43fd6a5b152a408 100644
--- a/src/PHYEX/micro/mode_lima_ice4_nucleation.f90
+++ b/src/PHYEX/micro/mode_lima_ice4_nucleation.f90
@@ -29,8 +29,7 @@ SUBROUTINE LIMA_ICE4_NUCLEATION(CST, KSIZE, &
! ------------
!
USE MODD_CST, ONLY: CST_t
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_PARAM_LIMA_COLD, ONLY : XALPHA1, XBETA1, XALPHA2, XBETA2, XNU10, XNU20, XMNU0
USE MODD_PARAM_LIMA, ONLY: LFEEDBACKT, XRTMIN
!
@@ -53,7 +52,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due
!* 0.2 declaration of local variables
!
REAL, DIMENSION(KSIZE) :: ZW ! work array
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
ZUSW, & ! Undersaturation over water
diff --git a/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90 b/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
index 03f4c10b228955877104f014612422e0374ce9d2..c442ab8b02965cbbf95a0a20709632085783b02b 100644
--- a/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
+++ b/src/PHYEX/micro/mode_lima_ice_aggregation_snow.f90
@@ -38,8 +38,8 @@ CONTAINS
!
USE MODD_CST, ONLY : XTT
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT, NMOM_I, XNUS, XALPHAS, XCEXVT
-USE MODD_PARAM_LIMA_COLD, ONLY : XBI, XCCS, XCXS, XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
- XAGGS_RLARGE1, XAGGS_RLARGE2, XFIAGGS, XBS, XNS, XFVELOS, XEXIAGGS
+USE MODD_PARAM_LIMA_COLD, ONLY : XBI, XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2, XFIAGGS, XFVELOS, XEXIAGGS
!
IMPLICIT NONE
!
diff --git a/src/PHYEX/micro/mode_lima_ice_deposition.f90 b/src/PHYEX/micro/mode_lima_ice_deposition.f90
index ed7540ca238a6898c0c9c4a61ac52eaad60d2035..99ea4469cca24a3066f51ca7ee305a3558130b26 100644
--- a/src/PHYEX/micro/mode_lima_ice_deposition.f90
+++ b/src/PHYEX/micro/mode_lima_ice_deposition.f90
@@ -40,15 +40,10 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS,&
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XNUI, &
NMOM_I, NMOM_S
-USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
- XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
- XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
- XSCFAC, XDICNVS_LIM, XLBDAICNVS_LIM, &
+USE MODD_PARAM_LIMA_COLD, ONLY : XDICNVS_LIM, XLBDAICNVS_LIM, &
XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
- XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
- XAGGS_RLARGE1, XAGGS_RLARGE2, &
XDI, X0DEPI, X2DEPI
USE MODD_CST, ONLY : XTT
!
diff --git a/src/PHYEX/micro/mode_lima_init_ccn_activation_spectrum.f90 b/src/PHYEX/micro/mode_lima_init_ccn_activation_spectrum.f90
index c11b9222e8a25524ee32b40d0a16b49c0abd7077..a706525749d8ca10a8ea1ab46481cc58927d683c 100644
--- a/src/PHYEX/micro/mode_lima_init_ccn_activation_spectrum.f90
+++ b/src/PHYEX/micro/mode_lima_init_ccn_activation_spectrum.f90
@@ -230,10 +230,9 @@ REAL :: PZRIDDR
!
!
INTEGER, PARAMETER :: MAXIT=60
-REAL, PARAMETER :: UNUSED=0.0 !-1.11e30
REAL :: fh,fl, fm,fnew
REAL :: s,xh,xl,xm,xnew
-INTEGER :: j, JL
+INTEGER :: j
!
PZRIDDR= 999999.
fl = DSDD(PX1,XDDRY,XKAPPA,XT)
@@ -397,17 +396,17 @@ END FUNCTION DSDD
!
!* 0.1 declarations of arguments and result
!
- integer M
- integer N
- real X(N)
- real FVEC(M)
- integer IFLAG
+ integer, intent(in) :: M
+ integer, intent(in) :: N
+ real, intent(in) :: X(N)
+ real, intent(out) :: FVEC(M)
+ integer, intent(inout) :: IFLAG
!
!* 0.2 declarations of local variables
!
integer I
real C
- real ZW, ZW2
+ real ZW
!
! print *, "X = ", X
IF ( ANY(X .LT.0.) .OR. X(1).gt.2*X(2)) THEN
diff --git a/src/PHYEX/micro/mode_lima_nucleation_procs.f90 b/src/PHYEX/micro/mode_lima_nucleation_procs.f90
index 7bb5431361d9da3ab465178815ae9eed43e56d30..58f9212cc92f27eeca5fb93952f8a5e476357ba9 100644
--- a/src/PHYEX/micro/mode_lima_nucleation_procs.f90
+++ b/src/PHYEX/micro/mode_lima_nucleation_procs.f90
@@ -39,13 +39,11 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
use modd_budget, only: NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1
-!USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
USE MODD_PARAM_LIMA, ONLY : LNUCL, LMEYERS, LACTI, LHHONI, &
NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO, NMOM_I, NMOM_C
-USE MODD_TURB_n, ONLY : LSUBG_COND
+USE MODD_NEB_n, ONLY : LSUBG_COND
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
diff --git a/src/PHYEX/micro/mode_lima_phillips_ifn_nucleation.f90 b/src/PHYEX/micro/mode_lima_phillips_ifn_nucleation.f90
index 37d4b321f11f73814c63fb5fd163bd87b9ecf614..41b8b5762cf9f83d9fbe762a21061fcfff7133ae 100644
--- a/src/PHYEX/micro/mode_lima_phillips_ifn_nucleation.f90
+++ b/src/PHYEX/micro/mode_lima_phillips_ifn_nucleation.f90
@@ -75,7 +75,7 @@ USE MODD_CST, ONLY: CST_t
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
- XDSI0, XRTMIN, XCTMIN, NPHILLIPS
+ XDSI0, NPHILLIPS
USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
use mode_tools, only: Countjv
@@ -149,7 +149,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIT ! Nucleated Ice nuclei conc. source
!
REAL, DIMENSION(:), ALLOCATABLE &
:: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
ZZT, & ! Temperature
ZPRES, & ! Pressure
ZEXNREF, & ! EXNer Pressure REFerence
diff --git a/src/PHYEX/micro/mode_lima_rain_accr_snow.f90 b/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
index 66f06a67fe17542a7f11409800e09a9ea9f75d8e..6c83bf6cd49554c08f21caed8d9d6258be9d5fd5 100644
--- a/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
+++ b/src/PHYEX/micro/mode_lima_rain_accr_snow.f90
@@ -281,8 +281,8 @@ END WHERE
!
CONTAINS
FUNCTION GET_XKER_RACCSS(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
+ INTEGER, DIMENSION(:), INTENT(IN) :: I1
+ INTEGER, DIMENSION(:), INTENT(IN) :: I2
REAL, DIMENSION(SIZE(I1)) :: RET
!
INTEGER I
@@ -295,8 +295,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_N_RACCSS(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
+ INTEGER, DIMENSION(:), INTENT(IN) :: I1
+ INTEGER, DIMENSION(:), INTENT(IN) :: I2
REAL, DIMENSION(SIZE(I1)) :: RET
!
INTEGER I
@@ -309,8 +309,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_RACCS(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
+ INTEGER, DIMENSION(:), INTENT(IN) :: I1
+ INTEGER, DIMENSION(:), INTENT(IN) :: I2
REAL, DIMENSION(SIZE(I1)) :: RET
!
INTEGER I
@@ -323,8 +323,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_N_RACCS(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
+ INTEGER, DIMENSION(:), INTENT(IN) :: I1
+ INTEGER, DIMENSION(:), INTENT(IN) :: I2
REAL, DIMENSION(SIZE(I1)) :: RET
!
INTEGER I
@@ -337,8 +337,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_SACCRG(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
+ INTEGER, DIMENSION(:), INTENT(IN) :: I1
+ INTEGER, DIMENSION(:), INTENT(IN) :: I2
REAL, DIMENSION(SIZE(I1)) :: RET
!
INTEGER I
@@ -351,8 +351,8 @@ CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION GET_XKER_N_SACCRG(I1,I2) RESULT(RET)
- INTEGER, DIMENSION(:) :: I1
- INTEGER, DIMENSION(:) :: I2
+ INTEGER, DIMENSION(:), INTENT(IN) :: I1
+ INTEGER, DIMENSION(:), INTENT(IN) :: I2
REAL, DIMENSION(SIZE(I1)) :: RET
!
INTEGER I
diff --git a/src/PHYEX/micro/mode_lima_sedimentation.f90 b/src/PHYEX/micro/mode_lima_sedimentation.f90
index dc6164d492aedbacd1aa7819285d9289d210e909..1efeb31919684052c0a3fe5ba224450e668fb0e9 100644
--- a/src/PHYEX/micro/mode_lima_sedimentation.f90
+++ b/src/PHYEX/micro/mode_lima_sedimentation.f90
@@ -47,12 +47,11 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
XLB, XLBEX, XD, XFSEDR, XFSEDC, &
XALPHAC, XNUC, XALPHAS, XNUS, LSNOW_T, &
NMOM_S
-USE MODD_PARAM_LIMA_COLD, ONLY: XLBEXI, XLBI, XDI, XLBDAS_MAX, XBS, XEXSEDS, &
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBDAS_MAX, XBS, &
XLBDAS_MIN, XTRANS_MP_GAMMAS, XFVELOS
use mode_tools, only: Countjv
diff --git a/src/PHYEX/micro/mode_lima_snow_deposition.f90 b/src/PHYEX/micro/mode_lima_snow_deposition.f90
index 0a520c063aa1e96b4c6631a836ab3c4470b62023..c45153e9e817098e2f0dbaebdd43829dd08efaf2 100644
--- a/src/PHYEX/micro/mode_lima_snow_deposition.f90
+++ b/src/PHYEX/micro/mode_lima_snow_deposition.f90
@@ -42,15 +42,11 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS, NMOM_I
-USE MODD_PARAM_LIMA_COLD, ONLY : XNS,XBS, &
- XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAS, XNUS, NMOM_I
+USE MODD_PARAM_LIMA_COLD, ONLY : 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, XFVELOS
+ X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XFVELOS
!
IMPLICIT NONE
diff --git a/src/PHYEX/micro/mode_lima_snow_self_collection.f90 b/src/PHYEX/micro/mode_lima_snow_self_collection.f90
index 50339a87f9cfab882ee4e4ea81fea509d1aebfd2..1a3bdb581aedd1a875c96665989f8f6c1747a220 100644
--- a/src/PHYEX/micro/mode_lima_snow_self_collection.f90
+++ b/src/PHYEX/micro/mode_lima_snow_self_collection.f90
@@ -61,8 +61,8 @@ REAL, DIMENSION(SIZE(PCST)) :: &
ZW2
LOGICAL, DIMENSION(SIZE(PCST)) :: GSSC
INTEGER :: IGSSC, JJ
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices
-REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1, ZVEC3 ! Work vectors
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/micro/mode_lima_tendencies.f90 b/src/PHYEX/micro/mode_lima_tendencies.f90
index d25250bcc03b6020789d727a7b4d915fce8ef20c..cbfde662f9a2a3c67c487e313b5199da0dd7ebc1 100644
--- a/src/PHYEX/micro/mode_lima_tendencies.f90
+++ b/src/PHYEX/micro/mode_lima_tendencies.f90
@@ -72,13 +72,12 @@ CONTAINS
!
USE MODD_CST, ONLY : XP00, XRD, XRV, XMD, XMV, XCPD, XCPV, XCL, XCI, XLVTT, XLSTT, XTT, &
XALPW, XBETAW, XGAMW, XALPI, XBETAI, XGAMI
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XNUS, LCIBU, LRDSF, &
- LNUCL, LACTI, LKHKO, LSNOW_T, &
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LCIBU, LRDSF, LKHKO, LSNOW_T, &
NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR, XCCR, XCXR
-USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XCCG, XCXG, XLBH, XLBEXH, XCCH, XCXH, XLBDAG_MAX
+USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XCCG, XCXG, XLBH, XLBEXH, XCCH, XCXH
USE MODD_PARAM_LIMA_COLD, ONLY : XSCFAC, XLBI, XLBEXI, XLBS, XLBEXS, XLBDAS_MAX, XTRANS_MP_GAMMAS, &
- XFVELOS, XLBDAS_MIN, XCCS, XCXS, XBS, XNS
+ XLBDAS_MIN, XCCS, XCXS, XBS, XNS
!
USE MODE_LIMA_DROPLETS_HOM_FREEZING, ONLY: LIMA_DROPLETS_HOM_FREEZING
USE MODE_LIMA_DROPLETS_SELF_COLLECTION, ONLY: LIMA_DROPLETS_SELF_COLLECTION
diff --git a/src/PHYEX/micro/mode_lima_update_nsv.f90 b/src/PHYEX/micro/mode_lima_update_nsv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b6d507d2cb5dd8f9d14ad2e265ff658c34b00c40
--- /dev/null
+++ b/src/PHYEX/micro/mode_lima_update_nsv.f90
@@ -0,0 +1,188 @@
+!MNH_LIC Copyright 1995-2023 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+MODULE MODE_LIMA_UPDATE_NSV
+!> @file
+!! This module contains code to update the NSV module variable relative to the LIMA scheme
+!
+IMPLICIT NONE
+!
+CONTAINS
+!
+SUBROUTINE LIMA_UPDATE_NSV(LDINIT, KMI, KSV, CDCLOUD, LDUPDATE)
+!!*** *LIMA_UPDATE_NSV* - update modd_nsv values realtive to LIMA
+!!
+!!* PURPOSE
+!! -------
+!! The modd_nsv values relative to the LIMA scheme are initialised (if LDINIT is .TRUE)
+!! according to the micromisics scheme used.
+!! If LDUPDATE is .TRUE., the scalar values of modd_nsv module receive the values
+!! assigned for the KMI model.
+!!
+!!* METHOD
+!! ------
+!!
+!!* EXTERNAL
+!! --------
+!!
+!!* IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_NSV, MODD_PARAM_LIMA
+!!
+!!* REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original April 2023
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODD_NSV, ONLY: NSV_LIMA_BEG_A, NSV_LIMA_END_A, NSV_LIMA_A, &
+ & NSV_LIMA_NC_A, NSV_LIMA_NR_A, NSV_LIMA_NI_A, NSV_LIMA_NS_A, NSV_LIMA_NG_A, NSV_LIMA_NH_A, &
+ & NSV_LIMA_CCN_FREE_A, NSV_LIMA_CCN_ACTI_A, NSV_LIMA_SCAVMASS_A, &
+ & NSV_LIMA_IFN_FREE_A, NSV_LIMA_IFN_NUCL_A, NSV_LIMA_IMM_NUCL_A, &
+ & NSV_LIMA_HOM_HAZE_A, NSV_LIMA_SPRO_A, &
+ & NSV_LIMA_BEG, NSV_LIMA_END, NSV_LIMA, &
+ & NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
+ & NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, NSV_LIMA_SCAVMASS, &
+ & NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, &
+ & NSV_LIMA_HOM_HAZE, NSV_LIMA_SPRO
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, LSCAV, LAERO_MASS, &
+ NMOD_IFN, NMOD_IMM, LHHONI, &
+ LSPRO, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+IMPLICIT NONE
+LOGICAL, INTENT(IN) :: LDINIT !< .TRUE. to fill the different NSV_LIMA_*_A arrays
+INTEGER, INTENT(IN) :: KMI !< model number
+INTEGER, INTENT(INOUT) :: KSV !< IN: Initial value to use when filling the NSV_LIMA_*_A arrays;
+ !! OUT: Final value after having filled the arrays
+CHARACTER(LEN=4), INTENT(IN) :: CDCLOUD !< Cloud scheme
+LOGICAL, INTENT(IN) :: LDUPDATE !< .TRUE. to goto model
+!
+!* 1. INITIALISATION
+! -----------------
+!
+IF(LDINIT) THEN
+ IF(CDCLOUD=='LIMA') THEN
+ KSV = KSV+1
+ NSV_LIMA_BEG_A(KMI) = KSV
+ ! Nc
+ IF (NMOM_C.GE.2) THEN
+ NSV_LIMA_NC_A(KMI) = KSV
+ KSV = KSV+1
+ END IF
+ ! Nr
+ IF (NMOM_R.GE.2) THEN
+ NSV_LIMA_NR_A(KMI) = KSV
+ KSV = KSV+1
+ END IF
+ ! CCN
+ IF (NMOD_CCN .GT. 0) THEN
+ NSV_LIMA_CCN_FREE_A(KMI) = KSV
+ KSV = KSV + NMOD_CCN
+ NSV_LIMA_CCN_ACTI_A(KMI) = KSV
+ KSV = KSV + NMOD_CCN
+ END IF
+ ! Scavenging
+ IF (LSCAV .AND. LAERO_MASS) THEN
+ NSV_LIMA_SCAVMASS_A(KMI) = KSV
+ KSV = KSV+1
+ END IF
+ ! Ni
+ IF (NMOM_I.GE.2) THEN
+ NSV_LIMA_NI_A(KMI) = KSV
+ KSV = KSV+1
+ END IF
+ ! Ns
+ IF (NMOM_S.GE.2) THEN
+ NSV_LIMA_NS_A(KMI) = KSV
+ KSV = KSV+1
+ END IF
+ ! Ng
+ IF (NMOM_G.GE.2) THEN
+ NSV_LIMA_NG_A(KMI) = KSV
+ KSV = KSV+1
+ END IF
+ ! Nh
+ IF (NMOM_H.GE.2) THEN
+ NSV_LIMA_NH_A(KMI) = KSV
+ KSV = KSV+1
+ END IF
+ ! IFN
+ IF (NMOD_IFN .GT. 0) THEN
+ NSV_LIMA_IFN_FREE_A(KMI) = KSV
+ KSV = KSV + NMOD_IFN
+ NSV_LIMA_IFN_NUCL_A(KMI) = KSV
+ KSV = KSV + NMOD_IFN
+ END IF
+ ! IMM
+ IF (NMOD_IMM .GT. 0) THEN
+ NSV_LIMA_IMM_NUCL_A(KMI) = KSV
+ KSV = KSV + MAX(1,NMOD_IMM)
+ END IF
+ ! Homogeneous freezing of CCN
+ IF (LHHONI) THEN
+ NSV_LIMA_HOM_HAZE_A(KMI) = KSV
+ KSV = KSV + 1
+ END IF
+ ! Supersaturation
+ IF (LSPRO) THEN
+ NSV_LIMA_SPRO_A(KMI) = KSV
+ KSV = KSV + 1
+ END IF
+ !
+ ! End and total variables
+ !
+ KSV = KSV - 1
+ NSV_LIMA_END_A(KMI) = KSV
+ NSV_LIMA_A(KMI) = NSV_LIMA_END_A(KMI) - NSV_LIMA_BEG_A(KMI) + 1
+ ELSE
+ NSV_LIMA_A(KMI) = 0
+ !
+ ! force First index to be superior to last index
+ ! in order to create a null section
+ !
+ NSV_LIMA_BEG_A(KMI) = 1
+ NSV_LIMA_END_A(KMI) = 0
+ ENDIF
+ENDIF
+!
+!* 2. UPDATE
+! ---------
+!
+IF(LDUPDATE) THEN
+ NSV_LIMA = NSV_LIMA_A(KMI)
+ NSV_LIMA_BEG = NSV_LIMA_BEG_A(KMI)
+ NSV_LIMA_END = NSV_LIMA_END_A(KMI)
+ NSV_LIMA_NC = NSV_LIMA_NC_A(KMI)
+ NSV_LIMA_NR = NSV_LIMA_NR_A(KMI)
+ NSV_LIMA_CCN_FREE = NSV_LIMA_CCN_FREE_A(KMI)
+ NSV_LIMA_CCN_ACTI = NSV_LIMA_CCN_ACTI_A(KMI)
+ NSV_LIMA_SCAVMASS = NSV_LIMA_SCAVMASS_A(KMI)
+ NSV_LIMA_NI = NSV_LIMA_NI_A(KMI)
+ NSV_LIMA_NS = NSV_LIMA_NS_A(KMI)
+ NSV_LIMA_NG = NSV_LIMA_NG_A(KMI)
+ NSV_LIMA_NH = NSV_LIMA_NH_A(KMI)
+ NSV_LIMA_IFN_FREE = NSV_LIMA_IFN_FREE_A(KMI)
+ NSV_LIMA_IFN_NUCL = NSV_LIMA_IFN_NUCL_A(KMI)
+ NSV_LIMA_IMM_NUCL = NSV_LIMA_IMM_NUCL_A(KMI)
+ NSV_LIMA_HOM_HAZE = NSV_LIMA_HOM_HAZE_A(KMI)
+ NSV_LIMA_SPRO = NSV_LIMA_SPRO_A(KMI)
+ENDIF
+!
+END SUBROUTINE LIMA_UPDATE_NSV
+!
+END MODULE MODE_LIMA_UPDATE_NSV
diff --git a/src/PHYEX/micro/mode_nrcolss.f90 b/src/PHYEX/micro/mode_nrcolss.f90
index 3da87d0a49abb048b03c968b8334228ac906dd62..85d083bb430cb7a33f13abc9fa02e0fea7d8a36c 100644
--- a/src/PHYEX/micro/mode_nrcolss.f90
+++ b/src/PHYEX/micro/mode_nrcolss.f90
@@ -87,7 +87,7 @@ CONTAINS
USE MODI_GENERAL_GAMMA
!
USE MODD_CST
-USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_DESCR_n
!
IMPLICIT NONE
!
diff --git a/src/PHYEX/micro/mode_nscolrg.f90 b/src/PHYEX/micro/mode_nscolrg.f90
index 593d838d6951769c140653ea40fecdaac2352948..f3d3a8e911c69bc2b473ce5b6d35ec80cf52bb84 100644
--- a/src/PHYEX/micro/mode_nscolrg.f90
+++ b/src/PHYEX/micro/mode_nscolrg.f90
@@ -86,7 +86,7 @@ CONTAINS
USE MODI_GENERAL_GAMMA
!
USE MODD_CST
-USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_DESCR_n
!
IMPLICIT NONE
!
diff --git a/src/PHYEX/micro/mode_qsatmx_tab.f90 b/src/PHYEX/micro/mode_qsatmx_tab.f90
index 01d697b19bdeeb1cc011c4826e8c37da037cb944..9e2c333735104e66e635cd3c205db2623b2f6994 100644
--- a/src/PHYEX/micro/mode_qsatmx_tab.f90
+++ b/src/PHYEX/micro/mode_qsatmx_tab.f90
@@ -3,7 +3,6 @@ IMPLICIT NONE
CONTAINS
FUNCTION QSATMX_TAB(P,T,FICE)
- USE PARKIND1, ONLY : JPRB
USE MODD_CST ,ONLY : XEPSILO
USE MODE_TIWMX, ONLY : ESATI,ESATW
diff --git a/src/PHYEX/micro/mode_read_xker_gweth.f90 b/src/PHYEX/micro/mode_read_xker_gweth.f90
index c0e18f57e5bfad43bc9fe712abfcf7a5e2774595..bca7bc043c5d7eb9774ac03e54c2685dd5f5942a 100644
--- a/src/PHYEX/micro/mode_read_xker_gweth.f90
+++ b/src/PHYEX/micro/mode_read_xker_gweth.f90
@@ -12,8 +12,7 @@ CONTAINS
PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
PFDINFTY,PKER_GWETH )
!DEC$ OPTIMIZE:0
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the graupel-hail wet growth process
@@ -81,7 +80,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_XKER_GWETH',0,ZHOOK_HANDLE)
KND= 50
KWETLBDAH= 40
diff --git a/src/PHYEX/micro/mode_read_xker_raccs.f90 b/src/PHYEX/micro/mode_read_xker_raccs.f90
index 8ca45d9bfacfaee372868359d79a73fddbed233f..eeae9e13d8991d2b73ad9fe99bd75abeb5035d07 100644
--- a/src/PHYEX/micro/mode_read_xker_raccs.f90
+++ b/src/PHYEX/micro/mode_read_xker_raccs.f90
@@ -12,8 +12,7 @@ CONTAINS
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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ##########################################################################
!
!!**** * * - initialize the kernels for the rain-snow accretion process
@@ -85,7 +84,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_XKER_RACCS',0,ZHOOK_HANDLE)
KND= 50
KACCLBDAS= 40
diff --git a/src/PHYEX/micro/mode_read_xker_rdryg.f90 b/src/PHYEX/micro/mode_read_xker_rdryg.f90
index 4ab0f47df6a4fd4cc7d263dacdc8385ddf49d8d0..20e0f6a45a3f2ee59fb6466124f750b30dcdf418 100644
--- a/src/PHYEX/micro/mode_read_xker_rdryg.f90
+++ b/src/PHYEX/micro/mode_read_xker_rdryg.f90
@@ -18,8 +18,7 @@ CONTAINS
PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
PFDINFTY,PKER_RDRYG )
!DEC$ OPTIMIZE:0
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-graupel dry growth process
@@ -86,7 +85,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_XKER_RDRYG',0,ZHOOK_HANDLE)
KND= 50
KDRYLBDAG= 40
diff --git a/src/PHYEX/micro/mode_read_xker_rweth.f90 b/src/PHYEX/micro/mode_read_xker_rweth.f90
index 9f04157ad7bf94878e24ab0bc57ccb2c8438a3b9..1d011283bfe775421fbb8d5b8afaa32d86b32741 100644
--- a/src/PHYEX/micro/mode_read_xker_rweth.f90
+++ b/src/PHYEX/micro/mode_read_xker_rweth.f90
@@ -12,8 +12,7 @@ CONTAINS
PWETLBDAH_MAX,PWETLBDAR_MAX,PWETLBDAH_MIN,PWETLBDAR_MIN, &
PFDINFTY,PKER_RWETH )
!DEC$ OPTIMIZE:0
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the rain-hail wet growth process
@@ -80,7 +79,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_XKER_RWETH',0,ZHOOK_HANDLE)
KND= 50
KWETLBDAH= 40
diff --git a/src/PHYEX/micro/mode_read_xker_sdryg.f90 b/src/PHYEX/micro/mode_read_xker_sdryg.f90
index 088e569cd1b552ed48b8007d4fec57c04537ab2d..bb46c16be3eec47e6b274862f5951cec78b0956b 100644
--- a/src/PHYEX/micro/mode_read_xker_sdryg.f90
+++ b/src/PHYEX/micro/mode_read_xker_sdryg.f90
@@ -12,8 +12,7 @@ CONTAINS
PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
PFDINFTY,PKER_SDRYG )
!DEC$ OPTIMIZE:0
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-graupel dry growth process
@@ -82,7 +81,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_XKER_SDRYG',0,ZHOOK_HANDLE)
KND= 50
KDRYLBDAG= 40
diff --git a/src/PHYEX/micro/mode_read_xker_sweth.f90 b/src/PHYEX/micro/mode_read_xker_sweth.f90
index 48d4b1aa4fdaaff9a24e2096f9ddd1e1137624c7..a10c94f466f70d1a44b1dabae9c8e69d3cb4f3fe 100644
--- a/src/PHYEX/micro/mode_read_xker_sweth.f90
+++ b/src/PHYEX/micro/mode_read_xker_sweth.f90
@@ -12,8 +12,7 @@ CONTAINS
PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
PFDINFTY,PKER_SWETH )
!DEC$ OPTIMIZE:0
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################################
!
!!**** * * - initialize the kernels for the snow-hail wet growth process
@@ -82,7 +81,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_XKER_SWETH',0,ZHOOK_HANDLE)
KND= 50
KWETLBDAH= 40
diff --git a/src/PHYEX/micro/mode_rrcolss.f90 b/src/PHYEX/micro/mode_rrcolss.f90
index bfeaa1adb56745853e3da69cb13334c27da8e29f..78413f699b76884a7b3593335837b961f81ded3f 100644
--- a/src/PHYEX/micro/mode_rrcolss.f90
+++ b/src/PHYEX/micro/mode_rrcolss.f90
@@ -13,8 +13,7 @@ CONTAINS
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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################################
!
!
@@ -92,7 +91,7 @@ CONTAINS
USE MODI_GENERAL_GAMMA
!
USE MODD_CST
-USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_DESCR_n
!
IMPLICIT NONE
!
@@ -177,7 +176,7 @@ REAL :: ZCST1
!
!* 1.0 Initialization
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('RRCOLSS',0,ZHOOK_HANDLE)
PRRCOLSS(:,:) = 0.0
ZCST1 = (3.0/XPI)/XRHOLW
@@ -243,21 +242,25 @@ DO JLBDAS = 1,SIZE(PRRCOLSS(:,:),1)
END IF
DO JDR = 1,INR-1
ZDR = ZDDCOLLR * REAL(JDR)
+#ifdef REPRO48
ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
-#if defined(REPRO48)
* PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDR**PEXFALLR) &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
#else
+ ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
* PESR * ABS(PFALLS*ZDS**PEXFALLS * EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) &
-#endif
* GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
+#endif
END DO
+#ifdef REPRO48
ZCOLLDRMAX = (ZDS+ZDRMAX)**2 * ZDRMAX**PEXMASSR &
-#if defined(REPRO48)
* PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDRMAX**PEXFALLR) &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
#else
+ ZCOLLDRMAX = (ZDS+ZDRMAX)**2 * ZDRMAX**PEXMASSR &
* PESR * ABS(PFALLS*ZDS**PEXFALLS* EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDRMAX**PEXFALLR) &
-#endif
* GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
+#endif
ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR)
!
!* 1.9 Compute the normalization factor by integration over the
diff --git a/src/PHYEX/micro/mode_rscolrg.f90 b/src/PHYEX/micro/mode_rscolrg.f90
index 77e00251fce73e7531074f6bf3bd382245cf8f1e..2eb4d272a0535136b954cdcecb2b188689061615 100644
--- a/src/PHYEX/micro/mode_rscolrg.f90
+++ b/src/PHYEX/micro/mode_rscolrg.f90
@@ -13,8 +13,7 @@ CONTAINS
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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################################
!
!
@@ -91,7 +90,7 @@ CONTAINS
USE MODI_GENERAL_GAMMA
!
USE MODD_CST
-USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_DESCR_n
!
IMPLICIT NONE
!
@@ -174,7 +173,7 @@ REAL :: ZCST1
!
!* 1.0 Initialization
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('RSCOLRG',0,ZHOOK_HANDLE)
PRSCOLRG(:,:) = 0.0
ZCST1 = (3.0/XPI)/XRHOLW
@@ -236,20 +235,24 @@ DO JLBDAR = 1,SIZE(PRSCOLRG(:,:),1)
ZDDCOLLR = (ZDRMAX-ZDRMIN) / REAL(INR)
DO JDR = 1,INR-1
ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN
+#ifdef REPRO48
ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
* GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
-#if defined(REPRO48)
* PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDR**PEXFALLR)
#else
+ ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
* PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDR**PEXFALLR)
#endif
END DO
IF( ZDRMIN>0.0 ) THEN
+#ifdef REPRO48
ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
* GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
-#if defined(REPRO48)
* PESR * ABS(PFALLS*ZDS**PEXFALLS-PFALLR*ZDRMIN**PEXFALLR)
#else
+ ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
+ * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
* PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDRMIN**PEXFALLR)
#endif
ELSE
diff --git a/src/PHYEX/micro/mode_rzcolx.f90 b/src/PHYEX/micro/mode_rzcolx.f90
index 3370bc01fc979498af1073544a4b7efa7013c3f6..f3ef464948915356ab5f1884b0a0af8e18e604ef 100644
--- a/src/PHYEX/micro/mode_rzcolx.f90
+++ b/src/PHYEX/micro/mode_rzcolx.f90
@@ -14,8 +14,7 @@ CONTAINS
PFALLZ, PEXFALLZ, PFALLEXPZ, &
PLBDAXMAX, PLBDAZMAX, PLBDAXMIN, PLBDAZMIN, &
PDINFTY, PRZCOLX )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################################
!
!
@@ -173,7 +172,7 @@ REAL :: ZFUNC ! Ancillary function
!
!* 1.1 Compute the growth rate of the slope factors LAMBDA
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: 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) )
@@ -215,7 +214,7 @@ DO JLBDAX = 1,SIZE(PRZCOLX(:,:),1)
!* 1.7 Compute the scaled fall speed difference by integration over
! the dimensional spectrum of specy Z
!
-#if defined(REPRO48)
+#ifdef REPRO48
ZCOLLZ = ZCOLLZ + ZFUNC &
* PEXZ * ABS(PFALLX*ZDX**PEXFALLX-PFALLZ*ZDZ**PEXFALLZ)
#else
diff --git a/src/PHYEX/micro/mode_set_conc_lima.f90 b/src/PHYEX/micro/mode_set_conc_lima.f90
index 6c132a78edde92569f54a608e1d145f4ad1ebb8e..c7ffbfc6efe0b98ed56b2e9907e33e2645007642 100644
--- a/src/PHYEX/micro/mode_set_conc_lima.f90
+++ b/src/PHYEX/micro/mode_set_conc_lima.f90
@@ -12,7 +12,7 @@ implicit none
contains
! ###########################################################################
- SUBROUTINE SET_CONC_LIMA( kmi, HGETCLOUD, PRHODREF, PRT, PSVT )
+ SUBROUTINE SET_CONC_LIMA( kmi, HGETCLOUD, PRHODREF, PRT, PSVT, LDLBC )
! ###########################################################################
!
!!**** *SET_CONC_LIMA * - initialize droplet, raindrop and ice
@@ -73,16 +73,13 @@ contains
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_CCN, NMOD_IFN, &
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, &
NMOM_C, NMOM_R, NMOM_I
-USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI, XAS, XBS
+USE MODD_PARAM_LIMA_COLD, ONLY : XAS, XBS
USE MODD_PARAM_LIMA_MIXED,ONLY : XAG, XBG, XAH, XBH
-USE MODD_NSV, ONLY : NSV_LIMA_BEG_A, NSV_LIMA_NC_A, NSV_LIMA_NR_A, NSV_LIMA_CCN_ACTI_A, &
- NSV_LIMA_NI_A, NSV_LIMA_NS_A, NSV_LIMA_NG_A, NSV_LIMA_NH_A, NSV_LIMA_IFN_NUCL_A, &
- NSV_LIMA_BEG, NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_ACTI, &
+USE MODD_NSV, ONLY : NSV_LIMA_BEG, NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_ACTI, &
NSV_LIMA_NI, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, NSV_LIMA_IFN_NUCL
-USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
-USE MODD_CONF, ONLY : NVERB
+USE MODD_CST, ONLY : XPI, XRHOLW
!
IMPLICIT NONE
!
@@ -95,6 +92,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! microphys. concentrations
+LOGICAL, OPTIONAL, INTENT(IN) :: LDLBC ! T to activate LBC mode
!
!
!* 0.2 Declarations of local variables :
@@ -102,6 +100,8 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! microphys. concentrations
REAL :: ZCONC
INTEGER :: ISV_LIMA_NC, ISV_LIMA_NR, ISV_LIMA_CCN_ACTI
INTEGER :: ISV_LIMA_NI, ISV_LIMA_NS, ISV_LIMA_NG, ISV_LIMA_NH, ISV_LIMA_IFN_NUCL
+LOGICAL :: LLLBC
+REAL :: ZSVTHR
!
!-------------------------------------------------------------------------------
!* 1. RETRIEVE LOGICAL UNIT NUMBER
@@ -119,24 +119,32 @@ ISV_LIMA_IFN_NUCL = NSV_LIMA_IFN_NUCL - NSV_LIMA_BEG + 1
!* 2. INITIALIZATION
! --------------
!
+LLLBC=.FALSE.
+IF(PRESENT(LDLBC)) LLLBC=LDLBC
+IF(LLLBC) THEN
+ ZSVTHR=1.E-11 ! valid value to check
+ELSE
+ ZSVTHR=1.E20 ! to deactivate this test
+ENDIF
+!
IF (NMOM_C.GE.2) THEN
!
! droplets
!
ZCONC = 300.E6 ! droplet concentration set at 300 cm-3
- WHERE ( PRT(:,:,:,2) > 1.E-11 )
+ WHERE ( PRT(:,:,:,2) > 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NC)<ZSVTHR)
PSVT(:,:,:,ISV_LIMA_NC) = ZCONC
END WHERE
- WHERE ( PRT(:,:,:,2) <= 1.E-11 )
+ WHERE ( PRT(:,:,:,2) <= 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NC)<ZSVTHR)
PRT(:,:,:,2) = 0.0
PSVT(:,:,:,ISV_LIMA_NC) = 0.0
END WHERE
IF (NMOD_CCN .GE. 1) THEN
- WHERE ( PRT(:,:,:,2) > 1.E-11 )
+ WHERE ( PRT(:,:,:,2) > 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NC)<ZSVTHR)
PSVT(:,:,:,ISV_LIMA_CCN_ACTI) = ZCONC
END WHERE
- WHERE ( PRT(:,:,:,2) <= 1.E-11 )
+ WHERE ( PRT(:,:,:,2) <= 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NC)<ZSVTHR)
PSVT(:,:,:,ISV_LIMA_CCN_ACTI) = 0.0
END WHERE
END IF
@@ -151,11 +159,11 @@ IF (NMOM_R.GE.2) THEN
IF (HGETCLOUD == 'INI1') THEN ! init from REVE scheme
PSVT(:,:,:,ISV_LIMA_NR) = 0.0
ELSE ! init from KESS, ICE3...
- WHERE ( PRT(:,:,:,3) > 1.E-11 )
+ WHERE ( PRT(:,:,:,3) > 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NR)<ZSVTHR )
PSVT(:,:,:,ISV_LIMA_NR) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
*ZCONC)),1. )
END WHERE
- WHERE ( PRT(:,:,:,3) <= 1.E-11 )
+ WHERE ( PRT(:,:,:,3) <= 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NR)<ZSVTHR )
PRT(:,:,:,3) = 0.0
PSVT(:,:,:,ISV_LIMA_NR) = 0.0
END WHERE
@@ -167,7 +175,7 @@ IF (NMOM_I.GE.2) THEN
! ice crystals
!
ZCONC = 100.E3 ! maximum ice concentration set at 100/L
- WHERE ( PRT(:,:,:,4) > 1.E-11 )
+ WHERE ( PRT(:,:,:,4) > 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NI)<ZSVTHR )
!
! PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = MIN( PRHODREF(:,:,:) / &
! ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
@@ -175,16 +183,16 @@ IF (NMOM_I.GE.2) THEN
! Correction
PSVT(:,:,:,ISV_LIMA_NI) = MIN(PRT(:,:,:,4)/(0.82*(10.E-06)**2.5),ZCONC )
END WHERE
- WHERE ( PRT(:,:,:,4) <= 1.E-11 )
+ WHERE ( PRT(:,:,:,4) <= 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NI)<ZSVTHR )
PRT(:,:,:,4) = 0.0
PSVT(:,:,:,ISV_LIMA_NI) = 0.0
END WHERE
IF (NMOD_IFN .GE. 1) THEN
- WHERE ( PRT(:,:,:,4) > 1.E-11 )
+ WHERE ( PRT(:,:,:,4) > 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NI)<ZSVTHR )
PSVT(:,:,:,ISV_LIMA_IFN_NUCL) = PSVT(:,:,:,ISV_LIMA_NI)
END WHERE
- WHERE ( PRT(:,:,:,4) <= 1.E-11 )
+ WHERE ( PRT(:,:,:,4) <= 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NI)<ZSVTHR )
PSVT(:,:,:,ISV_LIMA_IFN_NUCL) = 0.0
END WHERE
END IF
@@ -196,9 +204,10 @@ IF (ISV_LIMA_NS.GE.1) THEN
! snow
!
ZCONC = 1./ (XAS*0.001**XBS) ! 1mm particle size
- WHERE ( PRT(:,:,:,5) > 1.E-11 )
+ WHERE ( PRT(:,:,:,5) > 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NS)<ZSVTHR )
PSVT(:,:,:,ISV_LIMA_NS) = PRT(:,:,:,5) * ZCONC
- ELSEWHERE
+ END WHERE
+ WHERE ( PRT(:,:,:,5) <= 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NS)<ZSVTHR )
PRT(:,:,:,5) = 0.0
PSVT(:,:,:,ISV_LIMA_NS) = 0.0
END WHERE
@@ -209,9 +218,10 @@ IF (ISV_LIMA_NG.GE.1) THEN
! graupel
!
ZCONC = 1./ (XAG*0.001**XBG) ! 1mm particle size
- WHERE ( PRT(:,:,:,6) > 1.E-11 )
+ WHERE ( PRT(:,:,:,6) > 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NG)<ZSVTHR )
PSVT(:,:,:,ISV_LIMA_NG) = PRT(:,:,:,6) * ZCONC
- ELSEWHERE
+ END WHERE
+ WHERE ( PRT(:,:,:,6) <= 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NG)<ZSVTHR )
PRT(:,:,:,6) = 0.0
PSVT(:,:,:,ISV_LIMA_NG) = 0.0
END WHERE
@@ -222,9 +232,10 @@ IF (ISV_LIMA_NH.GE.1) THEN
! hail
!
ZCONC = 1./ (XAH*0.001**XBH) ! 1mm particle size
- WHERE ( PRT(:,:,:,7) > 1.E-11 )
+ WHERE ( PRT(:,:,:,7) > 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NH)<ZSVTHR )
PSVT(:,:,:,ISV_LIMA_NH) = PRT(:,:,:,7) * ZCONC
- ELSEWHERE
+ END WHERE
+ WHERE ( PRT(:,:,:,7) <= 1.E-11 .AND. PSVT(:,:,:,ISV_LIMA_NH)<ZSVTHR )
PRT(:,:,:,7) = 0.0
PSVT(:,:,:,ISV_LIMA_NH) = 0.0
END WHERE
diff --git a/src/PHYEX/micro/mode_tiwmx.f90 b/src/PHYEX/micro/mode_tiwmx.f90
index dbfbdc712330cd2f959e1bbccd1c0b3f642b9137..dc98d10c2bfa819b09dfea670358bbee73a1a176 100644
--- a/src/PHYEX/micro/mode_tiwmx.f90
+++ b/src/PHYEX/micro/mode_tiwmx.f90
@@ -29,7 +29,7 @@
IMPLICIT NONE
REAL, PARAMETER :: XNDEGR = 100.0
-INTEGER, PARAMETER :: NSTART = 10000
+INTEGER, PARAMETER :: NSTART = 13200 ! A too small value may result into a FPE in single precision mode. REK.
INTEGER, PARAMETER :: NSTOP = 37316
! Saturation tables and derivatives
diff --git a/src/PHYEX/micro/mode_tiwmx_tab.f90 b/src/PHYEX/micro/mode_tiwmx_tab.f90
index e8e42bcd6ef2d9082705d9351d42db729ebca2d9..4921638028c7fdede4d22c1785736d3670ed9e64 100644
--- a/src/PHYEX/micro/mode_tiwmx_tab.f90
+++ b/src/PHYEX/micro/mode_tiwmx_tab.f90
@@ -49,9 +49,8 @@ FUNCTION TIWMX_TAB(P,T,QR,FICE,QRSN,RS,EPS)
! 1.1 MODULES USED
USE MODD_CST, ONLY : XEPSILO, XCPD, XLSTT, XLVTT
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODE_TIWMX, ONLY : ESATI, ESATW, DESDTI, DESDTW
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- USE PARKIND1, ONLY : JPRB
IMPLICIT NONE
@@ -68,7 +67,7 @@ FUNCTION TIWMX_TAB(P,T,QR,FICE,QRSN,RS,EPS)
REAL :: F,DFDT,T2,DT,QSN,DQSDT,B
REAL :: ZES,ZDESDT
INTEGER :: ITER
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TIWMX_TAB',0,ZHOOK_HANDLE)
diff --git a/src/PHYEX/micro/modi_condensation.f90 b/src/PHYEX/micro/modi_condensation.f90
index 812dae784eb9a29e7c860111520c12e6fc82a32c..ff01c3fb000451049dd0c2608861786d94b1de73 100644
--- a/src/PHYEX/micro/modi_condensation.f90
+++ b/src/PHYEX/micro/modi_condensation.f90
@@ -2,13 +2,14 @@
MODULE MODI_CONDENSATION
! ########################
!
+IMPLICIT NONE
INTERFACE
!
- SUBROUTINE CONDENSATION(D, CST, ICEP, NEB, TURBN, &
+ SUBROUTINE CONDENSATION(D, CST, ICEP, NEBN, 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, &
+ &OSIGMAS, OCND2, &
&PICLDFR, PWCLDFR, PSSIO, PSSIU, PIFR, PSIGQSAT, &
&PLV, PLS, PCPH, &
&PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -16,14 +17,15 @@ INTERFACE
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE MODD_NEB, ONLY: NEB_t
+USE MODD_NEB_n, ONLY: NEB_t
USE MODD_TURB_n, ONLY: TURB_t
-USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+IMPLICIT NONE
!
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(NEB_t), INTENT(IN) :: NEBN
TYPE(TURB_t), INTENT(IN) :: TURBN
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
CHARACTER(LEN=4), INTENT(IN) :: HCONDENS
@@ -55,7 +57,6 @@ LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma
! or that from turbulence scheme
LOGICAL, INTENT(IN) :: OCND2 ! logical switch to sparate liquid and ice
! more rigid (DEFALT value : .FALSE.)
-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
diff --git a/src/PHYEX/micro/modi_ice_adjust.f90 b/src/PHYEX/micro/modi_ice_adjust.f90
index 95680b082309ec4a6e00eb196b0028a770c96550..578d405386546b250d36563124d1d68f2e258cbf 100644
--- a/src/PHYEX/micro/modi_ice_adjust.f90
+++ b/src/PHYEX/micro/modi_ice_adjust.f90
@@ -2,11 +2,11 @@
MODULE MODI_ICE_ADJUST
! ######################
!
+IMPLICIT NONE
INTERFACE
!
- SUBROUTINE ICE_ADJUST (D, CST, ICEP, NEB, TURBN, BUCONF, KRR, &
- &HFRAC_ICE, &
- &HBUNAME, OCND2, LHGT_QS, &
+ SUBROUTINE ICE_ADJUST (D, CST, ICEP, NEBN, TURBN, PARAMI, BUCONF, KRR, &
+ &HBUNAME, &
&PTSTEP, PSIGQSAT, &
&PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,&
&PPABST, PZZ, &
@@ -21,9 +21,10 @@ INTERFACE
&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_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_NEB_n, ONLY: NEB_t
USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
!
@@ -34,16 +35,12 @@ IMPLICIT NONE
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(NEB_t), INTENT(IN) :: NEBN
TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
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
@@ -52,8 +49,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobia
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
+REAL, DIMENSION(MERGE(D%NIJT,0,NEBN%LSUBG_COND),&
+ MERGE(D%NKT,0,NEBN%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
diff --git a/src/PHYEX/micro/modi_ini_neb.f90 b/src/PHYEX/micro/modi_ini_neb.f90
deleted file mode 100644
index eaa71d814aba5264d69e8de759b00ce5f52d9190..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/modi_ini_neb.f90
+++ /dev/null
@@ -1,16 +0,0 @@
-!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
deleted file mode 100644
index 24dd0d68de12ce2b27d5d2ef3f0a9e60f1978fa1..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/modi_ini_rain_ice.f90
+++ /dev/null
@@ -1,23 +0,0 @@
-! ######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
deleted file mode 100644
index 788ec7c9a8f216a921b5ddcbba27ab78195188b0..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/modi_ini_snow.f90
+++ /dev/null
@@ -1,15 +0,0 @@
-! ######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
deleted file mode 100644
index 9ef7e6409e537b13fe57af01140bc353dddfe029..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/modi_ini_tiwmx.f90
+++ /dev/null
@@ -1,16 +0,0 @@
-!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_lima.f90 b/src/PHYEX/micro/modi_lima.f90
index 6cd5fa338a4bde2175fa985d0e14d370718c9ec7..383df6c4d7fcad487defdff132df7cca37bb3b74 100644
--- a/src/PHYEX/micro/modi_lima.f90
+++ b/src/PHYEX/micro/modi_lima.f90
@@ -1,5 +1,6 @@
MODULE MODI_LIMA
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
@@ -16,6 +17,7 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
+IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
diff --git a/src/PHYEX/micro/modi_lima_adjust_split.f90 b/src/PHYEX/micro/modi_lima_adjust_split.f90
index aeb84748a1a24cd73f99e9c042969df03f645deb..cc4920e2f6c3284d349fec561e1693b4856424a5 100644
--- a/src/PHYEX/micro/modi_lima_adjust_split.f90
+++ b/src/PHYEX/micro/modi_lima_adjust_split.f90
@@ -2,6 +2,7 @@
MODULE MODI_LIMA_ADJUST_SPLIT
! #############################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE LIMA_ADJUST_SPLIT(D, CST, BUCONF, TBUDGETS, KBUDGETS, &
@@ -16,6 +17,7 @@ INTERFACE
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
+IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
diff --git a/src/PHYEX/micro/modi_lima_precip_scavenging.f90 b/src/PHYEX/micro/modi_lima_precip_scavenging.f90
index 918e2982eba4d565648da504c0051aa88922fb34..2a4708fdf509a8810a8c90d4905f72badb9c28a5 100644
--- a/src/PHYEX/micro/modi_lima_precip_scavenging.f90
+++ b/src/PHYEX/micro/modi_lima_precip_scavenging.f90
@@ -2,15 +2,17 @@
MODULE MODI_LIMA_PRECIP_SCAVENGING
!#################################
!
+ IMPLICIT NONE
INTERFACE
!
SUBROUTINE LIMA_PRECIP_SCAVENGING (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ HCLOUD, CDCONF, KLUOUT, KTCOUNT, PTSTEP, &
PRRT, PRHODREF, PRHODJ, PZZ, &
PPABST, PTHT, PSVT, PRSVS, PINPAP )
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
use modd_budget, only: TBUDGETDATA,TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
+ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
@@ -19,6 +21,7 @@ MODULE MODI_LIMA_PRECIP_SCAVENGING
INTEGER, INTENT(IN) :: KBUDGETS
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
+ CHARACTER(LEN=5), INTENT(IN) :: CDCONF ! CCONF from MODD_CONF
INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
REAL, INTENT(IN) :: PTSTEP ! Double timestep except
diff --git a/src/PHYEX/micro/modi_rain_ice.f90 b/src/PHYEX/micro/modi_rain_ice.f90
index bf65a39d521a0b9ce389d053524d36f815a21f44..abb7ff6b5430b32c0da9cda82f0fe64b99c91c96 100644
--- a/src/PHYEX/micro/modi_rain_ice.f90
+++ b/src/PHYEX/micro/modi_rain_ice.f90
@@ -2,9 +2,9 @@
MODULE MODI_RAIN_ICE
! ####################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
- KPROMA, OCND2, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -18,9 +18,10 @@ INTERFACE
!
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_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_TURB_n, ONLY: TURB_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -31,10 +32,6 @@ 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
-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
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
diff --git a/src/PHYEX/micro/modn_param_lima.f90 b/src/PHYEX/micro/modn_param_lima.f90
deleted file mode 100644
index 390ba1dc8853237ddf00550f04dbeb9465636c3d..0000000000000000000000000000000000000000
--- a/src/PHYEX/micro/modn_param_lima.f90
+++ /dev/null
@@ -1,37 +0,0 @@
-!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-------------------------------------------------------------------------------
-! ######################
- MODULE MODN_PARAM_LIMA
-! ######################
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_LIMA
-!
-IMPLICIT NONE
-!
-!
-NAMELIST/NAM_PARAM_LIMA/LNUCL, LSEDI, LHHONI, LMEYERS, &
- NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
- NMOD_IFN, XIFN_CONC, LIFN_HOM, &
- CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
- LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
- XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
- XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
- LCIBU, XNDEBRIS_CIBU, LRDSF, LMURAKAMI, &
- LACTI, LSEDC, LACTIT, LBOUND, LSPRO, &
- LADJ, LKHKO, LKESSLERAC, NMOM_C, NMOM_R, &
- NMOD_CCN, XCCN_CONC, &
- LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
- XALPHAC, XNUC, XALPHAR, XNUR, &
- XFSOLUB_CCN, XACTEMP_CCN, XAERDIFF, XAERHEIGHT, &
- LSCAV, LAERO_MASS, LDEPOC, XVDEPOC, LACTTKE, &
- LPTSPLIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS
-!
-END MODULE MODN_PARAM_LIMA
diff --git a/src/PHYEX/micro/prognos_lima.f90 b/src/PHYEX/micro/prognos_lima.f90
index 64834850299bea38e862fe05238081fc5dac9b1a..aaba695968f56ce9cff37a79ed2e5689e8b4f2fa 100644
--- a/src/PHYEX/micro/prognos_lima.f90
+++ b/src/PHYEX/micro/prognos_lima.f90
@@ -7,9 +7,11 @@
MODULE MODI_PROGNOS_LIMA
! #######################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE PROGNOS_LIMA(PTSTEP,PDZ,PLV,PCPH,PPRES,PRHOD,PRR,PTT,PRV,PRC,PS0,PNAS,PCCS,PNFS)
+IMPLICIT NONE
!
REAL, INTENT(IN) :: PTSTEP
REAL, DIMENSION(:), INTENT(IN) :: PPRES
@@ -382,9 +384,9 @@ CONTAINS
FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
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, INTENT(IN) :: PALPHA ! first shape parameter of the DIMENSIONnal distribution
+REAL, INTENT(IN) :: PNU ! second shape parameter of the DIMENSIONnal distribution
+REAL, INTENT(IN) :: PP ! order of the moment
REAL :: PMOMG ! result: moment of order ZP
PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
!
diff --git a/src/PHYEX/micro/radar_rain_ice.f90 b/src/PHYEX/micro/radar_rain_ice.f90
index cf97a981ade422f5d257a46c93a48cf234056ce1..13cfa19bd0b4abc4d53a3b7552431aae46ec1aa3 100644
--- a/src/PHYEX/micro/radar_rain_ice.f90
+++ b/src/PHYEX/micro/radar_rain_ice.f90
@@ -7,9 +7,11 @@
MODULE MODI_RADAR_RAIN_ICE
! ##########################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE RADAR_RAIN_ICE(PRT,PCIT,PRHODREF,PTEMP,PRARE,PVDOP,PRZDR,PRKDP,&
PCRT,PCST,PCGT,PCHT)
+IMPLICIT NONE
!
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! microphysical mix. ratios at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! pristine ice concentration at t
@@ -98,8 +100,8 @@ END MODULE MODI_RADAR_RAIN_ICE
!
USE MODD_CST
USE MODD_REF
-USE MODD_PARAM_ICE, ONLY: LSNOW_T_I=>LSNOW_T
-USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEXR,&
+USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I=>LSNOW_T
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEXR,&
XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XAR_I=>XAR,&
XALPHAC_I=>XALPHAC,XNUC_I=>XNUC,&
XLBC_I=>XLBC,XBC_I=>XBC,XAC_I=>XAC,&
@@ -554,9 +556,9 @@ CONTAINS
!
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, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL, INTENT(IN) :: PP ! order of the moment
REAL :: PMOMG ! result: moment of order ZP
!
!------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/radtr_satel.f90 b/src/PHYEX/micro/radtr_satel.f90
index 5c79550bb3f34b5eb7929616036b6468aa5c01ec..5f29acd95a57c40e775b0d2b07a23b00bb83727e 100644
--- a/src/PHYEX/micro/radtr_satel.f90
+++ b/src/PHYEX/micro/radtr_satel.f90
@@ -6,6 +6,7 @@
! #######################
MODULE MODI_RADTR_SATEL
! #######################
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE RADTR_SATEL(KYEARF, KMONTHF, KDAYF, PSECF, &
@@ -13,6 +14,7 @@ INTERFACE
PTSRAD, PSTATM, PTHT, PRT, PPABST, PZZ, &
PSIGS, PMFCONV, PCLDFR, OUSERI, OSIGMAS, &
OSUBG_COND, ORAD_SUBG_COND, PIRBT, PWVBT, KGEO,PSIGQSAT )
+IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KYEARF ! year of Final date
INTEGER, INTENT(IN) :: KMONTHF ! month of Final date
@@ -111,8 +113,8 @@ 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_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
+USE MODD_NEB_n, ONLY: NEBN
USE MODD_TURB_n, ONLY: TURBN
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
@@ -497,11 +499,11 @@ IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
! 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, &
+ CALL CONDENSATION(D, CST, RAIN_ICE_PARAMN, NEBN, 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., &
+ &OSIGMAS, .FALSE., &
&ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, ZSIGQSAT2D)
DEALLOCATE(ZTEMP,ZSIGRC)
DEALLOCATE(ZRV_OUT)
diff --git a/src/PHYEX/micro/rain_c2r2_khko.f90 b/src/PHYEX/micro/rain_c2r2_khko.f90
index cc19dbbf0cc7dc6aa5a287f8dec73f6ba3b46952..6284e4f1fbbc787d4305cf1811b216db85401634 100644
--- a/src/PHYEX/micro/rain_c2r2_khko.f90
+++ b/src/PHYEX/micro/rain_c2r2_khko.f90
@@ -7,6 +7,7 @@
MODULE MODI_RAIN_C2R2_KHKO
! ######################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE RAIN_C2R2_KHKO(HCLOUD,OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
KMI,TPFILE, &
@@ -21,6 +22,7 @@ INTERFACE
PINDEP, PSUPSAT, PNACT )
!
USE MODD_IO, ONLY: TFILEDATA
+IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! kind of cloud
diff --git a/src/PHYEX/micro/rain_ice.f90 b/src/PHYEX/micro/rain_ice.f90
index db2f59b2341f0faaaf64534e05eb032995493b27..18b10bb3de19c5c346847d2688fd77479c0c4a74 100644
--- a/src/PHYEX/micro/rain_ice.f90
+++ b/src/PHYEX/micro/rain_ice.f90
@@ -5,7 +5,6 @@
!-----------------------------------------------------------------
! ######spl
SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
- KPROMA, OCND2, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -177,16 +176,15 @@
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
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_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& ITH, & ! Potential temperature
& IRV, & ! Water vapor
@@ -197,10 +195,10 @@ USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& IRG, & ! Graupel
& IRH ! Hail
-USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
-USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE MODE_BUDGET_PHY, ONLY: 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_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
USE MODE_ICE4_SEDIMENTATION, ONLY: ICE4_SEDIMENTATION
USE MODE_ICE4_PACK, ONLY: ICE4_PACK
USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
@@ -218,10 +216,6 @@ 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
-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
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
@@ -276,7 +270,7 @@ REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air pr
!
!* 0.2 Declarations of local variables :
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
INTEGER :: JIJ, JK
INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE
@@ -311,8 +305,8 @@ 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')
+IF(PARAMI%LOCND2) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'LOCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION')
END IF
ZINV_TSTEP=1./PTSTEP
!
@@ -432,13 +426,13 @@ ENDDO
!
IF(PARAMI%LPACK_MICRO) THEN
ISIZE=COUNT(LLMICRO) ! Number of points with active microphysics
- !KPROMA is the requested size for cache_blocking loop
+ !PARAMI%NPROMICRO is the requested size for cache_blocking loop
!IPROMA is the effective size
!This parameter must be computed here because it is used for array dimensioning in ice4_pack
- IF (KPROMA > 0 .AND. ISIZE > 0) THEN
+ IF (PARAMI%NPROMICRO > 0 .AND. ISIZE > 0) THEN
! Cache-blocking is active
! number of chunks :
- IGPBLKS = (ISIZE-1)/MIN(KPROMA,ISIZE)+1
+ IGPBLKS = (ISIZE-1)/MIN(PARAMI%NPROMICRO,ISIZE)+1
! Adjust IPROMA to limit the number of small chunks
IPROMA=(ISIZE-1)/IGPBLKS+1
ELSE
@@ -453,7 +447,6 @@ ENDIF
!This part is put in another routine to separate pack/unpack operations from computations
CALL ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
IPROMA, ISIZE, ISIZE2, &
- HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
PTSTEP, KRR, LLMICRO, PEXN, &
PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -474,7 +467,7 @@ CALL ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
!*** 6.1 total tendencies limited by available species
!
DO JK = IKTB, IKTE
- DO CONCURRENT (JIJ=IIJB:IIJE)
+ DO 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)
diff --git a/src/PHYEX/micro/rain_ice_elec.f90 b/src/PHYEX/micro/rain_ice_elec.f90
index d1a432f20b26e1f371778fd54366e65bb2e0c784..bdd4de76281fe67a4fc3285f3f8e7ea957e2adf8 100644
--- a/src/PHYEX/micro/rain_ice_elec.f90
+++ b/src/PHYEX/micro/rain_ice_elec.f90
@@ -7,6 +7,7 @@
MODULE MODI_RAIN_ICE_ELEC
! #########################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
KSPLITR, PTSTEP, KMI, KRR, &
@@ -19,6 +20,7 @@ INTERFACE
PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PQHT, PQHS )
+IMPLICIT NONE
!
!
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
@@ -219,9 +221,9 @@ USE MODD_LES
USE MODE_ll
USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND ! Scalar variables for budgets
USE MODD_PARAMETERS
-USE MODD_PARAM_ICE
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
+USE MODD_PARAM_ICE_n
+USE MODD_RAIN_ICE_DESCR_n
+USE MODD_RAIN_ICE_PARAM_n
USE MODD_REF, ONLY: XTHVREFZ
use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
@@ -5132,9 +5134,9 @@ END SUBROUTINE ELEC_INI_NI_SAUNQ
!
IMPLICIT NONE
!
-REAL, DIMENSION(IMICRO) :: ZEW
-REAL, DIMENSION(IMICRO) :: ZDQTAKA_AUX
-REAL, DIMENSION(NIND_LWC+1,NIND_TEMP+1) :: XTAKA_AUX !XMANSELL or XTAKA_TM)
+REAL, DIMENSION(IMICRO), INTENT(IN) :: ZEW
+REAL, DIMENSION(IMICRO), INTENT(INOUT) :: ZDQTAKA_AUX
+REAL, DIMENSION(NIND_LWC+1,NIND_TEMP+1), INTENT(IN) :: XTAKA_AUX !XMANSELL or XTAKA_TM)
!
!
ALLOCATE ( IVEC1(IGTAKA) )
@@ -5824,9 +5826,9 @@ IMPLICIT NONE
!
!* 0.2 Declaration of local variables
!
-INTEGER :: KN ! Size of the result vector
-INTEGER, DIMENSION(KN) :: KI ! Tabulated coordinate
-INTEGER, DIMENSION(KN) :: KJ ! Tabulated coordinate
+INTEGER, INTENT(IN) :: KN ! Size of the result vector
+INTEGER, INTENT(IN), DIMENSION(KN) :: KI ! Tabulated coordinate
+INTEGER, INTENT(IN), DIMENSION(KN) :: KJ ! Tabulated coordinate
REAL, INTENT(IN), DIMENSION(:,:) :: ZT ! Tabulated data
REAL, INTENT(IN), DIMENSION(KN) :: PDX, PDY !
REAL, DIMENSION(KN) :: Y ! Interpolated value
diff --git a/src/PHYEX/micro/rain_ice_fast_rg.f90 b/src/PHYEX/micro/rain_ice_fast_rg.f90
index 0799d824aa16f617ead6073703f4ba18f4229347..0cb5620003a9e6899a8be9db0bac62a3880269ce 100644
--- a/src/PHYEX/micro/rain_ice_fast_rg.f90
+++ b/src/PHYEX/micro/rain_ice_fast_rg.f90
@@ -33,9 +33,9 @@ SUBROUTINE RAIN_ICE_FAST_RG(KRR, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST,
use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
tbudgets
-use MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
-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, &
+USE MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
+USE MODD_RAIN_ICE_DESCR_n, only: XBS, XCEXVT, XCXG, XCXS, XDG, XRTMIN
+USE MODD_RAIN_ICE_PARAM_n, 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
@@ -204,13 +204,8 @@ 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)
- *( 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 d41b61143d2db7ef49ab7926d371e2dc53a7b972..b962448be59de5dc28e9ee9e7c0b3a99c59ab691 100644
--- a/src/PHYEX/micro/rain_ice_fast_rh.f90
+++ b/src/PHYEX/micro/rain_ice_fast_rh.f90
@@ -30,9 +30,9 @@ SUBROUTINE RAIN_ICE_FAST_RH(OMICRO, PRHODREF, PRVT, PRCT, PRIT, PRST, PRGT, PRHT
use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
tbudgets
-use MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
-use MODD_RAIN_ICE_DESCR, only: XBG, XBS, XCEXVT, XCXG, XCXH, XCXS, XDH, XLBEXH, XLBH, XRTMIN
-use MODD_RAIN_ICE_PARAM, only: NWETLBDAG, NWETLBDAH, NWETLBDAS, X0DEPH, X1DEPH, &
+USE MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
+USE MODD_RAIN_ICE_DESCR_n, only: XBG, XBS, XCEXVT, XCXG, XCXH, XCXS, XDH, XLBEXH, XLBH, XRTMIN
+USE MODD_RAIN_ICE_PARAM_n, only: NWETLBDAG, NWETLBDAH, NWETLBDAS, X0DEPH, X1DEPH, &
XEX0DEPH, XEX1DEPH, XFGWETH, XFSWETH, XFWETH, XKER_GWETH, XKER_SWETH, &
XLBGWETH1, XLBGWETH2, XLBGWETH3, XLBSWETH1, XLBSWETH2, XLBSWETH3, &
XWETINTP1G, XWETINTP1H, XWETINTP1S, XWETINTP2G, XWETINTP2H, XWETINTP2S
@@ -186,13 +186,8 @@ 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)
- *( 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_ri.f90 b/src/PHYEX/micro/rain_ice_fast_ri.f90
index edb36a38b90fded9262d13f47e042247f5b448d5..3bb56e144f895b6259a55367c365379dcf7adc12 100644
--- a/src/PHYEX/micro/rain_ice_fast_ri.f90
+++ b/src/PHYEX/micro/rain_ice_fast_ri.f90
@@ -27,9 +27,9 @@ SUBROUTINE RAIN_ICE_FAST_RI(OMICRO, PRHODREF, PRIT, PRHODJ, PZT, PSSI, PLSFACT,
use modd_budget, only: lbudget_th, lbudget_rc, lbudget_ri, &
NBUDGET_TH, NBUDGET_RC, NBUDGET_RI, &
tbudgets
-use MODD_CST, only: XTT
-use MODD_RAIN_ICE_DESCR, only: XDI, XLBEXI, XLBI, XRTMIN
-use MODD_RAIN_ICE_PARAM, only: X0DEPI, X2DEPI
+USE MODD_CST, only: XTT
+USE MODD_RAIN_ICE_DESCR_n, only: XDI, XLBEXI, XLBI, XRTMIN
+USE MODD_RAIN_ICE_PARAM_n, only: X0DEPI, X2DEPI
use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
diff --git a/src/PHYEX/micro/rain_ice_fast_rs.f90 b/src/PHYEX/micro/rain_ice_fast_rs.f90
index 682a1ba3fe3148aa37be1f6e705b789fd84542ec..7d90f8034d2fcbee3b35d9ad61e040c63b103c1b 100644
--- a/src/PHYEX/micro/rain_ice_fast_rs.f90
+++ b/src/PHYEX/micro/rain_ice_fast_rs.f90
@@ -31,9 +31,9 @@ SUBROUTINE RAIN_ICE_FAST_RS(PTSTEP, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRST, PR
use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_rs, lbudget_rg, &
NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, &
tbudgets
-use MODD_CST, only: XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
-use MODD_RAIN_ICE_DESCR, only: XBS, XCEXVT, XCXS, XRTMIN
-use MODD_RAIN_ICE_PARAM, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XACCINTP1R, XACCINTP1S, XACCINTP2R, XACCINTP2S, &
+USE MODD_CST, only: XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
+USE MODD_RAIN_ICE_DESCR_n, only: XBS, XCEXVT, XCXS, XRTMIN
+USE MODD_RAIN_ICE_PARAM_n, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XACCINTP1R, XACCINTP1S, XACCINTP2R, XACCINTP2S, &
XCRIMSG, XCRIMSS, XEX0DEPS, XEX1DEPS, XEXCRIMSG, XEXCRIMSS, XEXSRIMCG, XFRACCSS, &
XFSACCRG, XFSCVMG, XGAMINC_RIM1, XGAMINC_RIM1, XGAMINC_RIM2, XKER_RACCS, &
XKER_RACCSS, XKER_SACCRG, XLBRACCS1, XLBRACCS2, XLBRACCS3, XLBSACCR1, XLBSACCR2, XLBSACCR3, &
@@ -136,15 +136,9 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
DO JJ = 1, IGRIM
JL = I1(JJ)
ZZW1(JJ) = MIN( PRCS(JL), &
-#if defined(REPRO48)
- 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))
@@ -163,21 +157,12 @@ 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)
- 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)
@@ -275,11 +260,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
DO JJ = 1, IGACC
JL = I1(JJ)
ZZW2(JJ) = & !! coef of RRACCS
-#if defined(REPRO48)
- 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
@@ -325,11 +306,7 @@ 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)
- ( 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) )
@@ -376,15 +353,9 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
!
! compute RSMLT
!
-#if defined(REPRO48)
- 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_nucleation.f90 b/src/PHYEX/micro/rain_ice_nucleation.f90
index 701e30282f15c6c3083767192f3d33f07f177d02..34b9c8efb4d90c5989bf421b25e3c15e56165f99 100644
--- a/src/PHYEX/micro/rain_ice_nucleation.f90
+++ b/src/PHYEX/micro/rain_ice_nucleation.f90
@@ -29,9 +29,9 @@ SUBROUTINE RAIN_ICE_NUCLEATION(KIB, KIE, KJB, KJE, KKTB, KKTE,KRR,PTSTEP,&
use modd_budget, only: lbudget_th, lbudget_rv, lbudget_ri, &
NBUDGET_TH, NBUDGET_RV, NBUDGET_RI, &
tbudgets
-use MODD_CST, only: XALPI, XALPW, XBETAI, XBETAW, XCI, XCL, XCPD, XCPV, XGAMI, XGAMW, &
+USE MODD_CST, only: XALPI, XALPW, XBETAI, XBETAW, XCI, XCL, XCPD, XCPV, XGAMI, XGAMW, &
XLSTT, XMD, XMV, XP00, XRD, XTT
-use MODD_RAIN_ICE_PARAM, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
+USE MODD_RAIN_ICE_PARAM_n, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
diff --git a/src/PHYEX/micro/rain_ice_old.f90 b/src/PHYEX/micro/rain_ice_old.f90
index d3edd8708cd5ac272febb7861a620ab9b9377c44..5535910e7c6150c627347bb26067373062ec901c 100644
--- a/src/PHYEX/micro/rain_ice_old.f90
+++ b/src/PHYEX/micro/rain_ice_old.f90
@@ -7,6 +7,7 @@
MODULE MODI_RAIN_ICE_OLD
! ####################
!
+IMPLICIT NONE
INTERFACE
SUBROUTINE RAIN_ICE_OLD (D, OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
KSPLITR, PTSTEP, KRR, &
@@ -18,6 +19,7 @@ INTERFACE
PRHT, PRHS, PINPRH, PFPR )
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
@@ -224,29 +226,29 @@ END MODULE MODI_RAIN_ICE_OLD
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbu_enable
-use MODD_CONF, only: LCHECK
-use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
+USE modd_budget, only: lbu_enable
+USE MODD_CONF, only: LCHECK
+USE MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
XALPI, XBETAI, XGAMI, XMD, XMV, 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: RAIN_ICE_DESCR, XLBEXR, XLBR, XRTMIN
-use MODD_RAIN_ICE_PARAM, only: XCRIAUTC
+USE MODD_LES, only: LLES_CALL
+USE MODD_PARAMETERS, only: JPVEXT
+USE MODD_PARAM_ICE_n, only: CSUBG_PR_PDF, LDEPOSC
+USE MODD_RAIN_ICE_DESCR_n, only: RAIN_ICE_DESCRN, XLBEXR, XLBR, XRTMIN
+USE MODD_RAIN_ICE_PARAM_n, only: XCRIAUTC
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-use MODE_MSG
-use MODE_RAIN_ICE_FAST_RG, only: RAIN_ICE_FAST_RG
-use MODE_RAIN_ICE_FAST_RH, only: RAIN_ICE_FAST_RH
-use MODE_RAIN_ICE_FAST_RI, only: RAIN_ICE_FAST_RI
-use MODE_RAIN_ICE_FAST_RS, only: RAIN_ICE_FAST_RS
-use MODE_RAIN_ICE_NUCLEATION, only: RAIN_ICE_NUCLEATION
-use MODE_RAIN_ICE_SEDIMENTATION_SPLIT, only: RAIN_ICE_SEDIMENTATION_SPLIT
-use MODE_RAIN_ICE_SEDIMENTATION_STAT, only: RAIN_ICE_SEDIMENTATION_STAT
-use MODE_RAIN_ICE_SLOW, only: RAIN_ICE_SLOW
-use MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
-use mode_tools, only: Countjv
-use mode_tools_ll, only: GET_INDICE_ll
+USE MODE_MSG
+USE MODE_RAIN_ICE_FAST_RG, only: RAIN_ICE_FAST_RG
+USE MODE_RAIN_ICE_FAST_RH, only: RAIN_ICE_FAST_RH
+USE MODE_RAIN_ICE_FAST_RI, only: RAIN_ICE_FAST_RI
+USE MODE_RAIN_ICE_FAST_RS, only: RAIN_ICE_FAST_RS
+USE MODE_RAIN_ICE_NUCLEATION, only: RAIN_ICE_NUCLEATION
+USE MODE_RAIN_ICE_SEDIMENTATION_SPLIT, only: RAIN_ICE_SEDIMENTATION_SPLIT
+USE MODE_RAIN_ICE_SEDIMENTATION_STAT, only: RAIN_ICE_SEDIMENTATION_STAT
+USE MODE_RAIN_ICE_SLOW, only: RAIN_ICE_SLOW
+USE MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
+USE mode_tools, only: Countjv
+USE mode_tools_ll, only: GET_INDICE_ll
USE MODE_ICE4_RAINFR_VERT
!
@@ -756,7 +758,7 @@ IF( IMICRO >= 0 ) THEN
DO JL=1,IMICRO
PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
END DO
- CALL ICE4_RAINFR_VERT(D, RAIN_ICE_DESCR, PRAINFR, PRRT(:,:,:), &
+ CALL ICE4_RAINFR_VERT(D, RAIN_ICE_DESCRN, 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
@@ -942,7 +944,7 @@ ELSE
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(D, RAIN_ICE_DESCR, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+CALL ICE4_RAINFR_VERT(D, RAIN_ICE_DESCRN, PRAINFR, PRRS(:,:,:)*PTSTEP, &
PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
!
!-------------------------------------------------------------------------------
diff --git a/src/PHYEX/micro/rain_ice_sedimentation_split.f90 b/src/PHYEX/micro/rain_ice_sedimentation_split.f90
index 370cc07ef9bea548c8fe2aef7dfd5aab70afffd2..0240caabe19ba979068a66eb234965edee8af32b 100644
--- a/src/PHYEX/micro/rain_ice_sedimentation_split.f90
+++ b/src/PHYEX/micro/rain_ice_sedimentation_split.f90
@@ -30,11 +30,11 @@ SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT(KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE
use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
tbudgets
-use MODD_CST, only: XCPD, XP00, XRD, XRHOLW
-use MODD_PARAM_ICE, only: XVDEPOSC
-use MODD_RAIN_ICE_DESCR, only: XCC, XCONC_LAND, xconc_sea, xconc_urban, XDC, XCEXVT, &
+USE MODD_CST, only: XCPD, XP00, XRD, XRHOLW
+USE MODD_PARAM_ICE_n, only: XVDEPOSC
+USE MODD_RAIN_ICE_DESCR_n, only: XCC, XCONC_LAND, xconc_sea, xconc_urban, XDC, XCEXVT, &
XALPHAC, XNUC, XALPHAC2, XNUC2, XLBEXC, XRTMIN, XLBEXC, XLBC
-use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
+USE MODD_RAIN_ICE_PARAM_n, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS, XFSEDC
use mode_budget, only: Budget_store_init, Budget_store_end
diff --git a/src/PHYEX/micro/rain_ice_sedimentation_stat.f90 b/src/PHYEX/micro/rain_ice_sedimentation_stat.f90
index 68eff90a2773e9ab61b3280428467a96662383ff..e25073ed075b47fcb13ab41774fec7db282e6ff0 100644
--- a/src/PHYEX/micro/rain_ice_sedimentation_stat.f90
+++ b/src/PHYEX/micro/rain_ice_sedimentation_stat.f90
@@ -30,11 +30,11 @@ SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT( KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE
use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
tbudgets
-use MODD_CST, only: XRHOLW
-use MODD_PARAM_ICE, only: LDEPOSC, XVDEPOSC
-use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
+USE MODD_CST, only: XRHOLW
+USE MODD_PARAM_ICE_n, only: LDEPOSC, XVDEPOSC
+USE MODD_RAIN_ICE_PARAM_n, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
XFSEDC, XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS
-use MODD_RAIN_ICE_DESCR, only: XALPHAC, XALPHAC2, XCC, XCEXVT, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
+USE MODD_RAIN_ICE_DESCR_n, only: XALPHAC, XALPHAC2, XCC, XCEXVT, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
XDC, XLBC, XLBEXC, XNUC, XNUC2, XRTMIN
use mode_budget, only: Budget_store_init, Budget_store_end
diff --git a/src/PHYEX/micro/rain_ice_slow.f90 b/src/PHYEX/micro/rain_ice_slow.f90
index 4f590c70d81c87262cfe19e85325f1d4206b6f80..fbd645ac665b78ca483a8df20d726d622a1bf909 100644
--- a/src/PHYEX/micro/rain_ice_slow.f90
+++ b/src/PHYEX/micro/rain_ice_slow.f90
@@ -29,9 +29,9 @@ SUBROUTINE RAIN_ICE_SLOW(OMICRO, PINVTSTEP, PRHODREF,
use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, &
NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, &
tbudgets
-use MODD_CST, only: XALPI, XBETAI, XCI, XCPV, XGAMI, XLSTT, XMNH_HUGE_12_LOG, XP00, XRV, XTT
-use MODD_RAIN_ICE_DESCR, only: XCEXVT, XLBDAS_MAX, XLBEXG, XLBEXS, XLBG, XLBS, XRTMIN, XBS
-use MODD_RAIN_ICE_PARAM, only: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA3, XBCRIAUTI, XBETA3, XCOLEXIS, XCRIAUTI, &
+USE MODD_CST, only: XALPI, XBETAI, XCI, XCPV, XGAMI, XLSTT, XMNH_HUGE_12_LOG, XP00, XRV, XTT
+USE MODD_RAIN_ICE_DESCR_n, only: XCEXVT, XLBDAS_MAX, XLBEXG, XLBEXS, XLBG, XLBS, XRTMIN, XBS
+USE MODD_RAIN_ICE_PARAM_n, only: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA3, XBCRIAUTI, XBETA3, XCOLEXIS, XCRIAUTI, &
XEX0DEPG, XEX0DEPS, XEX1DEPG, XEX1DEPS, XEXIAGGS, XFIAGGS, XHON, XSCFAC, XTEXAUTI, XTIMAUTI
use mode_budget, only: Budget_store_add
@@ -147,11 +147,7 @@ real, dimension(size(plsfact)) :: zz_diff
END WHERE
ZZW(:) = 0.0
WHERE ( (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0) )
-#if defined(REPRO48)
- 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(:)))
@@ -173,13 +169,8 @@ 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)
- * 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/micro/rain_ice_warm.f90 b/src/PHYEX/micro/rain_ice_warm.f90
index 0a781900c768fdd2cf37a3d36ecc27c238709efe..e31659abd784050f458ff6f7fe531a13dcc53a06 100644
--- a/src/PHYEX/micro/rain_ice_warm.f90
+++ b/src/PHYEX/micro/rain_ice_warm.f90
@@ -29,10 +29,10 @@ SUBROUTINE RAIN_ICE_WARM(OMICRO, KMICRO, K1, K2, K3,
use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, &
tbudgets
-use MODD_CST, only: XALPW, XBETAW, XCL, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
-use MODD_PARAM_ICE, only: CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP
-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: XALPW, XBETAW, XCL, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
+USE MODD_PARAM_ICE_n, only: CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP
+USE MODD_RAIN_ICE_DESCR_n, only: XCEXVT, XRTMIN
+USE MODD_RAIN_ICE_PARAM_n, only: X0EVAR, X1EVAR, XCRIAUTC, XEX0EVAR, XEX1EVAR, XEXCACCR, XFCACCR, XTIMAUTC
use mode_budget, only: Budget_store_add
use MODE_MSG
diff --git a/src/PHYEX/turb/les_mean_subgrid.f90 b/src/PHYEX/turb/les_mean_subgrid.f90
index 24895fdb06e56b851a2297c1c025eb9881da7c3c..a2b5854fd64c6a3f5fffc223403f965f3104dd36 100644
--- a/src/PHYEX/turb/les_mean_subgrid.f90
+++ b/src/PHYEX/turb/les_mean_subgrid.f90
@@ -12,9 +12,11 @@
MODULE MODI_LES_MEAN_SUBGRID
! #####################
!
+IMPLICIT NONE
INTERFACE LES_MEAN_SUBGRID
!
SUBROUTINE LES_MEAN_SUBGRID_3D(PA, PA_MEAN, OSUM)
+IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
!
@@ -26,6 +28,7 @@ END SUBROUTINE LES_MEAN_SUBGRID_3D
!
SUBROUTINE LES_MEAN_SUBGRID_SURF(PA, PA_MEAN, OSUM)
+IMPLICIT NONE
REAL, DIMENSION(:,:), INTENT(IN) :: PA
!
diff --git a/src/PHYEX/turb/les_mean_subgrid_phy.f90 b/src/PHYEX/turb/les_mean_subgrid_phy.f90
index 92d0629464e0cff34788b70ae8bcc8cd6d4071b5..a8ca991c2ee6406bce503da0484d1e37c31f014b 100644
--- a/src/PHYEX/turb/les_mean_subgrid_phy.f90
+++ b/src/PHYEX/turb/les_mean_subgrid_phy.f90
@@ -12,6 +12,7 @@
MODULE MODI_LES_MEAN_SUBGRID_PHY
! #####################
!
+IMPLICIT NONE
INTERFACE LES_MEAN_SUBGRID_PHY
!
diff --git a/src/PHYEX/turb/modd_cturb.f90 b/src/PHYEX/turb/modd_cturb.f90
index 10b21c7580b75424c1eca936247d1f46ff4c7635..166228d89a0d09d8a716800e22f77c512ee902f4 100644
--- a/src/PHYEX/turb/modd_cturb.f90
+++ b/src/PHYEX/turb/modd_cturb.f90
@@ -44,30 +44,20 @@ TYPE CSTURB_t
!
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 :: 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 :: XCET ! constant into the transport term of the TKE eq.
-REAL :: XCED ! constant into the dissipation term of the TKE 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 :: XTKEMIN ! mimimum value for the TKE
REAL :: XRM17 ! Rodier et al 2017 constant in shear term for mixing length
!
-REAL :: XLINI ! initial value for BL mixing length
REAL :: XLINF ! to prevent division by zero in the BL algorithm
!
REAL :: XALPSBL ! constant linking TKE and friction velocity in the SBL
@@ -78,7 +68,6 @@ 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 :: XPHI_LIM ! Threshold value for Phi3 and Psi3
REAL :: XSBL_O_BL ! SBL height / BL height ratio
@@ -90,30 +79,20 @@ 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()
@@ -124,7 +103,6 @@ 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()
@@ -135,30 +113,20 @@ 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
@@ -169,7 +137,6 @@ IMPLICIT NONE
XA3=>CSTURB%XA3
XA5=>CSTURB%XA5
XCTD=>CSTURB%XCTD
- XCTP=>CSTURB%XCTP
!
XPHI_LIM=>CSTURB%XPHI_LIM
XSBL_O_BL=>CSTURB%XSBL_O_BL
diff --git a/src/PHYEX/turb/modd_param_mfshalln.f90 b/src/PHYEX/turb/modd_param_mfshalln.f90
index 72a5644bf955b2cf90266ebeed7b161564f081bc..664812c582f179a458ab25c786b1c0db22964a46 100644
--- a/src/PHYEX/turb/modd_param_mfshalln.f90
+++ b/src/PHYEX/turb/modd_param_mfshalln.f90
@@ -1,21 +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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!-----------------------------------------------------------------
! #############################
MODULE MODD_PARAM_MFSHALL_n
! #############################
-!
-!!**** *MODD_PARAM_MFSHALL_n* - Declaration of Mass flux scheme free parameters
+!> @file
+!! *MODD_PARAM_MFSHALL_n* - Declaration of Mass flux scheme free parameters
!!
!! PURPOSE
!! -------
!! The purpose of this declarative module is to declare the
!! variables that may be set by namelist for the mass flux scheme
!!
-!!** IMPLICIT ARGUMENTS
+!! IMPLICIT ARGUMENTS
!! ------------------
!! None
!!
@@ -42,54 +42,46 @@ IMPLICIT NONE
TYPE PARAM_MFSHALL_t
-REAL :: XIMPL_MF ! degre of implicitness
+REAL :: XIMPL_MF !< degre of implicitness
-CHARACTER (LEN=4) :: CMF_UPDRAFT ! Type of Mass Flux Scheme
- ! 'NONE' if no parameterization
-CHARACTER (LEN=4) :: CMF_CLOUD
+CHARACTER (LEN=4) :: CMF_UPDRAFT !< Type of Mass Flux Scheme
+ !! 'NONE' if no parameterization
+CHARACTER (LEN=4) :: CMF_CLOUD !< Type of cloud scheme associated
-LOGICAL :: LMIXUV ! True if mixing of momentum
-LOGICAL :: LMF_FLX ! logical switch for the storage of
- ! the mass flux fluxes
-REAL :: XALP_PERT ! coefficient for the perturbation of
- ! theta_l and r_t at the first level of
- ! the updraft
-REAL :: XABUO ! coefficient of the buoyancy term in the w_up equation
-REAL :: XBENTR ! coefficient of the entrainment term in the w_up equation
-REAL :: XBDETR ! coefficient of the detrainment term in the w_up equation
-REAL :: XCMF ! coefficient for the mass flux at the first level
- ! of the updraft (closure)
-REAL :: XENTR_MF ! entrainment constant (m/Pa) = 0.2 (m)
-REAL :: XCRAD_MF ! cloud radius in cloudy part
-REAL :: XENTR_DRY ! coefficient for entrainment in dry part
-REAL :: XDETR_DRY ! coefficient for detrainment in dry part
-REAL :: XDETR_LUP ! coefficient for detrainment in dry part
-REAL :: XKCF_MF ! coefficient for cloud fraction
-REAL :: XKRC_MF ! coefficient for convective rc
+LOGICAL :: LMIXUV !< True if mixing of momentum
+LOGICAL :: LMF_FLX !< logical switch for the storage of the mass flux fluxes
+REAL :: XALP_PERT !< coefficient for the perturbation of
+ !! theta_l and r_t at the first level of the updraft
+REAL :: XABUO !< coefficient of the buoyancy term in the w_up equation
+REAL :: XBENTR !< coefficient of the entrainment term in the w_up equation
+REAL :: XBDETR !< coefficient of the detrainment term in the w_up equation
+REAL :: XCMF !< coefficient for the mass flux at the first level of the updraft (closure)
+REAL :: XENTR_MF !< entrainment constant (m/Pa) = 0.2 (m)
+REAL :: XCRAD_MF !< cloud radius in cloudy part
+REAL :: XENTR_DRY !< coefficient for entrainment in dry part
+REAL :: XDETR_DRY !< coefficient for detrainment in dry part
+REAL :: XDETR_LUP !< coefficient for detrainment in dry part
+REAL :: XKCF_MF !< coefficient for cloud fraction
+REAL :: XKRC_MF !< coefficient for convective rc
REAL :: XTAUSIGMF
-REAL :: XPRES_UV ! coefficient for pressure term in wind
- ! mixing
-REAL :: XALPHA_MF ! coefficient for cloudy fraction
-REAL :: XSIGMA_MF ! coefficient for sigma computation
-REAL :: XFRAC_UP_MAX! maximum Updraft fraction
-!
-! Parameter for Rio et al (2010) formulation for entrainment and detrainment (RHCJ10)
-REAL :: XA1
-REAL :: XB
-REAL :: XC
-REAL :: XBETA1
-!
-! Parameters for closure assumption of Hourdin et al 2002
-
-REAL :: XR ! Aspect ratio of updraft
+REAL :: XPRES_UV !< coefficient for pressure term in wind mixing
+REAL :: XALPHA_MF !< coefficient for cloudy fraction
+REAL :: XSIGMA_MF !< coefficient for sigma computation
+REAL :: XFRAC_UP_MAX!< maximum Updraft fraction
+!
+REAL :: XA1 !< Parameter for Rio et al (2010) formulation for entrainment and detrainment (RHCJ10)
+REAL :: XB !!
+REAL :: XC !!
+REAL :: XBETA1 !!
!
-! Grey Zone
-LOGICAL :: LGZ ! Grey Zone Surface Closure
-REAL :: XGZ ! Tuning of the surface initialisation
+REAL :: XR !< Parameter for closure assumption of Hourdin et al (2002): aspect ratio of updraft
!
-! Thermodynamic parameter
-REAL :: XLAMBDA_MF ! Lambda to compute ThetaS1 from ThetaL
+LOGICAL :: LGZ !< Grey Zone Surface Closure
+REAL :: XGZ !< Tuning of the surface initialisation for Grey Zone
+!
+LOGICAL :: LTHETAS_MF !< .TRUE. to use ThetaS1 instead of ThetaL
+REAL :: XLAMBDA_MF !< Thermodynamic parameter: Lambda to compute ThetaS1 from ThetaL
END TYPE PARAM_MFSHALL_t
@@ -124,14 +116,29 @@ REAL, POINTER :: XB=>NULL()
REAL, POINTER :: XC=>NULL()
REAL, POINTER :: XBETA1=>NULL()
REAL, POINTER :: XR=>NULL()
+LOGICAL, POINTER :: LTHETAS_MF=>NULL()
REAL, POINTER :: XLAMBDA_MF=>NULL()
LOGICAL, POINTER :: LGZ=>NULL()
REAL, POINTER :: XGZ=>NULL()
+!
+NAMELIST/NAM_PARAM_MFSHALLn/XIMPL_MF,CMF_UPDRAFT,CMF_CLOUD,LMIXUV,LMF_FLX,&
+ XALP_PERT,XABUO,XBENTR,XBDETR,XCMF,XENTR_MF,&
+ XCRAD_MF,XENTR_DRY,XDETR_DRY,XDETR_LUP,XKCF_MF,&
+ XKRC_MF,XTAUSIGMF,XPRES_UV,XALPHA_MF,XSIGMA_MF,&
+ XFRAC_UP_MAX,XA1,XB,XC,XBETA1,XR,LTHETAS_MF,LGZ,XGZ
+!
+!-------------------------------------------------------------------------------
+!
CONTAINS
SUBROUTINE PARAM_MFSHALL_GOTO_MODEL(KFROM, KTO)
+!! This subroutine associate all the pointers to the right component of
+!! the right strucuture. A value can be accessed through the structure PARAM_MFSHALLN
+!! or through the strucuture PARAM_MFSHALL_MODEL(KTO) or directly through these pointers.
INTEGER, INTENT(IN) :: KFROM, KTO
!
+IF(.NOT. ASSOCIATED(PARAM_MFSHALLN, PARAM_MFSHALL_MODEL(KTO))) THEN
+!
PARAM_MFSHALLN => PARAM_MFSHALL_MODEL(KTO)
!
! Save current state for allocated arrays
@@ -165,10 +172,143 @@ XB=>PARAM_MFSHALL_MODEL(KTO)%XB
XC=>PARAM_MFSHALL_MODEL(KTO)%XC
XBETA1=>PARAM_MFSHALL_MODEL(KTO)%XBETA1
XR=>PARAM_MFSHALL_MODEL(KTO)%XR
+LTHETAS_MF=>PARAM_MFSHALL_MODEL(KTO)%LTHETAS_MF
XLAMBDA_MF=>PARAM_MFSHALL_MODEL(KTO)%XLAMBDA_MF
LGZ=>PARAM_MFSHALL_MODEL(KTO)%LGZ
XGZ=>PARAM_MFSHALL_MODEL(KTO)%XGZ
!
+ENDIF
+!
END SUBROUTINE PARAM_MFSHALL_GOTO_MODEL
+SUBROUTINE PARAM_MFSHALLN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ &LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
+!!*** *PARAM_MFSHALLN* - Code needed to initialize the MODD_PARAM_MFSHALL_n module
+!!
+!!* PURPOSE
+!! -------
+!! Sets the default values, reads the namelist, performs the checks and prints
+!!
+!!* METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Default values
+!! 2. Namelist
+!! 3. Checks
+!! 4. Prints
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Feb 2023
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
+USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
+INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
+INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
+LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDREADNAM !< Must we read the namelist (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDCHECK !< Must we perform some checks on values (defaults to .TRUE.)
+INTEGER, OPTIONAL, INTENT(IN) :: KPRINT !< Print level (defaults to 0): 0 for no print, 1 to safely print namelist,
+ !! 2 to print informative messages
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+LOGICAL :: LLDEFAULTVAL, LLREADNAM, LLCHECK, LLFOUND
+INTEGER :: IPRINT
+
+LLDEFAULTVAL=.TRUE.
+LLREADNAM=.TRUE.
+LLCHECK=.TRUE.
+IPRINT=0
+IF(PRESENT(LDDEFAULTVAL)) LLDEFAULTVAL=LDDEFAULTVAL
+IF(PRESENT(LDREADNAM )) LLREADNAM =LDREADNAM
+IF(PRESENT(LDCHECK )) LLCHECK =LDCHECK
+IF(PRESENT(KPRINT )) IPRINT =KPRINT
+!
+!* 1. DEFAULT VALUES
+! -----------------
+!
+IF(LLDEFAULTVAL) THEN
+ !NOTES ON GENERAL DEFAULTS AND MODEL-SPECIFIC DEFAULTS :
+ !- General default values *MUST* remain unchanged.
+ !- To change the default value for a given application,
+ ! an "IF(HPROGRAM=='...')" condition must be used.
+
+ 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
+ XALPHA_MF=2.
+ XSIGMA_MF=20.
+ XFRAC_UP_MAX=0.33
+ XA1=2./3.
+ XB=0.002
+ XC=0.012
+ XBETA1=0.9
+ XR=2.
+ LTHETAS_MF=.FALSE.
+ XLAMBDA_MF=0.
+ LGZ=.FALSE.
+ XGZ=1.83 ! between 1.83 and 1.33
+ENDIF
+!
+!* 2. NAMELIST
+! -----------
+!
+IF(LLREADNAM) THEN
+ CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_MFSHALLN', LDNEEDNAM, LLFOUND, KLUOUT)
+ IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_MFSHALLn)
+ENDIF
+!
+!* 3. CHECKS
+! ---------
+!
+IF(LLCHECK) THEN
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CMF_CLOUD', CMF_CLOUD, 'NONE', 'STAT', 'DIRE', 'BIGA')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CMF_UPDRAFT', CMF_UPDRAFT, 'NONE', 'EDKF', 'RHCJ', 'RAHA')
+ENDIF
+!
+!* 3. PRINTS
+! ---------
+!
+IF(IPRINT>=1) THEN
+ WRITE(UNIT=KLUOUT,NML=NAM_PARAM_MFSHALLn)
+ENDIF
+!
+END SUBROUTINE PARAM_MFSHALLN_INIT
+!
END MODULE MODD_PARAM_MFSHALL_n
diff --git a/src/PHYEX/turb/modd_turbn.f90 b/src/PHYEX/turb/modd_turbn.f90
index defaab643b41917ccd50e45c98c533aee266b3bf..b4c173c55c0f15b29987a2d25658bbb25a326a2f 100644
--- a/src/PHYEX/turb/modd_turbn.f90
+++ b/src/PHYEX/turb/modd_turbn.f90
@@ -6,7 +6,7 @@
! ##################
MODULE MODD_TURB_n
! ##################
-!
+!> @file
!!**** *MODD_TURB$n* - declaration of turbulence scheme free parameters
!!
!! PURPOSE
@@ -41,6 +41,7 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! D. Ricard May 2021 add the switches for Leonard terms
!! JL Redelsperger 03/2021 Add O-A flux for auto-coupled LES case
+!! S. Riette June 2023: add LSMOOTH_PRANDTL, XMINSIGS and XBL89EXP/XUSRBL89
!!
!-------------------------------------------------------------------------------
!
@@ -53,90 +54,104 @@ IMPLICIT NONE
TYPE TURB_t
!
!
- REAL :: XIMPL ! implicitness degree for the vertical terms of
- ! the turbulence scheme
- REAL :: XKEMIN ! mimimum value for the TKE
- REAL :: XCEDIS ! Constant for dissipation of Tke
- REAL :: XCADAP ! Coefficient for ADAPtative mixing length
- CHARACTER (LEN=4) :: CTURBLEN ! type of length used for the closure
- ! 'BL89' Bougeault and Lacarrere scheme
- ! 'DELT' length = ( volum) ** 1/3
- CHARACTER (LEN=4) :: CTURBDIM ! dimensionality of the turbulence scheme
- ! '1DIM' for purely vertical computations
- ! '3DIM' for computations in the 3
- ! directions
- LOGICAL :: LTURB_FLX ! logical switch for the storage of all
- ! the turbulent fluxes
- LOGICAL :: LTURB_DIAG! logical switch for the storage of some
- ! turbulence related diagnostics
- LOGICAL :: LSUBG_COND! Switch for subgrid condensation
- 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 &
-! ! Carlotti 2001
- CHARACTER(LEN=4) :: CTOM ! type of Third Order Moments
- ! 'NONE' none
- ! 'TM06' Tomas Masson 2006
- CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid rc->rr autoconv. method
- CHARACTER(LEN=80) :: CSUBG_AUCV_RI ! type of subgrid ri->rs autoconv. method
- CHARACTER(LEN=80) :: CCONDENS ! subrgrid condensation PDF
- CHARACTER(LEN=4) :: CLAMBDA3 ! lambda3 choice for subgrid cloud scheme
- CHARACTER(LEN=80) :: CSUBG_MF_PDF ! PDF to use for MF cloud autoconversions
+ REAL :: XIMPL !< implicitness degree for the vertical terms of the turbulence scheme
+ REAL :: XTKEMIN !< mimimum value for the TKE
+ REAL :: XCED !< Constant for dissipation of Tke
+ REAL :: XCTP !< Constant for temperature and vapor pressure-correlations
+ 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 :: XCPR1 !< first ct. for the turbulent Prandtl numbers
+ REAL :: XCADAP !< Coefficient for ADAPtative mixing length
+ CHARACTER (LEN=4) :: CTURBLEN !< type of length used for the closure:
+ !! 'BL89' Bougeault and Lacarrere scheme;
+ !! 'DELT' length = ( volum) ** 1/3
+ CHARACTER (LEN=4) :: CTURBDIM !< dimensionality of the turbulence scheme:
+ !! '1DIM' for purely vertical computations;
+ !! '3DIM' for computations in the 3 directions
+ LOGICAL :: LTURB_FLX !< logical switch for the storage of all the turbulent fluxes
+ LOGICAL :: LTURB_DIAG !< logical switch for the storage of some turbulence related diagnostics
+ LOGICAL :: LSIG_CONV !< Switch for computing Sigma_s due to convection
+!
+ LOGICAL :: LHARAT !< if true RACMO turbulence is used
+ LOGICAL :: LRMC01 !< Switch for computing separate mixing and dissipative length in the SBL
+ !! according to Redelsperger, Mahe & Carlotti 2001
+ CHARACTER(LEN=4) :: CTOM !< type of Third Order Moments:
+ !! 'NONE' none;
+ !! 'TM06' Tomas Masson 2006
! REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL() ! BL depth for TOMS computations
! REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()! SurfaceBL depth for RMC01 computations
! REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()! Mass Flux vert. transport of buoyancy
- REAL :: VSIGQSAT ! coeff applied to qsat variance contribution
- REAL, DIMENSION(:,:,:), POINTER :: XDYP=>NULL() ! Dynamical production of Kinetic energy
- REAL, DIMENSION(:,:,:), POINTER :: XTHP=>NULL() ! Thermal production of Kinetic energy
- REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL() ! Transport production of Kinetic energy
- REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL() ! Dissipation of Kinetic energy
- REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL() ! Mixing length
- REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL() ! O-A interface flux for u
- 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 :: 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
- REAL :: XCLDTHOLD ! cloud threshold to apply the Leonard terms
- ! negative value : applied everywhere
- ! 0.000001 applied only inside the clouds ri+rc > 10**-6 kg/kg
-!
+ REAL, DIMENSION(:,:,:), POINTER :: XDYP=>NULL() !< Dynamical production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XTHP=>NULL() !< Thermal production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL() !< Transport production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL() !< Dissipation of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL() !< Mixing length
+ REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL() !< O-A interface flux for u
+ 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 :: 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
+ REAL :: XCLDTHOLD !< cloud threshold to apply the Leonard terms:
+ !! negative value to apply everywhere;
+ !! 0.000001 applied only inside the clouds ri+rc > 10**-6 kg/kg
+ REAL :: XLINI !< initial value for BL mixing length
+ LOGICAL :: LROTATE_WIND !< .TRUE. to rotate wind components
+ LOGICAL :: LTKEMINTURB !< set a minimum value for the TKE in the turbulence scheme
+ LOGICAL :: LPROJQITURB !< project the rt tendency on rc/ri
+ LOGICAL :: LSMOOTH_PRANDTL !< .TRUE. to smooth prandtl functions
+ REAL :: XMINSIGS !< minimum value for SIGS computed by the turbulence scheme
+ REAL :: XBL89EXP, XUSRBL89 !< exponent on final BL89 length
+ INTEGER :: NTURBSPLIT !<number of time-splitting for turb_hor
+ LOGICAL :: LCLOUDMODIFLM !< .TRUE. to activate modification of mixing length in clouds
+ CHARACTER(LEN=4) :: CTURBLEN_CLOUD !< type of length in the clouds
+ ! 'DEAR' Deardorff mixing length
+ ! 'BL89' Bougeault and Lacarrere scheme
+ ! 'DELT' length = ( volum) ** 1/3
+REAL :: XCOEF_AMPL_SAT !< saturation of the amplification coefficient
+REAL :: XCEI_MIN !< minimum threshold for the instability index CEI
+ !(beginning of the amplification)
+REAL :: XCEI_MAX !< maximum threshold for the instability index CEI
+ !(beginning of the saturation of the amplification)
+REAL, DIMENSION(:,:,:), POINTER :: XCEI !< Cloud Entrainment instability index to emphasize localy
+ ! turbulent fluxes
+
+!
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()
+REAL, POINTER :: XTKEMIN=>NULL()
+REAL, POINTER :: XCED=>NULL()
+REAL, POINTER :: XCTP=>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 :: XCADAP=>NULL()
CHARACTER (LEN=4), POINTER :: CTURBLEN=>NULL()
CHARACTER (LEN=4), POINTER :: CTURBDIM=>NULL()
LOGICAL, POINTER :: LTURB_FLX=>NULL()
LOGICAL, POINTER :: LTURB_DIAG=>NULL()
-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()
-CHARACTER(LEN=80),POINTER :: CCONDENS=>NULL()
-CHARACTER(LEN=4),POINTER :: CLAMBDA3=>NULL()
-CHARACTER(LEN=80),POINTER :: CSUBG_MF_PDF=>NULL()
REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL()
REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()
-REAL, POINTER :: VSIGQSAT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XDYP=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTHP=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL()
@@ -151,54 +166,87 @@ REAL, POINTER :: XCOEFHGRADTHL=>NULL()
REAL, POINTER :: XCOEFHGRADRM=>NULL()
REAL, POINTER :: XALTHGRAD=>NULL()
REAL, POINTER :: XCLDTHOLD=>NULL()
-
+REAL, POINTER :: XLINI=>NULL()
+LOGICAL, POINTER :: LROTATE_WIND=>NULL()
+LOGICAL, POINTER :: LTKEMINTURB=>NULL()
+LOGICAL, POINTER :: LPROJQITURB=>NULL()
+LOGICAL, POINTER :: LSMOOTH_PRANDTL=>NULL()
+REAL, POINTER :: XMINSIGS=>NULL()
+REAL, POINTER :: XBL89EXP=>NULL(), XUSRBL89=>NULL()
+INTEGER, POINTER :: NTURBSPLIT=>NULL()
+LOGICAL, POINTER :: LCLOUDMODIFLM=>NULL()
+CHARACTER(LEN=4), POINTER :: CTURBLEN_CLOUD=>NULL()
+REAL, POINTER :: XCOEF_AMPL_SAT=>NULL()
+REAL, POINTER :: XCEI_MIN=>NULL()
+REAL, POINTER :: XCEI_MAX =>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XCEI=>NULL()
+!
+NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
+ LSIG_CONV,LRMC01,CTOM,&
+ XTKEMIN,XCED,XCTP,XCADAP,&
+ LLEONARD,XCOEFHGRADTHL, XCOEFHGRADRM, &
+ XALTHGRAD, XCLDTHOLD, XLINI, LHARAT, &
+ LPROJQITURB, LSMOOTH_PRANDTL, XMINSIGS, NTURBSPLIT, &
+ LCLOUDMODIFLM, CTURBLEN_CLOUD, &
+ XCOEF_AMPL_SAT, XCEI_MIN, XCEI_MAX
+!
+!-------------------------------------------------------------------------------
+!
CONTAINS
SUBROUTINE TURB_GOTO_MODEL(KFROM, KTO)
+!! This subroutine associate all the pointers to the right component of
+!! the right strucuture. A value can be accessed through the structure TURBN
+!! or through the strucuture TURB_MODEL(KTO) or directly through these pointers.
+IMPLICIT NONE
INTEGER, INTENT(IN) :: KFROM, KTO
!
+IF(.NOT. ASSOCIATED(TURBN, TURB_MODEL(KTO))) THEN
+!
TURBN => TURB_MODEL(KTO)
!
! Save current state for allocated arrays
!
-!TURB_MODEL(KFROM)%XBL_DEPTH=>XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
-!TURB_MODEL(KFROM)%XSBL_DEPTH=>XSBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
-!TURB_MODEL(KFROM)%XWTHVMF=>XWTHVMF !Done in FIELDLIST_GOTO_MODEL
-TURB_MODEL(KFROM)%XDYP=>XDYP
-TURB_MODEL(KFROM)%XTHP=>XTHP
-TURB_MODEL(KFROM)%XTR=>XTR
-TURB_MODEL(KFROM)%XDISS=>XDISS
-TURB_MODEL(KFROM)%XLEM=>XLEM
-TURB_MODEL(KFROM)%XSSUFL_C=>XSSUFL_C
-TURB_MODEL(KFROM)%XSSVFL_C=>XSSVFL_C
-TURB_MODEL(KFROM)%XSSTFL_C=>XSSTFL_C
-TURB_MODEL(KFROM)%XSSRFL_C=>XSSRFL_C
+IF(KFROM>0 .AND. KFROM<=JPMODELMAX) THEN
+ !TURB_MODEL(KFROM)%XBL_DEPTH=>XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
+ !TURB_MODEL(KFROM)%XSBL_DEPTH=>XSBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
+ !TURB_MODEL(KFROM)%XWTHVMF=>XWTHVMF !Done in FIELDLIST_GOTO_MODEL
+ TURB_MODEL(KFROM)%XDYP=>XDYP
+ TURB_MODEL(KFROM)%XTHP=>XTHP
+ TURB_MODEL(KFROM)%XTR=>XTR
+ TURB_MODEL(KFROM)%XDISS=>XDISS
+ TURB_MODEL(KFROM)%XLEM=>XLEM
+ TURB_MODEL(KFROM)%XSSUFL_C=>XSSUFL_C
+ TURB_MODEL(KFROM)%XSSVFL_C=>XSSVFL_C
+ TURB_MODEL(KFROM)%XSSTFL_C=>XSSTFL_C
+ TURB_MODEL(KFROM)%XSSRFL_C=>XSSRFL_C
+ TURB_MODEL(KFROM)%XCEI=>XCEI
+ENDIF
!
! Current model is set to model KTO
XIMPL=>TURB_MODEL(KTO)%XIMPL
-XKEMIN=>TURB_MODEL(KTO)%XKEMIN
-XCEDIS=>TURB_MODEL(KTO)%XCEDIS
+XTKEMIN=>TURB_MODEL(KTO)%XTKEMIN
+XCED=>TURB_MODEL(KTO)%XCED
+XCTP=>TURB_MODEL(KTO)%XCTP
+XCSHF=>TURB_MODEL(KTO)%XCSHF
+XCHF=>TURB_MODEL(KTO)%XCHF
+XCTV=>TURB_MODEL(KTO)%XCTV
+XCHV=>TURB_MODEL(KTO)%XCHV
+XCHT1=>TURB_MODEL(KTO)%XCHT1
+XCHT2=>TURB_MODEL(KTO)%XCHT2
+XCPR1=>TURB_MODEL(KTO)%XCPR1
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
LSIG_CONV=>TURB_MODEL(KTO)%LSIG_CONV
LRMC01=>TURB_MODEL(KTO)%LRMC01
CTOM=>TURB_MODEL(KTO)%CTOM
-CSUBG_AUCV=>TURB_MODEL(KTO)%CSUBG_AUCV
-CSUBG_AUCV_RI=>TURB_MODEL(KTO)%CSUBG_AUCV_RI
-CCONDENS=>TURB_MODEL(KTO)%CCONDENS
-CLAMBDA3=>TURB_MODEL(KTO)%CLAMBDA3
-CSUBG_MF_PDF=>TURB_MODEL(KTO)%CSUBG_MF_PDF
!XBL_DEPTH=>TURB_MODEL(KTO)%XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
!XSBL_DEPTH=>TURB_MODEL(KTO)%XSBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
!XWTHVMF=>TURB_MODEL(KTO)%XWTHVMF !Done in FIELDLIST_GOTO_MODEL
-VSIGQSAT=>TURB_MODEL(KTO)%VSIGQSAT
XDYP=>TURB_MODEL(KTO)%XDYP
XTHP=>TURB_MODEL(KTO)%XTHP
XTR=>TURB_MODEL(KTO)%XTR
@@ -213,7 +261,171 @@ XCOEFHGRADTHL=>TURB_MODEL(KTO)%XCOEFHGRADTHL
XCOEFHGRADRM=>TURB_MODEL(KTO)%XCOEFHGRADRM
XALTHGRAD=>TURB_MODEL(KTO)%XALTHGRAD
XCLDTHOLD=>TURB_MODEL(KTO)%XCLDTHOLD
-
+XLINI=>TURB_MODEL(KTO)%XLINI
+LROTATE_WIND=>TURB_MODEL(KTO)%LROTATE_WIND
+LTKEMINTURB=>TURB_MODEL(KTO)%LTKEMINTURB
+LPROJQITURB=>TURB_MODEL(KTO)%LPROJQITURB
+LSMOOTH_PRANDTL=>TURB_MODEL(KTO)%LSMOOTH_PRANDTL
+XMINSIGS=>TURB_MODEL(KTO)%XMINSIGS
+XBL89EXP=>TURB_MODEL(KTO)%XBL89EXP
+XUSRBL89=>TURB_MODEL(KTO)%XUSRBL89
+NTURBSPLIT=>TURB_MODEL(KTO)%NTURBSPLIT
+LCLOUDMODIFLM=>TURB_MODEL(KTO)%LCLOUDMODIFLM
+CTURBLEN_CLOUD=>TURB_MODEL(KTO)%CTURBLEN_CLOUD
+XCOEF_AMPL_SAT=>TURB_MODEL(KTO)%XCOEF_AMPL_SAT
+XCEI_MIN=>TURB_MODEL(KTO)%XCEI_MIN
+XCEI_MAX =>TURB_MODEL(KTO)%XCEI_MAX
+XCEI=>TURB_MODEL(KTO)%XCEI
+!
+ENDIF
+!
END SUBROUTINE TURB_GOTO_MODEL
+SUBROUTINE TURBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ &LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
+!!*** *TURBN_INIT* - Code needed to initialize the MODD_TURB_n module
+!!
+!!* PURPOSE
+!! -------
+!! Sets the default values, reads the namelist, performs the checks and prints
+!!
+!!* METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Default values
+!! 2. Namelist
+!! 3. Checks
+!! 4. Prints
+!!
+!! AUTHOR
+!! ------
+!! S. Riette
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original Feb 2023
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
+USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+USE MODD_PARAMETERS, ONLY: XUNDEF
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
+INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
+INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
+LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDREADNAM !< Must we read the namelist (defaults to .TRUE.)
+LOGICAL, OPTIONAL, INTENT(IN) :: LDCHECK !< Must we perform some checks on values (defaults to .TRUE.)
+INTEGER, OPTIONAL, INTENT(IN) :: KPRINT !< Print level (defaults to 0): 0 for no print, 1 to safely print namelist,
+ !! 2 to print informative messages
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+LOGICAL :: LLDEFAULTVAL, LLREADNAM, LLCHECK, LLFOUND
+INTEGER :: IPRINT
+
+LLDEFAULTVAL=.TRUE.
+LLREADNAM=.TRUE.
+LLCHECK=.TRUE.
+IPRINT=0
+IF(PRESENT(LDDEFAULTVAL)) LLDEFAULTVAL=LDDEFAULTVAL
+IF(PRESENT(LDREADNAM )) LLREADNAM =LDREADNAM
+IF(PRESENT(LDCHECK )) LLCHECK =LDCHECK
+IF(PRESENT(KPRINT )) IPRINT =KPRINT
+!
+!* 1. DEFAULT VALUES
+! -----------------
+!
+IF(LLDEFAULTVAL) THEN
+ !NOTES ON GENERAL DEFAULTS AND MODEL-SPECIFIC DEFAULTS :
+ !- General default values *MUST* remain unchanged.
+ !- To change the default value for a given application,
+ ! an "IF(HPROGRAM=='...')" condition must be used.
+
+ XIMPL = 1.
+ XTKEMIN = 0.01
+ XCED = XUNDEF
+ XCTP = XUNDEF
+ XCADAP = 0.5
+ CTURBLEN = 'BL89'
+ CTURBDIM = '1DIM'
+ LTURB_FLX =.FALSE.
+ LTURB_DIAG=.FALSE.
+ LSIG_CONV =.FALSE.
+ LRMC01 =.FALSE.
+ CTOM ='NONE'
+ LLEONARD =.FALSE.
+ XCOEFHGRADTHL = 1.0
+ XCOEFHGRADRM = 1.0
+ XALTHGRAD = 2000.0
+ XCLDTHOLD = -1.0
+ XLINI=0.1 !old value: 10.
+ LHARAT=.FALSE.
+ LROTATE_WIND=.FALSE.
+ LTKEMINTURB=.TRUE.
+ LPROJQITURB=.TRUE.
+ LSMOOTH_PRANDTL=.TRUE.
+ XMINSIGS=0.
+ NTURBSPLIT=1
+ LCLOUDMODIFLM = .FALSE.
+ CTURBLEN_CLOUD = 'DELT'
+ XCOEF_AMPL_SAT = 5.
+ XCEI_MIN = 0.001E-06
+ XCEI_MAX = 0.01E-06
+ !
+ IF(HPROGRAM=='AROME') THEN
+ XTKEMIN=1.E-6
+ XLINI=0.
+ LPROJQITURB=.FALSE.
+ LSMOOTH_PRANDTL=.FALSE.
+ ELSEIF(HPROGRAM=='MESONH') THEN
+ LROTATE_WIND=.TRUE.
+ LTKEMINTURB=.FALSE.
+ XMINSIGS=1.E-12
+ ELSEIF(HPROGRAM=='LMDZ') THEN
+ XTKEMIN=1.E-6
+ XLINI=0.
+ ENDIF
+ENDIF
+!
+!* 2. NAMELIST
+! -----------
+!
+IF(LLREADNAM) THEN
+ CALL POSNAM_PHY(KUNITNML, 'NAM_TURBN', LDNEEDNAM, LLFOUND, KLUOUT)
+ IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_TURBn)
+ENDIF
+!
+!* 3. CHECKS
+! ---------
+!
+IF(LLCHECK) THEN
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBDIM', CTURBDIM, '1DIM', '3DIM')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN', CTURBLEN, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'ADAP')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTOM', CTOM, 'NONE', 'TM06')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN_CLOUD', CTURBLEN_CLOUD, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'ADAP')
+
+ENDIF
+!
+!* 3. PRINTS
+! ---------
+!
+IF(IPRINT>=1) THEN
+ WRITE(UNIT=KLUOUT,NML=NAM_TURBn)
+ENDIF
+!
+END SUBROUTINE TURBN_INIT
+!
END MODULE MODD_TURB_n
diff --git a/src/PHYEX/turb/mode_bl89.f90 b/src/PHYEX/turb/mode_bl89.f90
index 6a24431aebf4772b89a9fe6fe282f2a8357c0edd..dc0afbd4c22cf84d7a9448eaf81a9d173f3ee4ec 100644
--- a/src/PHYEX/turb/mode_bl89.f90
+++ b/src/PHYEX/turb/mode_bl89.f90
@@ -6,9 +6,8 @@ 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
+ SUBROUTINE BL89(D,CST,CSTURB,TURBN,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM,OOCEAN)
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #########################################################
!
!!**** *BL89* -
@@ -58,8 +57,8 @@ CONTAINS
!
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_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_PRECISION, ONLY: MNHREAL
!
!
@@ -71,6 +70,7 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -81,7 +81,6 @@ 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
@@ -113,10 +112,10 @@ INTEGER :: JRR ! moist loop counter
REAL :: ZRVORD ! Rv/Rd
REAL :: ZPOTE,ZLWORK1,ZLWORK2
REAL :: ZTEST,ZTEST0,ZTESTM ! test for vectorization
-REAL :: Z2SQRT2,ZUSRBL89,ZBL89EXP
+REAL :: Z2SQRT2
!-------------------------------------------------------------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('BL89',0,ZHOOK_HANDLE)
Z2SQRT2=2.*SQRT(2.)
!
@@ -158,9 +157,6 @@ END IF
ZSQRT_TKE(:,:) = SQRT(PTKEM(:,:))
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
-!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
!-------------------------------------------------------------------------------
!
!* 2. Virtual potential temperature on the model grid
@@ -249,11 +245,7 @@ DO JK=IKTB,IKTE
+ 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
@@ -298,11 +290,7 @@ DO JK=IKTB,IKTE
(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
@@ -318,14 +306,9 @@ DO JK=IKTB,IKTE
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
- PLM(JIJ,JK) = ZLWORK1*(2./ZLWORK2)**ZUSRBL89
-#endif
- PLM(JIJ,JK)=MAX(PLM(JIJ,JK),CSTURB%XLINI)
+ ZLWORK2=1.d0 + ZPOTE**TURBN%XBL89EXP
+ PLM(JIJ,JK) = ZLWORK1*(2./ZLWORK2)**TURBN%XUSRBL89
+ PLM(JIJ,JK)=MAX(PLM(JIJ,JK),TURBN%XLINI)
END DO
diff --git a/src/PHYEX/turb/mode_bl_depth_diag.f90 b/src/PHYEX/turb/mode_bl_depth_diag.f90
index a5e897a8dd12b49922dcc1c1a54c6897f4e26e8b..8d91826c43e86f086f655bab19ede5b561a3c616 100644
--- a/src/PHYEX/turb/mode_bl_depth_diag.f90
+++ b/src/PHYEX/turb/mode_bl_depth_diag.f90
@@ -3,6 +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 MODE_BL_DEPTH_DIAG
+IMPLICIT NONE
!
INTERFACE BL_DEPTH_DIAG
MODULE PROCEDURE BL_DEPTH_DIAG_3D
@@ -12,8 +13,7 @@ END INTERFACE
CONTAINS
!
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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
!
!!**** *SBL_DEPTH* - computes SBL depth
@@ -72,7 +72,7 @@ REAL :: ZFLX ! flux at top of BL
!
!----------------------------------------------------------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_3D',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -106,8 +106,7 @@ 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
@@ -128,7 +127,7 @@ REAL, DIMENSION(1,1,D%NKT) :: ZZZ
REAL, DIMENSION(1,1) :: ZBL_DEPTH_DIAG
!
INTEGER :: IKT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_1D',0,ZHOOK_HANDLE)
IKT=D%NKT
ZSURF = PSURF
diff --git a/src/PHYEX/turb/mode_compute_bl89_ml.f90 b/src/PHYEX/turb/mode_compute_bl89_ml.f90
index f59e548a91da1410966c8e8f78bf8db1b66cb56b..8ebf242e6e46eb0cc03322a68d8e5cead996cbca 100644
--- a/src/PHYEX/turb/mode_compute_bl89_ml.f90
+++ b/src/PHYEX/turb/mode_compute_bl89_ml.f90
@@ -5,8 +5,7 @@ CONTAINS
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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ###################################################################
!!
!! COMPUTE_BL89_ML routine to:
@@ -88,7 +87,7 @@ REAL :: ZTEST,ZTEST0,ZTESTM !test for vectorization
!
!* 1. INITIALISATION
! --------------
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_BL89_ML',0,ZHOOK_HANDLE)
!
IIJE=D%NIJE
diff --git a/src/PHYEX/turb/mode_compute_function_thermo_mf.f90 b/src/PHYEX/turb/mode_compute_function_thermo_mf.f90
index 2e294edf612d092d297afe27ba293a86e96a588e..6ec457e681f18793cb28cbe4b62a52e4e89a84a7 100644
--- a/src/PHYEX/turb/mode_compute_function_thermo_mf.f90
+++ b/src/PHYEX/turb/mode_compute_function_thermo_mf.f90
@@ -53,8 +53,7 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -95,7 +94,7 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: &
INTEGER :: JRR, JIJ, JK
INTEGER :: IIJB,IIJE ! physical horizontal domain indices
INTEGER :: IKTB,IKTE
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud.f90 b/src/PHYEX/turb/mode_compute_mf_cloud.f90
index c1ee0cfd6d86aca723cc05f4b4f8d73582ef19df..a9a6d456848a4ccfc3ed64fa2c5798c134574f2e 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud.f90
@@ -11,7 +11,7 @@ IMPLICIT NONE
CONTAINS
!
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD(D, CST, CSTURB, PARAMMF, OSTATNW, &
+ SUBROUTINE COMPUTE_MF_CLOUD(D, CST, TURBN, PARAMMF, OSTATNW, &
KRR, KRRL, KRRI, &
PFRAC_ICE, &
PRC_UP,PRI_UP,PEMF, &
@@ -63,7 +63,7 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_TURB_n, ONLY: TURB_t
USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
!
USE MODE_MSG
@@ -72,8 +72,7 @@ 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
IMPLICIT NONE
@@ -83,7 +82,7 @@ IMPLICIT NONE
!
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(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
@@ -110,7 +109,7 @@ REAL, DIMENSION(D%NIJT), INTENT(IN) :: PDEPTH ! Deepness of cl
!
! 1.2 Declaration of local variables
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!------------------------------------------------------------------------
! 1. INITIALISATION
@@ -132,7 +131,7 @@ IF (PARAMMF%CMF_CLOUD == 'DIRE') 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(D, CST, CSTURB, PARAMMF, &
+ CALL COMPUTE_MF_CLOUD_STAT(D, CST, TURBN, PARAMMF, &
&KRR, KRRL, KRRI, OSTATNW, &
&PFRAC_ICE,&
&PTHLM, PRTM, PPABSM, PRM,&
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud_bigaus.f90 b/src/PHYEX/turb/mode_compute_mf_cloud_bigaus.f90
index a9bd850469bcbe06e7b6d74a8828e0f07c1f5480..6b8045050b8ebb900200d447a49bcf116ffef79b 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud_bigaus.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud_bigaus.f90
@@ -63,8 +63,7 @@ USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
!
USE MODI_SHUMAN_MF, ONLY: MZF_MF, GZ_M_W_MF
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -99,7 +98,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',0,ZHOOK_HANDLE)
!
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud_direct.f90 b/src/PHYEX/turb/mode_compute_mf_cloud_direct.f90
index 2323b77f523cf7d886bc038730eabe17d0052916..b742e0fc2fb3f804b29a2f6a0e82625274f4c6a8 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud_direct.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud_direct.f90
@@ -55,8 +55,7 @@ CONTAINS
! ------------
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 YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -72,8 +71,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud frac
!
!* 0.1 Declaration of local variables
!
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JI,JK, JK0, IKB,IKE,IKL,IIJB,IIJE
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Initialisation
!
@@ -95,14 +94,10 @@ PRI_MF(:,:)=0.
PCF_MF(:,:)=0.
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) &
diff --git a/src/PHYEX/turb/mode_compute_mf_cloud_stat.f90 b/src/PHYEX/turb/mode_compute_mf_cloud_stat.f90
index 027cc3c7906d9c326412da3c3f955aa347219e57..6d3c4b0fb2e9399e17e9ae26f703335f0f754d58 100644
--- a/src/PHYEX/turb/mode_compute_mf_cloud_stat.f90
+++ b/src/PHYEX/turb/mode_compute_mf_cloud_stat.f90
@@ -9,7 +9,7 @@
IMPLICIT NONE
CONTAINS
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD_STAT(D, CST, CSTURB, PARAMMF, &
+ SUBROUTINE COMPUTE_MF_CLOUD_STAT(D, CST, TURBN, PARAMMF, &
&KRR, KRRL, KRRI, OSTATNW, &
&PFRAC_ICE,&
&PTHLM, PRTM, PPABSM, PRM,&
@@ -58,14 +58,13 @@ CONTAINS
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 MODD_TURB_n, ONLY: TURB_t
!
USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
USE MODE_COMPUTE_FUNCTION_THERMO_MF, ONLY: COMPUTE_FUNCTION_THERMO_MF
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -73,7 +72,7 @@ IMPLICIT NONE
!
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(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
LOGICAL, INTENT(IN) :: OSTATNW ! cloud scheme inclues convect. covar. contrib
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -100,7 +99,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
!* 0.2 initialisation
!
@@ -131,7 +130,7 @@ IF (KRRL > 0) THEN
CALL GZ_M_W_MF(D, PTHLM(:,:), PDZZ(:,:), ZWK(:,:))
IF (OSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZFLXZ(:,:) = -2 * CSTURB%XCTV* PARAMMF%XTAUSIGMF * PEMF(:,:)* &
+ ZFLXZ(:,:) = -2 * TURBN%XCTV* PARAMMF%XTAUSIGMF * PEMF(:,:)* &
& (PTHL_UP(:,:)-ZFLXZ(:,:)) * ZWK(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
@@ -163,7 +162,7 @@ IF (KRRL > 0) THEN
CALL GZ_M_W_MF(D, PRTM(:,:), PDZZ(:,:), ZWK2(:,:))
IF (OSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZFLXZ2(:,:) = -2 * CSTURB%XCTV * PARAMMF%XTAUSIGMF * PEMF(:,:)* &
+ ZFLXZ2(:,:) = -2 * TURBN%XCTV * PARAMMF%XTAUSIGMF * PEMF(:,:)* &
& (PRT_UP(:,:)-ZFLXZ2(:,:)) * ZWK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
@@ -187,7 +186,7 @@ IF (KRRL > 0) THEN
!
! 1.2.2 contribution from <Rnp Thl>
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZFLXZ3(:,:) = - CSTURB%XCTV * PARAMMF%XTAUSIGMF * &
+ ZFLXZ3(:,:) = - TURBN%XCTV * PARAMMF%XTAUSIGMF * &
(PEMF(:,:)*(PRT_UP(:,:)-ZFLXZ2(:,:)) * &
ZWK(:,:) + &
PEMF(:,:)*(PTHL_UP(:,:)-ZFLXZ(:,:)) * &
diff --git a/src/PHYEX/turb/mode_compute_updraft.f90 b/src/PHYEX/turb/mode_compute_updraft.f90
index 6dc98937cf12519875bce491bd190d226658f874..810cb023091493b45d8985171b38932395252e92 100644
--- a/src/PHYEX/turb/mode_compute_updraft.f90
+++ b/src/PHYEX/turb/mode_compute_updraft.f90
@@ -9,8 +9,8 @@
!
IMPLICIT NONE
CONTAINS
- SUBROUTINE COMPUTE_UPDRAFT(D,CST,NEB,PARAMMF,TURBN,CSTURB, &
- KSV, HFRAC_ICE, &
+ SUBROUTINE COMPUTE_UPDRAFT(D,CST,NEBN,PARAMMF,TURBN,CSTURB, &
+ KSV, &
OENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
@@ -69,7 +69,7 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE MODD_NEB, ONLY: NEB_t
+USE MODD_NEB_n, 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
@@ -78,8 +78,7 @@ 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
IMPLICIT NONE
@@ -89,12 +88,11 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
-TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(NEB_t), INTENT(IN) :: NEBN
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
@@ -195,7 +193,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
! 1.3 Declaration of additional local variables for compute_entr_detr
!
@@ -354,7 +352,7 @@ IF (OENTR_DETR) THEN
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), &
+ CALL TH_R_FROM_THL_RT(CST, NEBN, D%NIJT, NEBN%CFRAC_ICE_SHALLOW_MF,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)
@@ -392,29 +390,28 @@ IF (OENTR_DETR) THEN
ZSHEAR = 0. !no shear in bl89 mixing length
END IF
!
-#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)
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
ZLUP(:)=MAX(ZLUP(:),1.E-10)
! Compute Buoyancy flux at the ground
ZWTHVSURF(:) = (ZTHVM_F(:,IKB)/ZTHM_F(:,IKB))*PSFTH(:)+ &
(0.61*ZTHM_F(:,IKB))*PSFRV(:)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
! Mass flux at KKB level (updraft triggered if PSFTH>0.)
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
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
ZSURF(:)=TANH(PARAMMF%XGZ*SQRT(PDX*PDY)/ZLUP(:))
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
ELSE
ZSURF(:)=1.
END IF
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (ZWTHVSURF(:)>0.)
PEMF(:,IKB) = PARAMMF%XCMF * ZSURF(:) * ZRHO_F(:,IKB) * &
((ZG_O_THVREF(:,IKB))*ZWTHVSURF(:)*ZLUP(:))**(1./3.)
@@ -472,7 +469,7 @@ DO JK=IKB,IKE-IKL,IKL
ZRI_MIX(:,JK) = ZRI_MIX(:,JK-IKL) ! guess of Ri of mixture
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDIF
- CALL COMPUTE_ENTR_DETR(D, CST, NEB, PARAMMF, JK,IKB,IKE,IKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
+ CALL COMPUTE_ENTR_DETR(D, CST, NEBN, PARAMMF, JK,IKB,IKE,IKL,GTEST,GTESTLCL,PFRAC_ICE_UP(:,JK),&
PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+IKL),&
PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), &
PTHLM(:,:),PRTM(:,:),ZW_UP2(:,:),ZTH_UP(:,JK), &
@@ -520,15 +517,10 @@ DO JK=IKB,IKE-IKL,IKL
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
@@ -584,7 +576,7 @@ DO JK=IKB,IKE-IKL,IKL
ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
ZRI_UP(:)=PRI_UP(:,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), &
+ CALL TH_R_FROM_THL_RT(CST, NEBN, D%NIJT, NEBN%CFRAC_ICE_SHALLOW_MF,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)
@@ -703,9 +695,9 @@ 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,&
+ SUBROUTINE COMPUTE_ENTR_DETR(D, CST, NEBN, PARAMMF,&
KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
- HFRAC_ICE,PFRAC_ICE,PRHODREF,&
+ PFRAC_ICE,PRHODREF,&
PPRE_MINUS_HALF,&
PPRE_PLUS_HALF,PZZ,PDZZ,&
PTHVM,PTHLM,PRTM,PW_UP2,PTH_UP,&
@@ -770,7 +762,7 @@ INCLUDE "compute_frac_ice.func.h"
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE MODD_NEB, ONLY: NEB_t
+USE MODD_NEB_n, ONLY: NEB_t
USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
!
IMPLICIT NONE
@@ -781,7 +773,7 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
-TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(NEB_t), INTENT(IN) :: NEBN
TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
!
INTEGER, INTENT(IN) :: KK
@@ -790,9 +782,6 @@ INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physica
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
@@ -949,7 +938,7 @@ ENDDO
ZRCMIX(:)=PRC_UP(:)
ZRIMIX(:)=PRI_UP(:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
-CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,&
+CALL TH_R_FROM_THL_RT(CST,NEBN,D%NIJT,NEBN%CFRAC_ICE_SHALLOW_MF,ZFRAC_ICE,&
PPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
@@ -1025,7 +1014,7 @@ DO JIJ=IIJB,IIJE
ZMIXRT(JIJ) = 0.1
ENDIF
ENDDO
-CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,&
+CALL TH_R_FROM_THL_RT(CST,NEBN,D%NIJT,NEBN%CFRAC_ICE_SHALLOW_MF,ZFRAC_ICE,&
ZPRE,ZMIXTHL,ZMIXRT,&
ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
@@ -1039,7 +1028,7 @@ ZMIXTHL(:) = ZKIC_INIT * 0.5*(PTHLM(:,KK)+PTHLM(:,KK+KKL))+&
ZMIXRT(:) = ZKIC_INIT * 0.5*(PRTM(:,KK)+PRTM(:,KK+KKL))+&
& (1. - ZKIC_INIT)*PRT_UP(:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
-CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,&
+CALL TH_R_FROM_THL_RT(CST,NEBN,D%NIJT,NEBN%CFRAC_ICE_SHALLOW_MF,ZFRAC_ICE,&
PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,&
diff --git a/src/PHYEX/turb/mode_compute_updraft_raha.f90 b/src/PHYEX/turb/mode_compute_updraft_raha.f90
index b8b4969997b0f412ee8b5c3859d419fa4893f3c0..9eb868cc8664947d4a6196cb2a6d52d1dacb344b 100644
--- a/src/PHYEX/turb/mode_compute_updraft_raha.f90
+++ b/src/PHYEX/turb/mode_compute_updraft_raha.f90
@@ -9,8 +9,8 @@
!
IMPLICIT NONE
CONTAINS
- SUBROUTINE COMPUTE_UPDRAFT_RAHA(D, CST, NEB, PARAMMF, &
- KSV, HFRAC_ICE, OENTR_DETR, &
+ SUBROUTINE COMPUTE_UPDRAFT_RAHA(D, CST, NEBN, PARAMMF, &
+ KSV, OENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
@@ -60,13 +60,12 @@ CONTAINS
! ------------
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE MODD_NEB, ONLY: NEB_t
+USE MODD_NEB_n, 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
IMPLICIT NONE
@@ -76,10 +75,9 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
-TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(NEB_t), INTENT(IN) :: NEBN
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) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
@@ -123,18 +121,13 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PDEPTH ! Deepness of clo
!
!
! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHM_F,ZRVM_F,ZRCM_F ! Theta,rv of
- ! updraft environnement
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHM_F,ZRVM_F ! Theta,rv of updraft environnement
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(D%NIJT,D%NKT,KSV) :: ZSVM_F ! scalar variables
-
-
-
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
@@ -144,35 +137,26 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHS_UP,ZTHSM
REAL, DIMENSION(D%NIJT,D%NKT) :: ZCOEF ! diminution coefficient for too high clouds
-REAL, DIMENSION(D%NIJT) :: ZWTHVSURF ! Surface w'thetav'
-
REAL :: ZRDORV ! RD/RV
REAL :: ZRVORD ! RV/RD
REAL, DIMENSION(D%NIJT) :: ZMIX1,ZMIX2,ZMIX3
-REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground
-
-REAL, DIMENSION(D%NIJT) :: ZDEPTH ! Deepness limit for cloud
-INTEGER :: JK,JIJ,JSV ! loop counters
+INTEGER :: JK,JIJ ! loop counters
INTEGER :: IIJB,IIJE ! physical horizontal domain indices
INTEGEr :: IKT,IKB,IKE,IKL
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(D%NIJT) :: GWORK1
LOGICAL, DIMENSION(D%NIJT,D%NKT) :: GWORK2
-INTEGER :: ITEST
-REAL, DIMENSION(D%NIJT) :: ZRC_UP, ZRI_UP, ZRV_UP, ZWP2, ZRSATW, ZRSATI
+REAL, DIMENSION(D%NIJT) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
-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
@@ -182,14 +166,14 @@ 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, DIMENSION(D%NIJT) :: 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAF_RAHA',0,ZHOOK_HANDLE)
!
IIJE=D%NIJE
@@ -316,7 +300,7 @@ 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), &
+CALL TH_R_FROM_THL_RT(CST, NEBN, D%NIJT, NEBN%CFRAC_ICE_SHALLOW_MF,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)
@@ -512,7 +496,7 @@ DO JK=IKB,IKE-IKL,IKL
ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
ZRV_UP(:)=PRV_UP(:,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), &
+ CALL TH_R_FROM_THL_RT(CST,NEBN, D%NIJT, NEBN%CFRAC_ICE_SHALLOW_MF,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)
diff --git a/src/PHYEX/turb/mode_compute_updraft_rhcj10.f90 b/src/PHYEX/turb/mode_compute_updraft_rhcj10.f90
index 85eccf595c1bc53c0f2abbe529d838d4b0050cda..13d3153076f4d874e981746f1607bd6887ad4211 100644
--- a/src/PHYEX/turb/mode_compute_updraft_rhcj10.f90
+++ b/src/PHYEX/turb/mode_compute_updraft_rhcj10.f90
@@ -10,8 +10,8 @@
IMPLICIT NONE
CONTAINS
!
-SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(D,CST,NEB,PARAMMF,TURBN,CSTURB, &
- KSV, HFRAC_ICE, &
+SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(D,CST,NEBN,PARAMMF,TURBN,CSTURB,&
+ KSV, &
OENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
@@ -63,7 +63,7 @@ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(D,CST,NEB,PARAMMF,TURBN,CSTURB, &
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
-USE MODD_NEB, ONLY: NEB_t
+USE MODD_NEB_n, 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
@@ -71,8 +71,7 @@ USE MODD_CTURB, ONLY: CSTURB_t
USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
IMPLICIT NONE
@@ -82,12 +81,11 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
-TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(NEB_t), INTENT(IN) :: NEBN
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
@@ -139,10 +137,6 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZPRES_F,ZTHVM_F ! interpolated at
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(D%NIJT,D%NKT,KSV) :: ZSVM_F ! scalar variables
-
-
-
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
@@ -161,7 +155,7 @@ REAL, DIMENSION(D%NIJT) :: ZMIX1,ZMIX2
REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground
-INTEGER :: JK,JIJ,JSV ! loop counters
+INTEGER :: JK,JIJ ! loop counters
INTEGER :: IIJB,IIJE ! physical horizontal domain indices
INTEGER :: IKT,IKB,IKE,IKL
LOGICAL, DIMENSION(D%NIJT) :: GTEST,GTESTLCL
@@ -171,8 +165,6 @@ LOGICAL :: GLMIX
LOGICAL, DIMENSION(D%NIJT) :: GWORK1
LOGICAL, DIMENSION(D%NIJT,D%NKT) :: GWORK2
-INTEGER :: ITEST
-
REAL, DIMENSION(D%NIJT) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
REAL, DIMENSION(D%NIJT,D%NKT) :: ZZDZ
@@ -193,7 +185,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',0,ZHOOK_HANDLE)
!
IIJE=D%NIJE
@@ -327,7 +319,7 @@ ZW_UP2(:,IKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,IKB))
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), &
+CALL TH_R_FROM_THL_RT(CST,NEBN,D%NIJT,NEBN%CFRAC_ICE_SHALLOW_MF,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)
@@ -446,7 +438,7 @@ DO JK=IKB,IKE-IKL,IKL
ZRI_UP(:) =PRI_UP(:,JK) ! guess
ZRV_UP(:) =PRV_UP(:,JK)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
- CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
+ CALL TH_R_FROM_THL_RT(CST,NEBN, D%NIJT, NEBN%CFRAC_ICE_SHALLOW_MF,PFRAC_ICE_UP(:,JK),&
PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),&
ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,&
PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE)
@@ -549,7 +541,7 @@ DO JK=IKB,IKE-IKL,IKL
ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
ZRV_UP(:)=PRV_UP(:,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), &
+ CALL TH_R_FROM_THL_RT(CST,NEBN, D%NIJT, NEBN%CFRAC_ICE_SHALLOW_MF,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)
diff --git a/src/PHYEX/turb/mode_emoist.f90 b/src/PHYEX/turb/mode_emoist.f90
index d3e920d614937d61a4940fbcb7fe1f20c341539c..2ea9b0a80c76943e47c687a2168d024797c45d75 100644
--- a/src/PHYEX/turb/mode_emoist.f90
+++ b/src/PHYEX/turb/mode_emoist.f90
@@ -6,8 +6,7 @@ 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ############################################################################
!
! PURPOSE
@@ -68,8 +67,8 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
-INTEGER :: KRR ! number of moist var.
-INTEGER :: KRRI ! number of ice var.
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM ! Conservative pot. temperature
@@ -98,7 +97,7 @@ INTEGER :: IIJB,IIJE,IKT
!* 1. COMPUTE EMOIST
! --------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('EMOIST',0,ZHOOK_HANDLE)
!
IIJB=D%NIJB
diff --git a/src/PHYEX/turb/mode_etheta.f90 b/src/PHYEX/turb/mode_etheta.f90
index 41ba28fb1653c6f00391983107baa22d6b9a2f30..9296b922c226c77f4501b51efd0731b30a60c307 100644
--- a/src/PHYEX/turb/mode_etheta.f90
+++ b/src/PHYEX/turb/mode_etheta.f90
@@ -6,8 +6,7 @@ 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ############################################################################
!
! PURPOSE
@@ -66,8 +65,8 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
-INTEGER :: KRR ! number of moist var.
-INTEGER :: KRRI ! number of ice var.
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM ! Conservative pot. temperature
@@ -102,7 +101,7 @@ INTEGER :: IIJB,IIJE,IKT
! --------------
!
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ETHETA',0,ZHOOK_HANDLE)
!
IIJB=D%NIJB
diff --git a/src/PHYEX/turb/mode_ibm_mixinglength.f90 b/src/PHYEX/turb/mode_ibm_mixinglength.f90
index bc584c94082a6a3b64adb527556d6373f11e944b..608af23415bcba280ec196b3d60deda7e21367cb 100644
--- a/src/PHYEX/turb/mode_ibm_mixinglength.f90
+++ b/src/PHYEX/turb/mode_ibm_mixinglength.f90
@@ -54,6 +54,7 @@ SUBROUTINE IBM_MIXINGLENGTH(D,PLM,PLEPS,PMU,PHI,PTKE)
USE MODD_IBM_PARAM_n
USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
USE MODD_CTURB
+ USE MODD_TURB_n, ONLY: XCED
USE MODD_CST
USE MODD_GRID_n, ONLY: XZZ
!
diff --git a/src/PHYEX/turb/mode_ini_mfshall.f90 b/src/PHYEX/turb/mode_ini_mfshall.f90
new file mode 100644
index 0000000000000000000000000000000000000000..56973284350b4d8a1d3665de3aab17f3ed5cef5b
--- /dev/null
+++ b/src/PHYEX/turb/mode_ini_mfshall.f90
@@ -0,0 +1,66 @@
+MODULE MODE_INI_MFSHALL
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE INI_MFSHALL()
+! ###########################################################
+!
+!!**** *INI_MFSHALL * - initialize the constants necessary for the
+!! shallow convection scheme.
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used by
+!! the shallow convection scheme.
+!!
+!!** METHOD
+!! ------
+!! The constants are initialized to their numerical values.
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_MFSHALL_n, ONLY: LTHETAS_MF, XLAMBDA_MF
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+
+!
+!* 0.2 Declarations of local variables :
+!
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('INI_MFSHALL',0,ZHOOK_HANDLE)
+!
+IF(LTHETAS_MF) THEN
+ XLAMBDA_MF=5.87
+ELSE
+ XLAMBDA_MF=0.
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('INI_MFSHALL',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INI_MFSHALL
+!
+END MODULE MODE_INI_MFSHALL
diff --git a/src/PHYEX/turb/ini_cturb.f90 b/src/PHYEX/turb/mode_ini_turb.f90
similarity index 79%
rename from src/PHYEX/turb/ini_cturb.f90
rename to src/PHYEX/turb/mode_ini_turb.f90
index ea3f0c70d937df63992fde48dba3347e5f6b5fd4..fc70cfaf945db2312defa67a60b887f9f3bea4af 100644
--- a/src/PHYEX/turb/ini_cturb.f90
+++ b/src/PHYEX/turb/mode_ini_turb.f90
@@ -2,38 +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$ $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-! #####################
- MODULE MODI_INI_CTURB
-! #####################
-!
-INTERFACE
-!
-SUBROUTINE INI_CTURB
-END SUBROUTINE INI_CTURB
-!
-END INTERFACE
-!
-END MODULE MODI_INI_CTURB
-!
-!
-!
+MODULE MODE_INI_TURB
+IMPLICIT NONE
+CONTAINS
! ####################
- SUBROUTINE INI_CTURB
+ SUBROUTINE INI_TURB(HPROGRAM)
! ####################
!
-!!**** *INI_CTURB* - routine to initialize the turbulence scheme
+!!**** *INI_TURB* - routine to initialize the turbulence scheme
!! constants.
!!
!! PURPOSE
!! -------
! The purpose of this routine is to initialize the turbulence
-! scheme constants that are stored in module MODD_CTURB
+! scheme constants that are stored in module MODD_CTURB and MODD_TURBN
!
!! METHOD
!! ------
@@ -63,24 +45,27 @@ END MODULE MODI_INI_CTURB
!! P.Jabouille 20/10/99 XCET=0.4
!! V.Masson 13/11/02 XALPSBL and XASBL
!! 05/06 Remove KEPS
-!! Q.Rodier 01/19 XCED replaced by XCEDIS in read_exsegn.f90 and ini_modeln.f90
-!! Remove XASBL (not used)
+!! Q.Rodier 01/19 Remove XASBL (not used)
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST
-USE MODD_CTURB
+USE MODD_TURB_n, ONLY : XCTP, XCED, XCSHF, XCHF, XCTV, XCHV, XCHT1, XCHT2, XCPR1, CTURBLEN, &
+ & XBL89EXP, XUSRBL89
+USE MODD_NEB_n, ONLY: LSTATNW
+USE MODD_CTURB ! For true constants (not tunable)
+USE MODD_PARAMETERS, ONLY : XUNDEF
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
-IF (LHOOK) CALL DR_HOOK('INI_CTURB',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('INI_TURB',0,ZHOOK_HANDLE)
!
CALL CTURB_ASSOCIATE()
!
@@ -91,13 +76,22 @@ CALL CTURB_ASSOCIATE()
!
! 1.1 Constant for dissipation of Tke
!
-!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
-! Rodier, Masson, Couvreux, Paci (2017) = 0.34
+!
+IF(XCED == XUNDEF) THEN
+ ! Redelsperger-Sommeria (1981) = 0.70
+ ! Schmidt-Schumann (1989) = 0.845
+ ! Cheng-Canuto-Howard (2002) = 0.845
+ ! Rodier, Masson, Couvreux, Paci (2017) = 0.34
+ IF(CTURBLEN=='RM17' .OR. CTURBLEN=='ADAP') THEN
+ XCED=0.34
+ ELSE
+ IF(HPROGRAM=='AROME') THEN
+ XCED=0.85
+ ELSE
+ XCED=0.84
+ END IF
+ ENDIF
+ENDIF
!
!
! 1.2 Constant for wind pressure-correlations
@@ -143,7 +137,14 @@ XCTD = 1.2
!
! 1.7 Constant for temperature and vapor pressure-correlations
!
-XCTP = 4.65
+IF(XCTP == XUNDEF) THEN
+ IF (LSTATNW) THEN
+ !wc in STATNW consistent use of Redelsperger-Sommeria for (co)variances
+ XCTP = 4.0
+ ELSE
+ XCTP = 4.65
+ ENDIF
+ENDIF
! Redelsperger-Sommeria (1981) = 4.
! Schmidt-Schumann (1989) = 3.25
! Cheng-Canuto-Howard (2002) = 4.65
@@ -225,10 +226,6 @@ XCPR5= XCPR2
! 3. MINIMUM VALUES
! --------------
!
-XTKEMIN=0.01 ! This value is replaced by XKEMIN in &NAM_TURBn
-!
-!XLINI=10. ! BL mixing length
-XLINI=0.1 ! BL mixing length
XLINF=1.E-10! to prevent division by zero
!
!
@@ -259,5 +256,12 @@ 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
+! 7. Constants for BL89 computation
+!
+XBL89EXP=LOG(16.)/(4.*LOG(XKARMAN)+LOG(XCED)-3.*LOG(XCMFS))
+XUSRBL89=1./XBL89EXP
+!
+!
+IF (LHOOK) CALL DR_HOOK('INI_TURB',1,ZHOOK_HANDLE)
+END SUBROUTINE INI_TURB
+END MODULE MODE_INI_TURB
diff --git a/src/PHYEX/turb/mode_mf_turb.f90 b/src/PHYEX/turb/mode_mf_turb.f90
index 0cede49ad0e9f14b030d1d005c51ffd31f246681..dd39e118828ce8aefcc48266c5e14b931eec566d 100644
--- a/src/PHYEX/turb/mode_mf_turb.f90
+++ b/src/PHYEX/turb/mode_mf_turb.f90
@@ -67,8 +67,7 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODI_SHUMAN_MF, ONLY: MZM_MF
USE MODE_TRIDIAG_MASSFLUX, ONLY: TRIDIAG_MASSFLUX
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -131,7 +130,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
!----------------------------------------------------------------------------
!
diff --git a/src/PHYEX/turb/mode_mf_turb_expl.f90 b/src/PHYEX/turb/mode_mf_turb_expl.f90
index 8463dd902a9d46b751d72663cd10101cc9ddfefc..16d1e9f8a545fa9feb9673b824d361b6470afc5c 100644
--- a/src/PHYEX/turb/mode_mf_turb_expl.f90
+++ b/src/PHYEX/turb/mode_mf_turb_expl.f90
@@ -53,8 +53,7 @@ CONTAINS
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 YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODI_SHUMAN_MF, ONLY: MZM_MF
IMPLICIT NONE
@@ -100,7 +99,7 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHLM_F,ZRTM_F
INTEGER :: JK, JIJ ! loop counter
INTEGER :: IIJB,IIJE ! physical horizontal domain indices
INTEGER :: IKT,IKB,IKE,IKL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
diff --git a/src/PHYEX/turb/mode_prandtl.f90 b/src/PHYEX/turb/mode_prandtl.f90
index f8f63f41324260074f34c016112306acd8e4fae9..6158c5c4dff154f19e9667605580dd5067c860a3 100644
--- a/src/PHYEX/turb/mode_prandtl.f90
+++ b/src/PHYEX/turb/mode_prandtl.f90
@@ -5,15 +5,16 @@
!-----------------------------------------------------------------
! ####################
MODULE MODE_PRANDTL
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ####################
!
!* 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
+! 06/2023 S. Riette add the LSMOOTH_PRANDTL key
!
USE MODD_CTURB, ONLY : CSTURB_t
+USE MODD_TURB_n, ONLY : TURB_t
USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
!
@@ -23,7 +24,7 @@ IMPLICIT NONE
!----------------------------------------------------------------------------
CONTAINS
!----------------------------------------------------------------------------
- SUBROUTINE PRANDTL(D,CST,CSTURB,KRR,KSV,KRRI,OTURB_DIAG,&
+ SUBROUTINE PRANDTL(D,CST,CSTURB,TURBN,KRR,KSV,KRRI,OTURB_DIAG,&
HTURBDIM,OOCEAN,OHARAT,O2D,OCOMPUTE_SRC,&
TPFILE, OFLAT, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -87,7 +88,7 @@ CONTAINS
!!
!! Module MODD_CTURB: contains the set of constants for
!! the turbulence scheme
-!! CSTURB%XCTV,XCPR2 : constants for the turbulent prandtl numbers
+!! TURBN%XCTV,XCPR2 : constants for the turbulent prandtl numbers
!! XTKEMIN : minimum value allowed for the TKE
!!
!! Module MODD_PARAMETERS
@@ -141,15 +142,13 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-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: TFIELDMETADATA, TYPEREAL
+USE MODD_TURB_n, ONLY: TURB_t
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
!
USE MODE_EMOIST, ONLY: EMOIST
USE MODE_ETHETA, ONLY: ETHETA
@@ -164,6 +163,7 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -217,9 +217,9 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PEMOIST ! coefficient E_moist
! 0.2 declaration of local variables
!
REAL, DIMENSION(D%NIJT,D%NKT) :: &
- ZW1, ZW2, ZW3, &
+ ZW1, ZW2, &
! working variables
- ZWORK1,ZWORK2,ZWORK3,ZWORK4, ZWORK5, ZWORK6,ZWORK7, &
+ ZWORK1,ZWORK2,ZWORK3,ZWORK4, &
ZGXMM_PTH,ZGYMM_PTH,ZGXMM_PRM,ZGYMM_PRM, ZGXMM_PSV,ZGYMM_PSV
! working variables for explicit array
!
@@ -228,7 +228,6 @@ INTEGER :: IKE ! vertical index value for the last inner mass point
INTEGER:: JSV,JIJ,JK ! loop index
INTEGER :: IIJB,IIJE,IKT,IKA,IKL
-INTEGER :: JLOOP
REAL :: ZMINVAL
TYPE(TFIELDMETADATA) :: TZFIELD
! ---------------------------------------------------------------------------
@@ -236,7 +235,7 @@ TYPE(TFIELDMETADATA) :: TZFIELD
!* 1. DEFAULT VALUES, 1D REDELSPERGER NUMBERS
! ----------------------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PRANDTL',0,ZHOOK_HANDLE)
IF (OHARAT) THEN
@@ -290,21 +289,21 @@ CALL GZ_M_W_PHY(D,PTHLM,PDZZ,ZWORK1)
!
IF (OOCEAN) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PREDTH1(:,:)= CSTURB%XCTV*PBLL_O_E(:,:)*ZWORK1(:,:)
+ PREDTH1(:,:)= TURBN%XCTV*PBLL_O_E(:,:)*ZWORK1(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PREDR1(:,:) = 0.
ELSE
IF (KRR /= 0) THEN ! moist case
CALL GZ_M_W_PHY(D,PRM(:,:,1),PDZZ,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PREDTH1(:,:)= CSTURB%XCTV*PBLL_O_E(:,:) * PETHETA(:,:) &
+ PREDTH1(:,:)= TURBN%XCTV*PBLL_O_E(:,:) * PETHETA(:,:) &
* ZWORK1(:,:)
- PREDR1(:,:) = CSTURB%XCTV*PBLL_O_E(:,:) * PEMOIST(:,:) &
+ PREDR1(:,:) = TURBN%XCTV*PBLL_O_E(:,:) * PEMOIST(:,:) &
* ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE ! dry case
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PREDTH1(:,:)= CSTURB%XCTV*PBLL_O_E(:,:) * ZWORK1(:,:)
+ PREDTH1(:,:)= TURBN%XCTV*PBLL_O_E(:,:) * ZWORK1(:,:)
PREDR1(:,:) = 0.
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
@@ -371,7 +370,7 @@ ENDDO
DO JSV=1,KSV
CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK1)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PREDS1(:,:,JSV)=CSTURB%XCTV*PBLL_O_E(:,:)*ZWORK1(:,:)
+ PREDS1(:,:,JSV)=TURBN%XCTV*PBLL_O_E(:,:)*ZWORK1(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END DO
!
@@ -425,13 +424,13 @@ ELSE IF (O2D) THEN ! 3D case in a 2D model
CALL MZM_PHY(D,ZWORK1,ZWORK4)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PRED2TH3(:,:)= PREDTH1(:,:)**2+(CSTURB%XCTV*PBLL_O_E(:,:) &
+ PRED2TH3(:,:)= PREDTH1(:,:)**2+(TURBN%XCTV*PBLL_O_E(:,:) &
*PETHETA(:,:) )**2 * ZWORK2(:,:)
!
- PRED2R3(:,:)= PREDR1(:,:)**2 + (CSTURB%XCTV*PBLL_O_E(:,:) &
+ PRED2R3(:,:)= PREDR1(:,:)**2 + (TURBN%XCTV*PBLL_O_E(:,:) &
* PEMOIST(:,:))**2 * ZWORK3(:,:)
!
- PRED2THR3(:,:)= PREDR1(:,:) * PREDTH1(:,:) + CSTURB%XCTV**2 &
+ PRED2THR3(:,:)= PREDR1(:,:) * PREDTH1(:,:) + TURBN%XCTV**2 &
* PBLL_O_E(:,:)**2 &
* PEMOIST(:,:) * PETHETA(:,:) &
* ZWORK4(:,:)
@@ -443,7 +442,7 @@ ELSE IF (O2D) THEN ! 3D case in a 2D model
!
ELSE ! dry 3D case in a 2D model
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PRED2TH3(:,:) = PREDTH1(:,:)**2 + CSTURB%XCTV**2 &
+ PRED2TH3(:,:) = PREDTH1(:,:)**2 + TURBN%XCTV**2 &
* PBLL_O_E(:,:)**2 * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PRED2TH3(:,IKB)=PRED2TH3(:,IKB+IKL)
@@ -478,13 +477,13 @@ ELSE ! 3D case in a 3D model
CALL MZM_PHY(D,ZWORK1,ZWORK4)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PRED2TH3(:,:)= PREDTH1(:,:)**2 + ( CSTURB%XCTV*PBLL_O_E(:,:) &
+ PRED2TH3(:,:)= PREDTH1(:,:)**2 + ( TURBN%XCTV*PBLL_O_E(:,:) &
* PETHETA(:,:) )**2 * ZWORK2(:,:)
!
- PRED2R3(:,:)= PREDR1(:,:)**2 + (CSTURB%XCTV*PBLL_O_E(:,:) &
+ PRED2R3(:,:)= PREDR1(:,:)**2 + (TURBN%XCTV*PBLL_O_E(:,:) &
* PEMOIST(:,:))**2 * ZWORK3(:,:)
!
- PRED2THR3(:,:)= PREDR1(:,:) * PREDTH1(:,:) + CSTURB%XCTV**2 &
+ PRED2THR3(:,:)= PREDR1(:,:) * PREDTH1(:,:) + TURBN%XCTV**2 &
* PBLL_O_E(:,:)**2 * &
PEMOIST(:,:) * PETHETA(:,:) * ZWORK4(:,:)
@@ -496,7 +495,7 @@ ELSE ! 3D case in a 3D model
!
ELSE ! dry 3D case in a 3D model
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PRED2TH3(:,:) = PREDTH1(:,:)**2 + CSTURB%XCTV**2 &
+ PRED2TH3(:,:) = PREDTH1(:,:)**2 + TURBN%XCTV**2 &
* PBLL_O_E(:,:)**2 * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -733,9 +732,10 @@ 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)
+SUBROUTINE SMOOTH_TURB_FUNCT(D,CSTURB,TURBN,PPHI3,PF_LIM,PF)
!
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -754,17 +754,20 @@ IIJE=D%NIJE
IIJB=D%NIJB
IKT=D%NKT
!
-!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-ZCOEF(:,:) = MAX(MIN(( 10.*(1.-PPHI3(:,:)/CSTURB%XPHI_LIM)) ,1.), 0.)
-!
-PF(:,:) = ZCOEF(:,:) * PF(:,:) &
- + (1.-ZCOEF(:,:)) * PF_LIM(:,:)
-!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+IF(TURBN%LSMOOTH_PRANDTL) THEN
+ !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ ZCOEF(:,:) = MAX(MIN(( 10.*(1.-PPHI3(:,:)/CSTURB%XPHI_LIM)) ,1.), 0.)
+ !
+ PF(:,:) = ZCOEF(:,:) * PF(:,:) &
+ + (1.-ZCOEF(:,:)) * PF_LIM(:,:)
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
+ENDIF
!
END SUBROUTINE SMOOTH_TURB_FUNCT
!----------------------------------------------------------------------------
-SUBROUTINE PHI3(D,CSTURB,PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PPHI3)
+SUBROUTINE PHI3(D,CSTURB,TURBN,PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PPHI3)
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
@@ -778,7 +781,7 @@ SUBROUTINE PHI3(D,CSTURB,PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSE
REAL, DIMENSION(D%NIJT,D%NKT) :: ZW1, ZW2
INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE, IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PHI3',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -836,8 +839,9 @@ PPHI3(:,IKE+1)=PPHI3(:,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)
+SUBROUTINE PSI_SV(D,CSTURB,TURBN,KSV,PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3,PPSI_SV)
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
TYPE(DIMPHYEX_t), INTENT(IN) :: D
INTEGER, INTENT(IN) :: KSV
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
@@ -852,7 +856,7 @@ SUBROUTINE PSI_SV(D,CSTURB,KSV,PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI
INTEGER :: IKB, IKE, IIJB,IIJE, IKT
INTEGER :: JSV,JIJ,JK
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI_SV',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -891,8 +895,9 @@ 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)
+SUBROUTINE D_PHI3DTDZ_O_DDTDZ(D,CSTURB,TURBN,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PD_PHI3DTDZ_O_DDTDZ)
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
@@ -904,7 +909,7 @@ SUBROUTINE D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,H
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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -916,11 +921,7 @@ IF (HTURBDIM=='3DIM') THEN
!* 3DIM case
IF (OUSERV) THEN
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
-#ifdef REPRO48
- WHERE (PPHI3(:,:)/=CSTURB%XPHI_LIM)
-#else
WHERE (PPHI3(:,:)<=CSTURB%XPHI_LIM)
-#endif
PD_PHI3DTDZ_O_DDTDZ(:,:) = PPHI3(:,:) &
* (1. - PREDTH1(:,:) * (3./2.+PREDTH1(:,:)+PREDR1(:,:)) &
/((1.+PREDTH1(:,:)+PREDR1(:,:)) &
@@ -940,11 +941,7 @@ IF (HTURBDIM=='3DIM') THEN
!
ELSE
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
-#ifdef REPRO48
- WHERE (PPHI3(:,:)/=CSTURB%XPHI_LIM)
-#else
WHERE (PPHI3(:,:)<=CSTURB%XPHI_LIM)
-#endif
PD_PHI3DTDZ_O_DDTDZ(:,:) = PPHI3(:,:) &
* (1. - PREDTH1(:,:) * (3./2.+PREDTH1(:,:)) &
/((1.+PREDTH1(:,:))*(1.+1./2.*PREDTH1(:,:)))) &
@@ -972,11 +969,8 @@ DO JK=1,IKT
ENDDO
END IF
!
-#ifdef REPRO48
-#else
!* smoothing
-CALL SMOOTH_TURB_FUNCT(D,CSTURB,PPHI3,PPHI3,PD_PHI3DTDZ_O_DDTDZ)
-#endif
+CALL SMOOTH_TURB_FUNCT(D,CSTURB,TURBN,PPHI3,PPHI3,PD_PHI3DTDZ_O_DDTDZ)
!
PD_PHI3DTDZ_O_DDTDZ(:,IKB-1)=PD_PHI3DTDZ_O_DDTDZ(:,IKB)
PD_PHI3DTDZ_O_DDTDZ(:,IKE+1)=PD_PHI3DTDZ_O_DDTDZ(:,IKE)
@@ -984,8 +978,9 @@ PD_PHI3DTDZ_O_DDTDZ(:,IKE+1)=PD_PHI3DTDZ_O_DDTDZ(:,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)
+SUBROUTINE D_PHI3DRDZ_O_DDRDZ(D,CSTURB,TURBN,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PD_PHI3DRDZ_O_DDRDZ)
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
@@ -997,7 +992,7 @@ SUBROUTINE D_PHI3DRDZ_O_DDRDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,H
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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1010,11 +1005,7 @@ IF (HTURBDIM=='3DIM') THEN
!* 3DIM case
IF (OUSERV) THEN
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
-#ifdef REPRO48
- WHERE (PPHI3(:,:)/=CSTURB%XPHI_LIM)
-#else
WHERE (PPHI3(:,:)<=CSTURB%XPHI_LIM)
-#endif
PD_PHI3DRDZ_O_DDRDZ(:,:) = PPHI3(:,:) &
* (1.-PREDR1(:,:)*(3./2.+PREDTH1(:,:)+PREDR1(:,:)) &
/ ((1.+PREDTH1(:,:)+PREDR1(:,:)) &
@@ -1036,11 +1027,7 @@ IF (HTURBDIM=='3DIM') THEN
ELSE
!* 1DIM case
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
-#ifdef REPRO48
- WHERE (PPHI3(:,:)/=CSTURB%XPHI_LIM)
-#else
WHERE (PPHI3(:,:)<=CSTURB%XPHI_LIM)
-#endif
PD_PHI3DRDZ_O_DDRDZ(:,:) = PPHI3(:,:) &
* (1. - PREDR1(:,:)*PPHI3(:,:))
ELSEWHERE
@@ -1049,11 +1036,8 @@ ELSE
!$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
+CALL SMOOTH_TURB_FUNCT(D,CSTURB,TURBN,PPHI3,PPHI3,PD_PHI3DRDZ_O_DDRDZ)
!
PD_PHI3DRDZ_O_DDRDZ(:,IKB-1)=PD_PHI3DRDZ_O_DDRDZ(:,IKB)
PD_PHI3DRDZ_O_DDRDZ(:,IKE+1)=PD_PHI3DRDZ_O_DDRDZ(:,IKE)
@@ -1061,8 +1045,9 @@ PD_PHI3DRDZ_O_DDRDZ(:,IKE+1)=PD_PHI3DRDZ_O_DDRDZ(:,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)
+SUBROUTINE D_PHI3DTDZ2_O_DDTDZ(D,CSTURB,TURBN,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV,PD_PHI3DTDZ2_O_DDTDZ)
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
@@ -1076,7 +1061,7 @@ SUBROUTINE D_PHI3DTDZ2_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1087,7 +1072,7 @@ 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)
+ CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,TURBN,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,ZWORK1)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_PHI3DTDZ2_O_DDTDZ(:,:) = PDTDZ(:,:) &
* (PPHI3(:,:) + ZWORK1(:,:))
@@ -1095,11 +1080,7 @@ IF (HTURBDIM=='3DIM') THEN
ELSE
!* 1DIM case
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
-#ifdef REPRO48
- WHERE (PPHI3(:,:)/=CSTURB%XPHI_LIM)
-#else
WHERE (PPHI3(:,:)<=CSTURB%XPHI_LIM)
-#endif
PD_PHI3DTDZ2_O_DDTDZ(:,:) = PPHI3(:,:)*PDTDZ(:,:) &
* (2. - PREDTH1(:,:)*PPHI3(:,:))
ELSEWHERE
@@ -1108,11 +1089,8 @@ ELSE
!$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
+CALL SMOOTH_TURB_FUNCT(D,CSTURB,TURBN,PPHI3,PPHI3*2.*PDTDZ,PD_PHI3DTDZ2_O_DDTDZ)
!
!
PD_PHI3DTDZ2_O_DDTDZ(:,IKB-1)=PD_PHI3DTDZ2_O_DDTDZ(:,IKB)
@@ -1121,9 +1099,10 @@ PD_PHI3DTDZ2_O_DDTDZ(:,IKE+1)=PD_PHI3DTDZ2_O_DDTDZ(:,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)
+SUBROUTINE M3_WTH_WTH2(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PM3_WTH_WTH2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1132,7 +1111,7 @@ SUBROUTINE M3_WTH_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PM3_WTH_WTH2)
REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_WTH2
INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1141,7 +1120,7 @@ IIJB=D%NIJB
IKT=D%NKT
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-PM3_WTH_WTH2(:,:) = CSTURB%XCSHF*PBLL_O_E(:,:)&
+PM3_WTH_WTH2(:,:) = TURBN%XCSHF*PBLL_O_E(:,:)&
* PETHETA(:,:)*0.5/CSTURB%XCTD &
* (1.+0.5*PREDTH1(:,:)+PREDR1(:,:)) / PD(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1151,9 +1130,10 @@ PM3_WTH_WTH2(:,IKE+1)=PM3_WTH_WTH2(:,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)
+SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1163,7 +1143,7 @@ SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_
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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1173,10 +1153,10 @@ IKT=D%NKT
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_WTH_WTH2_O_DDTDZ(:,:) = &
-(0.5*CSTURB%XCSHF*PBLL_O_E(:,:)*PETHETA(:,:)*0.5/CSTURB%XCTD/PD(:,:) &
+(0.5*TURBN%XCSHF*PBLL_O_E(:,:)*PETHETA(:,:)*0.5/CSTURB%XCTD/PD(:,:) &
- PM3_WTH_WTH2(:,:)/PD(:,:)&
*(1.5+PREDTH1(:,:)+PREDR1(:,:)) )&
-* PBLL_O_E(:,:) * PETHETA(:,:) * CSTURB%XCTV
+* PBLL_O_E(:,:) * PETHETA(:,:) * TURBN%XCTV
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PD_M3_WTH_WTH2_O_DDTDZ(:,IKB-1)=PD_M3_WTH_WTH2_O_DDTDZ(:,IKB)
@@ -1185,9 +1165,10 @@ PD_M3_WTH_WTH2_O_DDTDZ(:,IKE+1)=PD_M3_WTH_WTH2_O_DDTDZ(:,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)
+SUBROUTINE M3_WTH_W2TH(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PKEFF,PTKE,PM3_WTH_W2TH)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1197,7 +1178,7 @@ SUBROUTINE M3_WTH_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1207,7 +1188,7 @@ IKT=D%NKT
!
CALL MZM_PHY(D,PTKE,ZWORK1)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-PM3_WTH_W2TH(:,:) = CSTURB%XCSHF*PKEFF(:,:)*1.5/ZWORK1(:,:) &
+PM3_WTH_W2TH(:,:) = TURBN%XCSHF*PKEFF(:,:)*1.5/ZWORK1(:,:) &
* (1. - 0.5*PREDR1(:,:)*(1.+PREDR1(:,:))/PD(:,:) ) &
/ (1.+PREDTH1(:,:))
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1218,9 +1199,10 @@ PM3_WTH_W2TH(:,IKE+1)=PM3_WTH_W2TH(:,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)
+SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1232,7 +1214,7 @@ SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKE
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1243,8 +1225,8 @@ IKT=D%NKT
CALL MZM_PHY(D,PTKE,ZWORK1)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_WTH_W2TH_O_DDTDZ(:,:) = &
- - CSTURB%XCSHF*PKEFF(:,:)*1.5/ZWORK1(:,:)/(1.+PREDTH1(:,:))**2 &
- * CSTURB%XCTV*PBLL_O_E(:,:)*PETHETA(:,:) &
+ - TURBN%XCSHF*PKEFF(:,:)*1.5/ZWORK1(:,:)/(1.+PREDTH1(:,:))**2 &
+ * TURBN%XCTV*PBLL_O_E(:,:)*PETHETA(:,:) &
* (1. - 0.5*PREDR1(:,:)*(1.+PREDR1(:,:))/PD(:,:)* &
( 1.+(1.+PREDTH1(:,:))*(1.5+PREDR1(:,:)+PREDTH1(:,:))&
/PD(:,:)) )
@@ -1256,9 +1238,10 @@ PD_M3_WTH_W2TH_O_DDTDZ(:,IKE+1)=PD_M3_WTH_W2TH_O_DDTDZ(:,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)
+SUBROUTINE M3_WTH_W2R(D,CSTURB,TURBN,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_WTH_W2R)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1269,7 +1252,7 @@ SUBROUTINE M3_WTH_W2R(D,CSTURB,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ,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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1280,7 +1263,7 @@ IKT=D%NKT
CALL MZM_PHY(D,PTKE,ZWORK1)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PM3_WTH_W2R(:,:) = &
- - CSTURB%XCSHF*PKEFF(:,:)*0.75*CSTURB%XCTV*PBLL_O_E(:,:) &
+ - TURBN%XCSHF*PKEFF(:,:)*0.75*TURBN%XCTV*PBLL_O_E(:,:) &
/ZWORK1(:,:)*PEMOIST(:,:)*PDTDZ(:,:)/PD(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1290,9 +1273,10 @@ PM3_WTH_W2R(:,IKE+1)=PM3_WTH_W2R(:,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)
+SUBROUTINE D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1304,7 +1288,7 @@ SUBROUTINE D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,P
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1315,7 +1299,7 @@ IKT=D%NKT
CALL MZM_PHY(D,PTKE,ZWORK1)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_WTH_W2R_O_DDTDZ(:,:) = &
-- CSTURB%XCSHF*PKEFF(:,:)*0.75*CSTURB%XCTV*PBLL_O_E(:,:) &
+- TURBN%XCSHF*PKEFF(:,:)*0.75*TURBN%XCTV*PBLL_O_E(:,:) &
/ZWORK1(:,:)*PEMOIST(:,:)/PD(:,:) &
* (1. - PREDTH1(:,:)*(1.5+PREDTH1(:,:)&
+PREDR1(:,:))/PD(:,:))
@@ -1327,9 +1311,10 @@ PD_M3_WTH_W2R_O_DDTDZ(:,IKE+1)=PD_M3_WTH_W2R_O_DDTDZ(:,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)
+SUBROUTINE M3_WTH_WR2(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1343,7 +1328,7 @@ SUBROUTINE M3_WTH_WR2(D,CSTURB,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMO
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1357,8 +1342,8 @@ ZWORK1(:,:) = PBETA(:,:)*PLEPS(:,:) &
!$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(:,:) = - CSTURB%XCSHF*PKEFF(:,:)&
- *0.25*PBLL_O_E(:,:)*CSTURB%XCTV*PEMOIST(:,:)**2 &
+PM3_WTH_WR2(:,:) = - TURBN%XCSHF*PKEFF(:,:)&
+ *0.25*PBLL_O_E(:,:)*TURBN%XCTV*PEMOIST(:,:)**2 &
*ZWORK2(:,:)/CSTURB%XCTD*PDTDZ(:,:)/PD(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1368,9 +1353,11 @@ PM3_WTH_WR2(:,IKE+1)=PM3_WTH_WR2(:,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)
+SUBROUTINE D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1385,7 +1372,7 @@ SUBROUTINE D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1399,8 +1386,8 @@ ZWORK1(:,:) = PBETA(:,:)*PLEPS(:,:)&
!$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(:,:) = - CSTURB%XCSHF*PKEFF(:,:)&
- *0.25*PBLL_O_E(:,:)*CSTURB%XCTV*PEMOIST(:,:)**2 &
+PD_M3_WTH_WR2_O_DDTDZ(:,:) = - TURBN%XCSHF*PKEFF(:,:)&
+ *0.25*PBLL_O_E(:,:)*TURBN%XCTV*PEMOIST(:,:)**2 &
*ZWORK2(:,:)/CSTURB%XCTD/PD(:,:) &
* (1. - PREDTH1(:,:)* &
(1.5+PREDTH1(:,:)+PREDR1(:,:))/PD(:,:))
@@ -1412,9 +1399,10 @@ PD_M3_WTH_WR2_O_DDTDZ(:,IKE+1)=PD_M3_WTH_WR2_O_DDTDZ(:,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)
+SUBROUTINE M3_WTH_WTHR(D,CSTURB,TURBN,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST,PM3_WTH_WTHR)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1427,7 +1415,7 @@ SUBROUTINE M3_WTH_WTHR(D,CSTURB,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOI
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1442,7 +1430,7 @@ ZWORK1(:,:) = PBETA(:,:)*PLEPS(:,:)&
CALL MZM_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PM3_WTH_WTHR(:,:) = &
- CSTURB%XCSHF*PKEFF(:,:)*PEMOIST(:,:)*ZWORK2(:,:) &
+ TURBN%XCSHF*PKEFF(:,:)*PEMOIST(:,:)*ZWORK2(:,:) &
*0.5*PLEPS(:,:)/CSTURB%XCTD*(1+PREDR1(:,:))/PD(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1452,9 +1440,10 @@ PM3_WTH_WTHR(:,IKE+1)=PM3_WTH_WTHR(:,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)
+SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1464,7 +1453,7 @@ SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_
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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1475,7 +1464,7 @@ IKT=D%NKT
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_WTH_WTHR_O_DDTDZ(:,:) = &
- PM3_WTH_WTHR(:,:) * (1.5+PREDTH1(:,:)+PREDR1(:,:))&
- /PD(:,:)*CSTURB%XCTV*PBLL_O_E(:,:)*PETHETA(:,:)
+ /PD(:,:)*TURBN%XCTV*PBLL_O_E(:,:)*PETHETA(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PD_M3_WTH_WTHR_O_DDTDZ(:,IKB-1)=PD_M3_WTH_WTHR_O_DDTDZ(:,IKB)
@@ -1484,9 +1473,10 @@ PD_M3_WTH_WTHR_O_DDTDZ(:,IKE+1)=PD_M3_WTH_WTHR_O_DDTDZ(:,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)
+SUBROUTINE M3_TH2_W2TH(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE,PM3_TH2_W2TH)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1498,7 +1488,7 @@ SUBROUTINE M3_TH2_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE,PM3_TH2_W
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1513,7 +1503,7 @@ ZWORK1(:,:) = (1.-0.5*PREDR1(:,:)*(1.+PREDR1(:,:))&
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PM3_TH2_W2TH(:,:) = - ZWORK2(:,:) &
- * 1.5*PLM(:,:)*PLEPS(:,:)/PTKE(:,:)*CSTURB%XCTV
+ * 1.5*PLM(:,:)*PLEPS(:,:)/PTKE(:,:)*TURBN%XCTV
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PM3_TH2_W2TH(:,IKB-1)=PM3_TH2_W2TH(:,IKB)
@@ -1522,9 +1512,10 @@ PM3_TH2_W2TH(:,IKE+1)=PM3_TH2_W2TH(:,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)
+SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1536,7 +1527,7 @@ SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSER
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1545,7 +1536,7 @@ IIJB=D%NIJB
IKT=D%NKT
!
IF (OUSERV) THEN
-! D_M3_TH2_W2TH_O_DDTDZ(:,:) = - 1.5*PLM*PLEPS/PTKE*CSTURB%XCTV * MZF( &
+! D_M3_TH2_W2TH_O_DDTDZ(:,:) = - 1.5*PLM*PLEPS/PTKE*TURBN%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)
@@ -1557,7 +1548,7 @@ IF (OUSERV) THEN
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_TH2_W2TH_O_DDTDZ(:,:) = - 1.5*PLM(:,:)*PLEPS(:,:) &
- /PTKE(:,:)*CSTURB%XCTV * ZWORK2(:,:)
+ /PTKE(:,:)*TURBN%XCTV * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1566,7 +1557,7 @@ ELSE
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_TH2_W2TH_O_DDTDZ(:,:) = - 1.5*PLM(:,:)*PLEPS(:,:) &
- /PTKE(:,:)*CSTURB%XCTV * ZWORK2(:,:)
+ /PTKE(:,:)*TURBN%XCTV * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
@@ -1576,9 +1567,10 @@ PD_M3_TH2_W2TH_O_DDTDZ(:,IKE+1)=PD_M3_TH2_W2TH_O_DDTDZ(:,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)
+SUBROUTINE M3_TH2_WTH2(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_TH2_WTH2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1588,7 +1580,7 @@ SUBROUTINE M3_TH2_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1612,9 +1604,10 @@ PM3_TH2_WTH2(:,IKE+1)=PM3_TH2_WTH2(:,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)
+SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1626,7 +1619,7 @@ SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1643,7 +1636,7 @@ ZWORK1(:,:) = PBLL_O_E(:,:)*PETHETA(:,:) &
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_TH2_WTH2_O_DDTDZ(:,:) = PLEPS(:,:) &
- *0.5/CSTURB%XCTD/PSQRT_TKE(:,:)*CSTURB%XCTV * ZWORK2(:,:)
+ *0.5/CSTURB%XCTD/PSQRT_TKE(:,:)*TURBN%XCTV * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PD_M3_TH2_WTH2_O_DDTDZ(:,IKB-1)=PD_M3_TH2_WTH2_O_DDTDZ(:,IKB)
@@ -1652,9 +1645,10 @@ PD_M3_TH2_WTH2_O_DDTDZ(:,IKE+1)=PD_M3_TH2_WTH2_O_DDTDZ(:,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)
+SUBROUTINE M3_TH2_W2R(D,CSTURB,TURBN,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_W2R)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1666,7 +1660,7 @@ SUBROUTINE M3_TH2_W2R(D,CSTURB,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1680,7 +1674,7 @@ ZWORK1(:,:) = PBLL_O_E(:,:)*PEMOIST(:,:) &
!$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(:,:) = 0.75*CSTURB%XCTV**2*ZWORK2(:,:) &
+PM3_TH2_W2R(:,:) = 0.75*TURBN%XCTV**2*ZWORK2(:,:) &
*PLM(:,:)*PLEPS(:,:)/PTKE(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1690,9 +1684,10 @@ PM3_TH2_W2R(:,IKE+1)=PM3_TH2_W2R(:,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)
+SUBROUTINE D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1706,7 +1701,7 @@ SUBROUTINE D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1721,7 +1716,7 @@ ZWORK1(:,:) = PBLL_O_E(:,:)*PEMOIST(:,:)&
!$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(:,:) = 0.75*CSTURB%XCTV**2*PLM(:,:) *PLEPS(:,:) &
+PD_M3_TH2_W2R_O_DDTDZ(:,:) = 0.75*TURBN%XCTV**2*PLM(:,:) *PLEPS(:,:) &
/PTKE(:,:) * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1731,9 +1726,10 @@ PD_M3_TH2_W2R_O_DDTDZ(:,IKE+1)=PD_M3_TH2_W2R_O_DDTDZ(:,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)
+SUBROUTINE M3_TH2_WR2(D,CSTURB,TURBN,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WR2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1744,7 +1740,7 @@ SUBROUTINE M3_TH2_WR2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1758,7 +1754,7 @@ ZWORK1(:,:) = (PBLL_O_E(:,:)*PEMOIST(:,:)&
!$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(:,:) = 0.25*CSTURB%XCTV**2*ZWORK2(:,:)&
+PM3_TH2_WR2(:,:) = 0.25*TURBN%XCTV**2*ZWORK2(:,:)&
*PLEPS(:,:)/PSQRT_TKE(:,:)/CSTURB%XCTD
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1768,9 +1764,10 @@ PM3_TH2_WR2(:,IKE+1)=PM3_TH2_WR2(:,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)
+SUBROUTINE D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1783,7 +1780,7 @@ SUBROUTINE D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1798,7 +1795,7 @@ ZWORK1(:,:) = (PBLL_O_E(:,:)*PEMOIST(:,:))**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_WR2_O_DDTDZ(:,:) = 0.25*CSTURB%XCTV**2*PLEPS(:,:) &
+PD_M3_TH2_WR2_O_DDTDZ(:,:) = 0.25*TURBN%XCTV**2*PLEPS(:,:) &
/ PSQRT_TKE(:,:)/CSTURB%XCTD * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1808,9 +1805,10 @@ PD_M3_TH2_WR2_O_DDTDZ(:,IKE+1)=PD_M3_TH2_WR2_O_DDTDZ(:,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)
+SUBROUTINE M3_TH2_WTHR(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1822,7 +1820,7 @@ SUBROUTINE M3_TH2_WTHR(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1836,7 +1834,7 @@ ZWORK1(:,:) = PBLL_O_E(:,:)*PEMOIST(:,:) &
!$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(:,:) = - 0.5*CSTURB%XCTV*PLEPS(:,:) &
+PM3_TH2_WTHR(:,:) = - 0.5*TURBN%XCTV*PLEPS(:,:) &
/ PSQRT_TKE(:,:)/CSTURB%XCTD * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1846,9 +1844,10 @@ PM3_TH2_WTHR(:,IKE+1)=PM3_TH2_WTHR(:,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)
+SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1861,7 +1860,7 @@ SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1876,7 +1875,7 @@ ZWORK1(:,:) = PBLL_O_E(:,:)*PEMOIST(:,:)* &
!$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(:,:) = - 0.5*CSTURB%XCTV*PLEPS(:,:) &
+PD_M3_TH2_WTHR_O_DDTDZ(:,:) = - 0.5*TURBN%XCTV*PLEPS(:,:) &
/ PSQRT_TKE(:,:)/CSTURB%XCTD * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
@@ -1886,9 +1885,10 @@ PD_M3_TH2_WTHR_O_DDTDZ(:,IKE+1)=PD_M3_TH2_WTHR_O_DDTDZ(:,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)
+SUBROUTINE M3_THR_WTHR(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_THR_WTHR)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1898,7 +1898,7 @@ SUBROUTINE M3_THR_WTHR(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1922,9 +1922,10 @@ PM3_THR_WTHR(:,IKE+1)=PM3_THR_WTHR(:,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)
+SUBROUTINE D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1936,7 +1937,7 @@ SUBROUTINE D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1952,7 +1953,7 @@ ZWORK1(:,:) = PETHETA(:,:)*PBLL_O_E(:,:)/PD(:,:) &
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_THR_WTHR_O_DDTDZ(:,:) = 0.5*PLEPS(:,:)/PSQRT_TKE(:,:) &
- / CSTURB%XCTD * CSTURB%XCTV * ZWORK2(:,:)
+ / CSTURB%XCTD * TURBN%XCTV * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PD_M3_THR_WTHR_O_DDTDZ(:,IKB-1)=PD_M3_THR_WTHR_O_DDTDZ(:,IKB)
@@ -1961,9 +1962,10 @@ PD_M3_THR_WTHR_O_DDTDZ(:,IKE+1)=PD_M3_THR_WTHR_O_DDTDZ(:,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)
+SUBROUTINE M3_THR_WTH2(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -1975,7 +1977,7 @@ SUBROUTINE M3_THR_WTH2(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -1990,7 +1992,7 @@ ZWORK1(:,:) = (1.+PREDR1(:,:))*PBLL_O_E(:,:)* &
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PM3_THR_WTH2(:,:) = - 0.25*PLEPS(:,:) &
- / PSQRT_TKE(:,:)/CSTURB%XCTD*CSTURB%XCTV * ZWORK2(:,:)
+ / PSQRT_TKE(:,:)/CSTURB%XCTD*TURBN%XCTV * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PM3_THR_WTH2(:,IKB-1)=PM3_THR_WTH2(:,IKB)
@@ -1999,9 +2001,10 @@ PM3_THR_WTH2(:,IKE+1)=PM3_THR_WTH2(:,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)
+SUBROUTINE D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2014,7 +2017,7 @@ SUBROUTINE D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -2031,7 +2034,7 @@ ZWORK1(:,:) = -(1.+PREDR1(:,:))*(PBLL_O_E(:,:) &
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_THR_WTH2_O_DDTDZ(:,:) = - 0.25*PLEPS(:,:) &
- /PSQRT_TKE(:,:)/CSTURB%XCTD*CSTURB%XCTV**2 * ZWORK2(:,:)
+ /PSQRT_TKE(:,:)/CSTURB%XCTD*TURBN%XCTV**2 * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PD_M3_THR_WTH2_O_DDTDZ(:,IKB-1)=PD_M3_THR_WTH2_O_DDTDZ(:,IKB)
@@ -2040,9 +2043,10 @@ PD_M3_THR_WTH2_O_DDTDZ(:,IKE+1)=PD_M3_THR_WTH2_O_DDTDZ(:,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)
+SUBROUTINE D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2054,7 +2058,7 @@ SUBROUTINE D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -2070,7 +2074,7 @@ ZWORK1(:,:) = PBLL_O_E(:,:)*PETHETA(:,:)/PD(:,:)&
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_THR_WTH2_O_DDRDZ(:,:) = - 0.25*PLEPS(:,:)/PSQRT_TKE(:,:)&
- / CSTURB%XCTD*CSTURB%XCTV * ZWORK2(:,:)
+ / CSTURB%XCTD*TURBN%XCTV * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PD_M3_THR_WTH2_O_DDRDZ(:,IKB-1)=PD_M3_THR_WTH2_O_DDRDZ(:,IKB)
@@ -2079,9 +2083,10 @@ PD_M3_THR_WTH2_O_DDRDZ(:,IKE+1)=PD_M3_THR_WTH2_O_DDRDZ(:,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)
+SUBROUTINE M3_THR_W2TH(D,CSTURB,TURBN,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ,PM3_THR_W2TH)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2092,7 +2097,7 @@ SUBROUTINE M3_THR_W2TH(D,CSTURB,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ,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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2TH',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -2106,7 +2111,7 @@ ZWORK1(:,:) = (1.+PREDR1(:,:))*PDRDZ(:,:)/PD(:,:)
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PM3_THR_W2TH(:,:) = - 0.75*PLM(:,:)*PLEPS(:,:)&
- / PTKE(:,:) * CSTURB%XCTV * ZWORK2(:,:)
+ / PTKE(:,:) * TURBN%XCTV * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PM3_THR_W2TH(:,IKB-1)=PM3_THR_W2TH(:,IKB)
@@ -2115,9 +2120,10 @@ PM3_THR_W2TH(:,IKE+1)=PM3_THR_W2TH(:,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)
+SUBROUTINE D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2131,7 +2137,7 @@ SUBROUTINE D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -2147,7 +2153,7 @@ ZWORK1(:,:) = -PETHETA(:,:)*PBLL_O_E(:,:)*&
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_THR_W2TH_O_DDTDZ(:,:) = - 0.75*PLM(:,:)*PLEPS(:,:)&
- / PTKE(:,:) * CSTURB%XCTV**2 * ZWORK1(:,:)
+ / PTKE(:,:) * TURBN%XCTV**2 * ZWORK1(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PD_M3_THR_W2TH_O_DDTDZ(:,IKB-1)=PD_M3_THR_W2TH_O_DDTDZ(:,IKB)
@@ -2156,9 +2162,10 @@ PD_M3_THR_W2TH_O_DDTDZ(:,IKE+1)=PD_M3_THR_W2TH_O_DDTDZ(:,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)
+SUBROUTINE D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2TH_O_DDRDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2169,7 +2176,7 @@ SUBROUTINE D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PD_M3
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
@@ -2185,7 +2192,7 @@ ZWORK1(:,:) = -(1.+PREDR1(:,:))*PREDR1(:,:)&
CALL MZF_PHY(D,ZWORK1,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PD_M3_THR_W2TH_O_DDRDZ(:,:) = - 0.75*PLM(:,:)*PLEPS(:,:)&
- / PTKE(:,:) * CSTURB%XCTV * ZWORK2(:,:)
+ / PTKE(:,:) * TURBN%XCTV * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
PD_M3_THR_W2TH_O_DDRDZ(:,IKB-1)=PD_M3_THR_W2TH_O_DDRDZ(:,IKB)
@@ -2197,9 +2204,10 @@ END SUBROUTINE D_M3_THR_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!
-SUBROUTINE PSI3(D,CSTURB,PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PPSI3)
+SUBROUTINE PSI3(D,CSTURB,TURBN,PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PPSI3)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2209,16 +2217,17 @@ SUBROUTINE PSI3(D,CSTURB,PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSE
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PPSI3
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: 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)
+CALL PHI3(D,CSTURB,TURBN,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)
+SUBROUTINE D_PSI3DRDZ_O_DDRDZ(D,CSTURB,TURBN,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DRDZ_O_DDRDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2228,18 +2237,19 @@ SUBROUTINE D_PSI3DRDZ_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HT
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE D_PSI3DTDZ_O_DDTDZ(D,CSTURB,TURBN,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DTDZ_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2249,16 +2259,17 @@ SUBROUTINE D_PSI3DTDZ_O_DDTDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HT
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_PHI3DRDZ_O_DDRDZ(D,CSTURB,TURBN,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)
+SUBROUTINE D_PSI3DRDZ2_O_DDRDZ(D,CSTURB,TURBN,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV,PD_PSI3DRDZ2_O_DDRDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2269,16 +2280,17 @@ SUBROUTINE D_PSI3DRDZ2_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,P
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_PHI3DTDZ2_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_WR_WR2(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PM3_WR_WR2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2286,16 +2298,17 @@ SUBROUTINE M3_WR_WR2(D,CSTURB,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PM3_WR_WR2)
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_WTH_WTH2(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_WR_WR2_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2304,16 +2317,17 @@ SUBROUTINE D_M3_WR_WR2_O_DDRDZ(D,CSTURB,PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PE
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_WR_W2R(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,PKEFF,PTKE,PM3_WR_W2R)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2321,16 +2335,17 @@ SUBROUTINE M3_WR_W2R(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PM3_WR_W2R)
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_WTH_W2TH(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_WR_W2R_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2340,16 +2355,17 @@ SUBROUTINE D_M3_WR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_WR_W2TH(D,CSTURB,TURBN,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_WR_W2TH)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2358,16 +2374,17 @@ SUBROUTINE M3_WR_W2TH(D,CSTURB,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_WR_W2TH)
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_WTH_W2R(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_WR_W2TH_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2377,16 +2394,17 @@ SUBROUTINE D_M3_WR_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,P
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_WR_WTH2(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2398,16 +2416,18 @@ SUBROUTINE M3_WR_WTH2(D,CSTURB,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETH
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_WTH_WR2(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_WR_WTH2_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2420,16 +2440,17 @@ SUBROUTINE D_M3_WR_WTH2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_WR_WTHR(D,CSTURB,TURBN,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA,PM3_WR_WTHR)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2440,16 +2461,17 @@ SUBROUTINE M3_WR_WTHR(D,CSTURB,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHE
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_WTH_WTHR(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_WR_WTHR_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2458,16 +2480,17 @@ SUBROUTINE D_M3_WR_WTHR_O_DDRDZ(D,CSTURB,PM3_WR_WTHR,PREDR1,PREDTH1,PD,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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_R2_W2R(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE,PM3_R2_W2R)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2477,16 +2500,17 @@ SUBROUTINE M3_R2_W2R(D,CSTURB,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE,PM3_R2_W2R)
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_TH2_W2TH(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_R2_W2R_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2496,16 +2520,17 @@ SUBROUTINE D_M3_R2_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV,
LOGICAL, INTENT(IN) :: OUSERV
REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_R2_W2R_O_DDRDZ
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_R2_WR2(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PM3_R2_WR2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2513,16 +2538,17 @@ SUBROUTINE M3_R2_WR2(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PM3_R2_WR2)
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_TH2_WTH2(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_R2_WR2_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2532,16 +2558,17 @@ SUBROUTINE D_M3_R2_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_R2_W2TH(D,CSTURB,TURBN,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_W2TH)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2551,16 +2578,17 @@ SUBROUTINE M3_R2_W2TH(D,CSTURB,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_W
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_TH2_W2R(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_R2_W2TH_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2572,16 +2600,17 @@ SUBROUTINE D_M3_R2_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_R2_WTH2(D,CSTURB,TURBN,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTH2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2590,16 +2619,17 @@ SUBROUTINE M3_R2_WTH2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_TH2_WR2(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_R2_WTH2_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2610,16 +2640,17 @@ SUBROUTINE D_M3_R2_WTH2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_R2_WTHR(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2629,16 +2660,17 @@ SUBROUTINE M3_R2_WTHR(D,CSTURB,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_TH2_WTHR(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_R2_WTHR_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2649,16 +2681,17 @@ SUBROUTINE D_M3_R2_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_THR_WTHR_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2668,16 +2701,17 @@ SUBROUTINE D_M3_THR_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_THR_WR2(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2687,16 +2721,17 @@ SUBROUTINE M3_THR_WR2(D,CSTURB,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_THR_WTH2(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_THR_WR2_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2707,16 +2742,17 @@ SUBROUTINE D_M3_THR_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_THR_WR2_O_DDTDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2726,16 +2762,17 @@ SUBROUTINE D_M3_THR_WR2_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,TURBN,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)
+SUBROUTINE M3_THR_W2R(D,CSTURB,TURBN,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ,PM3_THR_W2R)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2744,16 +2781,17 @@ SUBROUTINE M3_THR_W2R(D,CSTURB,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ,PM3_THR_W2R)
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
+REAL(KIND=JPHOOK) :: 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)
+CALL M3_THR_W2TH(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_THR_W2R_O_DDRDZ(D,CSTURB,TURBN,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
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2765,16 +2803,17 @@ SUBROUTINE D_M3_THR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,TURBN,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)
+SUBROUTINE D_M3_THR_W2R_O_DDTDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2R_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
+ TYPE(TURB_t), INTENT(IN) :: TURBN
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
@@ -2783,9 +2822,9 @@ SUBROUTINE D_M3_THR_W2R_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PD_M3_
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
+REAL(KIND=JPHOOK) :: 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)
+CALL D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,TURBN,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
diff --git a/src/PHYEX/turb/mode_rmc01.f90 b/src/PHYEX/turb/mode_rmc01.f90
index cdd81bc62c496ee8377ba5b7ae852b66c676dd21..98f6db452f8880477d95205668fe0f53b25b4cbe 100644
--- a/src/PHYEX/turb/mode_rmc01.f90
+++ b/src/PHYEX/turb/mode_rmc01.f90
@@ -5,9 +5,8 @@
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
+SUBROUTINE RMC01(D,CST,CSTURB,TURBN,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,PLMO,PLK,PLEPS)
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ##############################################################
!
!!**** *RMC01* -
@@ -49,6 +48,7 @@ USE MODD_PARAMETERS, ONLY: XUNDEF
USE MODD_CST, ONLY : CST_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CTURB, ONLY: CSTURB_t
+USE MODD_TURB_n, ONLY: TURB_t
!
USE MODE_UPDATE_IIJU_PHY, ONLY: UPDATE_IIJU_PHY
USE MODE_SBL_PHY, ONLY: BUSINGER_PHIM, BUSINGER_PHIE
@@ -63,7 +63,7 @@ IMPLICIT NONE
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
+TYPE(TURB_t), INTENT(IN) :: TURBN
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)
@@ -103,7 +103,7 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZDH ! hor. grid mesh
! ---------------
!
! horizontal boundaries
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('RMC01',0,ZHOOK_HANDLE)
IKTB=D%NKTB
IKTE=D%NKTE
@@ -157,7 +157,7 @@ CALL BUSINGER_PHIM(D,ZZ_O_LMO,ZPHIM)
CALL BUSINGER_PHIE(D,CSTURB,ZZ_O_LMO,ZPHIE)
!
!-------------------------------------------------------------------------------
-SELECT CASE (HTURBLEN)
+SELECT CASE (TURBN%CTURBLEN)
!-------------------------------------------------------------------------------
!
!* 3. altitude where turbulence is isotropic inside a layer of given width (3D case)
@@ -269,7 +269,7 @@ PLK(:,IKU) = PLK(:,IKE)
! --------------------------------------
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-ZL(:,:) = ZL(:,:) * (CSTURB%XALPSBL**(3./2.)*CST%XKARMAN*CSTURB%XCED) &
+ZL(:,:) = ZL(:,:) * (CSTURB%XALPSBL**(3./2.)*CST%XKARMAN*TURBN%XCED) &
/ (CST%XKARMAN/SQRT(CSTURB%XALPSBL)/CSTURB%XCMFS)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
diff --git a/src/PHYEX/turb/mode_sbl.f90 b/src/PHYEX/turb/mode_sbl.f90
index c219c43f422d073e7f1d3cc0f5743df1e6d9ecb9..1ccb9a47e061cb33e0179e140479c3c02b363806 100644
--- a/src/PHYEX/turb/mode_sbl.f90
+++ b/src/PHYEX/turb/mode_sbl.f90
@@ -39,8 +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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
+IMPLICIT NONE
!
!* 0. DECLARATIONS
!
@@ -85,7 +85,7 @@ SUBROUTINE BUSINGER_PHIM_3D(PZ_O_LMO,BUSINGER_PHIM3D)
REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)),INTENT(OUT) :: BUSINGER_PHIM3D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_3D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:,:) < 0. )
BUSINGER_PHIM3D(:,:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
@@ -101,7 +101,7 @@ 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)),INTENT(OUT) :: BUSINGER_PHIM2D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_2D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:) < 0. )
BUSINGER_PHIM2D(:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
@@ -117,7 +117,7 @@ SUBROUTINE BUSINGER_PHIM_1D(PZ_O_LMO,BUSINGER_PHIM1D)
REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
REAL, DIMENSION(SIZE(PZ_O_LMO)),INTENT(OUT) :: BUSINGER_PHIM1D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_1D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:) < 0. )
BUSINGER_PHIM1D(:) = (1.-15.*PZ_O_LMO)**(-0.25)
@@ -133,7 +133,7 @@ SUBROUTINE BUSINGER_PHIM_0D(PZ_O_LMO,BUSINGER_PHIM0D)
REAL, INTENT(IN) :: PZ_O_LMO
REAL,INTENT(OUT) :: BUSINGER_PHIM0D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_0D',0,ZHOOK_HANDLE)
IF ( PZ_O_LMO < 0. ) THEN
BUSINGER_PHIM0D = (1.-15.*PZ_O_LMO)**(-0.25)
@@ -151,7 +151,7 @@ SUBROUTINE BUSINGER_PHIH_3D(PZ_O_LMO,BUSINGER_PHIH3D)
REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)),INTENT(OUT) :: BUSINGER_PHIH3D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_3D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:,:) < 0. )
BUSINGER_PHIH3D(:,:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
@@ -167,7 +167,7 @@ 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)),INTENT(OUT) :: BUSINGER_PHIH2D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_2D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:) < 0. )
BUSINGER_PHIH2D(:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
@@ -183,7 +183,7 @@ SUBROUTINE BUSINGER_PHIH_1D(PZ_O_LMO,BUSINGER_PHIH1D)
REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
REAL, DIMENSION(SIZE(PZ_O_LMO)),INTENT(OUT) :: BUSINGER_PHIH1D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_1D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:) < 0. )
BUSINGER_PHIH1D(:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
@@ -199,7 +199,7 @@ SUBROUTINE BUSINGER_PHIH_0D(PZ_O_LMO,BUSINGER_PHIH0D)
REAL, INTENT(IN) :: PZ_O_LMO
REAL,INTENT(OUT) :: BUSINGER_PHIH0D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_0D',0,ZHOOK_HANDLE)
IF ( PZ_O_LMO < 0. ) THEN
BUSINGER_PHIH0D = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
@@ -218,7 +218,7 @@ SUBROUTINE BUSINGER_PHIE_3D(PZ_O_LMO,BUSINGER_PHIE3D)
REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)),INTENT(OUT) :: BUSINGER_PHIE3D
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE_3D',0,ZHOOK_HANDLE)
WHERE ( PZ_O_LMO(:,:,:) < 0. )
BUSINGER_PHIE3D(:,:,:) = (1.+(-PZ_O_LMO)**(2./3.)/XALPSBL) &
@@ -239,7 +239,7 @@ SUBROUTINE PAULSON_PSIM_2D(PZ_O_LMO,PAULSON_PSIM2D)
!
REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: ZX
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_2D',0,ZHOOK_HANDLE)
ZX=1.
WHERE ( PZ_O_LMO(:,:) < 0. )
@@ -260,7 +260,7 @@ SUBROUTINE PAULSON_PSIM_1D(PZ_O_LMO,PAULSON_PSIM1D)
!
REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: ZX
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_1D',0,ZHOOK_HANDLE)
ZX=1.
WHERE ( PZ_O_LMO(:) < 0. )
@@ -281,7 +281,7 @@ SUBROUTINE PAULSON_PSIM_0D(PZ_O_LMO,PAULSON_PSIM0D)
!
REAL :: ZX
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_0D',0,ZHOOK_HANDLE)
ZX=1.
IF ( PZ_O_LMO < 0. ) THEN
@@ -298,7 +298,7 @@ END SUBROUTINE PAULSON_PSIM_0D
!
SUBROUTINE LMO_2D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO2D)
USE MODD_CST
- USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
+ USE MODD_PARAMETERS, ONLY: XUNDEF
REAL, DIMENSION(:,:), INTENT(IN) :: PUSTAR
REAL, DIMENSION(:,:), INTENT(IN) :: PTHETA
REAL, DIMENSION(:,:), INTENT(IN) :: PRV
@@ -311,7 +311,7 @@ SUBROUTINE LMO_2D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO2D)
REAL :: ZEPS
!
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_2D',0,ZHOOK_HANDLE)
ZEPS=(XRV-XRD)/XRD
ZTHETAV(:,:) = PTHETA(:,:) * ( 1. +ZEPS * PRV(:,:))
@@ -329,7 +329,7 @@ END SUBROUTINE LMO_2D
!
SUBROUTINE LMO_1D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO1D)
USE MODD_CST
- USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
+ USE MODD_PARAMETERS, ONLY: XUNDEF
REAL, DIMENSION(:), INTENT(IN) :: PUSTAR
REAL, DIMENSION(:), INTENT(IN) :: PTHETA
REAL, DIMENSION(:), INTENT(IN) :: PRV
@@ -341,7 +341,7 @@ SUBROUTINE LMO_1D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO1D)
REAL :: ZEPS
!
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_1D',0,ZHOOK_HANDLE)
ZEPS=(XRV-XRD)/XRD
!
@@ -359,7 +359,7 @@ END SUBROUTINE LMO_1D
!
SUBROUTINE LMO_0D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO0D)
USE MODD_CST
- USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
+ USE MODD_PARAMETERS, ONLY: XUNDEF
REAL, INTENT(IN) :: PUSTAR
REAL, INTENT(IN) :: PTHETA
REAL, INTENT(IN) :: PRV
@@ -371,7 +371,7 @@ SUBROUTINE LMO_0D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV,LMO0D)
REAL :: ZEPS
!
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_0D',0,ZHOOK_HANDLE)
ZEPS=(XRV-XRD)/XRD
!
@@ -391,7 +391,7 @@ END SUBROUTINE LMO_0D
!
SUBROUTINE USTAR_2D(PU,PV,PZ,PZ0,PLMO,USTAR2D)
USE MODD_CST
- USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
+ USE MODD_PARAMETERS, ONLY: XUNDEF
REAL, DIMENSION(:,:), INTENT(IN) :: PU
REAL, DIMENSION(:,:), INTENT(IN) :: PV
REAL, DIMENSION(:,:), INTENT(IN) :: PZ
@@ -404,7 +404,7 @@ SUBROUTINE USTAR_2D(PU,PV,PZ,PZ0,PLMO,USTAR2D)
REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: ZWORK1,ZWORK2
!
!* purely unstable case
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_2D',0,ZHOOK_HANDLE)
USTAR2D(:,:) = 0.
ZZ_O_LMO(:,:) = XUNDEF
@@ -435,7 +435,7 @@ END SUBROUTINE USTAR_2D
!
SUBROUTINE USTAR_1D(PU,PV,PZ,PZ0,PLMO,USTAR1D)
USE MODD_CST
- USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
+ USE MODD_PARAMETERS, ONLY: XUNDEF
REAL, DIMENSION(:), INTENT(IN) :: PU
REAL, DIMENSION(:), INTENT(IN) :: PV
REAL, DIMENSION(:), INTENT(IN) :: PZ
@@ -448,7 +448,7 @@ SUBROUTINE USTAR_1D(PU,PV,PZ,PZ0,PLMO,USTAR1D)
REAL, DIMENSION(SIZE(PU)) :: ZWORK1,ZWORK2
!
!* purely unstable case
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_1D',0,ZHOOK_HANDLE)
USTAR1D(:) = 0.
ZZ_O_LMO(:) = XUNDEF
@@ -479,17 +479,17 @@ END SUBROUTINE USTAR_1D
!
SUBROUTINE USTAR_0D(PU,PV,PZ,PZ0,PLMO,USTAR0D)
USE MODD_CST
- USE MODD_PARAMETERS, ONLY: JPVEXT_TURB,XUNDEF
+ USE MODD_PARAMETERS, ONLY: XUNDEF
REAL, INTENT(IN) :: PU
REAL, INTENT(IN) :: PV
REAL, INTENT(IN) :: PZ
REAL, INTENT(IN) :: PZ0
REAL, INTENT(IN) :: PLMO
REAL, INTENT(OUT) :: USTAR0D
- REAL :: ZWORK, ZWORK2
+ REAL :: ZWORK1, ZWORK2
!
!* purely unstable case
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_0D',0,ZHOOK_HANDLE)
USTAR0D = 0.
!
diff --git a/src/PHYEX/turb/mode_sbl_depth.f90 b/src/PHYEX/turb/mode_sbl_depth.f90
index 351b732f54cf3d143386566806c333778ceac496..8da65ac5643dc573d4e5706c1a4b76cbb8456464 100644
--- a/src/PHYEX/turb/mode_sbl_depth.f90
+++ b/src/PHYEX/turb/mode_sbl_depth.f90
@@ -7,8 +7,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #################################################################
!
!
@@ -86,7 +85,7 @@ REAL, DIMENSION(D%NIJT) :: ZA ! ponderation coefficient
!* initialisations
!
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('SBL_DEPTH',0,ZHOOK_HANDLE)
!
IKB=D%NKTB
@@ -131,7 +130,7 @@ ZSBL_THER(:)= CSTURB%XSBL_O_BL * ZSBL_THER(:)
PSBL_DEPTH(:) = 0.
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (ZSBL_THER(:)> 0. .AND. ZSBL_DYN(:)> 0.)
- PSBL_DEPTH = MIN(ZSBL_THER(:),ZSBL_DYN(:))
+ PSBL_DEPTH(:) = MIN(ZSBL_THER(:),ZSBL_DYN(:))
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
diff --git a/src/PHYEX/turb/mode_sbl_phy.f90 b/src/PHYEX/turb/mode_sbl_phy.f90
index fcf58f980249bfde88387bf499b8aedf3cab1061..f4e17e1ab94f004f7848f9771f303e7e8a55af64 100644
--- a/src/PHYEX/turb/mode_sbl_phy.f90
+++ b/src/PHYEX/turb/mode_sbl_phy.f90
@@ -39,8 +39,7 @@
!! 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
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!-------------------------------------------------------------------------------
@@ -57,7 +56,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JIJ,JK,IIJB,IIJE,IKT
!
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM',0,ZHOOK_HANDLE)
@@ -88,7 +87,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JIJ,JK,IIJB,IIJE,IKT
!
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH',0,ZHOOK_HANDLE)
@@ -120,7 +119,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JIJ,JK,IIJB,IIJE,IKT
!
IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE',0,ZHOOK_HANDLE)
@@ -143,7 +142,7 @@ 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
+ USE MODD_PARAMETERS, ONLY: XUNDEF
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
@@ -158,7 +157,7 @@ SUBROUTINE LMO(D,CST,PUSTAR,PTHETA,PRV,PSFTH,PSFRV,PLMO)
REAL :: ZEPS
INTEGER :: IIJB,IIJE, JIJ,IKT
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO',0,ZHOOK_HANDLE)
!
IIJE=D%NIJE
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 59c68a39727156ea751af1d1e622f02d24ca0ab0..cd56c9dcfea18b326a2aff8775dd63c40bb3240a 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
@@ -49,8 +49,7 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY : CST_t
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
IMPLICIT NONE
!
@@ -81,7 +80,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
!
diff --git a/src/PHYEX/turb/mode_tke_eps_sources.f90 b/src/PHYEX/turb/mode_tke_eps_sources.f90
index ef2af6385bb73cc3853bb6998a045dea8c4e445f..b6f059aa2f0408bd48501e491acae9c940ccca44 100644
--- a/src/PHYEX/turb/mode_tke_eps_sources.f90
+++ b/src/PHYEX/turb/mode_tke_eps_sources.f90
@@ -7,7 +7,7 @@ MODULE MODE_TKE_EPS_SOURCES
IMPLICIT NONE
CONTAINS
SUBROUTINE TKE_EPS_SOURCES(D,CST,CSTURB,BUCONF,TURBN,TLES, &
- & HPROGRAM, KMI,PTKEM,PLM,PLEPS,PDP, &
+ & PTKEM,PLM,PLEPS,PDP, &
& PTRH,PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
& PTSTEP,PEXPL, &
& TPFILE,ODIAG_IN_RUN,OOCEAN, &
@@ -60,10 +60,10 @@ CONTAINS
!! Module MODD_CTURB: contains the set of constants for
!! the turbulence scheme
!!
-!! CSTURB%XCET,CSTURB%XCED : transport and dissipation cts. for the TKE
+!! CSTURB%XCET,TURBN%XCED : transport and dissipation cts. for the TKE
!! XCDP,XCDD,XCDT: constants from the parameterization of
!! the K-epsilon equation
-!! CSTURB%XTKEMIN,XEPSMIN : minimum values for the TKE and its
+!! TURBN%XTKEMIN,XEPSMIN : minimum values for the TKE and its
!! dissipation
!!
!! Module MODD_PARAMETERS:
@@ -127,19 +127,17 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY: JPRB
USE MODE_SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZF_PHY, DZM_PHY
-USE YOMHOOK, ONLY: LHOOK, DR_HOOK
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK
!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-USE MODD_BUDGET, ONLY: TBUDGETCONF_t, NBUDGET_TKE, NBUDGET_TH, TBUDGETDATA
+USE MODD_BUDGET, ONLY: TBUDGETCONF_t, NBUDGET_TKE, TBUDGETDATA
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES, ONLY: TLES_t
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_TURB_n, ONLY: TURB_t
!
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_END_PHY, BUDGET_STORE_INIT_PHY
@@ -164,8 +162,6 @@ TYPE(CSTURB_t), INTENT(IN) :: CSTURB
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
TYPE(TURB_t), INTENT(IN) :: TURBN
TYPE(TLES_t), INTENT(INOUT):: TLES
-CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! CPROGRAM is the program currently running (modd_conf)
-INTEGER, INTENT(IN) :: KMI ! model index number
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
@@ -219,7 +215,7 @@ INTEGER :: IIJB,IIJE,IKB,IKE,IKT,IKA,IKL ! Index value for the mass
TYPE(LIST_ll), POINTER :: TZFIELDDISS_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(TFIELDMETADATA) :: TZFIELD
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
INTEGER :: JIJ,JK
!
!----------------------------------------------------------------------------
@@ -282,7 +278,7 @@ CALL MZM_PHY(D,ZKEFF,ZMWORK1)
CALL MZM_PHY(D,PRHODJ,ZMWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-ZFLX(:,:) = CSTURB%XCED * SQRT(PTKEM(:,:)) / PLEPS(:,:)
+ZFLX(:,:) = TURBN%XCED * SQRT(PTKEM(:,:)) / PLEPS(:,:)
ZSOURCE(:,:) = ( PRTKES(:,:) + PRTKEMS(:,:) ) &
/ PRHODJ(:,:) - PTKEM(:,:) / PTSTEP &
+ PDP(:,:) + PTP(:,:) + ZTR(:,:) &
@@ -328,11 +324,11 @@ 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
+IF(TURBN%LTKEMINTURB) THEN
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
- GTKENEG(:,:) = ZRES(:,:) <= CSTURB%XTKEMIN
+ GTKENEG(:,:) = ZRES(:,:) <= TURBN%XTKEMIN
WHERE ( GTKENEG(:,:) )
- ZRES(:,:) = CSTURB%XTKEMIN
+ ZRES(:,:) = TURBN%XTKEMIN
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
@@ -400,7 +396,7 @@ IF (BUCONF%LBUDGET_TKE) THEN
!
! Dissipation
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZMWORK1(:,:) = -CSTURB%XCED * SQRT(PTKEM(:,:))/PLEPS(:,:) * &
+ ZMWORK1(:,:) = -TURBN%XCED * SQRT(PTKEM(:,:))/PLEPS(:,:) * &
(PEXPL*PTKEM(:,:) + TURBN%XIMPL*ZRES(:,:))*PRHODJ(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TKE), 'DISS',ZMWORK1)
@@ -411,19 +407,10 @@ END IF
!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(:,:) = PRTKES(:,:) + PDP(:,:) * PRHODJ(:,:)
-PRTKES(:,:) = PRTKES(:,:) + PTP(:,:) * PRHODJ(:,:)
-PRTKES(:,:) = PRTKES(:,:) - CSTURB%XCED * SQRT(PTKEM(:,:)) / PLEPS(:,:) * &
- (PEXPL*PTKEM(:,:) + TURBN%XIMPL*ZRES(:,:)) * PRHODJ(:,:)
-END IF
-#else
PRTKES(:,:) = PRTKES(:,:) + PRHODJ(:,:) * &
( PDP(:,:) + PTP(:,:) &
- - CSTURB%XCED * SQRT(PTKEM(:,:)) / PLEPS(:,:) &
+ - TURBN%XCED * SQRT(PTKEM(:,:)) / PLEPS(:,:) &
* ( PEXPL*PTKEM(:,:) + TURBN%XIMPL*ZRES(:,:) ) )
-#endif
!
PTDIFF(:,:) = ZRES(:,:) / PTSTEP - PRTKES(:,:)&
/PRHODJ(:,:) &
@@ -448,7 +435,7 @@ IF (BUCONF%LBUDGET_TKE) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TKE), 'TR'
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PRTHLS(:,:) = PRTHLS(:,:) + &
- CSTURB%XCED * SQRT(PTKEM(:,:)) / PLEPS(:,:) * &
+ TURBN%XCED * SQRT(PTKEM(:,:)) / PLEPS(:,:) * &
(PEXPL*PTKEM(:,:) + TURBN%XIMPL*ZRES(:,:)) &
* PRHODJ(:,:) * PCOEF_DISS(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -460,13 +447,13 @@ PRTHLS(:,:) = PRTHLS(:,:) + &
IF(PRESENT(PTR)) PTR=ZTR
IF(PRESENT(PDISS)) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- PDISS(:,:) = -CSTURB%XCED * (PTKEM(:,:)**1.5) / PLEPS(:,:)
+ PDISS(:,:) = -TURBN%XCED * (PTKEM(:,:)**1.5) / PLEPS(:,:)
!$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(:,:) = CSTURB%XCED * (PTKEM(:,:)**1.5) / PLEPS(:,:)
+ PEDR(:,:) = TURBN%XCED * (PTKEM(:,:)**1.5) / PLEPS(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
diff --git a/src/PHYEX/turb/mode_tm06.f90 b/src/PHYEX/turb/mode_tm06.f90
index 1da05315c07f0d7ee905b59894d3368f51ff5b5c..c626ed489e62f9e509a4ada01bbe6d49b7c6668f 100644
--- a/src/PHYEX/turb/mode_tm06.f90
+++ b/src/PHYEX/turb/mode_tm06.f90
@@ -6,8 +6,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #################################################################
!
!
@@ -47,7 +46,7 @@ SUBROUTINE TM06(D,CST,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
!
USE MODD_CST, ONLY: CST_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_PARAMETERS, ONLY: XUNDEF,JPVEXT_TURB
+USE MODD_PARAMETERS, ONLY: XUNDEF
!
!
IMPLICIT NONE
@@ -77,7 +76,7 @@ INTEGER :: IIJE,IIJB
INTEGER :: IKTB,IKTE,IKB,IKE,IKT,IKU ! vertical levels
!----------------------------------------------------------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TM06',0,ZHOOK_HANDLE)
IKTB=D%NKTB
IKTE=D%NKTE
diff --git a/src/PHYEX/turb/mode_tm06_h.f90 b/src/PHYEX/turb/mode_tm06_h.f90
index f250ee3af27b1ba1e0b048caed4a3df84b93b495..22a1e8e99d08b8ddaa42fad52f7d4a80efeb37d0 100644
--- a/src/PHYEX/turb/mode_tm06_h.f90
+++ b/src/PHYEX/turb/mode_tm06_h.f90
@@ -6,8 +6,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #################################################################
!
!
@@ -73,7 +72,7 @@ REAL :: ZGROWTH ! maximum BL growth rate
!----------------------------------------------------------------------------
!
!* mixed boundary layer cannot grow more rapidly than 1800m/h
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TM06_H',0,ZHOOK_HANDLE)
ZGROWTH = 2.0 ! (m/s)
!
diff --git a/src/PHYEX/turb/mode_tridiag.f90 b/src/PHYEX/turb/mode_tridiag.f90
index 6b6b6bfae0c4fa504bfa7d64913db5332775d6de..1da934a793b37e925f15151c94ce01a765d36782 100644
--- a/src/PHYEX/turb/mode_tridiag.f90
+++ b/src/PHYEX/turb/mode_tridiag.f90
@@ -7,8 +7,7 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE TRIDIAG(D,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
PRHODJ,PSOURCE,PVARP )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #################################################
!
!
@@ -114,7 +113,6 @@ SUBROUTINE TRIDIAG(D,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
!
!* 0. DECLARATIONS
!
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -150,7 +148,7 @@ INTEGER :: IIJB, IIJE ! start, end of ij loops i
!* 1. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRIDIAG',0,ZHOOK_HANDLE)
!
IKT=D%NKT
diff --git a/src/PHYEX/turb/mode_tridiag_massflux.f90 b/src/PHYEX/turb/mode_tridiag_massflux.f90
index 871eaa033524cb38cba360ca18c4c649cf5b0fc1..802cea0435b1e638e0ce755dcfe78e89163f24f7 100644
--- a/src/PHYEX/turb/mode_tridiag_massflux.f90
+++ b/src/PHYEX/turb/mode_tridiag_massflux.f90
@@ -8,8 +8,7 @@ CONTAINS
SUBROUTINE TRIDIAG_MASSFLUX(D,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
PDZZ,PRHODJ,PVARP )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #################################################
!
!
@@ -162,7 +161,7 @@ INTEGER :: IKL
!* 1. Preliminaries
! -------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRIDIAG_MASSFLUX',0,ZHOOK_HANDLE)
!
IIJE=D%NIJE
diff --git a/src/PHYEX/turb/mode_tridiag_thermo.f90 b/src/PHYEX/turb/mode_tridiag_thermo.f90
index a4070154427e7a7082d1c1e47fd576bed641b3a5..9f9c17b10fb4bd4c33768da7a89c76bc0e8914d3 100644
--- a/src/PHYEX/turb/mode_tridiag_thermo.f90
+++ b/src/PHYEX/turb/mode_tridiag_thermo.f90
@@ -116,12 +116,9 @@ SUBROUTINE TRIDIAG_THERMO(D,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
!
!* 0. DECLARATIONS
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
-USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
!
-USE MODI_SHUMAN, ONLY : MZM
USE MODE_SHUMAN_PHY, ONLY: MZM_PHY
!
IMPLICIT NONE
@@ -162,7 +159,7 @@ INTEGER :: IKL
!* 1. Preliminaries
! -------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRIDIAG_THERMO',0,ZHOOK_HANDLE)
IKT=D%NKT
IKTB=D%NKTB
diff --git a/src/PHYEX/turb/mode_tridiag_tke.f90 b/src/PHYEX/turb/mode_tridiag_tke.f90
index 1c11a85689bc57b2155d185fc47d02cee5031c8d..a51e71c61bbe0eeda6c3402c1924ccebf4ed675d 100644
--- a/src/PHYEX/turb/mode_tridiag_tke.f90
+++ b/src/PHYEX/turb/mode_tridiag_tke.f90
@@ -7,8 +7,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ########################################################
!
!
@@ -150,7 +149,7 @@ INTEGER :: IKL
!* 1. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRIDIAG_TKE',0,ZHOOK_HANDLE)
!
IKT=D%NKT
diff --git a/src/PHYEX/turb/mode_tridiag_wind.f90 b/src/PHYEX/turb/mode_tridiag_wind.f90
index b19d6dd2174956d997bab38744a52065d4b22de9..aee067175d2c2404ab4c1d47a68212a01bbf7253 100644
--- a/src/PHYEX/turb/mode_tridiag_wind.f90
+++ b/src/PHYEX/turb/mode_tridiag_wind.f90
@@ -7,8 +7,7 @@ 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
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! #############################################################
!
!
@@ -155,7 +154,7 @@ INTEGER :: IKL
!* 1. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRIDIAG_WIND',0,ZHOOK_HANDLE)
!
IKT=D%NKT
diff --git a/src/PHYEX/turb/mode_turb_hor.f90 b/src/PHYEX/turb/mode_turb_hor.f90
index c4a03a1be51710935bc3defb4f7827c96137c079..490fca72344b1c225eb75d798e721eec403c2b7f 100644
--- a/src/PHYEX/turb/mode_turb_hor.f90
+++ b/src/PHYEX/turb/mode_turb_hor.f90
@@ -5,7 +5,7 @@
MODULE MODE_TURB_HOR
IMPLICIT NONE
CONTAINS
- SUBROUTINE TURB_HOR(D,CST,CSTURB,TURBN,TLES, &
+ SUBROUTINE TURB_HOR(D,CST,CSTURB,TURBN,NEBN,TLES, &
KSPLT, KRR, KRRL, KRRI, PTSTEP, &
KSV, KSV_LGBEG, KSV_LGEND, OFLAT,O2D,ONOMIXLG, &
OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
@@ -141,6 +141,7 @@ CONTAINS
USE MODD_CST, ONLY : CST_t
USE MODD_CTURB, ONLY : CSTURB_t
USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_NEB_n, ONLY: NEB_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
@@ -165,6 +166,7 @@ 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(NEB_t), INTENT(IN) :: NEBN
TYPE(TLES_t), INTENT(INOUT):: TLES ! modd_les structure
INTEGER, INTENT(IN) :: KSPLT ! current split index
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -277,7 +279,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!* 8. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>, Sigma_s
!
IF (KSPLT==1) &
- CALL TURB_HOR_THERMO_CORR(D,CST,TURBN,TLES, &
+ CALL TURB_HOR_THERMO_CORR(D,CST,TURBN,NEBN,TLES, &
KRR, KRRL, KRRI, &
OOCEAN,OCOMPUTE_SRC,O2D, &
TPFILE, &
@@ -367,7 +369,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
PRSVS )
!
IF (KSPLT==1 .AND. TLES%LLES_CALL) &
- CALL TURB_HOR_SV_CORR(D,CST,CSTURB,TLES, &
+ CALL TURB_HOR_SV_CORR(D,CST,CSTURB,TURBN,TLES, &
KSV,KSV_LGBEG,KSV_LGEND, &
KRR,KRRL,KRRI,OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
ONOMIXLG,O2D, &
diff --git a/src/PHYEX/turb/mode_turb_hor_dyn_corr.f90 b/src/PHYEX/turb/mode_turb_hor_dyn_corr.f90
index 32270e64e5176722c2eaf993ef9376614878d4e9..7acf5b2c9630309c2ac0d30e31f47912c273dd10 100644
--- a/src/PHYEX/turb/mode_turb_hor_dyn_corr.f90
+++ b/src/PHYEX/turb/mode_turb_hor_dyn_corr.f90
@@ -88,7 +88,6 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
USE MODE_TRIDIAG_W, ONLY: TRIDIAG_W
!
diff --git a/src/PHYEX/turb/mode_turb_hor_splt.f90 b/src/PHYEX/turb/mode_turb_hor_splt.f90
index 83fdd1ed2d39f76780a3613955029e4f50e1dfa5..323542374780af5b9061fb6687d84319bcbc3ec2 100644
--- a/src/PHYEX/turb/mode_turb_hor_splt.f90
+++ b/src/PHYEX/turb/mode_turb_hor_splt.f90
@@ -5,11 +5,11 @@
MODULE MODE_TURB_HOR_SPLT
IMPLICIT NONE
CONTAINS
- SUBROUTINE TURB_HOR_SPLT(D,CST,CSTURB,TURBN,TLES, &
+ SUBROUTINE TURB_HOR_SPLT(D,CST,CSTURB,TURBN,NEBN,TLES, &
KSPLIT, KRR,KRRL,KRRI,KSV, KSV_LGBEG,KSV_LGEND,&
PTSTEP,HLBCX,HLBCY, OFLAT, O2D, ONOMIXLG, &
OOCEAN,OCOMPUTE_SRC,OBLOWSNOW,PRSNOW, &
- TPFILE, HPROGRAM, KHALO, &
+ TPFILE, KHALO, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
@@ -162,6 +162,7 @@ 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_NEB_n, ONLY: NEB_t
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
@@ -183,6 +184,7 @@ 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(NEB_t), INTENT(IN) :: NEBN
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.
@@ -197,7 +199,6 @@ LOGICAL, INTENT(IN) :: O2D ! Logical for 2D model ver
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
@@ -314,7 +315,7 @@ NULLIFY(TZFIELDS_ll)
!* 2. SPLIT PROCESS LOOP
! ------------------
!
-IF (KSPLIT>1 .AND. HPROGRAM=='MESONH') THEN
+IF (KSPLIT>1) THEN
!
!* 2.1 allocations
! -----------
@@ -372,7 +373,7 @@ IF (KSPLIT>1 .AND. HPROGRAM=='MESONH') THEN
DO JSPLT=1,KSPLIT
!
! compute the turbulent tendencies for the small time step
- CALL TURB_HOR(D,CST,CSTURB,TURBN,TLES, &
+ CALL TURB_HOR(D,CST,CSTURB,TURBN,NEBN,TLES, &
JSPLT, KRR, KRRL, KRRI, PTSTEP, &
KSV, KSV_LGBEG, KSV_LGEND, OFLAT,O2D, ONOMIXLG,&
OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
@@ -515,7 +516,7 @@ IF (KSPLIT>1 .AND. HPROGRAM=='MESONH') THEN
!
ELSE
!
- CALL TURB_HOR(D,CST,CSTURB,TURBN,TLES, &
+ CALL TURB_HOR(D,CST,CSTURB,TURBN,NEBN,TLES, &
1, KRR, KRRL, KRRI, PTSTEP, &
KSV, KSV_LGBEG, KSV_LGEND, OFLAT,O2D, ONOMIXLG,&
OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
diff --git a/src/PHYEX/turb/mode_turb_hor_sv_corr.f90 b/src/PHYEX/turb/mode_turb_hor_sv_corr.f90
index 1ebc83f7fdef805bfb4504376260aecb9009c9bb..35878c3d4420c2b43ff987a97cb78f4d15c55bac 100644
--- a/src/PHYEX/turb/mode_turb_hor_sv_corr.f90
+++ b/src/PHYEX/turb/mode_turb_hor_sv_corr.f90
@@ -5,7 +5,7 @@
MODULE MODE_TURB_HOR_SV_CORR
IMPLICIT NONE
CONTAINS
- SUBROUTINE TURB_HOR_SV_CORR(D,CST,CSTURB,TLES,KSV,KSV_LGBEG,KSV_LGEND,&
+ SUBROUTINE TURB_HOR_SV_CORR(D,CST,CSTURB,TURBN,TLES,KSV,KSV_LGBEG,KSV_LGEND,&
KRR,KRRL,KRRI,OOCEAN,OCOMPUTE_SRC,OBLOWSNOW, &
ONOMIXLG,O2D, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PRSNOW, &
@@ -51,6 +51,7 @@ CONTAINS
!
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_PARAMETERS
USE MODD_LES, ONLY: TLES_t
@@ -76,6 +77,7 @@ IMPLICIT NONE
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) :: KRRL ! number of liquid var.
@@ -127,9 +129,9 @@ CALL SECOND_MNH(ZTIME1)
!
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
+ ZCSV= TURBN%XCHF/PRSNOW
ELSE
- ZCSV= CSTURB%XCHF
+ ZCSV= TURBN%XCHF
ENDIF
!
DO JSV=1,KSV
@@ -160,11 +162,11 @@ DO JSV=1,KSV
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) &
- ) * (CSTURB%XCSHF+ZCSV) / (2.*ZCTSVD)
+ ) * (TURBN%XCSHF+ZCSV) / (2.*ZCTSVD)
ELSE
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
- * (CSTURB%XCSHF+ZCSV) / (2.*ZCTSVD)
+ * (TURBN%XCSHF+ZCSV) / (2.*ZCTSVD)
END IF
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. )
@@ -175,11 +177,11 @@ DO JSV=1,KSV
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) &
- ) * (CSTURB%XCHF+ZCSV) / (2.*ZCQSVD)
+ ) * (TURBN%XCHF+ZCSV) / (2.*ZCQSVD)
ELSE
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
- * (CSTURB%XCHF+ZCSV) / (2.*ZCQSVD)
+ * (TURBN%XCHF+ZCSV) / (2.*ZCQSVD)
END IF
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. )
diff --git a/src/PHYEX/turb/mode_turb_hor_sv_flux.f90 b/src/PHYEX/turb/mode_turb_hor_sv_flux.f90
index db1b033eb0a08f2670ba8cc52706c4b97b8bf8f1..a84139fe54080bfcbcfdfd05c232b728e9287f7e 100644
--- a/src/PHYEX/turb/mode_turb_hor_sv_flux.f90
+++ b/src/PHYEX/turb/mode_turb_hor_sv_flux.f90
@@ -75,7 +75,6 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -156,9 +155,9 @@ ISV = SIZE(PSVM,4)
!
IF(OBLOWSNOW) THEN
! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
- ZCSV= XCHF/PRSNOW
+ ZCSV= TURBN%XCHF/PRSNOW
ELSE
- ZCSV= XCHF
+ ZCSV= TURBN%XCHF
ENDIF
!
! compute the coefficients for the uncentred gradient computation near the
diff --git a/src/PHYEX/turb/mode_turb_hor_thermo_corr.f90 b/src/PHYEX/turb/mode_turb_hor_thermo_corr.f90
index 268f923931607513832a9af54690e02638893bde..cded77fc60b907ffcad81edf3ffe289d86dac95a 100644
--- a/src/PHYEX/turb/mode_turb_hor_thermo_corr.f90
+++ b/src/PHYEX/turb/mode_turb_hor_thermo_corr.f90
@@ -6,7 +6,7 @@
MODULE MODE_TURB_HOR_THERMO_CORR
IMPLICIT NONE
CONTAINS
- SUBROUTINE TURB_HOR_THERMO_CORR(D,CST,TURBN,TLES, &
+ SUBROUTINE TURB_HOR_THERMO_CORR(D,CST,TURBN,NEBN,TLES, &
KRR, KRRL, KRRI, &
OOCEAN,OCOMPUTE_SRC,O2D, &
TPFILE, &
@@ -63,6 +63,7 @@ USE MODD_CST, ONLY : CST_t
USE MODD_CTURB
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
+USE MODD_NEB_n, ONLY: NEB_t
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES, ONLY: TLES_t
USE MODD_PARAMETERS
@@ -92,6 +93,7 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
TYPE(TURB_t), INTENT(IN) :: TURBN
+TYPE(NEB_t), INTENT(IN) :: NEBN
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.
@@ -169,24 +171,24 @@ ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
!
!
!
-IF ( ( KRRL > 0 .AND. TURBN%LSUBG_COND) .OR. ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) &
+IF ( ( KRRL > 0 .AND. NEBN%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. O2D) THEN
- ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
+ ZFLX(:,:,:) = TURBN%XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
ELSE
- ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
+ ZFLX(:,:,:) = TURBN%XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2
END IF
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
!
- ZFLX(:,:,IKB:IKB) = XCTV * PLM(:,:,IKB:IKB) &
+ ZFLX(:,:,IKB:IKB) = TURBN%XCTV * PLM(:,:,IKB:IKB) &
* PLEPS(:,:,IKB:IKB) * ( &
( MXF(DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB)) &
- ( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
@@ -249,18 +251,18 @@ IF ( ( KRRL > 0 .AND. TURBN%LSUBG_COND) .OR. ( TURBN%LTURB_FLX .AND. TPFILE%LOPE
PLM(:,:,:) * PLEPS(:,:,:) * &
(GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY) * GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
- ) * (XCHT1+XCHT2)
+ ) * (TURBN%XCHT1+TURBN%XCHT2)
ELSE
ZFLX(:,:,:)= &
PLM(:,:,:) * PLEPS(:,:,:) * &
(GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- ) * (XCHT1+XCHT2)
+ ) * (TURBN%XCHT1+TURBN%XCHT2)
END IF
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
- ZFLX(:,:,IKB:IKB) = (XCHT1+XCHT2) * PLM(:,:,IKB:IKB) &
+ ZFLX(:,:,IKB:IKB) = (TURBN%XCHT1+TURBN%XCHT2) * PLM(:,:,IKB:IKB) &
* PLEPS(:,:,IKB:IKB) * ( &
( MXF(DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB)) &
- ( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
@@ -334,17 +336,17 @@ IF ( ( KRRL > 0 .AND. TURBN%LSUBG_COND) .OR. ( TURBN%LTURB_FLX .AND. TPFILE%LOPE
!
! Computes the horizontal variance <Rnp Rnp>
IF (.NOT. O2D) THEN
- ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
+ ZFLX(:,:,:) = TURBN%XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
ELSE
- ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
+ ZFLX(:,:,:) = TURBN%XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
END IF
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
- ZFLX(:,:,IKB:IKB) = XCHV * PLM(:,:,IKB:IKB) &
+ ZFLX(:,:,IKB:IKB) = TURBN%XCHV * PLM(:,:,IKB:IKB) &
* PLEPS(:,:,IKB:IKB) * ( &
( MXF(DXM(PRM(:,:,IKB:IKB,1)) * PINV_PDXX(:,:,IKB:IKB)) &
- ( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
diff --git a/src/PHYEX/turb/mode_turb_hor_thermo_flux.f90 b/src/PHYEX/turb/mode_turb_hor_thermo_flux.f90
index 0654ed9918e6e044ccc1c1ee87988a1e6d9e674c..67ac0255e117b590fc449aaa72d633576f3e5089 100644
--- a/src/PHYEX/turb/mode_turb_hor_thermo_flux.f90
+++ b/src/PHYEX/turb/mode_turb_hor_thermo_flux.f90
@@ -173,12 +173,12 @@ ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
! --------------
!
!
-ZFLX(:,:,:) = -XCSHF * MXM( PK ) * GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)
+ZFLX(:,:,:) = -TURBN%XCSHF * MXM( PK ) * GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
-ZFLX(:,:,IKB:IKB) = -XCSHF * MXM( PK(:,:,IKB:IKB) ) * &
+ZFLX(:,:,IKB:IKB) = -TURBN%XCSHF * MXM( PK(:,:,IKB:IKB) ) * &
( DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB) &
-MXM( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
+ZCOEFF(:,:,IKB+1:IKB+1)*PTHLM(:,:,IKB+1:IKB+1) &
@@ -279,12 +279,12 @@ END IF
! -----------
IF (KRR/=0) THEN
!
- ZFLX(:,:,:) = -XCHF * MXM( PK ) * GX_M_U(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)
+ ZFLX(:,:,:) = -TURBN%XCHF * MXM( PK ) * GX_M_U(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
- ZFLX(:,:,IKB:IKB) = -XCHF * MXM( PK(:,:,IKB:IKB) ) * &
+ ZFLX(:,:,IKB:IKB) = -TURBN%XCHF * MXM( PK(:,:,IKB:IKB) ) * &
( DXM(PRM(:,:,IKB:IKB,1)) * PINV_PDXX(:,:,IKB:IKB) &
-MXM( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
+ZCOEFF(:,:,IKB+1:IKB+1)*PRM(:,:,IKB+1:IKB+1,1) &
@@ -424,7 +424,7 @@ END IF
!
!
IF (.NOT. O2D) THEN
- ZFLX(:,:,:) = -XCSHF * MYM( PK ) * GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)
+ ZFLX(:,:,:) = -TURBN%XCSHF * MYM( PK ) * GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
ELSE
ZFLX(:,:,:) = 0.
@@ -433,7 +433,7 @@ END IF
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
-ZFLX(:,:,IKB:IKB) = -XCSHF * MYM( PK(:,:,IKB:IKB) ) * &
+ZFLX(:,:,IKB:IKB) = -TURBN%XCSHF * MYM( PK(:,:,IKB:IKB) ) * &
( DYM(PTHLM(:,:,IKB:IKB)) * PINV_PDYY(:,:,IKB:IKB) &
-MYM( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
+ZCOEFF(:,:,IKB+1:IKB+1)*PTHLM(:,:,IKB+1:IKB+1) &
@@ -540,7 +540,7 @@ END IF
IF (KRR/=0) THEN
!
IF (.NOT. O2D) THEN
- ZFLX(:,:,:) = -XCHF * MYM( PK ) * GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)
+ ZFLX(:,:,:) = -TURBN%XCHF * MYM( PK ) * GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
ELSE
ZFLX(:,:,:) = 0.
@@ -548,7 +548,7 @@ IF (KRR/=0) THEN
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
- ZFLX(:,:,IKB:IKB) = -XCHF * MYM( PK(:,:,IKB:IKB) ) * &
+ ZFLX(:,:,IKB:IKB) = -TURBN%XCHF * MYM( PK(:,:,IKB:IKB) ) * &
( DYM(PRM(:,:,IKB:IKB,1)) * PINV_PDYY(:,:,IKB:IKB) &
-MYM( ZCOEFF(:,:,IKB+2:IKB+2)*PRM(:,:,IKB+2:IKB+2,1) &
+ZCOEFF(:,:,IKB+1:IKB+1)*PRM(:,:,IKB+1:IKB+1,1) &
diff --git a/src/PHYEX/turb/mode_turb_hor_uv.f90 b/src/PHYEX/turb/mode_turb_hor_uv.f90
index 717ef59073695384a958d49e2c3a1ff00090ec2b..e0ad7d63d4e2c5b113e500e067bd469effe91dfd 100644
--- a/src/PHYEX/turb/mode_turb_hor_uv.f90
+++ b/src/PHYEX/turb/mode_turb_hor_uv.f90
@@ -74,7 +74,6 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
diff --git a/src/PHYEX/turb/mode_turb_hor_uw.f90 b/src/PHYEX/turb/mode_turb_hor_uw.f90
index 1885d3d9eda92940af4df9714b87cb8cf6db225a..918c5fac1fc0a56d5970f33554523f37952eacc5 100644
--- a/src/PHYEX/turb/mode_turb_hor_uw.f90
+++ b/src/PHYEX/turb/mode_turb_hor_uw.f90
@@ -78,7 +78,6 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
diff --git a/src/PHYEX/turb/mode_turb_hor_vw.f90 b/src/PHYEX/turb/mode_turb_hor_vw.f90
index 2fe089f60f8dc098787ad3c5dea9dd9b858fa9d2..c6cfd8294a5ef99e37de2aad206daa43c788b904 100644
--- a/src/PHYEX/turb/mode_turb_hor_vw.f90
+++ b/src/PHYEX/turb/mode_turb_hor_vw.f90
@@ -77,7 +77,6 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
diff --git a/src/PHYEX/turb/mode_turb_ver.f90 b/src/PHYEX/turb/mode_turb_ver.f90
index 848abf83551f9c3d2650604e58cb71fbf54a0de0..5b767c7e0aa72375096a291797cb0e07931fbbc7 100644
--- a/src/PHYEX/turb/mode_turb_ver.f90
+++ b/src/PHYEX/turb/mode_turb_ver.f90
@@ -6,10 +6,11 @@
MODULE MODE_TURB_VER
IMPLICIT NONE
CONTAINS
-SUBROUTINE TURB_VER(D,CST,CSTURB,TURBN,TLES,KRR,KRRL,KRRI,KGRADIENTS,&
+SUBROUTINE TURB_VER(D,CST,CSTURB,TURBN,NEBN,TLES, &
+ KRR,KRRL,KRRI,KGRADIENTS, &
OOCEAN,ODEEPOC,OCOMPUTE_SRC, &
KSV,KSV_LGBEG,KSV_LGEND, &
- PEXPL, HPROGRAM, O2D, ONOMIXLG, OFLAT, &
+ PEXPL, O2D, ONOMIXLG, OFLAT, &
OCOUPLES,OBLOWSNOW,OFLYER,PRSNOW, &
PTSTEP, TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
@@ -210,20 +211,17 @@ SUBROUTINE TURB_VER(D,CST,CSTURB,TURBN,TLES,KRR,KRRL,KRRI,KGRADIENTS,&
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY: JPRB
-USE YOMHOOK, ONLY: LHOOK, DR_HOOK
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK
!
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_FIELD, ONLY: TFIELDMETADATA, 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 MODD_NEB_n, ONLY: NEB_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_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_PRANDTL, ONLY: PSI_SV, PSI3, PHI3, PRANDTL
@@ -245,6 +243,7 @@ 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(NEB_t), INTENT(IN) :: NEBN
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.
@@ -259,7 +258,6 @@ LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero ororogr
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.
@@ -388,7 +386,7 @@ INTEGER :: IKB,IKE,IIJE,IIJB,IKT ! index value for the Beginning
INTEGER :: JSV,JIJ,JK ! loop counter
REAL :: ZTIME1
REAL :: ZTIME2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
TYPE(TFIELDMETADATA) :: TZFIELD
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
@@ -408,7 +406,7 @@ IIJB=D%NIJB
! 3D Redelsperger numbers
!
!
-CALL PRANDTL(D,CST,CSTURB,KRR,KSV,KRRI,TURBN%LTURB_FLX, &
+CALL PRANDTL(D,CST,CSTURB,TURBN, KRR,KSV,KRRI,TURBN%LTURB_FLX, &
TURBN%CTURBDIM,OOCEAN,TURBN%LHARAT,O2D,OCOMPUTE_SRC,&
TPFILE, OFLAT, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -462,13 +460,13 @@ ENDIF
!
GUSERV = KRR/=0
!
-CALL PHI3(D,CSTURB,ZREDTH1,ZREDR1,ZRED2TH3,ZRED2R3,ZRED2THR3,TURBN%CTURBDIM,GUSERV,ZPHI3)
+CALL PHI3(D,CSTURB,TURBN,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)
+CALL PSI3(D,CSTURB,TURBN,ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,TURBN%CTURBDIM,GUSERV,ZPSI3)
!
! Prandtl numbers for scalars
!
-CALL PSI_SV(D,CSTURB,KSV,ZREDTH1,ZREDR1,ZREDS1,ZRED2THS,ZRED2RS,ZPHI3,ZPSI3,ZPSI_SV)
+CALL PSI_SV(D,CSTURB,TURBN,KSV,ZREDTH1,ZREDR1,ZREDS1,ZRED2THS,ZRED2RS,ZPHI3,ZPSI3,ZPSI_SV)
!
! LES diagnostics
!
@@ -506,7 +504,7 @@ ENDIF
KRR,KRRL,KRRI,KSV,KGRADIENTS, &
OOCEAN,ODEEPOC,OFLYER, &
OCOUPLES,OCOMPUTE_SRC, &
- PEXPL,PTSTEP,HPROGRAM,TPFILE, &
+ PEXPL,PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PRHODJ,PTHVREF,PHGRAD,PZS, &
PSFTHM,PSFRM,PSFTHP,PSFRP, &
@@ -521,7 +519,7 @@ ENDIF
PRTHLS,PRRS,ZTHLP,ZRP,PTP,PWTH,PWRC, &
PSSTFL, PSSTFL_C, PSSRFL_C )
!
- CALL TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,TLES, &
+ CALL TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,NEBN,TLES, &
KRR,KRRL,KRRI,KSV, &
OCOMPUTE_SRC, &
OCOUPLES, &
@@ -588,7 +586,7 @@ CALL TURB_VER_SV_FLUX(D,CST,CSTURB,TURBN,TLES,ONOMIXLG, &
!
!
IF (KSV>0 .AND. TLES%LLES_CALL) &
-CALL TURB_VER_SV_CORR(D,CST,CSTURB,TLES,KRR,KRRL,KRRI,OOCEAN, &
+CALL TURB_VER_SV_CORR(D,CST,CSTURB,TURBN,TLES,KRR,KRRL,KRRI,OOCEAN,&
PDZZ,KSV,KSV_LGBEG,KSV_LGEND,ONOMIXLG, &
OBLOWSNOW,OCOMPUTE_SRC,PRSNOW, &
PTHLM,PRM,PTHVREF, &
diff --git a/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90 b/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
index e500f4e5dbde508a36f94d8c68b4bee391d82b47..a5ed7627c1583b15f95ae79d8d771bcb716b8680 100644
--- a/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_dyn_flux.f90
@@ -204,9 +204,8 @@ SUBROUTINE TURB_VER_DYN_FLUX(D,CST,CSTURB,TURBN,TLES,KSV,O2D,OFLAT, &
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY: JPRB
USE MODE_SHUMAN_PHY
-USE YOMHOOK, ONLY: LHOOK, DR_HOOK
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK
!
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
@@ -214,7 +213,7 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES, ONLY: TLES_t
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB, XUNDEF
+USE MODD_PARAMETERS, ONLY: XUNDEF
USE MODD_TURB_n, ONLY: TURB_t
!
USE MODE_GRADIENT_U_PHY, ONLY : GZ_U_UW_PHY, GX_U_M_PHY
@@ -317,7 +316,7 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
ZWORK1,ZWORK2,&
ZWORK3,ZWORK4,&
- ZWORK5,ZWORK6! working var. for shuman operators (array syntax)
+ ZWORK5 ! 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
@@ -337,7 +336,7 @@ TYPE(TFIELDMETADATA) :: TZFIELD
!
!* 1. PRELIMINARIES
! -------------
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TURB_VER_DYN_FLUX',0,ZHOOK_HANDLE)
!
ZA(:,:)=XUNDEF
diff --git a/src/PHYEX/turb/mode_turb_ver_sv_corr.f90 b/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
index 2f1dc8d9ac32d9ac2c56c338a897b55ee1426501..414746214615b1fee83f80ecbe2948b2033c890a 100644
--- a/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
+++ b/src/PHYEX/turb/mode_turb_ver_sv_corr.f90
@@ -5,7 +5,7 @@
MODULE MODE_TURB_VER_SV_CORR
IMPLICIT NONE
CONTAINS
-SUBROUTINE TURB_VER_SV_CORR(D,CST,CSTURB,TLES,KRR,KRRL,KRRI,OOCEAN, &
+SUBROUTINE TURB_VER_SV_CORR(D,CST,CSTURB,TURBN,TLES,KRR,KRRL,KRRI,OOCEAN, &
PDZZ,KSV,KSV_LGBEG,KSV_LGEND,ONOMIXLG, &
OBLOWSNOW,OCOMPUTE_SRC,PRSNOW, &
PTHLM,PRM,PTHVREF, &
@@ -53,13 +53,12 @@ SUBROUTINE TURB_VER_SV_CORR(D,CST,CSTURB,TLES,KRR,KRRL,KRRI,OOCEAN, &
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
!
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_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_LES, ONLY: TLES_t
!
USE MODE_SHUMAN_PHY, ONLY: MZF_PHY
@@ -79,6 +78,7 @@ IMPLICIT NONE
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) :: OOCEAN ! switch for Ocean model version
@@ -131,7 +131,7 @@ 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
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_CORR',0,ZHOOK_HANDLE)
!
IIJE=D%NIJE
@@ -142,9 +142,9 @@ CALL SECOND_MNH(ZTIME1)
!
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
+ ZCSV= TURBN%XCHF/PRSNOW
ELSE
- ZCSV= CSTURB%XCHF
+ ZCSV= TURBN%XCHF
ENDIF
!
DO JSV=1,KSV
@@ -178,7 +178,7 @@ DO JSV=1,KSV
CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZFLXZ(:,:)= ( CSTURB%XCSHF * PPHI3(:,:) + ZCSV * PPSI_SV(:,:,JSV) ) &
+ ZFLXZ(:,:)= ( TURBN%XCSHF * PPHI3(:,:) + ZCSV * PPSI_SV(:,:,JSV) ) &
* ZWORK1(:,:) * ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!
diff --git a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90 b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
index 21443271df8bc1968d471c2e683e20003032c6b9..b91bca2b68fe7b2debfaa13368868f1b37e6b1e1 100644
--- a/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_sv_flux.f90
@@ -210,9 +210,8 @@ SUBROUTINE TURB_VER_SV_FLUX(D,CST,CSTURB,TURBN,TLES,ONOMIXLG, &
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY: JPRB
USE MODE_SHUMAN_PHY, ONLY: DZM_PHY, MZM_PHY, MZF_PHY
-USE YOMHOOK, ONLY: LHOOK, DR_HOOK
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK
!
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
@@ -220,11 +219,9 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES, ONLY: TLES_t
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB, NMNHNAMELGTMAX
+USE MODD_PARAMETERS, ONLY: NMNHNAMELGTMAX
USE MODD_TURB_n, ONLY: TURB_t
!
-USE MODE_EMOIST, ONLY: EMOIST
-USE MODE_ETHETA, ONLY: ETHETA
USE MODE_GRADIENT_W_PHY, ONLY: GZ_W_M_PHY
USE MODE_GRADIENT_M_PHY, ONLY: GZ_M_W_PHY
USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
@@ -306,7 +303,7 @@ REAL :: ZCSVP = 4.0 ! constant for scalar flux presso-correlation (RS81)
REAL :: ZCSV !constant for the scalar flux
!
CHARACTER(LEN=NMNHNAMELGTMAX) :: YMNHNAME
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
TYPE(TFIELDMETADATA) :: TZFIELD
!----------------------------------------------------------------------------
!
@@ -338,9 +335,9 @@ ENDIF
!
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
+ ZCSV=TURBN%XCHF/PRSNOW
ELSE
- ZCSV=CSTURB%XCHF
+ ZCSV=TURBN%XCHF
ENDIF
!----------------------------------------------------------------------------
!
diff --git a/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90 b/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
index 2ee5d5de45e9fe302c8fd4af1c058719b03aafcc..d93fbfb87a71e076307a436dd14912812c083167 100644
--- a/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
+++ b/src/PHYEX/turb/mode_turb_ver_thermo_corr.f90
@@ -6,7 +6,7 @@
MODULE MODE_TURB_VER_THERMO_CORR
IMPLICIT NONE
CONTAINS
-SUBROUTINE TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,TLES, &
+SUBROUTINE TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,NEBN,TLES, &
KRR,KRRL,KRRI,KSV, &
OCOMPUTE_SRC,OCOUPLES, &
PEXPL,TPFILE, &
@@ -140,7 +140,7 @@ SUBROUTINE TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,TLES, &
!! 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
+!! TURBN%XCTV,TURBN%XCHV : cts for the T and moisture variances
!!
!! Module MODD_PARAMETERS
!!
@@ -199,14 +199,14 @@ SUBROUTINE TURB_VER_THERMO_CORR(D,CST,CSTURB,TURBN,TLES, &
!! 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
+!! Modifications: June 2023 (S. Riette) tunable value for SIGS minimum value
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY: JPRB
USE MODE_SHUMAN_PHY, ONLY: MZM_PHY, MZF_PHY, DZM_PHY
-USE YOMHOOK, ONLY: LHOOK, DR_HOOK
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK
!
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
@@ -216,6 +216,7 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES, ONLY: TLES_t
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_NEB_n, ONLY: NEB_t
!
USE MODE_IO_FIELD_WRITE_PHY, ONLY: IO_FIELD_WRITE_PHY
USE MODE_PRANDTL
@@ -233,6 +234,7 @@ 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(NEB_t), INTENT(IN) :: NEBN
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.
@@ -309,14 +311,11 @@ REAL, DIMENSION(MERGE(D%NIJT,0,OCOMPUTE_SRC),&
!
!
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
ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
ZDFDDTDZ, & ! dF/d(dTh/dz)
ZDFDDRDZ, & ! dF/d(dr/dz)
- Z3RDMOMENT, & ! 3 order term in flux or variance equation
! 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)
@@ -353,7 +352,7 @@ TYPE(TFIELDMETADATA) :: TZFIELD
!* 1. PRELIMINARIES
! -------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_CORR',0,ZHOOK_HANDLE)
!
IKB=D%NKB
@@ -382,7 +381,7 @@ ZCOEFF(:,IKB)= - (PDZZ(:,IKB+2*IKL)+2.*PDZZ(:,IKB+IKL)) / &
IF (TURBN%LHARAT) THEN
CALL MZF_PHY(D,PLM,PLMF)
!wc Part of the new statistical cloud scheme set up
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
CALL MZF_PHY(D,PLEPS,PLEPSF)
ELSE
PLEPSF(:,:)=PLMF(:,:)
@@ -435,9 +434,9 @@ END IF
ZWORK1(:,:)=PDTH_DZ(:,:)**2
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
CALL MZF_PHY(D,ZWORK1,ZWORK2)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZF(:,:) = CSTURB%XCTV * &
+ ZF(:,:) = TURBN%XCTV * &
PLMF(:,:)*PLEPSF(:,:)*ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
@@ -451,7 +450,7 @@ END IF
!$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(:,:) = CSTURB%XCTV*PLM(:,:)*PLEPS(:,:)&
+ ZF(:,:) = TURBN%XCTV*PLM(:,:)*PLEPS(:,:)&
* ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDIF
@@ -461,8 +460,8 @@ END IF
!
! d(w'th'2)/dz
IF (GFTH2) THEN
- CALL M3_TH2_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,ZWORK1)
- CALL D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ CALL M3_TH2_WTH2(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,ZWORK1)
+ CALL D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -475,10 +474,10 @@ END IF
!
! d(w'2th')/dz
IF (GFWTH) THEN
- CALL M3_TH2_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PDTH_DZ,&
+ CALL M3_TH2_W2TH(D,CSTURB,TURBN,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,&
+ CALL D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,&
& PLM,PLEPS,PTKEM,GUSERV,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -492,9 +491,9 @@ END IF
IF (KRR/=0) THEN
! d(w'r'2)/dz
IF (GFR2) THEN
- CALL M3_TH2_WR2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
+ CALL M3_TH2_WR2(D,CSTURB,TURBN,PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
& PEMOIST,PDTH_DZ,ZWORK1)
- CALL D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,&
+ CALL D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,&
& PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -507,10 +506,10 @@ END IF
!
! d(w'2r')/dz
IF (GFWR) THEN
- CALL M3_TH2_W2R(D,CSTURB,PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
+ CALL M3_TH2_W2R(D,CSTURB,TURBN,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,&
+ CALL D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,&
& PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -523,9 +522,9 @@ END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- CALL M3_TH2_WTHR(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,&
+ CALL M3_TH2_WTHR(D,CSTURB,TURBN,PREDR1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK1)
- CALL D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ CALL D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -567,14 +566,14 @@ END IF
+ZCOEFF(:,IKB )*PTHLP(:,IKB ) )**2 &
)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE)
- ZFLXZ(:,IKB) = CSTURB%XCTV * ZFLXZ(:,IKB)
+ ZFLXZ(:,IKB) = TURBN%XCTV * ZFLXZ(:,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
- END IF
+ END IF
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE)
- ZFLXZ(:,IKB) = CSTURB%XCTV * PPHI3(:,IKB+IKL) * PLM(:,IKB) &
+ ZFLXZ(:,IKB) = TURBN%XCTV * PPHI3(:,IKB+IKL) * PLM(:,IKB) &
* PLEPS(:,IKB) &
*( PEXPL * &
( ZCOEFF(:,IKB+2*IKL)*PTHLM(:,IKB+2*IKL) &
@@ -592,7 +591,7 @@ END IF
ZFLXZ(:,IKA) = ZFLXZ(:,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%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)
@@ -674,9 +673,9 @@ END IF
ZWORK1(:,:) = PDTH_DZ(:,:)*PDR_DZ(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
CALL MZF_PHY(D,ZWORK1,ZWORK2)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZF(:,:) = CSTURB%XCTV * &
+ ZF(:,:) = TURBN%XCTV * &
PLMF(:,:)*PLEPSF(:,:)*ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
@@ -691,7 +690,7 @@ END IF
!$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(:,:) = CSTURB%XCTV*PLM(:,:)*PLEPS(:,:)&
+ ZF(:,:) = TURBN%XCTV*PLM(:,:)*PLEPS(:,:)&
* ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDIF
@@ -702,11 +701,11 @@ END IF
!
! d(w'th'2)/dz
IF (GFTH2) THEN
- CALL M3_THR_WTH2(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,&
+ CALL M3_THR_WTH2(D,CSTURB,TURBN,PREDR1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
- CALL D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ CALL D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK2)
- CALL D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,&
+ CALL D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -721,11 +720,11 @@ END IF
! d(w'2th')/dz
IF (GFWTH) THEN
CALL MZF_PHY(D,PFWTH,ZWORK1)
- CALL M3_THR_W2TH(D,CSTURB,PREDR1,PD,PLM,PLEPS,PTKEM,&
+ CALL M3_THR_W2TH(D,CSTURB,TURBN,PREDR1,PD,PLM,PLEPS,PTKEM,&
& PDR_DZ,ZWORK2)
- CALL D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ CALL D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PLM,PLEPS,PTKEM,PBLL_O_E,PDR_DZ,PETHETA,ZWORK3)
- CALL D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,&
+ CALL D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PLM,PLEPS,PTKEM,ZWORK4)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -740,11 +739,11 @@ END IF
!
! d(w'r'2)/dz
IF (GFR2) THEN
- CALL M3_THR_WR2(D,CSTURB,PREDTH1,PD,PLEPS,PSQRT_TKE,&
+ CALL M3_THR_WR2(D,CSTURB,TURBN,PREDTH1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK1)
- CALL D_M3_THR_WR2_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ CALL D_M3_THR_WR2_O_DDTDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,&
& PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZWORK2)
- CALL D_M3_THR_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ CALL D_M3_THR_WR2_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,&
& PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -759,11 +758,11 @@ END IF
! d(w'2r')/dz
IF (GFWR) THEN
CALL MZF_PHY(D,PFWR,ZWORK1)
- CALL M3_THR_W2R(D,CSTURB,PREDTH1,PD,PLM,PLEPS,PTKEM,&
+ CALL M3_THR_W2R(D,CSTURB,TURBN,PREDTH1,PD,PLM,PLEPS,PTKEM,&
& PDTH_DZ,ZWORK2)
- CALL D_M3_THR_W2R_O_DDTDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ CALL D_M3_THR_W2R_O_DDTDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,&
& PLM,PLEPS,PTKEM,ZWORK3)
- CALL D_M3_THR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ CALL D_M3_THR_W2R_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,&
& PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST,ZWORK4)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -777,11 +776,11 @@ END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- CALL M3_THR_WTHR(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,&
+ CALL M3_THR_WTHR(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PLEPS,&
& PSQRT_TKE,ZWORK1)
- CALL D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ CALL D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZWORK2)
- CALL D_M3_THR_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ CALL D_M3_THR_WTHR_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -821,19 +820,19 @@ END IF
+ TURBN%XIMPL * ZDFDDTDZ(:,:) * ZWORK7(:,:) &
+ TURBN%XIMPL * ZDFDDRDZ(:,:) * ZWORK8(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZFLXZ(:,:) = CSTURB%XCTV * ZFLXZ(:,:)
+ ZFLXZ(:,:) = TURBN%XCTV * ZFLXZ(:,:)
!$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)
+ CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,TURBN,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)
+ CALL D_PSI3DTDZ_O_DDTDZ(D,CSTURB,TURBN,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)
+ CALL D_PHI3DRDZ_O_DDRDZ(D,CSTURB,TURBN,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)
+ CALL D_PSI3DRDZ_O_DDRDZ(D,CSTURB,TURBN,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI4)
! d(psi3*drdz )/ddrdz term
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -846,7 +845,7 @@ END IF
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZFLXZ(:,:) = ZF(:,:) &
- + TURBN%XIMPL * CSTURB%XCTV*PLM(:,:)*PLEPS(:,:)*0.5 &
+ + TURBN%XIMPL * TURBN%XCTV*PLM(:,:)*PLEPS(:,:)*0.5 &
* ZWORK6(:,:) &
+ TURBN%XIMPL * ZDFDDTDZ(:,:) * ZWORK7(:,:) &
+ TURBN%XIMPL * ZDFDDRDZ(:,:) * ZWORK8(:,:)
@@ -874,15 +873,15 @@ END IF
+ZCOEFF(:,IKB )*PRP(:,IKB )) &
)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE)
- ZFLXZ(:,IKB) = (CSTURB%XCHT1 + CSTURB%XCHT2) * ZFLXZ(:,IKB)
+ ZFLXZ(:,IKB) = (TURBN%XCHT1 + TURBN%XCHT2) * ZFLXZ(:,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZFLXZ(:,IKB) = &
- (CSTURB%XCHT1 * PPHI3(:,IKB+IKL) + CSTURB%XCHT2 * PPSI3(:,IKB+IKL)) &
+ (TURBN%XCHT1 * PPHI3(:,IKB+IKL) + TURBN%XCHT2 * PPSI3(:,IKB+IKL)) &
*( PEXPL * &
( ZCOEFF(:,IKB+2*IKL)*PTHLM(:,IKB+2*IKL) &
+ZCOEFF(:,IKB+IKL )*PTHLM(:,IKB+IKL ) &
@@ -905,7 +904,7 @@ END IF
ZFLXZ(:,IKA) = ZFLXZ(:,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%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)
@@ -913,7 +912,7 @@ END IF
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDIF
IF ( KRRL > 0 ) THEN
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%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(:,:) = PSIGS(:,:) - &
@@ -1001,9 +1000,9 @@ IF (TURBN%LHARAT) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = PLMF(:,:)*PLEPSF(:,:)*ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZF(:,:) = CSTURB%XCTV * ZF(:,:)
+ ZF(:,:) = TURBN%XCTV * ZF(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
ELSE
@@ -1012,7 +1011,7 @@ ELSE
!$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(:,:) = CSTURB%XCTV*PLM(:,:)*PLEPS(:,:)&
+ ZF(:,:) = TURBN%XCTV*PLM(:,:)*PLEPS(:,:)&
*ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDIF
@@ -1022,9 +1021,9 @@ ENDIF
!
! d(w'r'2)/dz
IF (GFR2) THEN
- CALL M3_R2_WR2(D,CSTURB,PREDR1,PREDTH1,PD,PLEPS,&
+ CALL M3_R2_WR2(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,PLEPS,&
& PSQRT_TKE,ZWORK1)
- CALL D_M3_R2_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ CALL D_M3_R2_WR2_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1037,9 +1036,9 @@ ENDIF
! d(w'2r')/dz
IF (GFWR) THEN
CALL MZF_PHY(D,PFWR,ZWORK1)
- CALL M3_R2_W2R(D,CSTURB,PREDR1,PREDTH1,PD,PDR_DZ,&
+ CALL M3_R2_W2R(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,PDR_DZ,&
& PLM,PLEPS,PTKEM,ZWORK2)
- CALL D_M3_R2_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ CALL D_M3_R2_W2R_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,&
& PD,PLM,PLEPS,PTKEM,GUSERV,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1052,9 +1051,9 @@ ENDIF
IF (KRR/=0) THEN
! d(w'r'2)/dz
IF (GFTH2) THEN
- CALL M3_R2_WTH2(D,CSTURB,PD,PLEPS,PSQRT_TKE,&
+ CALL M3_R2_WTH2(D,CSTURB,TURBN,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
- CALL D_M3_R2_WTH2_O_DDRDZ(D,CSTURB,PREDR1,&
+ CALL D_M3_R2_WTH2_O_DDRDZ(D,CSTURB,TURBN,PREDR1,&
& PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1067,9 +1066,9 @@ ENDIF
! d(w'2r')/dz
IF (GFWTH) THEN
CALL MZF_PHY(D,PFWTH,ZWORK1)
- CALL M3_R2_W2TH(D,CSTURB,PD,PLM,PLEPS,PTKEM,&
+ CALL M3_R2_W2TH(D,CSTURB,TURBN,PD,PLM,PLEPS,PTKEM,&
& PBLL_O_E,PETHETA,PDR_DZ,ZWORK2)
- CALL D_M3_R2_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ CALL D_M3_R2_W2TH_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,&
& PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1081,9 +1080,9 @@ ENDIF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- CALL M3_R2_WTHR(D,CSTURB,PREDTH1,PD,PLEPS,&
+ CALL M3_R2_WTHR(D,CSTURB,TURBN,PREDTH1,PD,PLEPS,&
& PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
- CALL D_M3_R2_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ CALL D_M3_R2_WTHR_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1114,13 +1113,13 @@ ENDIF
* ZWORK4(:,:) &
+ TURBN%XIMPL * ZDFDDRDZ(:,:) * ZWORK6(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZFLXZ(:,:) = CSTURB%XCTV * ZFLXZ(:,:)
+ ZFLXZ(:,:) = TURBN%XCTV * ZFLXZ(:,:)
!$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)
+ CALL D_PSI3DRDZ2_O_DDRDZ(D,CSTURB,TURBN,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI1)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZWORK1(:,:) = ZWKPHIPSI1(:,:)*ZWORK2(:,:) &
/ PDZZ(:,:)
@@ -1134,7 +1133,7 @@ ENDIF
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZFLXZ(:,:) = ZF(:,:) &
- + TURBN%XIMPL * CSTURB%XCTV*PLM(:,:) *PLEPS(:,:) &
+ + TURBN%XIMPL * TURBN%XCTV*PLM(:,:) *PLEPS(:,:) &
* ZWORK3(:,:) &
+ TURBN%XIMPL * ZDFDDRDZ(:,:) * ZWORK5(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1155,14 +1154,14 @@ ENDIF
+ZCOEFF(:,IKB )*PRP(:,IKB ))**2 &
)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%LSTATNW) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE)
- ZFLXZ(:,IKB) = CSTURB%XCHV * ZFLXZ(:,IKB)
+ ZFLXZ(:,IKB) = TURBN%XCHV * ZFLXZ(:,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE)
- ZFLXZ(:,IKB) = CSTURB%XCHV * PPSI3(:,IKB+IKL) * PLM(:,IKB) &
+ ZFLXZ(:,IKB) = TURBN%XCHV * PPSI3(:,IKB+IKL) * PLM(:,IKB) &
* PLEPS(:,IKB) &
*( PEXPL * &
( ZCOEFF(:,IKB+2*IKL)*PRM(:,IKB+2*IKL,1) &
@@ -1179,7 +1178,7 @@ ENDIF
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZFLXZ(:,IKA) = ZFLXZ(:,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%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)
@@ -1255,12 +1254,7 @@ ENDIF
PSIGS(:,IKU) = PSIGS(:,IKE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-#ifdef REPRO48
- PSIGS(:,:) = MAX (PSIGS(:,:) , 0.)
- PSIGS(:,:) = SQRT(PSIGS(:,:))
-#else
- PSIGS(:,:) = SQRT( MAX (PSIGS(:,:) , 1.E-12) )
-#endif
+ PSIGS(:,:) = SQRT( MAX (PSIGS(:,:) , TURBN%XMINSIGS) )
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
diff --git a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90 b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
index 470a474cce203d400740c9a1c9086f5a6e363ed4..642acf3e12abd8935db4dcf8e9b161c1a6b9942c 100644
--- a/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
+++ b/src/PHYEX/turb/mode_turb_ver_thermo_flux.f90
@@ -10,7 +10,7 @@ SUBROUTINE TURB_VER_THERMO_FLUX(D,CST,CSTURB,TURBN,TLES, &
KRR,KRRL,KRRI,KSV,KGRADIENTS, &
OOCEAN,ODEEPOC,OFLYER, &
OCOUPLES, OCOMPUTE_SRC, &
- PEXPL,PTSTEP,HPROGRAM, &
+ PEXPL,PTSTEP, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PRHODJ,PTHVREF,PHGRAD,PZS, &
@@ -147,9 +147,9 @@ SUBROUTINE TURB_VER_THERMO_FLUX(D,CST,CSTURB,TURBN,TLES, &
!! the turbulence scheme
!!
!! CSTURB%XCMFS,XCMFB : cts for the momentum flux
-!! CSTURB%XCSHF : ct for the sensible heat flux
+!! TURBN%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
+!! TURBN%XCTV,CSTURB%XCHV : cts for the T and moisture variances
!!
!! Module MODD_PARAMETERS
!!
@@ -229,9 +229,8 @@ SUBROUTINE TURB_VER_THERMO_FLUX(D,CST,CSTURB,TURBN,TLES, &
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY: JPRB
USE MODE_SHUMAN_PHY, ONLY: DZF_PHY, DZM_PHY, MXF_PHY, MYF_PHY, MZF_PHY, MZM_PHY
-USE YOMHOOK, ONLY: LHOOK, DR_HOOK
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK
!
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
@@ -239,7 +238,7 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES, ONLY: TLES_t
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB, JPHEXT, XUNDEF
+USE MODD_PARAMETERS, ONLY: XUNDEF
USE MODD_TURB_n, ONLY: TURB_t
!
USE MODE_GRADIENT_W_PHY, ONLY: GZ_W_M_PHY
@@ -274,7 +273,6 @@ LOGICAL, INTENT(IN) :: OCOUPLES ! switch to activate atmos
LOGICAL, INTENT(IN) :: OCOMPUTE_SRC ! flag to define dimensions of SIGS and
REAL, INTENT(IN) :: PEXPL ! Coef. for temporal disc.
REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! CPROGRAM is the program currently running (modd_conf)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY ! Metric coefficients
@@ -352,7 +350,6 @@ REAL, DIMENSION(D%NIJT), INTENT(IN),OPTIONAL :: PSSRFL_C ! O-A interface flu
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
ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
ZDFDDTDZ, & ! dF/d(dTh/dz)
@@ -375,10 +372,6 @@ INTEGER :: IIJB, IIJE
INTEGER :: IKL
!
REAL :: ZTIME1, ZTIME2
-REAL :: ZFLPROV
-INTEGER :: JKM ! vertical index loop
-INTEGER :: JSW
-REAL :: ZSWA ! index for time flux interpolation
!
INTEGER :: IIU, IJU
LOGICAL :: GUSERV ! flag to use water
@@ -393,7 +386,7 @@ TYPE(TFIELDMETADATA) :: TZFIELD
!* 1. PRELIMINARIES
! -------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_FLUX',0,ZHOOK_HANDLE)
!
! Size for a given proc & a given model
@@ -469,7 +462,7 @@ END IF
! Compute the turbulent flux F and F' at time t-dt.
!
CALL DZM_PHY(D,PTHLM,ZWORK1)
-CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWORK2)
+CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,TURBN,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWORK2)
IF (TURBN%LHARAT) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = -ZKEFF(:,:)*ZWORK1(:,:)/PDZZ(:,:)
@@ -477,9 +470,9 @@ IF (TURBN%LHARAT) THEN
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZF(:,:) = -CSTURB%XCSHF*PPHI3(:,:)*ZKEFF(:,:)&
+ ZF(:,:) = -TURBN%XCSHF*PPHI3(:,:)*ZKEFF(:,:)&
*ZWORK1(:,:)/PDZZ(:,:)
- ZDFDDTDZ(:,:) = -CSTURB%XCSHF*ZKEFF(:,:)*ZWORK2(:,:)
+ ZDFDDTDZ(:,:) = -TURBN%XCSHF*ZKEFF(:,:)*ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
!
@@ -500,8 +493,8 @@ END IF
!
! d(w'2th')/dz
IF (GFWTH) THEN
- CALL M3_WTH_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
- CALL D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,&
+ CALL M3_WTH_W2TH(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
+ CALL D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,&
& PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM,ZWORK1)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -513,8 +506,8 @@ END IF
!
! d(w'th'2)/dz
IF (GFTH2) THEN
- 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,&
+ CALL M3_WTH_WTH2(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,Z3RDMOMENT)
+ CALL D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,TURBN,Z3RDMOMENT,PREDTH1,PREDR1,&
& PD,PBLL_O_E,PETHETA,ZWORK1)
CALL MZM_PHY(D,PFTH2,ZWORK2)
!
@@ -528,8 +521,8 @@ END IF
!
! d(w'2r')/dz
IF (GFWR) THEN
- 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)
+ CALL M3_WTH_W2R(D,CSTURB,TURBN,PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK1)
+ CALL D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZF(:,:) = ZF(:,:) + ZWORK1(:,:) * PFWR(:,:)
@@ -540,9 +533,9 @@ END IF
!
! d(w'r'2)/dz
IF (GFR2) THEN
- CALL M3_WTH_WR2(D,CSTURB,PD,ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ,ZWORK1)
+ CALL M3_WTH_WR2(D,CSTURB,TURBN,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,&
+ CALL D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,TURBN,PREDTH1,PREDR1,PD,&
& ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -554,9 +547,9 @@ END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- CALL M3_WTH_WTHR(D,CSTURB,PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ CALL M3_WTH_WTHR(D,CSTURB,TURBN,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 D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,TURBN,Z3RDMOMENT,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,ZWORK1)
CALL MZM_PHY(D,PFTHR, ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -591,10 +584,7 @@ ELSE ! atmosp bottom
END IF
!
! atmos top
-#ifdef REPRO48
-#else
ZF(:,IKE+1)=0.
-#endif
END IF
!
! Compute the split conservative potential temperature at t+deltat
@@ -753,7 +743,7 @@ IF (OOCEAN) THEN
END IF
!* 2.3 Partial vertical divergence of the < Rc w > flux
! Correction for qc and qi negative in AROME
-IF(HPROGRAM/='AROME ') THEN
+IF(TURBN%LPROJQITURB) THEN
IF ( KRRL >= 1 ) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZWORK1(:,:) = ZFLXZ(:,:)/PDZZ(:,:)
@@ -813,7 +803,7 @@ IF (TLES%LLES_CALL) THEN
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK4, TLES%X_LES_SUBGRID_WThv , .TRUE. )
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZWORK2(:,:) = -CSTURB%XCTP*PSQRT_TKE(:,:)/PLM(:,:) &
+ ZWORK2(:,:) = -TURBN%XCTP*PSQRT_TKE(:,:)/PLM(:,:) &
*ZWORK1(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_ThlPz )
@@ -837,7 +827,7 @@ IF (TLES%LLES_CALL) THEN
ZA(:,:) = - ZFLXZ(:,:) / ZA(:,:) * PDZZ(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!$mnh_expand_array(JIJ=IIJB:IIJE)
- ZA(:,IKB) = CSTURB%XCSHF*PPHI3(:,IKB)*ZKEFF(:,IKB)
+ ZA(:,IKB) = TURBN%XCSHF*PPHI3(:,IKB)*ZKEFF(:,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
CALL MZF_PHY(D,ZA,ZA)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -873,11 +863,11 @@ IF (KRR /= 0) THEN
ZDFDDRDZ(:,:) = -ZKEFF(:,:)
!$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)
+ CALL D_PSI3DRDZ_O_DDRDZ(D,CSTURB,TURBN,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWORK2)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZF(:,:) = -CSTURB%XCSHF*PPSI3(:,:)*ZKEFF(:,:)&
+ ZF(:,:) = -TURBN%XCSHF*PPSI3(:,:)*ZKEFF(:,:)&
*ZWORK1(:,:)/PDZZ(:,:)
- ZDFDDRDZ(:,:) = -CSTURB%XCSHF*ZKEFF(:,:)*ZWORK2(:,:)
+ ZDFDDRDZ(:,:) = -TURBN%XCSHF*ZKEFF(:,:)*ZWORK2(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDIF
!
@@ -898,8 +888,8 @@ IF (KRR /= 0) THEN
!
! d(w'2r')/dz
IF (GFWR) THEN
- CALL M3_WR_W2R(D,CSTURB,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
- CALL D_M3_WR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,&
+ CALL M3_WR_W2R(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
+ CALL D_M3_WR_W2R_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,&
& PBLL_O_E,PEMOIST,ZKEFF,PTKEM,ZWORK1)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -911,9 +901,9 @@ IF (KRR /= 0) THEN
!
! d(w'r'2)/dz
IF (GFR2) THEN
- CALL M3_WR_WR2(D,CSTURB,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,Z3RDMOMENT)
+ CALL M3_WR_WR2(D,CSTURB,TURBN,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,&
+ CALL D_M3_WR_WR2_O_DDRDZ(D,CSTURB,TURBN,Z3RDMOMENT,PREDR1,&
& PREDTH1,PD,PBLL_O_E,PEMOIST,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -926,9 +916,9 @@ IF (KRR /= 0) THEN
!
! d(w'2th')/dz
IF (GFWTH) THEN
- CALL M3_WR_W2TH(D,CSTURB,PD,ZKEFF,&
+ CALL M3_WR_W2TH(D,CSTURB,TURBN,PD,ZKEFF,&
& PTKEM,PBLL_O_E,PETHETA,PDR_DZ,ZWORK1)
- CALL D_M3_WR_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,&
+ CALL D_M3_WR_W2TH_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -941,9 +931,9 @@ IF (KRR /= 0) THEN
! d(w'th'2)/dz
IF (GFTH2) THEN
CALL MZM_PHY(D,PFTH2,ZWORK1)
- CALL M3_WR_WTH2(D,CSTURB,PD,ZKEFF,PTKEM,&
+ CALL M3_WR_WTH2(D,CSTURB,TURBN,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,&
+ CALL D_M3_WR_WTH2_O_DDRDZ(D,CSTURB,TURBN,PREDR1,PREDTH1,PD,&
&ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,ZWORK3)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -955,10 +945,10 @@ IF (KRR /= 0) THEN
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- CALL M3_WR_WTHR(D,CSTURB,PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ CALL M3_WR_WTHR(D,CSTURB,TURBN,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, &
+ CALL D_M3_WR_WTHR_O_DDRDZ(D,CSTURB,TURBN,Z3RDMOMENT,PREDR1, &
& PREDTH1,PD,PBLL_O_E,PEMOIST,ZWORK2)
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -995,10 +985,7 @@ IF (KRR /= 0) THEN
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
! atmos top
-#ifdef REPRO48
-#else
ZF(:,IKE+1)=0.
-#endif
END IF
! Compute the split conservative potential temperature at t+deltat
CALL TRIDIAG_THERMO(D,PRM(:,:,1),ZF,ZDFDDRDZ,PTSTEP,TURBN%XIMPL,&
@@ -1141,7 +1128,7 @@ IF (KRR /= 0) THEN
!
!* 3.3 Complete vertical divergence of the < Rc w > flux
! Correction of qc and qi negative for AROME
-IF(HPROGRAM/='AROME ') THEN
+IF(TURBN%LPROJQITURB) THEN
IF ( KRRL >= 1 ) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZWORK2(:,:) = ZFLXZ(:,:) / &
@@ -1209,7 +1196,7 @@ END IF
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK4, TLES%X_LES_SUBGRID_WThv , .TRUE. )
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
- ZWORK2(:,:) = -CSTURB%XCTP*PSQRT_TKE(:,:)/PLM(:,:) &
+ ZWORK2(:,:) = -TURBN%XCTP*PSQRT_TKE(:,:)/PLM(:,:) &
*ZWORK1(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_RtPz )
@@ -1249,7 +1236,7 @@ IF ( ((TURBN%LTURB_FLX .AND. TPFILE%LOPENED) .OR. TLES%LLES_CALL) .AND. (KRRL >
CALL MZM_PHY(D,ZWORK1,ZWORK3)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZA(:,:) = ZWORK2(:,:)/ PDZZ(:,:) * &
- (-PPHI3(:,:)*ZWORK3(:,:)) * CSTURB%XCSHF
+ (-PPHI3(:,:)*ZWORK3(:,:)) * TURBN%XCSHF
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ENDIF
!$mnh_expand_array(JIJ=IIJB:IIJE)
diff --git a/src/PHYEX/turb/mode_update_iiju_phy.f90 b/src/PHYEX/turb/mode_update_iiju_phy.f90
index 92686e36ba21604116206a7fd8ba72108deb1fd0..382d57459335e9c53400bec9c74f15e3aaebc7d8 100644
--- a/src/PHYEX/turb/mode_update_iiju_phy.f90
+++ b/src/PHYEX/turb/mode_update_iiju_phy.f90
@@ -6,8 +6,7 @@ MODULE MODE_UPDATE_IIJU_PHY
IMPLICIT NONE
CONTAINS
SUBROUTINE UPDATE_IIJU_PHY(D,PVAR)
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
! ##############################################################
!
!!**** *MODE_UPDATE_IIJU_PHY* -
@@ -54,7 +53,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PVAR ! working variab
!
INTEGER :: IIE,IIB,IJE,IJB,IIU,IJU,IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('UPDATE_IIJU_PHY',0,ZHOOK_HANDLE)
IIE=D%NIEC
IIB=D%NIBC
diff --git a/src/PHYEX/turb/modi_shallow_mf.f90 b/src/PHYEX/turb/modi_shallow_mf.f90
index 564fdaa0927adf939bf8dc0a2066d54dc7b24d42..089fa4fbb037136510e790fb2c72fd4a0609b283 100644
--- a/src/PHYEX/turb/modi_shallow_mf.f90
+++ b/src/PHYEX/turb/modi_shallow_mf.f90
@@ -2,12 +2,13 @@
MODULE MODI_SHALLOW_MF
! ######################
!
+IMPLICIT NONE
INTERFACE
! #################################################################
- SUBROUTINE SHALLOW_MF(D, CST, NEB, PARAMMF, TURBN, CSTURB, &
+ SUBROUTINE SHALLOW_MF(D, CST, NEBN, PARAMMF, TURBN, CSTURB, &
KRR, KRRL, KRRI, KSV, &
- HFRAC_ICE,ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
PPABSM, PEXNM, &
@@ -27,18 +28,19 @@ INTERFACE
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_NEB_n, 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
+IMPLICIT NONE
!
!* 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(NEB_t), INTENT(IN) :: NEBN
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
@@ -46,11 +48,9 @@ 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
@@ -62,7 +62,7 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXNM ! Exner function at
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,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
@@ -73,7 +73,7 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT):: PDTHLDT_MF ! tendency of thl b
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) :: 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
@@ -81,7 +81,7 @@ 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) :: 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
@@ -93,12 +93,12 @@ 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, 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
+REAL,DIMENSION(JPSVMAX),INTENT(IN),OPTIONAL :: PSVMIN ! minimum value for SV variables (for Budgets)
END SUBROUTINE SHALLOW_MF
diff --git a/src/PHYEX/turb/modi_turb.f90 b/src/PHYEX/turb/modi_turb.f90
index 747f10538154c6456a3824f929eff22814de4330..f7141ca30fca10492d45724fba9bc77b5e8ec1fb 100644
--- a/src/PHYEX/turb/modi_turb.f90
+++ b/src/PHYEX/turb/modi_turb.f90
@@ -2,11 +2,12 @@
MODULE MODI_TURB
! ################
!
+IMPLICIT NONE
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, &
+ SUBROUTINE TURB(CST,CSTURB,BUCONF,TURBN,NEBN,D,TLES, &
+ & KRR,KRRL,KRRI,HLBCX,HLBCY,KGRADIENTS,KHALO, &
+ & KSPLIT,OCLOUDMODIFLM,KSV,KSV_LGBEG,KSV_LGEND, &
& KSV_LIMA_NR, KSV_LIMA_NS, KSV_LIMA_NG, KSV_LIMA_NH, &
& O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM,OFLYER, &
& OCOMPUTE_SRC, PRSNOW, &
@@ -38,17 +39,19 @@ 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_NEB_n, ONLY: NEB_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_LES, ONLY: TLES_t
+IMPLICIT NONE
!
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
+TYPE(NEB_t), INTENT(IN) :: NEBN ! modd_nebn 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.
@@ -56,7 +59,7 @@ INTEGER, INTENT(IN) :: KSV, KSV_LGBEG, KSV_LGEND ! number of sc
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) :: OCLOUDMODIFLM ! cloud mixing length modifs
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
@@ -109,8 +112,8 @@ REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%CTOM=='TM06')),INTENT(INOUT) :: PBL_DEPTH
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
+REAL, DIMENSION(MERGE(D%NIJT,0,OCLOUDMODIFLM),&
+ MERGE(D%NKT,0,OCLOUDMODIFLM)),INTENT(IN) :: PCEI
! Cloud Entrainment instability
! index to emphasize localy
! turbulent fluxes
@@ -158,7 +161,6 @@ 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)
!
@@ -178,8 +180,8 @@ 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
+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
!
!-------------------------------------------------------------------------------
!
diff --git a/src/PHYEX/turb/modn_param_mfshalln.f90 b/src/PHYEX/turb/modn_param_mfshalln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8b137891791fe96927ad78e64b0aad7bded08bdc
--- /dev/null
+++ b/src/PHYEX/turb/modn_param_mfshalln.f90
@@ -0,0 +1 @@
+
diff --git a/src/PHYEX/turb/shallow_mf.f90 b/src/PHYEX/turb/shallow_mf.f90
index 85c85e6fcedb012268c91cb1c6788cb91e49ec5e..4488cea00924ce0abea7027e78b961794ec3d0f4 100644
--- a/src/PHYEX/turb/shallow_mf.f90
+++ b/src/PHYEX/turb/shallow_mf.f90
@@ -3,11 +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.
!-----------------------------------------------------------------
-! ################################################################
- SUBROUTINE SHALLOW_MF(D, CST, NEB, PARAMMF, TURBN, CSTURB, &
+! #################################################################
+ SUBROUTINE SHALLOW_MF(D, CST, NEBN, PARAMMF, TURBN, CSTURB, &
KRR, KRRL, KRRI, KSV, &
- HFRAC_ICE,ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, &
+ ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
+ PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
PPABSM, PEXNM, &
@@ -22,7 +22,6 @@
PFRAC_UP,PEMF,PDETR,PENTR, &
KKLCL,KKETL,KKCTL,PDX,PDY,PRSVS,PSVMIN, &
BUCONF, TBUDGETS, KBUDGETS )
-
! #################################################################
!!
!!**** *SHALLOW_MF* -
@@ -72,15 +71,14 @@
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY: JPRB
USE MODE_SHUMAN_PHY, ONLY: MXM_PHY, MYM_PHY
-USE YOMHOOK, ONLY: LHOOK, DR_HOOK
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK
!
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_NEB_n, 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
@@ -104,7 +102,7 @@ IMPLICIT NONE
!
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(NEB_t), INTENT(IN) :: NEBN
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
@@ -112,11 +110,9 @@ 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(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(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! Height of flux point
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metric coefficients
@@ -191,7 +187,7 @@ INTEGER :: JIJ, JK, JSV
INTEGER :: IIJB,IIJE ! physical horizontal domain indices
INTEGER :: IKT
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!------------------------------------------------------------------------
!!! 1. Initialisation
@@ -221,7 +217,7 @@ ENDIF
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZWK(:,:)=PTHM(:,:)*PEXNM(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,ZFRAC_ICE(:,:),ZWK(:,:), IERR(:,:))
+CALL COMPUTE_FRAC_ICE(NEBN%CFRAC_ICE_SHALLOW_MF,NEBN,ZFRAC_ICE(:,:),ZWK(:,:), IERR(:,:))
! Conservative variables at t-dt
CALL THL_RT_FROM_TH_R_MF(D, CST, KRR,KRRL,KRRI, &
@@ -239,8 +235,8 @@ ZTHVM(:,:) = PTHM(:,:)*&
!
IF (PARAMMF%CMF_UPDRAFT == 'EDKF') THEN
GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT(D, CST, NEB, PARAMMF, TURBN, CSTURB, &
- KSV, HFRAC_ICE, GENTR_DETR, &
+ CALL COMPUTE_UPDRAFT(D, CST, NEBN, PARAMMF, TURBN, CSTURB, &
+ KSV, GENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV,PPABSM,PRHODREF, &
@@ -253,8 +249,8 @@ IF (PARAMMF%CMF_UPDRAFT == 'EDKF') THEN
PDX,PDY)
ELSEIF (PARAMMF%CMF_UPDRAFT == 'RHCJ') THEN
GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT_RHCJ10(D, CST, NEB, PARAMMF, TURBN, CSTURB,&
- KSV, HFRAC_ICE, GENTR_DETR, &
+ CALL COMPUTE_UPDRAFT_RHCJ10(D, CST, NEBN, PARAMMF, TURBN, CSTURB,&
+ KSV, GENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV,PPABSM,PRHODREF, &
@@ -265,8 +261,8 @@ ELSEIF (PARAMMF%CMF_UPDRAFT == 'RHCJ') THEN
PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
ELSEIF (PARAMMF%CMF_UPDRAFT == 'RAHA') THEN
- CALL COMPUTE_UPDRAFT_RAHA(D, CST, NEB, PARAMMF, &
- KSV, HFRAC_ICE, GENTR_DETR, &
+ CALL COMPUTE_UPDRAFT_RAHA(D, CST, NEBN, PARAMMF, &
+ KSV, GENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
@@ -288,7 +284,7 @@ ENDIF
!!! 5. Compute diagnostic convective cloud fraction and content
!!! --------------------------------------------------------
!
-CALL COMPUTE_MF_CLOUD(D,CST,CSTURB,PARAMMF,TURBN%LSTATNW,&
+CALL COMPUTE_MF_CLOUD(D,CST,TURBN,PARAMMF,NEBN%LSTATNW, &
KRR, KRRL, KRRI, &
ZFRAC_ICE, &
PRC_UP,PRI_UP,PEMF, &
@@ -308,10 +304,10 @@ CALL COMPUTE_MF_CLOUD(D,CST,CSTURB,PARAMMF,TURBN%LSTATNW,&
ZEMF_O_RHODREF(:,:)=PEMF(:,:)/PRHODREF(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
-IF ( PIMPL_MF > 1.E-10 ) THEN
+IF ( PARAMMF%XIMPL_MF > 1.E-10 ) THEN
CALL MF_TURB(D, KSV, PARAMMF%LMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, &
+ PARAMMF%XIMPL_MF, PTSTEP, &
PDZZ, &
PRHODJ, &
ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, &
@@ -337,8 +333,6 @@ IF( PARAMMF%CMF_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)
@@ -387,7 +381,6 @@ IF(PRESENT(BUCONF)) THEN
END DO
END IF
END IF
-#endif
!
IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',1,ZHOOK_HANDLE)
!
diff --git a/src/PHYEX/turb/shuman_mf.f90 b/src/PHYEX/turb/shuman_mf.f90
index 1ec7bc1ae92a1447a5d833aadc36bc26d5e0f563..ccab5397ddabda35921dd35a990113c88cfc13b1 100644
--- a/src/PHYEX/turb/shuman_mf.f90
+++ b/src/PHYEX/turb/shuman_mf.f90
@@ -6,6 +6,7 @@
MODULE MODI_SHUMAN_MF
! ##################
!
+IMPLICIT NONE
INTERFACE
!
SUBROUTINE DZF_MF(D, PA, PDZF)
diff --git a/src/PHYEX/turb/th_r_from_thl_rt.func.h b/src/PHYEX/turb/th_r_from_thl_rt.func.h
index 93467975a73440ffeb71c4f2c1059a5fedc8749d..fc5071e3727276956b50b7149f44a1a5ac6b8be6 100644
--- a/src/PHYEX/turb/th_r_from_thl_rt.func.h
+++ b/src/PHYEX/turb/th_r_from_thl_rt.func.h
@@ -2,7 +2,7 @@
!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, &
+ SUBROUTINE TH_R_FROM_THL_RT(CST, NEBN, KT, HFRAC_ICE,PFRAC_ICE,PP, &
PTHL, PRT, PTH, PRV, PRL, PRI, &
PRSATW, PRSATI, PRR, PRS, PRG, PRH, OOCEAN,&
PBUF, KB, KE)
@@ -51,7 +51,7 @@
! ------------
!
USE MODD_CST, ONLY : CST_t
-USE MODD_NEB, ONLY : NEB_t
+USE MODD_NEB_n, ONLY : NEB_t
!
IMPLICIT NONE
!
@@ -59,7 +59,7 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
TYPE(CST_t), INTENT(IN) :: CST
-TYPE(NEB_t), INTENT(IN) :: NEB
+TYPE(NEB_t), INTENT(IN) :: NEBN
INTEGER, INTENT(IN) :: KT
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
@@ -150,7 +150,7 @@ DO II=1,JITER
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))
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEBN,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
diff --git a/src/PHYEX/turb/turb.f90 b/src/PHYEX/turb/turb.f90
index 6da9720217d0eb18e185c7ad7dcfc35ec207a771..5549a0c826674351524f2707876a10a87816e827 100644
--- a/src/PHYEX/turb/turb.f90
+++ b/src/PHYEX/turb/turb.f90
@@ -3,9 +3,9 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
- 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, &
+ SUBROUTINE TURB(CST,CSTURB,BUCONF,TURBN,NEBN,D,TLES, &
+ & KRR,KRRL,KRRI,HLBCX,HLBCY,KGRADIENTS,KHALO, &
+ & KSPLIT, OCLOUDMODIFLM, KSV,KSV_LGBEG,KSV_LGEND, &
& KSV_LIMA_NR, KSV_LIMA_NS, KSV_LIMA_NG, KSV_LIMA_NH, &
& O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM,OFLYER, &
& OCOMPUTE_SRC, PRSNOW, &
@@ -239,12 +239,11 @@
!* 0. DECLARATIONS
! ------------
!
-USE PARKIND1, ONLY: JPRB
USE MODE_SHUMAN_PHY, ONLY: MZF_PHY,MXF_PHY,MYF_PHY
-USE YOMHOOK , ONLY: LHOOK, DR_HOOK
+USE YOMHOOK , ONLY: LHOOK, DR_HOOK, JPHOOK
!
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, &
+ NBUDGET_RI, NBUDGET_SV1, &
TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
@@ -254,6 +253,7 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES, ONLY: TLES_t
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB, XUNDEF
USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_NEB_n, ONLY: NEB_t
!
USE MODE_BL89, ONLY: BL89
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
@@ -290,9 +290,9 @@ TYPE(CST_t), INTENT(IN) :: CST ! modd_cst general constan
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(NEB_t), INTENT(IN) :: NEBN ! modd_nebn 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.
@@ -300,7 +300,8 @@ INTEGER, INTENT(IN) :: KSV, KSV_LGBEG, KSV_LGEND ! number of sc
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) :: OCLOUDMODIFLM ! cloud mixing length modifications
+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
@@ -312,8 +313,6 @@ LOGICAL, INTENT(IN) :: ODIAG_IN_RUN ! switch to activate onlin
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
-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
@@ -333,6 +332,7 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODJ ! dry density * Gri
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
@@ -340,7 +340,6 @@ REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV, &
! normal surface fluxes of (u,v) parallel to the orography
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(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! Pressure at time t
@@ -354,8 +353,8 @@ REAL, DIMENSION(MERGE(D%NIJT,0,TURBN%CTOM=='TM06')),INTENT(INOUT) :: PBL_DEPTH
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
+REAL, DIMENSION(MERGE(D%NIJT,0,OCLOUDMODIFLM),&
+ MERGE(D%NKT,0,OCLOUDMODIFLM)),INTENT(IN) :: PCEI
! Cloud Entrainment instability
! index to emphasize localy
! turbulent fluxes
@@ -403,7 +402,6 @@ 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)
!
@@ -487,7 +485,6 @@ 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,IKA,IKU ! array size in k direction
INTEGER :: IKL
@@ -508,7 +505,7 @@ TYPE(TFIELDMETADATA) :: TZFIELD
!* 1.1 Set the internal domains, ZEXPL
!
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE,ZHOOK_HANDLE2
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE,ZHOOK_HANDLE2
IF (LHOOK) CALL DR_HOOK('TURB',0,ZHOOK_HANDLE)
!
IF (TURBN%LHARAT .AND. TURBN%CTURBDIM /= '1DIM') THEN
@@ -600,7 +597,7 @@ IF (KRRL >=1) THEN
!* 2.5 Lv/Cph/Exn
!
IF ( KRRI >= 1 ) THEN
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%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)
@@ -630,7 +627,7 @@ IF (KRRL >=1) THEN
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
!wc call new stat functions or not
- IF (TURBN%LSTATNW) THEN
+ IF (NEBN%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
@@ -727,7 +724,7 @@ SELECT CASE (TURBN%CTURBLEN)
CASE ('BL89')
ZSHEAR(:,:)=0.
- CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN,HPROGRAM)
+ CALL BL89(D,CST,CSTURB,TURBN,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN)
!
!* 3.2 RM17 mixing length
! ------------------
@@ -745,7 +742,7 @@ SELECT CASE (TURBN%CTURBLEN)
ZSHEAR(:,:) = SQRT(ZDUDZ(:,:)*ZDUDZ(:,:) &
+ ZDVDZ(:,:)*ZDVDZ(:,:))
!$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 BL89(D,CST,CSTURB,TURBN,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN)
!
!* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths
! --------------------------------------------------
@@ -763,7 +760,7 @@ SELECT CASE (TURBN%CTURBLEN)
ZSHEAR(:,:) = SQRT(ZDUDZ(:,:)*ZDUDZ(:,:) &
+ ZDVDZ(:,:)*ZDVDZ(:,:))
!$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 BL89(D,CST,CSTURB,TURBN,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN)
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.
@@ -818,7 +815,7 @@ END SELECT
!
!* 3.5 Mixing length modification for cloud
! -----------------------
-IF (KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE') CALL CLOUD_MODIF_LM
+IF (OCLOUDMODIFLM) CALL CLOUD_MODIF_LM
ENDIF ! end LHARRAT
!
@@ -850,7 +847,7 @@ IF (TURBN%LRMC01) THEN
ZSFRV(:)=0.
CALL LMO(D,CST,ZUSTAR,ZTHLM(:,IKB),ZRVM,PSFTH,ZSFRV,ZLMO)
END IF
- CALL RMC01(D,CST,CSTURB,TURBN%CTURBLEN,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,ZLM,ZLEPS)
+ CALL RMC01(D,CST,CSTURB,TURBN,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,ZLM,ZLEPS)
END IF
!
!RMC01 is only applied on RM17 in HM21
@@ -883,7 +880,7 @@ ENDIF
!
!
!
-IF (HPROGRAM/='AROME ') THEN
+IF (TURBN%LROTATE_WIND) THEN
CALL ROTATE_WIND(D,PUT,PVT,PWT, &
PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
@@ -905,11 +902,7 @@ END IF
!
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZCDUEFF(:) =-SQRT ( (PSFU(:)**2 + PSFV(:)**2) / &
-#ifdef REPRO48
- (1.E-60 + ZUSLOPE(:)**2 + ZVSLOPE(:)**2 ) )
-#else
(CST%XMNH_TINY + ZUSLOPE(:)**2 + ZVSLOPE(:)**2 ) )
-#endif
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!* 4.6 compute the surface tangential fluxes
@@ -1003,11 +996,11 @@ IF( BUCONF%LBUDGET_SV ) THEN
END DO
END IF
-CALL TURB_VER(D,CST,CSTURB,TURBN,TLES, &
+CALL TURB_VER(D,CST,CSTURB,TURBN,NEBN,TLES, &
KRR,KRRL,KRRI,KGRADIENTS, &
OOCEAN, ODEEPOC, OCOMPUTE_SRC, &
KSV,KSV_LGBEG,KSV_LGEND, &
- ZEXPL,HPROGRAM, O2D, ONOMIXLG, OFLAT, &
+ ZEXPL, O2D, ONOMIXLG, OFLAT, &
OCOUPLES,OBLOWSNOW,OFLYER, PRSNOW, &
PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
@@ -1066,12 +1059,7 @@ IF( BUCONF%LBUDGET_SV ) THEN
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 (:,:) )
@@ -1105,14 +1093,11 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
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, &
+ CALL TURB_HOR_SPLT(D,CST,CSTURB, TURBN, NEBN, TLES, &
KSPLIT, KRR, KRRL, KRRI, KSV,KSV_LGBEG,KSV_LGEND, &
PTSTEP,HLBCX,HLBCY, OFLAT,O2D, ONOMIXLG, &
OOCEAN,OCOMPUTE_SRC,OBLOWSNOW,PRSNOW, &
- TPFILE, HPROGRAM, KHALO, &
+ TPFILE, KHALO, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
@@ -1125,7 +1110,6 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
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)
@@ -1167,10 +1151,7 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
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
@@ -1210,8 +1191,8 @@ ELSE
ZRTKEMS(:,:)=0.
END IF
!
-CALL TKE_EPS_SOURCES(D,CST,CSTURB,BUCONF,TURBN,TLES,HPROGRAM, &
- & KMI,PTKET,ZLM,ZLEPS,PDP,ZTRH, &
+CALL TKE_EPS_SOURCES(D,CST,CSTURB,BUCONF,TURBN,TLES, &
+ & PTKET,ZLM,ZLEPS,PDP,ZTRH, &
& PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
& PTSTEP,ZEXPL, &
& TPFILE,ODIAG_IN_RUN,OOCEAN, &
@@ -1958,7 +1939,7 @@ ELSE
! ------------------
CASE ('BL89','RM17','HM21')
ZSHEAR(:,:)=0.
- CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD,OOCEAN,HPROGRAM)
+ CALL BL89(D,CST,CSTURB,TURBN,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD,OOCEAN)
!
!* 3.2 Delta mixing length
! -------------------