From aeb97925c2e65326991dc6ca75e517e32f9dfec4 Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Sat, 26 Feb 2022 00:24:18 +0100
Subject: [PATCH] Quentin 26/02/2022: Add new files from MNH5.5.0 that will be
modified
---
src/mesonh/ext/lesn.f90 | 3569 ++++++++++++++++++++++++++++
src/mesonh/ext/prep_ideal_case.f90 | 1933 +++++++++++++++
src/mesonh/ext/set_rsou.f90 | 1633 +++++++++++++
src/mesonh/ext/shallow_mf_pack.f90 | 481 ++++
4 files changed, 7616 insertions(+)
create mode 100644 src/mesonh/ext/lesn.f90
create mode 100644 src/mesonh/ext/prep_ideal_case.f90
create mode 100644 src/mesonh/ext/set_rsou.f90
create mode 100644 src/mesonh/ext/shallow_mf_pack.f90
diff --git a/src/mesonh/ext/lesn.f90 b/src/mesonh/ext/lesn.f90
new file mode 100644
index 000000000..129929246
--- /dev/null
+++ b/src/mesonh/ext/lesn.f90
@@ -0,0 +1,3569 @@
+!MNH_LIC Copyright 2000-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ SUBROUTINE LES_n
+! #################
+!
+!
+!!**** *LES_n* computes the current time-step LES diagnostics for model _n
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!! 01/02/01 (D. Gazen) add module MODD_NSV for NSV variable
+!! 06/11/02 (V. Masson) add LES budgets and use of anomalies
+!! in LES quantities computations
+!! 01/04/03 (V. Masson and F. Couvreux) bug in BL height loop
+!! 10/07 (J.Pergaud) Add mass flux diagnostics
+!! 06/08 (O.Thouron) Add radiative diagnostics
+!! 12/10 (R.Honnert) Add EDKF mass flux in BL height
+!! 10/09 (P. Aumond) Add possibility of user maskS
+!! 10/14 (C.Lac) Correction on user masks
+!! 10/16 (C.Lac) Add ground droplet deposition amount
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_CTURB, ONLY : XFTOP_O_FSURF
+!
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_CONF
+USE MODD_LES_n
+USE MODD_RADIATIONS_n
+USE MODD_GRID_n
+USE MODD_REF_n
+USE MODD_FIELD_n
+USE MODD_CONF_n
+USE MODD_PARAM_n
+USE MODD_TURB_n
+USE MODD_METRICS_n
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_PRECIP_n, ONLY: XINPRR,XACPRR,XINPRR3D,XEVAP3D,XINPRC,XINDEP
+USE MODD_NSV, ONLY : NSV, NSV_CS
+USE MODD_PARAM_ICE, ONLY: LDEPOSC,LSEDIC
+USE MODD_PARAM_C2R2, ONLY: LDEPOC,LSEDC
+USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
+!
+USE MODI_SHUMAN
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODI_GRADIENT_W
+USE MODI_LES_VER_INT
+USE MODI_SPEC_VER_INT
+USE MODI_LES_MEAN_ll
+USE MODI_THL_RT_FROM_TH_R
+USE MODI_LES_RES_TR
+USE MODI_BUDGET_FLAGS
+USE MODI_LES_BUDGET_TEND_n
+USE MODI_BL_DEPTH_DIAG
+!
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+!
+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 :: 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
+!-------------------------------------------------------------------------------
+!
+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)
+!
+ILUOUT = TLUOUT%NLU
+!
+!-------------------------------------------------------------------------------
+!
+!* interpolation coefficients for Z type grid
+!
+IF (CSPECTRA_LEVEL_TYPE=='Z') THEN
+ IF (ALLOCATED(XCOEFLIN_CURRENT_SPEC)) DEALLOCATE(XCOEFLIN_CURRENT_SPEC)
+ IF (ALLOCATED(NKLIN_CURRENT_SPEC )) DEALLOCATE(NKLIN_CURRENT_SPEC )
+ !
+ ALLOCATE(XCOEFLIN_CURRENT_SPEC(IIU,IJU,NSPECTRA_K))
+ 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))
+ELSE
+ ALLOCATE(ZRI_LES (0,0,0))
+ ALLOCATE(ZIWP_LES(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) )
+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) )
+!
+ IF (LUSERS) &
+ CALL LES_MEAN_ll ( ZRS_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rs(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERG) &
+ CALL LES_MEAN_ll ( ZRG_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rg(:,NLES_CURRENT_TCOUNT,1) )
+!
+ IF (LUSERH) &
+ CALL LES_MEAN_ll ( ZRH_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Rh(:,NLES_CURRENT_TCOUNT,1) )
+!
+ DO JSV=1,NSV
+ CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_Sv(:,NLES_CURRENT_TCOUNT,1,JSV) )
+ END DO
+!
+ CALL LES_MEAN_ll ( ZDPDZ_LES, LLES_CURRENT_CART_MASK, &
+ ZMEAN_DPDZ(:) )
+ CALL LES_MEAN_ll ( ZDTHDZ_LES, LLES_CURRENT_CART_MASK, &
+ ZLES_MEAN_DTHDZ(:) )
+
+!
+!* build the 3D resolved turbulent fields by removing the mean field
+!
+DO JJ=1,IJU
+ DO JI=1,IIU
+ ZP_ANOM(JI,JJ,:) = ZP_LES(JI,JJ,:) - XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,1)
+ ZDPDZ_ANOM(JI,JJ,:) = ZDPDZ_LES(JI,JJ,:) - ZMEAN_DPDZ(:)
+ ZTH_ANOM(JI,JJ,:) = ZTH_LES(JI,JJ,:) - XLES_MEAN_Th(:,NLES_CURRENT_TCOUNT,1)
+ ZRHO_ANOM(JI,JJ,:) = ZRHO_LES(JI,JJ,:) - XLES_MEAN_Rho(:,NLES_CURRENT_TCOUNT,1)
+ IF (LUSERV) THEN
+ ZTHV_ANOM(JI,JJ,:) = ZTHV_LES(JI,JJ,:) - XLES_MEAN_Thv(:,NLES_CURRENT_TCOUNT,1)
+ ZRV_ANOM(JI,JJ,:) = ZRV_LES(JI,JJ,:) - XLES_MEAN_Rv(:,NLES_CURRENT_TCOUNT,1)
+ END IF
+ IF (LUSERC) THEN
+ ZRC_ANOM(JI,JJ,:) = ZRC_LES(JI,JJ,:) - XLES_MEAN_Rc(:,NLES_CURRENT_TCOUNT,1)
+ ZLWP_ANOM(JI,JJ) =ZLWP_LES(JI,JJ)-XLES_LWP(NLES_CURRENT_TCOUNT)
+ END IF
+ IF (LUSERI) THEN
+ ZRI_ANOM(JI,JJ,:) = ZRI_LES(JI,JJ,:) - XLES_MEAN_Ri(:,NLES_CURRENT_TCOUNT,1)
+ END IF
+ IF (LUSERR) THEN
+ ZRR_ANOM(JI,JJ,:) = ZRR_LES(JI,JJ,:) - XLES_MEAN_Rr(:,NLES_CURRENT_TCOUNT,1)
+ END IF
+ END DO
+END DO
+!
+!
+!--------------------------------------------------------------------------------
+!
+!* vertical grid computed at first LES call for this model
+!
+IF (NLES_CURRENT_TCOUNT==1) THEN
+ ALLOCATE(ZZ_LES (IIU,IJU,NLES_K))
+ CALL LES_VER_INT( MZF(XZZ) ,ZZ_LES )
+ CALL LES_MEAN_ll ( ZZ_LES, LLES_CURRENT_CART_MASK, XLES_Z )
+ DEALLOCATE(ZZ_LES)
+ CALL LES_MEAN_ll ( XZS, LLES_CURRENT_CART_MASK(:,:,1), XLES_ZS )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Vertical interpolations to SECTRA computations vertical grid
+! ------------------------------------------------------------
+!
+!* note that velocity fields are previously localized on the MASS points
+!
+CALL SPEC_VER_INT(IMI, MXF(XUT) ,ZU_SPEC )
+CALL SPEC_VER_INT(IMI, MYF(XVT) ,ZV_SPEC )
+CALL SPEC_VER_INT(IMI, MZF(XWT) ,ZW_SPEC )
+CALL SPEC_VER_INT(IMI, XTHT ,ZTH_SPEC )
+IF (LUSERC) CALL SPEC_VER_INT(IMI, ZTHL ,ZTHL_SPEC)
+IRR = 0
+IF (LUSERV) THEN
+ IRR = IRR + 1
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRV_SPEC )
+END IF
+IF (LUSERC) THEN
+ IRR = IRR + 1
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRC_SPEC )
+END IF
+IF (LUSERR) THEN
+ IRR = IRR + 1
+END IF
+IF (LUSERI) THEN
+ IRR = IRR + 1
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRI_SPEC )
+END IF
+IF (NSV>0) THEN
+ DO JSV=1,NSV
+ CALL SPEC_VER_INT(IMI, XSVT(:,:,:,JSV), ZSV_SPEC(:,:,:,JSV) )
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Call to LES computations on cartesian (sub-)domain
+! --------------------------------------------------
+!
+IMASK=1
+!
+CALL LES(LLES_CURRENT_CART_MASK)
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Call to LES computations on nebulosity mask
+! -------------------------------------------
+!
+IF (LLES_NEB_MASK) THEN
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_NEB_MASK .AND. LLES_CURRENT_CART_MASK)
+!
+ IMASK=IMASK+1
+ CALL LES((.NOT. LLES_CURRENT_NEB_MASK) .AND. LLES_CURRENT_CART_MASK)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. Call to LES computations on cloud core mask
+! -------------------------------------------
+!
+IF (LLES_CORE_MASK) THEN
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_CORE_MASK .AND. LLES_CURRENT_CART_MASK)
+!
+ IMASK=IMASK+1
+ CALL LES((.NOT. LLES_CURRENT_CORE_MASK) .AND. LLES_CURRENT_CART_MASK)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. Call to LES computations on user mask
+! -------------------------------------
+!
+IF (LLES_MY_MASK) THEN
+ DO JI=1,NLES_MASKS_USER
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_MY_MASKS(:,:,:,JI))
+ END DO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7b. Call to LES computations on conditional sampling mask
+! -----------------------------------------------------
+!
+IF (LLES_CS_MASK) THEN
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_CS1_MASK)
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_CS2_MASK)
+ IMASK=IMASK+1
+ CALL LES(LLES_CURRENT_CS3_MASK)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. budgets
+! -------
+!
+!* 8.1 tendencies
+! ----------
+!
+!
+!* 8.2 dynamical production, transport and mean advection
+! --------------------------------------------------
+!
+ALLOCATE(ZLES_MEAN_DRtDZ(NLES_K))
+ALLOCATE(ZLES_MEAN_DSVDZ(NLES_K,NSV))
+!
+IF (LUSERV) THEN
+ ZLES_MEAN_DRtDZ(:) = XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,1)
+ELSE
+ ZLES_MEAN_DRtDZ(:) = XUNDEF
+END IF
+!
+ZLES_MEAN_DSVDZ = 0.
+DO JSV=1,NSV
+ ZLES_MEAN_DSvDZ(:,JSV) = XLES_MEAN_DSvDZ(:,NLES_CURRENT_TCOUNT,1,JSV)
+END DO
+!
+CALL LES_RES_TR(LUSERV, &
+ XLES_MEAN_DUDZ(:,NLES_CURRENT_TCOUNT,1), &
+ XLES_MEAN_DVDZ(:,NLES_CURRENT_TCOUNT,1), &
+ XLES_MEAN_DWDZ(:,NLES_CURRENT_TCOUNT,1), &
+ XLES_MEAN_DThlDZ(:,NLES_CURRENT_TCOUNT,1), &
+ ZLES_MEAN_DRtDZ(:), &
+ ZLES_MEAN_DSvDZ(:,:) )
+!
+DEALLOCATE(ZLES_MEAN_DRtDZ)
+DEALLOCATE(ZLES_MEAN_DSVDZ)
+!
+CALL LES_BUDGET_TEND_n
+!* 8.3 end of LES budgets computations
+! -------------------------------
+!
+DO JLOOP=1,NLES_TOT
+ XLES_BU_RES_KE (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_KE (:,JLOOP)
+ XLES_BU_RES_WThl (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_WThl (:,JLOOP)
+ XLES_BU_RES_Thl2 (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_Thl2 (:,JLOOP)
+ XLES_BU_SBG_Tke (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_SBG_Tke (:,JLOOP)
+ IF (LUSERV) THEN
+ XLES_BU_RES_WRt (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_WRt (:,JLOOP)
+ XLES_BU_RES_Rt2 (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_Rt2 (:,JLOOP)
+ XLES_BU_RES_ThlRt(:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_ThlRt(:,JLOOP)
+ END IF
+ DO JSV=1,NSV
+ XLES_BU_RES_Sv2 (:,NLES_CURRENT_TCOUNT,JLOOP,JSV) = X_LES_BU_RES_Sv2 (:,JLOOP,JSV)
+ XLES_BU_RES_WSv (:,NLES_CURRENT_TCOUNT,JLOOP,JSV) = X_LES_BU_RES_WSv (:,JLOOP,JSV)
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. Deallocations
+! -------------
+!
+!* 9.1 local variables
+! ---------------
+!
+DEALLOCATE(ZEXN )
+DEALLOCATE(ZTHL)
+DEALLOCATE(ZRT )
+DEALLOCATE(ZTHV )
+DEALLOCATE(ZRHO )
+DEALLOCATE(ZEW )
+
+DEALLOCATE(ZINDCLD )
+DEALLOCATE(ZINDCLD2 )
+DEALLOCATE(ZINDCLD2D )
+DEALLOCATE(ZINDCLD2D2)
+DEALLOCATE(ZCLDFR_LES)
+DEALLOCATE(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)
+! ---------------------------
+!
+DEALLOCATE(LLES_CURRENT_CART_MASK)
+IF (LLES_NEB_MASK) DEALLOCATE(LLES_CURRENT_NEB_MASK)
+IF (LLES_CORE_MASK) DEALLOCATE(LLES_CURRENT_CORE_MASK)
+IF (LLES_MY_MASK) THEN
+ DEALLOCATE(LLES_CURRENT_MY_MASKS)
+END IF
+IF (LLES_CS_MASK) THEN
+ DEALLOCATE(LLES_CURRENT_CS1_MASK)
+ IF (NSV_CS >= 2) DEALLOCATE(LLES_CURRENT_CS2_MASK)
+ IF (NSV_CS == 3) 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
+ XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = BL_DEPTH_DIAG(IKB,IKE,ZFRIC_SURF, XLES_ZS, &
+ ZFRIC_LES, XLES_Z, &
+ XFTOP_O_FSURF )
+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/mesonh/ext/prep_ideal_case.f90 b/src/mesonh/ext/prep_ideal_case.f90
new file mode 100644
index 000000000..370e21412
--- /dev/null
+++ b/src/mesonh/ext/prep_ideal_case.f90
@@ -0,0 +1,1933 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ PROGRAM PREP_IDEAL_CASE
+! #######################
+!
+!!**** *PREP_IDEAL_CASE* - program to write an initial FM-file
+!!
+!! PURPOSE
+!! -------
+! The purpose of this program is to prepare an initial meso-NH file
+! (LFIFM and DESFM files) filled with some idealized fields.
+!
+! ---- The present version can provide two types of fields:
+!
+! 1) CIDEAL = 'CSTN' : 3D fields derived from a vertical profile with
+! --------------- n levels of constant moist Brunt Vaisala frequency
+! The vertical profile is read in EXPRE file.
+! These fields can be used for model runs
+!
+! 2) CIDEAL = 'RSOU' : 3D fields derived from a radiosounding.
+! ---------------
+! The radiosounding is read in EXPRE file.
+! The following kind of data is permitted :
+! YKIND = 'STANDARD' : Zsol, Psol, Tsol, TDsol
+! (Pressure, dd, ff) ,
+! (Pressure, T, Td)
+! YKIND = 'PUVTHVMR' : zsol, Psol, Thvsol, Rsol
+! (Pressure, U, V) ,
+! (Pressure, THv, R)
+! YKIND = 'PUVTHVHU' : zsol, Psol, Thvsol, Husol
+! (Pressure, U, V) ,
+! (Pressure, THv, Hu)
+! YKIND = 'ZUVTHVHU' : zsol, Psol, Thvsol, Husol
+! (height, U, V) ,
+! (height, THv, Hu)
+! YKIND = 'ZUVTHVMR' : zsol, Psol, Thvsol, Rsol
+! (height, U, V) ,
+! (height, THv, R)
+! YKIND = 'PUVTHDMR' : zsol, Psol, Thdsol, Rsol
+! (Pressure, U, V) ,
+! (Pressure, THd, R)
+! YKIND = 'PUVTHDHU' : zsol, Psol, Thdsol, Husol
+! (Pressure, U, V) ,
+! (Pressure, THd, Hu)
+! YKIND = 'ZUVTHDMR' : zsol, Psol, Thdsol, Rsol
+! (height, U, V) ,
+! (height, THd, R)
+! YKIND = 'ZUVTHLMR' : zsol, Psol, Thdsol, Rsol
+! (height, U, V) ,
+! (height, THl, Rt)
+!
+! These fields can be used for model runs
+!
+! Cases (1) and (2) can be balanced
+! (geostrophic, hydrostatic and anelastic balances) if desired.
+!
+! ---- The orography can be flat (YZS='FLAT'), but also
+! sine-shaped (YZS='SINE') or bell-shaped (YZS='BELL')
+!
+! ---- The U(z) profile given in the RSOU and CSTN cases can
+! be multiplied (CUFUN="Y*Z") by a function of y (function FUNUY)
+! The V(z) profile given in the RSOU and CSTN cases can
+! be multiplied (CVFUN="X*Z") by a function of x (function FUNVX).
+! If it is not the case, i.e. U(y,z)=U(z) then CUFUN="ZZZ" and
+! CVFUN="ZZZ" for V(y,z)=V(z). Instead of these separable forms,
+! non-separables functions FUNUYZ (CUFUN="Y,Z") and FUNVXZ (CVFUN="X,Z")
+! can be used to specify the wind components.
+!
+!!** METHOD
+!! ------
+!! The directives and data to perform the preparation of the initial FM
+!! file are stored in EXPRE file. This file is composed of two parts :
+!! - a namelists-format part which is present in all cases
+!! - a free-format part which contains data in cases
+!! of discretised orography (CZS='DATA')
+!! of radiosounding (CIDEAL='RSOU') or Nv=cste profile (CIDEAL='CSTN')
+!! of forced version (LFORCING=.TRUE.)
+!!
+!!
+!! The following PREP_IDEAL_CASE program :
+!!
+!! - initializes physical constants by calling INI_CST
+!!
+!! - sets default values for global variables which will be
+!! written in DESFM file and for variables in EXPRE file (namelists part)
+!! which will be written in LFIFM file.
+!!
+!! - reads the namelists part of EXPRE file which gives
+!! informations about the preinitialization to perform,
+!!
+!! - allocates memory for arrays,
+!!
+!! - initializes fields depending on the
+!! directives (CIDEAL in namelist NAM_CONF_PRE) :
+!!
+!! * grid variables :
+!! The gridpoints are regularly spaced by XDELTAX, XDELTAY.
+!! The grid is stretched along the z direction, the mesh varies
+!! from XDZGRD near the ground to XDZTOP near the top and the
+!! weigthing function is a TANH function characterized by its
+!! center and width above and under this center
+!! The orography is initialized following the kind of orography
+!! (YZS in namelist NAM_CONF_PRE) and the degrees of freedom :
+!! sine-shape ---> ZHMAX, IEXPX,IEXPY
+!! bell-shape ---> ZHMAX, ZAX,ZAY,IIZS,IJZS
+!! The horizontal grid variables are initialized following
+!! the kind of geometry (LCARTESIAN in namelist NAM_CONF_PRE)
+!! and the grid parameters XLAT0,XLON0,XBETA in both geometries
+!! and XRPK,XLONORI,XLATORI in conformal projection.
+!! In the case of initialization from a radiosounding, the
+!! date and time is read in free-part of the EXPRE file. In other
+!! cases year, month and day are set to NUNDEF and time to 0.
+!!
+!! * prognostic fields :
+!!
+!! U,V,W, Theta and r. are first determined. They are
+!! multiplied by rhoj after the anelastic reference state
+!! computation.
+!! For the CSTN and RSOU cases, the determination of
+!! Theta and rv is performed respectively by SET_RSOU
+!! and by SET_CSTN which call the common routine SET_MASS.
+!! These three routines have the following actions :
+!! --- The input vertical profile is converted in
+!! variables (U,V,thetav,r) and interpolated
+!! on a mixed grid (with VERT_COORD) as in PREP_REAL_CASE
+!! --- A variation of the u-wind component( x-model axis component)
+!! is possible in y direction, a variation of the v-wind component
+!! (y-model axis component) is possible in x direction.
+!! --- Thetav could be computed with thermal wind balance
+!! (LGEOSBAL=.TRUE. with call of SET_GEOSBAL)
+!! --- The mass fields (theta and r ) and the wind components are
+!! then interpolated on the model grid with orography as in
+!! PREP_REAL_CASE with the option LSHIFT
+!! --- An anelastic correction is applied in PRESSURE_IN_PREP in
+!! the case of non-vanishing orography.
+!!
+!! * anelastic reference state variables :
+!!
+!! 1D reference state :
+!! RSOU and CSTN cases : rhorefz and thvrefz are computed
+!! by SET_REFZ (called by SET_MASS).
+!! They are deduced from thetav and r on the model grid
+!! without orography.
+!! The 3D reference state is computed by SET_REF
+!!
+!! * The total mass of dry air is computed by TOTAL_DMASS
+!!
+!! - writes the DESFM file,
+!!
+!! - writes the LFIFM file .
+!!
+!! EXTERNAL
+!! --------
+!! DEFAULT_DESFM : to set default values for variables which can be
+!! contained in DESFM file
+!! DEFAULT_EXPRE : to set default values for other global variables
+!! which can be contained in namelist-part of EXPRE file
+!! Module MODE_GRIDPROJ : contains conformal projection routines
+!! SM_GRIDPROJ : to compute some grid variables, in
+!! case of conformal projection.
+!! Module MODE_GRIDCART : contains cartesian geometry routines
+!! SM_GRIDCART : to compute some grid variables, in
+!! case of cartesian geometry.
+!! SET_RSOU : to initialize mass fields from a radiosounding
+!! SET_CSTN : to initialize mass fields from a vertical profile of
+!! n layers of Nv=cste
+!! SET_REF : to compute rhoJ
+!! RESSURE_IN_PREP : to apply an anelastic correction in the case of
+!! non-vanishing orography
+!! IO_File_open : to open a FM-file (DESFM + LFIFM)
+!! WRITE_DESFM : to write the DESFM file
+!! WRI_LFIFM : to write the LFIFM file
+!! IO_File_close : to close a FM-file (DESFM + LFIFM)
+!!
+!! MXM,MYM,MZM : Shuman operators
+!! WGUESS : to compute W with the continuity equation from
+!! the U,V values
+!!
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : contains parameters
+!! Module MODD_DIM1 : contains dimensions
+!! Module MODD_CONF : contains configuration variables for
+!! all models
+!! Module MODD_CST : contains physical constants
+!! Module MODD_GRID : contains grid variables for all models
+!! Module MODD_GRID1 : contains grid variables
+!! Module MODD_TIME : contains time variables for all models
+!! Module MODD_TIME1 : contains time variables
+!! Module MODD_REF : contains reference state variables for
+!! all models
+!! Module MODD_REF1 : contains reference state variables
+!! Module MODD_LUNIT : contains variables which concern names
+!! and logical unit numbers of files for all models
+!! Module MODD_FIELD1 : contains prognostics variables
+!! Module MODD_GR_FIELD1 : contains the surface prognostic variables
+!! Module MODD_LSFIELD1 : contains Larger Scale fields
+!! Module MODD_DYN1 : contains dynamic control variables for model 1
+!! Module MODD_LBC1 : contains lbc control variables for model 1
+!!
+!!
+!! Module MODN_CONF1 : contains configuration variables for model 1
+!! and the NAMELIST list
+!! Module MODN_LUNIT1 : contains variables which concern names
+!! and logical unit numbers of files and
+!! the NAMELIST list
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of MESO-NH documentation (program PREP_IDEAL_CASE)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/05/94
+!! updated V. Ducrocq 27/06/94
+!! updated P.M. 27/07/94
+!! updated V. Ducrocq 23/08/94
+!! updated V. Ducrocq 01/09/94
+!! namelist changes J. Stein 26/10/94
+!! namelist changes J. Stein 04/11/94
+!! remove the second step of the geostrophic balance 14/11/94 (J.Stein)
+!! add grid stretching in the z direction + Larger scale fields +
+!! cleaning 6/12/94 (J.Stein)
+!! periodize the orography and the grid sizes in the periodic case
+!! 19/12/94 (J.Stein)
+!! correct a bug in the Larger Scale Fields initialization
+!! 19/12/94 (J.Stein)
+!! add the vertical grid stretching 02/01/95 (J. Stein)
+!! Total mass of dry air computation 02/01/95 (J.P.Lafore)
+!! add the 1D switch 13/01/95 (J. Stein)
+!! enforce a regular vertical grid if desired 18/01/95 (J. Stein)
+!! add the tdtcur initialization 26/01/95 (J. Stein)
+!! bug in the test of the type of RS localization 25/02/95 (J. Stein)
+!! remove R from the historical variables 16/03/95 (J. Stein)
+!! error on the grid stretching 30/06/95 (J. Stein)
+!! add the soil fields 01/09/95 (S.Belair)
+!! change the streching function and the wind guess
+!! (J. Stein and V.Masson) 21/09/95
+!! reset to FALSE LUSERC,..,LUSERH 12/12/95 (J. Stein)
+!! enforce the RS localization in 1D and 2D config.
+!! + add the 'TSZ0' option for the soil variables 28/01/96 (J. Stein)
+!! initialization of domain from center point 31/01/96 (V. Masson)
+!! add the constant file reading 05/02/96 (J. Stein)
+!! enter vertical model levels values 20/10/95 (T.Montmerle)
+!! add LFORCING option 19/02/96 (K. Suhre)
+!! modify structure of NAM_CONF_PRE 20/02/96 (J.-P. Pinty)
+!! default of the domain center when use of pgd file 12/03/96 (V. Masson)
+!! change the surface initialization 20/03/96 ( Stein,
+!! Bougeault, Kastendeutsch )
+!! change the DEFAULT_DESFMN CALL 17/04/96 ( Lafore )
+!! set the STORAGE_TYPE to 'TT' (a single instant) 30/04/96 (Stein,
+!! Jabouille)
+!! new wguess to spread the divergence 15/05/96 (Stein)
+!! set LTHINSHELL to TRUE + return to the old wguess 29/08/96 (Stein)
+!! MY_NAME and DAD_NAME writing for nesting 30/07/96 (Lafore)
+!! MY_NAME and DAD_NAME reading in pgd file 26/09/96 (Masson)
+!! and reading of pgd grid in a new routine
+!! XXHAT and XYHAT are set to 0. at origine point 02/10/96 (Masson)
+!! add LTHINSHELL in namelist NAM_CONF_PRE 08/10/96 (Masson)
+!! restores use of TS and T2 26/11/96 (Masson)
+!! value XUNDEF for soil and vegetation fields on sea 27/11/96 (Masson)
+!! use of HUG and HU2 in both ISBA and TSZ0 cases 04/12/96 (Masson)
+!! add initialization of chemical variables 06/08/96 (K. Suhre)
+!! add MANUAL option for the terrain elevation 12/12/96 (J.-P. Pinty)
+!! set DATA instead of MANUAL for the terrain
+!! elevation option
+!! add new anelastic equations' systems 29/06/97 (Stein)
+!! split mode_lfifm_pgd 29/07/97 (Masson)
+!! add directional z0 and subgrid scale orography 31/07/97 (Masson)
+!! separates surface treatment in PREP_IDEAL_SURF 15/03/99 (Masson)
+!! new PGD fields allocations 15/03/99 (Masson)
+!! iterative call to pressure solver 15/03/99 (Masson)
+!! removes TSZ0 case 04/01/00 (Masson)
+!! parallelization 18/06/00 (Pinty)
+!! adaptation for patch approach 02/07/00 (Solmon/Masson)
+!! bug in W LB field on Y direction 05/03/01 (Stein)
+!! add module MODD_NSV for NSV variable 01/02/01 (D. Gazen)
+!! allow namelists in different orders 15/10/01 (I. Mallet)
+!! allow LUSERC and LUSERI in 1D configuration 05/06/02 (P. Jabouille)
+!! add ZUVTHLMR case (move in set_rsou latter) 05/12/02 Jabouille/Masson
+!! move LHORELAX_SV (after INI_NSV) 30/04/04 (Pinty)
+!! Correction Parallel bug IBEG & IDEND evalution 13/11/08 J.Escobar
+!! add the option LSHIFT for interpolation of 26/10/10 (G.Tanguy)
+!! correction for XHAT & parallelizarion of ZSDATA 23/09/11 J.Escobar
+!! the vertical profile (as in PREP_REAL_CASE)
+!! add use MODI of SURFEX routines 10/10/111 J.Escobar
+!!
+!! For 2D modeling:
+!! Initialization of ADVFRC profiles (SET_ADVFRC) 06/2010 (P.Peyrille)
+!! when LDUMMY(2)=T in PRE_IDEA1.nam
+!! USE MODDB_ADVFRC_n for grid-nesting 02*2012 (M. Tomasini)
+!! LBOUSS in MODD_REF 07/2013 (C.Lac)
+!! Correction for ZS in PGD file 04/2014 (G. TANGUY)
+!! Bug : remove NC WRITE_HGRID 05/2014 (S. Bielli via J.Escobar )
+!! BUG if ZFRC and ZFRC_ADV or ZFRC_REL are used together 11/2014 (G. Delautier)
+!! Bug : detected with cray compiler ,
+!! missing '&' in continuation string 3/12/2014 J.Escobar
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
+!! 01/2018 (G.Delautier) SURFEX 8.1
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
+! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! F. Auguste 02/2021: add IBM
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! Jean-Luc Redelsperger 03/2021: ocean LES case
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS ! Declarative modules
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_DIM_n
+USE MODD_CONF
+USE MODD_CST
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS
+USE MODD_METRICS_n
+USE MODD_PGDDIM
+USE MODD_PGDGRID
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_REF
+USE MODD_REF_n
+USE MODD_LUNIT
+USE MODD_FIELD_n
+USE MODD_DYN_n
+USE MODD_LBC_n
+USE MODD_LSFIELD_n
+USE MODD_PARAM_n
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM, LUSECHAQ, LUSECHIC, LCH_PH, LCH_INIT_FIELD
+USE MODD_CH_AEROSOL,ONLY: LORILAM, CORGANIC, LVARSIGI, LVARSIGJ, LINITPM, XINIRADIUSI, &
+ XINIRADIUSJ, XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT
+USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN
+USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT
+USE MODD_VAR_ll, ONLY: NPROC
+USE MODD_LUNIT, ONLY: TLUOUT0, TOUTDATAFILE
+USE MODD_LUNIT_n
+USE MODD_IO, ONLY: TFILE_DUMMY, TFILE_OUTPUTLISTING
+USE MODD_CONF_n
+USE MODD_NSV, ONLY: NSV
+use modd_precision, only: LFIINT, MNHREAL_MPI, MNHTIME
+!
+USE MODN_BLANK_n
+!
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
+USE MODE_THERMO
+USE MODE_POS
+USE MODE_GRIDCART ! Executive modules
+USE MODE_GRIDPROJ
+USE MODE_GATHER_ll
+USE MODE_IO, only: IO_Config_set, IO_Init, IO_Pack_set
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars
+USE MODE_MSG
+!
+USE MODI_DEFAULT_DESFM_n ! Interface modules
+USE MODI_DEFAULT_EXPRE
+USE MODI_IBM_INIT_LS
+USE MODI_READ_HGRID
+USE MODI_SHUMAN
+USE MODI_SET_RSOU
+USE MODI_SET_CSTN
+USE MODI_SET_FRC
+USE MODI_PRESSURE_IN_PREP
+USE MODI_WRITE_DESFM_n
+USE MODI_WRITE_LFIFM_n
+USE MODI_METRICS
+USE MODI_UPDATE_METRICS
+USE MODI_SET_REF
+USE MODI_SET_PERTURB
+USE MODI_TOTAL_DMASS
+USE MODI_CH_INIT_FIELD_n
+USE MODI_INI_NSV
+USE MODI_READ_PRE_IDEA_NAM_n
+USE MODI_ZSMT_PIC
+USE MODI_ZSMT_PGD
+USE MODI_READ_VER_GRID
+USE MODI_READ_ALL_NAMELISTS
+USE MODI_PGD_GRID_SURF_ATM
+USE MODI_SPLIT_GRID
+USE MODI_PGD_SURF_ATM
+USE MODI_ICE_ADJUST_BIS
+USE MODI_WRITE_PGD_SURF_ATM_n
+USE MODI_PREP_SURF_MNH
+!
+!JUAN
+USE MODE_SPLITTINGZ_ll
+USE MODD_SUB_MODEL_n
+USE MODE_MNH_TIMING
+USE MODN_CONFZ
+!JUAN
+USE MODI_TH_R_FROM_THL_RT_3D
+!
+USE MODI_VERSION
+USE MODI_INIT_PGD_SURF_ATM
+USE MODI_WRITE_SURF_ATM_N
+USE MODD_MNH_SURFEX_n
+! Modif ADVFRC
+USE MODD_2D_FRC
+USE MODD_ADVFRC_n ! Modif for grid-nesting
+USE MODI_SETADVFRC
+USE MODD_RELFRC_n ! Modif for grid-nesting
+USE MODI_SET_RELFRC
+!
+USE MODI_INI_CST
+USE MODI_INI_NEB
+USE MODI_WRITE_HGRID
+USE MODD_MPIF
+USE MODD_VAR_ll
+USE MODD_IO, ONLY: TFILEDATA,TFILE_SURFEX
+!
+USE MODE_MPPDB
+!
+USE MODD_GET_n
+!
+USE MODN_CONFIO, ONLY : NAM_CONFIO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of global variables not declared in the modules
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XJ ! Jacobian
+REAL :: XLATCEN=XUNDEF, XLONCEN=XUNDEF ! latitude and longitude of the center of
+ ! the domain for initialization. This
+ ! point is vertical vorticity point
+ ! ------------------------
+REAL :: XDELTAX=0.5E4, XDELTAY=0.5E4 ! horizontal mesh lengths
+ ! used to determine XXHAT,XYHAT
+!
+INTEGER :: NLUPRE,NLUOUT ! Logical unit numbers for EXPRE file
+ ! and for output_listing file
+INTEGER :: NRESP ! return code in FM routines
+INTEGER :: NTYPE ! type of file (cpio or not)
+INTEGER(KIND=LFIINT) :: NNPRAR ! number of articles predicted in the LFIFM file
+LOGICAL :: GFOUND ! Return code when searching namelist
+!
+INTEGER :: JLOOP,JILOOP,JJLOOP ! Loop indexes
+!
+INTEGER :: NIB,NJB,NKB ! Begining useful area in x,y,z directions
+INTEGER :: NIE,NJE ! Ending useful area in x,y directions
+INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions
+CHARACTER(LEN=4) :: CIDEAL ='CSTN' ! kind of idealized fields
+ ! 'CSTN' : Nv=cste case
+ ! 'RSOU' : radiosounding case
+CHARACTER(LEN=4) :: CZS ='FLAT' ! orography selector
+ ! 'FLAT' : zero orography
+ ! 'SINE' : sine-shaped orography
+ ! 'BELL' : bell-shaped orography
+REAL :: XHMAX=XUNDEF ! Maximum height for orography
+REAL :: NEXPX=3,NEXPY=1 ! Exponents for orography in case of CZS='SINE'
+REAL :: XAX= 1.E4, XAY=1.E4 ! Widths for orography in case CZS='BELL'
+ ! along x and y
+INTEGER :: NIZS = 5, NJZS = 5 ! Localization of the center in
+ ! case CZS ='BELL'
+!
+!* 0.1.1 Declarations of local variables for N=cste and
+! radiosounding cases :
+!
+INTEGER :: NYEAR,NMONTH,NDAY ! year, month and day in EXPRE file
+REAL :: XTIME ! time in EXPRE file
+LOGICAL :: LPERTURB =.FALSE. ! Logical to add a perturbation to
+ ! a basic state
+LOGICAL :: LGEOSBAL =.FALSE. ! Logical to satisfy the geostrophic
+ ! balance
+ ! .TRUE. for geostrophic balance
+ ! .FALSE. to ignore this balance
+LOGICAL :: LSHIFT =.FALSE. ! flag to perform vertical shift or not.
+CHARACTER(LEN=3) :: CFUNU ='ZZZ' ! CHARACTER STRING for variation of
+ ! U in y direction
+ ! 'ZZZ' : U = U(Z)
+ ! 'Y*Z' : U = F(Y) * U(Z)
+ ! 'Y,Z' : U = G(Y,Z)
+CHARACTER(LEN=3) :: CFUNV ='ZZZ' ! CHARACTER STRING for variation of
+ ! V in x direction
+ ! 'ZZZ' : V = V(Z)
+ ! 'Y*Z' : V = F(X) * V(Z)
+ ! 'Y,Z' : V = G(X,Z)
+CHARACTER(LEN=6) :: CTYPELOC='IJGRID' ! Type of informations used to give the
+ ! localization of vertical profile
+ ! 'IJGRID' for (i,j) point on index space
+ ! 'XYHATM' for (x,y) coordinates on
+ ! conformal or cartesian plane
+ ! 'LATLON' for (latitude,longitude) on
+ ! spherical earth
+REAL :: XLATLOC= 45., XLONLOC=0.
+ ! Latitude and longitude of the vertical
+ ! profile localization (used in case
+ ! CTYPELOC='LATLON')
+REAL :: XXHATLOC=2.E4, XYHATLOC=2.E4
+ ! (x,y) of the vertical profile
+ ! localization (used in cases
+ ! CTYPELOC='LATLON' and 'XYHATM')
+INTEGER, DIMENSION(1) :: NILOC=4, NJLOC=4
+ ! (i,j) of the vertical profile
+ ! localization
+!
+!
+REAL,DIMENSION(:,:,:),ALLOCATABLE :: XCORIOZ ! Coriolis parameter (this
+ ! is exceptionnaly a 3D array
+ ! for computing needs)
+!
+!
+!* 0.1.2 Declarations of local variables used when a PhysioGraphic Data
+! file is used :
+!
+INTEGER :: JSV ! loop index on scalar var.
+CHARACTER(LEN=28) :: CPGD_FILE=' ' ! Physio-Graphic Data file name
+LOGICAL :: LREAD_ZS = .TRUE., & ! switch to use orography
+ ! coming from the PGD file
+ LREAD_GROUND_PARAM = .TRUE. ! switch to use soil parameters
+ ! useful for the soil scheme
+ ! coming from the PGD file
+
+INTEGER :: NSLEVE =12 ! number of iteration for smooth orography
+REAL :: XSMOOTH_ZS = XUNDEF ! optional uniform smooth orography for SLEVE coordinate
+CHARACTER(LEN=28) :: YPGD_NAME, YPGD_DAD_NAME ! general information
+CHARACTER(LEN=2) :: YPGD_TYPE
+!
+INTEGER :: IINFO_ll ! return code of // routines
+TYPE(LIST_ll), POINTER :: TZ_FIELDS_ll ! list of metric coefficient fields
+!
+INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the
+INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
+INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
+INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
+INTEGER :: IBEG,IEND,IXOR,IXDIM,IYOR,IYDIM,ILBX,ILBY
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll, ZYHAT_ll
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZTHL,ZT,ZRT,ZFRAC_ICE,&
+ ZEXN,ZLVOCPEXN,ZLSOCPEXN,ZCPH, &
+ ZRSATW, ZRSATI
+ ! variables for adjustement
+REAL :: ZDIST
+!
+!JUAN TIMING
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2, ZEND, ZTOT
+CHARACTER :: YMI
+INTEGER :: IMI
+!JUAN TIMING
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZS_ll
+INTEGER :: IJ
+!
+REAL :: ZZS_MAX, ZZS_MAX_ll
+INTEGER :: IJPHEXT
+!
+TYPE(TFILEDATA),POINTER :: TZEXPREFILE => NULL()
+!
+!
+!* 0.2 Namelist declarations
+!
+NAMELIST/NAM_CONF_PRE/ LTHINSHELL,LCARTESIAN, &! Declarations in MODD_CONF
+ LPACK, &!
+ NVERB,CIDEAL,CZS, &!+global variables initialized
+ LBOUSS,LOCEAN,LPERTURB, &! at their declarations
+ LFORCING,CEQNSYS, &! at their declarations
+ LSHIFT,L2D_ADV_FRC,L2D_REL_FRC, &
+ NHALO , JPHEXT
+NAMELIST/NAM_GRID_PRE/ XLON0,XLAT0, & ! Declarations in MODD_GRID
+ XBETA,XRPK, &
+ XLONORI,XLATORI
+NAMELIST/NAM_GRIDH_PRE/ XLATCEN,XLONCEN, & ! local variables initialized
+ XDELTAX,XDELTAY, & ! at their declarations
+ XHMAX,NEXPX,NEXPY, &
+ XAX,XAY,NIZS,NJZS
+NAMELIST/NAM_VPROF_PRE/LGEOSBAL, CFUNU,CFUNV, &! global variables initialized
+ CTYPELOC,XLATLOC,XLONLOC, &! at their declarations
+ XXHATLOC,XYHATLOC,NILOC,NJLOC
+NAMELIST/NAM_REAL_PGD/CPGD_FILE, & ! Physio-Graphic Data file
+ ! name
+ LREAD_ZS, & ! switch to use orography
+ ! coming from the PGD file
+ LREAD_GROUND_PARAM
+NAMELIST/NAM_SLEVE/NSLEVE, XSMOOTH_ZS
+!
+!* 0.3 Auxillary Namelist declarations
+!
+NAMELIST/NAM_AERO_PRE/ LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ, &
+ XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT, &
+ LDUST, LSALT, CRGUNITD, CRGUNITS,&
+ NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,&
+ XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, &
+ NMODE_SLT
+!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. PROLOGUE
+! --------
+CALL MPPDB_INIT()
+!
+CALL GOTO_MODEL(1)
+!
+CALL IO_Init()
+NULLIFY(TZ_FIELDS_ll)
+CALL VERSION
+CPROGRAM='IDEAL '
+!
+!JUAN TIMING
+ XT_START = 0.0_MNHTIME
+ XT_STORE = 0.0_MNHTIME
+!
+ CALL SECOND_MNH2(ZEND)
+!
+!JUAN TIMING
+!
+!* 1. INITIALIZE PHYSICAL CONSTANTS :
+! ------------------------------
+!
+NVERB = 5
+CALL INI_CST
+CALL INI_NEB
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. SET DEFAULT VALUES :
+! --------------------
+!
+!
+!* 2.1 For variables in DESFM file
+!
+CALL ALLOC_FIELD_SCALARS()
+!
+CALL DEFAULT_DESFM_n(1)
+!
+CSURF = "NONE"
+!
+!
+!* 2.2 For other global variables in EXPRE file
+!
+CALL DEFAULT_EXPRE
+!-------------------------------------------------------------------------------
+!
+!* 3. READ THE EXPRE FILE :
+! --------------------
+!
+!* 3.1 initialize logical unit numbers (EXPRE and output-listing files)
+! and open these files :
+!
+!
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING1','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
+NLUOUT = TLUOUT0%NLU
+!Set output files for PRINT_MSG
+TLUOUT => TLUOUT0
+TFILE_OUTPUTLISTING => TLUOUT0
+!
+CALL IO_File_add2list(TZEXPREFILE,'PRE_IDEA1.nam','NML','READ')
+CALL IO_File_open(TZEXPREFILE)
+NLUPRE=TZEXPREFILE%NLU
+!
+!* 3.2 read in NLUPRE the namelist informations
+!
+WRITE(NLUOUT,FMT=*) 'attempt to read ',TRIM(TZEXPREFILE%CNAME),' file'
+CALL POSNAM(NLUPRE,'NAM_REAL_PGD',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_REAL_PGD)
+!
+!
+CALL POSNAM(NLUPRE,'NAM_CONF_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONF_PRE)
+!JUANZ
+CALL POSNAM(NLUPRE,'NAM_CONFZ',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFZ)
+!JUANZ
+CALL POSNAM(NLUPRE,'NAM_CONFIO',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFIO)
+CALL IO_Config_set()
+CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE)
+CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
+CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
+CALL POSNAM(NLUPRE,'NAM_BLANKN',GFOUND,NLUOUT)
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=NLUPRE,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
+CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
+CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
+CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
+!
+CALL INI_FIELD_LIST(1)
+!
+CALL INI_FIELD_SCALARS()
+!
+IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
+ ! open the PGD_FILE
+ CALL IO_File_add2list(TPGDFILE,TRIM(CPGD_FILE),'PGD','READ',KLFINPRAR=NNPRAR,KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TPGDFILE)
+
+ ! read the grid in the PGD file
+ CALL IO_Field_read(TPGDFILE,'IMAX', NIMAX)
+ CALL IO_Field_read(TPGDFILE,'JMAX', NJMAX)
+ CALL IO_Field_read(TPGDFILE,'JPHEXT',IJPHEXT)
+
+ IF ( CPGD_FILE /= CINIFILEPGD) THEN
+ WRITE(NLUOUT,FMT=*) ' WARNING : in PRE_IDEA1.nam, in NAM_LUNITn you&
+ & have CINIFILEPGD= ',CINIFILEPGD
+ WRITE(NLUOUT,FMT=*) ' whereas in NAM_REAL_PGD you have CPGD_FILE = '&
+ ,CPGD_FILE
+ WRITE(NLUOUT,FMT=*) ' '
+ WRITE(NLUOUT,FMT=*) ' CINIFILEPGD HAS BEEN SET TO ',CPGD_FILE
+ CINIFILEPGD=CPGD_FILE
+ END IF
+ IF ( IJPHEXT .NE. JPHEXT ) THEN
+ WRITE(NLUOUT,FMT=*) ' PREP_IDEAL_CASE : JPHEXT in PRE_IDEA1.nam/NAM_CONF_PRE ( or default value )&
+ & JPHEXT=',JPHEXT
+ WRITE(NLUOUT,FMT=*) ' different from PGD files=', CINIFILEPGD,' value JPHEXT=',IJPHEXT
+ WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','')
+ !WRITE(NLUOUT,FMT=*) ' JPHEXT HAS BEEN SET TO ', IJPHEXT
+ !IJPHEXT = JPHEXT
+ END IF
+END IF
+!
+NIMAX_ll=NIMAX !! _ll variables are global variables
+NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file
+!
+!* 3.3 check some parameters:
+!
+L1D=.FALSE. ; L2D=.FALSE.
+!
+IF ((NIMAX == 1).OR.(NJMAX == 1)) THEN
+ L2D=.TRUE.
+ NJMAX_ll=1
+ NIMAX_ll=MAX(NIMAX,NJMAX)
+ WRITE(NLUOUT,FMT=*) ' NJMAX HAS BEEN SET TO 1 SINCE 2D INITIAL FILE IS REQUIRED &
+ & (L2D=TRUE) )'
+END IF
+!
+IF ((NIMAX == 1).AND.(NJMAX == 1)) THEN
+ L1D=.TRUE.
+ NIMAX_ll = 1
+ NJMAX_ll = 1
+ WRITE(NLUOUT,FMT=*) ' 1D INITIAL FILE IS REQUIRED (L1D=TRUE) '
+END IF
+!
+IF(.NOT. L1D) THEN
+ LHORELAX_UVWTH=.TRUE.
+ LHORELAX_RV=.TRUE.
+ENDIF
+!
+NRIMX= MIN(JPRIMMAX,NIMAX_ll/2)
+!
+IF (L2D) THEN
+ NRIMY=0
+ELSE
+ NRIMY= MIN(JPRIMMAX,NJMAX_ll/2)
+END IF
+!
+IF (L1D) THEN
+ NRIMX=0
+ NRIMY=0
+END IF
+!
+IF (L1D .AND. ( LPERTURB .OR. LGEOSBAL .OR. &
+ (.NOT. LCARTESIAN ) .OR. (.NOT. LTHINSHELL) ))THEN
+ LGEOSBAL = .FALSE.
+ LPERTURB = .FALSE.
+ LCARTESIAN = .TRUE.
+ LTHINSHELL = .TRUE.
+ WRITE(NLUOUT,FMT=*) ' LGEOSBAL AND LPERTURB HAVE BEEN SET TO FALSE &
+ & AND LCARTESIAN AND LTHINSHELL TO TRUE &
+ & SINCE 1D INITIAL FILE IS REQUIRED (L1D=TRUE)'
+END IF
+!
+IF (LGEOSBAL .AND. LSHIFT ) THEN
+ LSHIFT=.FALSE.
+ WRITE(NLUOUT,FMT=*) ' LSHIFT HAS BEEN SET TO FALSE SINCE &
+ & LGEOSBAL=.TRUE. IS REQUIRED '
+END IF
+!
+!* 3.4 compute the number of moist variables :
+!
+IF (.NOT.LUSERV) THEN
+ LUSERV = .TRUE.
+ WRITE(NLUOUT,FMT=*) ' LUSERV HAS BEEN RESET TO TRUE, SINCE A MOIST VARIABLE &
+ & IS PRESENT IN EXPRE FILE (CIDEAL = RSOU OR CSTN)'
+END IF
+!
+IF((LUSERI .OR. LUSERC).AND. (CIDEAL /= 'RSOU')) THEN
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','use of hydrometeors is only allowed in RSOU case')
+ENDIF
+IF (LUSERI) THEN
+ LUSERC =.TRUE.
+ LUSERR =.TRUE.
+ LUSERI =.TRUE.
+ LUSERS =.TRUE.
+ LUSERG =.TRUE.
+ LUSERH =.FALSE.
+ CCLOUD='ICE3'
+ELSEIF(LUSERC) THEN
+ LUSERR =.FALSE.
+ LUSERI =.FALSE.
+ LUSERS =.FALSE.
+ LUSERG =.FALSE.
+ LUSERH =.FALSE.
+ CCLOUD='REVE'
+ELSE
+ LUSERC =.FALSE.
+ LUSERR =.FALSE.
+ LUSERI =.FALSE.
+ LUSERS =.FALSE.
+ LUSERG =.FALSE.
+ LUSERH =.FALSE.
+ LHORELAX_RC=.FALSE.
+ LHORELAX_RR=.FALSE.
+ LHORELAX_RI=.FALSE.
+ LHORELAX_RS=.FALSE.
+ LHORELAX_RG=.FALSE.
+ LHORELAX_RH=.FALSE.
+ CCLOUD='NONE'
+!
+END IF
+!
+NRR=0
+IF (LUSERV) THEN
+ NRR=NRR+1
+ IDX_RVT = NRR
+END IF
+IF (LUSERC) THEN
+ NRR=NRR+1
+ IDX_RCT = NRR
+END IF
+IF (LUSERR) THEN
+ NRR=NRR+1
+ IDX_RRT = NRR
+END IF
+IF (LUSERI) THEN
+ NRR=NRR+1
+ IDX_RIT = NRR
+END IF
+IF (LUSERS) THEN
+ NRR=NRR+1
+ IDX_RST = NRR
+END IF
+IF (LUSERG) THEN
+ NRR=NRR+1
+ IDX_RGT = NRR
+END IF
+IF (LUSERH) THEN
+ NRR=NRR+1
+ IDX_RHT = NRR
+END IF
+!
+! NRR=4 for RSOU case because RI and Rc always computed
+IF (CIDEAL == 'RSOU' .AND. NRR < 4 ) NRR=4
+!
+!
+!* 3.5 Chemistry
+!
+IF (LORILAM .OR. LCH_INIT_FIELD) THEN
+ LUSECHEM = .TRUE.
+ IF (LORILAM) THEN
+ CORGANIC = "MPMPO"
+ LVARSIGI = .TRUE.
+ LVARSIGJ = .TRUE.
+ END IF
+END IF
+! initialise NSV_* variables
+CALL INI_NSV(1)
+LHORELAX_SV(:)=.FALSE.
+IF(.NOT. L1D) LHORELAX_SV(1:NSV)=.TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. ALLOCATE MEMORY FOR ARRAYS :
+! ----------------------------
+!
+!* 4.1 Vertical Spatial grid
+!
+CALL READ_VER_GRID(TZEXPREFILE)
+!
+!* 4.2 Initialize parallel variables and compute array's dimensions
+!
+!
+IF(LGEOSBAL) THEN
+ CALL SET_SPLITTING_ll('XSPLITTING') ! required for integration of thermal wind balance
+ELSE
+ CALL SET_SPLITTING_ll('BSPLITTING')
+ENDIF
+CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DAD0_ll()
+CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
+CALL IO_Pack_set(L1D,L2D,LPACK)
+CALL SET_LBX_ll(CLBCX(1), 1)
+CALL SET_LBY_ll(CLBCY(1), 1)
+CALL SET_XRATIO_ll(1, 1)
+CALL SET_YRATIO_ll(1, 1)
+CALL SET_XOR_ll(1, 1)
+CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
+CALL SET_YOR_ll(1, 1)
+CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
+CALL SET_DAD_ll(0, 1)
+CALL INI_PARAZ_ll(IINFO_ll)
+!
+! sizes of arrays of the extended sub-domain
+!
+CALL GET_DIM_EXT_ll('B',NIU,NJU)
+CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
+CALL GET_INDICE_ll(NIB,NJB,NIE,NJE)
+CALL GET_OR_ll('B',IXOR,IYOR)
+NKB=1+JPVEXT
+NKU=NKMAX+2*JPVEXT
+!
+!* 4.3 Global variables absent from the modules :
+!
+ALLOCATE(XJ(NIU,NJU,NKU))
+SELECT CASE(CIDEAL)
+ CASE('RSOU','CSTN')
+ IF (LGEOSBAL) ALLOCATE(XCORIOZ(NIU,NJU,NKU)) ! exceptionally a 3D array
+ CASE DEFAULT ! undefined preinitialization
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CIDEAL is not correctly defined')
+END SELECT
+!
+!* 4.4 Prognostic variables at M instant (module MODD_FIELD1):
+!
+ALLOCATE(XUT(NIU,NJU,NKU))
+ALLOCATE(XVT(NIU,NJU,NKU))
+ALLOCATE(XWT(NIU,NJU,NKU))
+ALLOCATE(XTHT(NIU,NJU,NKU))
+ALLOCATE(XPABST(NIU,NJU,NKU))
+ALLOCATE(XRT(NIU,NJU,NKU,NRR))
+ALLOCATE(XSVT(NIU,NJU,NKU,NSV))
+!
+!* 4.5 Grid variables (module MODD_GRID1 and MODD_METRICS1):
+!
+ALLOCATE(XMAP(NIU,NJU))
+ALLOCATE(XLAT(NIU,NJU))
+ALLOCATE(XLON(NIU,NJU))
+ALLOCATE(XDXHAT(NIU),XDYHAT(NJU))
+IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(XZS(NIU,NJU))
+IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(ZZS_ll(NIMAX_ll))
+IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(XZSMT(NIU,NJU))
+ALLOCATE(XZZ(NIU,NJU,NKU))
+!
+ALLOCATE(XDXX(NIU,NJU,NKU))
+ALLOCATE(XDYY(NIU,NJU,NKU))
+ALLOCATE(XDZX(NIU,NJU,NKU))
+ALLOCATE(XDZY(NIU,NJU,NKU))
+ALLOCATE(XDZZ(NIU,NJU,NKU))
+!
+!* 4.6 Reference state variables (modules MODD_REF and MODD_REF1):
+!
+ALLOCATE(XRHODREFZ(NKU),XTHVREFZ(NKU))
+XTHVREFZ(:)=0.0
+IF (LCOUPLES) THEN
+ ! Arrays for reference state different in ocean and atmosphere
+ ALLOCATE(XRHODREFZO(NKU),XTHVREFZO(NKU))
+ XTHVREFZO(:)=0.0
+END IF
+IF(CEQNSYS == 'DUR') THEN
+ ALLOCATE(XRVREF(NIU,NJU,NKU))
+ELSE
+ ALLOCATE(XRVREF(0,0,0))
+END IF
+ALLOCATE(XRHODREF(NIU,NJU,NKU),XTHVREF(NIU,NJU,NKU),XEXNREF(NIU,NJU,NKU))
+ALLOCATE(XRHODJ(NIU,NJU,NKU))
+!
+!* 4.7 Larger Scale fields (modules MODD_LSFIELD1):
+!
+ALLOCATE(XLSUM(NIU,NJU,NKU))
+ALLOCATE(XLSVM(NIU,NJU,NKU))
+ALLOCATE(XLSWM(NIU,NJU,NKU))
+ALLOCATE(XLSTHM(NIU,NJU,NKU))
+IF ( NRR >= 1) THEN
+ ALLOCATE(XLSRVM(NIU,NJU,NKU))
+ELSE
+ ALLOCATE(XLSRVM(0,0,0))
+ENDIF
+!
+! allocate lateral boundary field used for coupling
+!
+IF ( L1D) THEN ! 1D case
+!
+ NSIZELBX_ll=0
+ NSIZELBXU_ll=0
+ NSIZELBY_ll=0
+ NSIZELBYV_ll=0
+ NSIZELBXTKE_ll=0
+ NSIZELBXR_ll=0
+ NSIZELBXSV_ll=0
+ NSIZELBYTKE_ll=0
+ NSIZELBYR_ll=0
+ NSIZELBYSV_ll=0
+ ALLOCATE(XLBXUM(0,0,0))
+ ALLOCATE(XLBYUM(0,0,0))
+ ALLOCATE(XLBXVM(0,0,0))
+ ALLOCATE(XLBYVM(0,0,0))
+ ALLOCATE(XLBXWM(0,0,0))
+ ALLOCATE(XLBYWM(0,0,0))
+ ALLOCATE(XLBXTHM(0,0,0))
+ ALLOCATE(XLBYTHM(0,0,0))
+ ALLOCATE(XLBXTKEM(0,0,0))
+ ALLOCATE(XLBYTKEM(0,0,0))
+ ALLOCATE(XLBXRM(0,0,0,0))
+ ALLOCATE(XLBYRM(0,0,0,0))
+ ALLOCATE(XLBXSVM(0,0,0,0))
+ ALLOCATE(XLBYSVM(0,0,0,0))
+!
+ELSEIF( L2D ) THEN ! 2D case (not yet parallelized)
+!
+ CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
+ IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
+ IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
+ NSIZELBY_ll=0
+ NSIZELBYV_ll=0
+ NSIZELBYTKE_ll=0
+ NSIZELBYR_ll=0
+ NSIZELBYSV_ll=0
+ ALLOCATE(XLBYUM(0,0,0))
+ ALLOCATE(XLBYVM(0,0,0))
+ ALLOCATE(XLBYWM(0,0,0))
+ ALLOCATE(XLBYTHM(0,0,0))
+ ALLOCATE(XLBYTKEM(0,0,0))
+ ALLOCATE(XLBYRM(0,0,0,0))
+ ALLOCATE(XLBYSVM(0,0,0,0))
+ !
+ IF ( LHORELAX_UVWTH ) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBX_ll=2*NRIMX+2
+ ! NSIZELBXU_ll=2*NRIMX+2
+ ALLOCATE(XLBXUM(IISIZEXFU,NJU,NKU))
+ ALLOCATE(XLBXVM(IISIZEXF,NJU,NKU))
+ ALLOCATE(XLBXWM(IISIZEXF,NJU,NKU))
+ ALLOCATE(XLBXTHM(IISIZEXF,NJU,NKU))
+! =======
+ NSIZELBX_ll=2*NRIMX+2*JPHEXT
+ NSIZELBXU_ll=2*NRIMX+2*JPHEXT
+ ! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,NJU,NKU))
+ ! ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,NJU,NKU))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
+ ELSE
+ NSIZELBX_ll= 2*JPHEXT ! 2
+ NSIZELBXU_ll=2*(JPHEXT+1) ! 4
+ ALLOCATE(XLBXUM(NSIZELBXU_ll,NJU,NKU))
+ ALLOCATE(XLBXVM(NSIZELBX_ll,NJU,NKU))
+ ALLOCATE(XLBXWM(NSIZELBX_ll,NJU,NKU))
+ ALLOCATE(XLBXTHM(NSIZELBX_ll,NJU,NKU))
+ END IF
+ !
+ IF ( NRR > 0 ) THEN
+ IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
+ .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
+ ) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBXR_ll=2* NRIMX+2
+ ALLOCATE(XLBXRM(IISIZEXF,NJU,NKU,NRR))
+! =======
+ NSIZELBXR_ll=2*NRIMX+2*JPHEXT
+ ! ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,NJU,NKU,NRR))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
+ ELSE
+ NSIZELBXR_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXRM(NSIZELBXR_ll,NJU,NKU,NRR))
+ ENDIF
+ ELSE
+ NSIZELBXR_ll=0
+ ALLOCATE(XLBXRM(0,0,0,0))
+ END IF
+ !
+ IF ( NSV > 0 ) THEN
+ IF ( ANY( LHORELAX_SV(:)) ) THEN
+!JUAN A REVOIR TODO_JPHEXT
+! <<<<<<< prep_ideal_case.f90
+ ! NSIZELBXSV_ll=2* NRIMX+2
+ ALLOCATE(XLBXSVM(IISIZEXF,NJU,NKU,NSV))
+! =======
+ NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
+ ! ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,NJU,NKU,NSV))
+! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
+ ELSE
+ NSIZELBXSV_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXSVM(NSIZELBXSV_ll,NJU,NKU,NSV))
+ END IF
+ ELSE
+ NSIZELBXSV_ll=0
+ ALLOCATE(XLBXSVM(0,0,0,0))
+ END IF
+!
+ELSE ! 3D case
+!
+ CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
+ IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
+ IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
+ CALL GET_SIZEY_LB(NIMAX_ll,NJMAX_ll,NRIMY, &
+ IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV, &
+ IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2)
+!
+ IF ( LHORELAX_UVWTH ) THEN
+ NSIZELBX_ll=2*NRIMX+2*JPHEXT
+ NSIZELBXU_ll=2*NRIMX+2*JPHEXT
+ NSIZELBY_ll=2*NRIMY+2*JPHEXT
+ NSIZELBYV_ll=2*NRIMY+2*JPHEXT
+ ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,NKU))
+ ALLOCATE(XLBYUM(IISIZEYF,IJSIZEYF,NKU))
+ ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,NKU))
+ ALLOCATE(XLBYVM(IISIZEYFV,IJSIZEYFV,NKU))
+ ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,NKU))
+ ALLOCATE(XLBYWM(IISIZEYF,IJSIZEYF,NKU))
+ ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,NKU))
+ ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,NKU))
+ ELSE
+ NSIZELBX_ll=2*JPHEXT ! 2
+ NSIZELBXU_ll=2*(JPHEXT+1) ! 4
+ NSIZELBY_ll=2*JPHEXT ! 2
+ NSIZELBYV_ll=2*(JPHEXT+1) ! 4
+ ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,NKU))
+ ALLOCATE(XLBYUM(IISIZEY2,IJSIZEY2,NKU))
+ ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,NKU))
+ ALLOCATE(XLBYVM(IISIZEY4,IJSIZEY4,NKU))
+ ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,NKU))
+ ALLOCATE(XLBYWM(IISIZEY2,IJSIZEY2,NKU))
+ ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,NKU))
+ ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,NKU))
+ END IF
+ !
+ IF ( NRR > 0 ) THEN
+ IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
+ .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
+ ) THEN
+ NSIZELBXR_ll=2*NRIMX+2*JPHEXT
+ NSIZELBYR_ll=2*NRIMY+2*JPHEXT
+ ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,NKU,NRR))
+ ALLOCATE(XLBYRM(IISIZEYF,IJSIZEYF,NKU,NRR))
+ ELSE
+ NSIZELBXR_ll=2*JPHEXT ! 2
+ NSIZELBYR_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,NKU,NRR))
+ ALLOCATE(XLBYRM(IISIZEY2,IJSIZEY2,NKU,NRR))
+ ENDIF
+ ELSE
+ NSIZELBXR_ll=0
+ NSIZELBYR_ll=0
+ ALLOCATE(XLBXRM(0,0,0,0))
+ ALLOCATE(XLBYRM(0,0,0,0))
+ END IF
+ !
+ IF ( NSV > 0 ) THEN
+ IF ( ANY( LHORELAX_SV(:)) ) THEN
+ NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
+ NSIZELBYSV_ll=2*NRIMY+2*JPHEXT
+ ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,NKU,NSV))
+ ALLOCATE(XLBYSVM(IISIZEYF,IJSIZEYF,NKU,NSV))
+ ELSE
+ NSIZELBXSV_ll=2*JPHEXT ! 2
+ NSIZELBYSV_ll=2*JPHEXT ! 2
+ ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,NKU,NSV))
+ ALLOCATE(XLBYSVM(IISIZEY2,IJSIZEY2,NKU,NSV))
+ END IF
+ ELSE
+ NSIZELBXSV_ll=0
+ NSIZELBYSV_ll=0
+ ALLOCATE(XLBXSVM(0,0,0,0))
+ ALLOCATE(XLBYSVM(0,0,0,0))
+ END IF
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. INITIALIZE ALL THE MODEL VARIABLES
+! ----------------------------------
+!
+!
+!* 5.1 Grid variables and RS localization:
+!
+!* 5.1.1 Horizontal Spatial grid :
+!
+IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
+!--------------------------------------------------------
+! the MESONH horizontal grid will be read in the PGD_FILE
+!--------------------------------------------------------
+ CALL READ_HGRID(1,TPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
+! control the cartesian option
+ IF( LCARTESIAN ) THEN
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : IN GENERAL, THE USE OF A PGD_FILE &
+ & IMPLIES THAT YOU MUST TAKE INTO ACCOUNT THE EARTH SPHERICITY'
+ WRITE(NLUOUT,FMT=*) 'NEVERTHELESS, LCARTESIAN HAS BEEN KEPT TO TRUE'
+ END IF
+!
+!* use of the externalized surface
+!
+ CSURF = "EXTE"
+!
+! determine whether the model is flat or no
+!
+ ZZS_MAX = ABS( MAXVAL(XZS(NIB:NIU-JPHEXT,NJB:NJU-JPHEXT)))
+ CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MNHREAL_MPI, MPI_MAX, &
+ NMNH_COMM_WORLD,IINFO_ll)
+ IF( ABS(ZZS_MAX_ll) < 1.E-10 ) THEN
+ LFLAT=.TRUE.
+ ELSE
+ LFLAT=.FALSE.
+ END IF
+!
+
+ELSE
+!------------------------------------------------------------------------
+! the MESONH horizontal grid is built from the PRE_IDEA1.nam informations
+!------------------------------------------------------------------------
+!
+ ALLOCATE(XXHAT(NIU),XYHAT(NJU))
+!
+! define the grid localization at the earth surface by the central point
+! coordinates
+!
+ IF (XLONCEN/=XUNDEF .OR. XLATCEN/=XUNDEF) THEN
+ IF (XLONCEN/=XUNDEF .AND. XLATCEN/=XUNDEF) THEN
+!
+! it should be noted that XLATCEN and XLONCEN refer to a vertical
+! vorticity point and (XLATORI, XLONORI) refer to the mass point of
+! conformal coordinates (0,0). This is to allow the centering of the model in
+! a non-cyclic configuration regarding to XLATCEN or XLONCEN.
+!
+ ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
+ ZXHAT_ll=0.
+ ZYHAT_ll=0.
+ CALL SM_LATLON(XLATCEN,XLONCEN, &
+ -XDELTAX*(NIMAX_ll/2-0.5+JPHEXT), &
+ -XDELTAY*(NJMAX_ll/2-0.5+JPHEXT), &
+ XLATORI,XLONORI)
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+!
+ WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : XLATORI=' , XLATORI, &
+ ' XLONORI= ', XLONORI
+ ELSE
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE',&
+ 'latitude and longitude of the center point must be initialized alltogether or not')
+ END IF
+ END IF
+!
+ IF (NPROC > 1) THEN
+ CALL GET_DIM_EXT_ll('B',IXDIM,IYDIM)
+ IBEG = IXOR-JPHEXT-1
+ IEND = IBEG+IXDIM-1
+ XXHAT(:) = (/ (REAL(JLOOP)*XDELTAX, JLOOP=IBEG,IEND) /)
+ IBEG = IYOR-JPHEXT-1
+ IEND = IBEG+IYDIM-1
+ XYHAT(:) = (/ (REAL(JLOOP)*XDELTAY, JLOOP=IBEG,IEND) /)
+!
+ ELSE
+ XXHAT(:) = (/ (REAL(JLOOP-NIB)*XDELTAX, JLOOP=1,NIU) /)
+ XYHAT(:) = (/ (REAL(JLOOP-NJB)*XDELTAY, JLOOP=1,NJU) /)
+ END IF
+END IF
+!
+!* 5.1.2 Orography and Gal-Chen Sommerville transformation :
+!
+IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN
+ SELECT CASE(CZS) ! 'FLAT' or 'SINE' or 'BELL'
+ CASE('FLAT')
+ LFLAT = .TRUE.
+ IF (XHMAX==XUNDEF) THEN
+ XZS(:,:) = 0.
+ ELSE
+ XZS(:,:) = XHMAX
+ END IF
+ CASE('SINE') ! sinus-shaped orography
+ IF (XHMAX==XUNDEF) XHMAX=300.
+ LFLAT =.FALSE.
+ XZS(:,:) = XHMAX & ! three-dimensional case
+ *SPREAD((/((SIN((XPI/(NIMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPX,JLOOP=IXOR-1,IXOR+NIU-2)/),2,NJU) &
+ *SPREAD((/((SIN((XPI/(NJMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPY,JLOOP=IYOR-1,IYOR+NJU-2)/),1,NIU)
+ IF(L1D) THEN ! one-dimensional case
+ XZS(:,:) = XHMAX
+ END IF
+ CASE('BELL') ! bell-shaped orography
+ IF (XHMAX==XUNDEF) XHMAX=300.
+ LFLAT = .FALSE.
+ IF(.NOT.L2D) THEN ! three-dimensional case
+ XZS(:,:) = XHMAX / ( 1. &
+ + ( (SPREAD(XXHAT(1:NIU),2,NJU) - REAL(NIZS) * XDELTAX) /XAX ) **2 &
+ + ( (SPREAD(XYHAT(1:NJU),1,NIU) - REAL(NJZS) * XDELTAY) /XAY ) **2 ) **1.5
+ ELSE ! two-dimensional case
+ XZS(:,:) = XHMAX / ( 1. &
+ + ( (SPREAD(XXHAT(1:NIU),2,NJU) - REAL(NIZS) * XDELTAX) /XAX ) **2 )
+ ENDIF
+ IF(L1D) THEN ! one-dimensional case
+ XZS(:,:) = XHMAX
+ END IF
+ CASE('COSI') ! (1+cosine)**4 shape
+ IF (XHMAX==XUNDEF) XHMAX=800.
+ LFLAT = .FALSE.
+ IF(L2D) THEN ! two-dimensional case
+ DO JILOOP = 1, NIU
+ ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
+ IF( ABS(ZDIST)<(4.0*XAX) ) THEN
+ XZS(JILOOP,:) = (XHMAX/16.0)*( 1.0 + COS((XPI*ZDIST)/(4.0*XAX)) )**4
+ ELSE
+ XZS(JILOOP,:) = 0.0
+ ENDIF
+ END DO
+ ENDIF
+ CASE('SCHA') ! exp(-(x/a)**2)*cosine(pi*x/lambda)**2 shape
+ IF (XHMAX==XUNDEF) XHMAX=800.
+ LFLAT = .FALSE.
+ IF(L2D) THEN ! two-dimensional case
+ DO JILOOP = 1, NIU
+ ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
+ IF( ABS(ZDIST)<(4.0*XAX) ) THEN
+ XZS(JILOOP,:) = XHMAX*EXP(-(ZDIST/XAY)**2)*COS((XPI*ZDIST)/XAX)**2
+ ELSE
+ XZS(JILOOP,:) = 0.0
+ ENDIF
+ END DO
+ ENDIF
+ CASE('AGNE') ! h*a**2/(x**2+a**2) shape
+ LFLAT = .FALSE.
+ IF(L2D) THEN ! two-dimensional case
+ DO JILOOP = 1, NIU
+ ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
+ XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2)
+ END DO
+ ELSE ! three dimensionnal case - infinite profile in y direction
+ DO JILOOP = 1, NIU
+ ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
+ XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2)
+ END DO
+ ENDIF
+
+ CASE('DATA') ! discretized orography
+ LFLAT =.FALSE.
+ WRITE(NLUOUT,FMT=*) 'CZS="DATA", ATTEMPT TO READ ARRAY &
+ &XZS(NIB:NIU-JPHEXT:1,NJU-JPHEXT:NJB:-1) &
+ &starting from the first index'
+ CALL POSKEY(NLUPRE,NLUOUT,'ZSDATA')
+ DO JJLOOP = NJMAX_ll+2*JPHEXT-1,JPHEXT+1,-1 ! input like a map prior the sounding
+ READ(NLUPRE,FMT=*) ZZS_ll
+ IF ( ( JJLOOP <= ( NJU-JPHEXT + IYOR-1 ) ) .AND. ( JJLOOP >= ( NJB + IYOR-1 ) ) ) THEN
+ IJ = JJLOOP - ( IYOR-1 )
+ XZS(NIB:NIU-JPHEXT,IJ) = ZZS_ll(IXOR:IXOR + NIU-JPHEXT - NIB )
+ END IF
+ END DO
+!
+ CASE DEFAULT ! undefined shape of orography
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','erroneous ground type')
+ END SELECT
+!
+ CALL ADD2DFIELD_ll( TZ_FIELDS_ll, XZS, 'PREP_IDEAL_CASE::XZS' )
+ CALL UPDATE_HALO_ll(TZ_FIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZ_FIELDS_ll)
+!
+END IF
+!
+!IF( ( LEN_TRIM(CPGD_FILE) /= 0 ) .AND. .NOT.LFLAT .AND. &
+! ((CLBCX(1) /= "OPEN" ) .OR. &
+! (CLBCX(2) /= "OPEN" ) .OR. (CLBCY(1) /= "OPEN" ) .OR. &
+! (CLBCY(2) /= "OPEN" )) ) THEN
+! !callabortstop
+! CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','with a PGD file, you cannot be in a cyclic LBC')
+!END IF
+!
+IF (LWEST_ll()) THEN
+ DO JILOOP = 1,JPHEXT
+ XZS(JILOOP,:) = XZS(NIB,:)
+ END DO
+END IF
+IF (LEAST_ll()) THEN
+ DO JILOOP = NIU-JPHEXT+1,NIU
+ XZS(JILOOP,:)=XZS(NIU-JPHEXT,:)
+ END DO
+END IF
+IF (LSOUTH_ll()) THEN
+ DO JJLOOP = 1,JPHEXT
+ XZS(:,JJLOOP)=XZS(:,NJB)
+ END DO
+END IF
+IF (LNORTH_ll()) THEN
+ DO JJLOOP =NJU-JPHEXT+1,NJU
+ XZS(:,JJLOOP)=XZS(:,NJU-JPHEXT)
+ END DO
+END IF
+!
+IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN
+ IF (LSLEVE) THEN
+ CALL ZSMT_PIC(NSLEVE,XSMOOTH_ZS)
+ ELSE
+ XZSMT(:,:) = 0.
+ END IF
+END IF
+!
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,XJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
+ XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,XJ)
+END IF
+!* 5.4.1 metrics coefficients and update halos:
+!
+CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+!* 5.1.3 Compute the localization in index space of the vertical profile
+! in CSTN and RSOU cases :
+!
+IF (CTYPELOC =='LATLON' ) THEN
+ IF (.NOT.LCARTESIAN) THEN ! compute (x,y) if
+ CALL SM_XYHAT(XLATORI,XLONORI, & ! the localization
+ XLATLOC,XLONLOC,XXHATLOC,XYHATLOC) ! is given in latitude
+ ELSE ! and longitude
+ WRITE(NLUOUT,FMT=*) 'CTYPELOC CANNOT BE LATLON IN CARTESIAN GEOMETRY'
+ WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CTYPELOC cannot be LATLON in cartesian geometry')
+ END IF
+END IF
+!
+ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT))
+CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP) !//
+CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP) !//
+IF (CTYPELOC /= 'IJGRID') THEN
+ NILOC = MINLOC(ABS(XXHATLOC-ZXHAT_ll(:)))
+ NJLOC = MINLOC(ABS(XYHATLOC-ZYHAT_ll(:)))
+END IF
+!
+IF ( L1D .AND. ( NILOC(1) /= 1 .OR. NJLOC(1) /= 1 ) ) THEN
+ NILOC = 1
+ NJLOC = 1
+ WRITE(NLUOUT,FMT=*) 'FOR 1D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT &
+ & I=1 AND J=1 (CENTRAL VERTICAL WITHOUT HALO)'
+END IF
+!
+IF ( L2D .AND. ( NJLOC(1) /= 1 ) ) THEN
+ NJLOC = 1
+ WRITE(NLUOUT,FMT=*) 'FOR 2D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT &
+ & J=1 (CENTRAL PLANE WITHOUT HALO)'
+END IF
+!
+!* 5.2 Prognostic variables (not multiplied by rhoJ) : u,v,w,theta,r
+! and 1D anelastic reference state
+!
+!
+!* 5.2.1 Use a Radiosounding : CIDEAL='RSOU''
+!
+IF (CIDEAL == 'RSOU') THEN
+ WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", attempt to read DATE'
+ CALL POSKEY(NLUPRE,NLUOUT,'RSOU')
+ READ(NLUPRE,FMT=*) NYEAR,NMONTH,NDAY,XTIME
+ TDTCUR = DATE_TIME(DATE(NYEAR,NMONTH,NDAY),XTIME)
+ TDTEXP = TDTCUR
+ TDTSEG = TDTCUR
+ TDTMOD = TDTCUR
+ WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", ATTEMPT TO PROCESS THE SOUNDING DATA'
+ IF (LGEOSBAL) THEN
+ CALL SET_RSOU(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
+ XJ,LSHIFT,XCORIOZ)
+ ELSE
+ CALL SET_RSOU(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
+ XJ,LSHIFT)
+ END IF
+!
+!* 5.2.2 N=cste and U(z) : CIDEAL='CSTN'
+!
+ELSE IF (CIDEAL == 'CSTN') THEN
+ WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", attempt to read DATE'
+ CALL POSKEY(NLUPRE,NLUOUT,'CSTN')
+ READ(NLUPRE,FMT=*) NYEAR,NMONTH,NDAY,XTIME
+ TDTCUR = DATE_TIME(DATE(NYEAR,NMONTH,NDAY),XTIME)
+ TDTEXP = TDTCUR
+ TDTSEG = TDTCUR
+ TDTMOD = TDTCUR
+ WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", ATTEMPT TO PROCESS THE SOUNDING DATA'
+ IF (LGEOSBAL) THEN
+ CALL SET_CSTN(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
+ XJ,LSHIFT,XCORIOZ)
+ ELSE
+ CALL SET_CSTN(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
+ XJ,LSHIFT)
+ END IF
+!
+END IF
+!
+!* 5.3 Forcing variables
+!
+IF (LFORCING) THEN
+ WRITE(NLUOUT,FMT=*) 'FORCING IS ENABLED, ATTEMPT TO SET FORCING FIELDS'
+ CALL POSKEY(NLUPRE,NLUOUT,'ZFRC ','PFRC')
+ CALL SET_FRC(TZEXPREFILE)
+END IF
+!
+!! ---------------------------------------------------------------------
+! Modif PP ADV FRC
+! 5.4.2 initialize profiles for adv forcings
+IF (L2D_ADV_FRC) THEN
+ WRITE(NLUOUT,FMT=*) 'L2D_ADV_FRC IS SET TO TRUE'
+ WRITE(NLUOUT,FMT=*) 'ADVECTING FORCING USED IS USER MADE, NOT STANDARD ONE '
+ WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY '
+ CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_ADV')
+ CALL SET_ADVFRC(TZEXPREFILE)
+ENDIF
+IF (L2D_REL_FRC) THEN
+ WRITE(NLUOUT,FMT=*) 'L2D_REL_FRC IS SET TO TRUE'
+ WRITE(NLUOUT,FMT=*) 'RELAXATION FORCING USED IS USER MADE, NOT STANDARD ONE '
+ WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY '
+ CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_REL')
+ CALL SET_RELFRC(TZEXPREFILE)
+ENDIF
+!* 5.4 3D Reference state variables :
+!
+!
+!* 5.4.1 metrics coefficients and update halos:
+!
+CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
+!
+!* 5.4.2 3D reference state :
+!
+CALL SET_REF(0,TFILE_DUMMY, &
+ XZZ,XZHAT,XJ,XDXX,XDYY,CLBCX,CLBCY, &
+ XREFMASS,XMASS_O_PHI0,XLINMASS, &
+ XRHODREF,XTHVREF,XRVREF,XEXNREF,XRHODJ)
+!
+!
+!* 5.5.1 Absolute pressure :
+!
+!
+!* 5.5.2 Total mass of dry air Md computation :
+!
+CALL TOTAL_DMASS(XJ,XRHODREF,XDRYMASST)
+!
+!
+!* 5.6 Complete prognostic variables (multipliy by rhoJ) at time t :
+!
+! U grid : gridpoint 2
+IF (LWEST_ll()) XUT(1,:,:) = 2.*XUT(2,:,:) - XUT(3,:,:)
+! V grid : gridpoint 3
+IF (LSOUTH_ll()) XVT(:,1,:) = 2.*XVT(:,2,:) - XVT(:,3,:)
+! SV : gridpoint 1
+XSVT(:,:,:,:) = 0.
+!
+!
+!* 5.7 Larger scale fields initialization :
+!
+XLSUM(:,:,:) = XUT(:,:,:) ! these fields do not satisfy the
+XLSVM(:,:,:) = XVT(:,:,:) ! lower boundary condition but are
+XLSWM(:,:,:) = XWT(:,:,:) ! in equilibrium
+XLSTHM(:,:,:)= XTHT(:,:,:)
+XLSRVM(:,:,:)= XRT(:,:,:,1)
+!
+! enforce the vertical homogeneity under the ground and above the top of
+! the model for the LS fields
+!
+XLSUM(:,:,NKB-1)=XLSUM(:,:,NKB)
+XLSUM(:,:,NKU)=XLSUM(:,:,NKU-1)
+XLSVM(:,:,NKB-1)=XLSVM(:,:,NKB)
+XLSVM(:,:,NKU)=XLSVM(:,:,NKU-1)
+XLSWM(:,:,NKB-1)=XLSWM(:,:,NKB)
+XLSWM(:,:,NKU)=XLSWM(:,:,NKU-1)
+XLSTHM(:,:,NKB-1)=XLSTHM(:,:,NKB)
+XLSTHM(:,:,NKU)=XLSTHM(:,:,NKU-1)
+IF ( NRR > 0 ) THEN
+ XLSRVM(:,:,NKB-1)=XLSRVM(:,:,NKB)
+ XLSRVM(:,:,NKU)=XLSRVM(:,:,NKU-1)
+END IF
+!
+ILBX=SIZE(XLBXUM,1)
+ILBY=SIZE(XLBYUM,2)
+IF(LWEST_ll() .AND. .NOT. L1D) THEN
+ XLBXUM(1:NRIMX+JPHEXT, :,:) = XUT(2:NRIMX+JPHEXT+1, :,:)
+ XLBXVM(1:NRIMX+JPHEXT, :,:) = XVT(1:NRIMX+JPHEXT, :,:)
+ XLBXWM(1:NRIMX+JPHEXT, :,:) = XWT(1:NRIMX+JPHEXT, :,:)
+ XLBXTHM(1:NRIMX+JPHEXT, :,:) = XTHT(1:NRIMX+JPHEXT, :,:)
+ XLBXRM(1:NRIMX+JPHEXT, :,:,:) = XRT(1:NRIMX+JPHEXT, :,:,:)
+ENDIF
+IF(LEAST_ll() .AND. .NOT. L1D) THEN
+ XLBXUM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XUT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
+ XLBXVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XVT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
+ XLBXWM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XWT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
+ XLBXTHM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XTHT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
+ XLBXRM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,:) = XRT(NIU-NRIMX-JPHEXT+1:NIU, :,:,:)
+ENDIF
+IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN
+ XLBYUM(:,1:NRIMY+JPHEXT, :) = XUT(:,1:NRIMY+JPHEXT, :)
+ XLBYVM(:,1:NRIMY+JPHEXT, :) = XVT(:,2:NRIMY+JPHEXT+1, :)
+ XLBYWM(:,1:NRIMY+JPHEXT, :) = XWT(:,1:NRIMY+JPHEXT, :)
+ XLBYTHM(:,1:NRIMY+JPHEXT, :) = XTHT(:,1:NRIMY+JPHEXT, :)
+ XLBYRM(:,1:NRIMY+JPHEXT, :,:) = XRT(:,1:NRIMY+JPHEXT, :,:)
+ENDIF
+IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
+ XLBYUM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XUT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
+ XLBYVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XVT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
+ XLBYWM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XWT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
+ XLBYTHM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XTHT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
+ XLBYRM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,:) = XRT(:,NJU-NRIMY-JPHEXT+1:NJU, :,:)
+ENDIF
+DO JSV = 1, NSV
+ IF(LWEST_ll() .AND. .NOT. L1D) &
+ XLBXSVM(1:NRIMX+JPHEXT, :,:,JSV) = XSVT(1:NRIMX+JPHEXT, :,:,JSV)
+ IF(LEAST_ll() .AND. .NOT. L1D) &
+ XLBXSVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,JSV) = XSVT(NIU-NRIMX-JPHEXT+1:NIU, :,:,JSV)
+ IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
+ XLBYSVM(:,1:NRIMY+JPHEXT, :,JSV) = XSVT(:,1:NRIMY+JPHEXT, :,JSV)
+ IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
+ XLBYSVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,JSV) = XSVT(:,NJU-NRIMY-JPHEXT+1:NJU, :,JSV)
+END DO
+!
+!
+!* 5.8 Add a perturbation to a basic state :
+!
+IF(LPERTURB) CALL SET_PERTURB(TZEXPREFILE)
+!
+!
+!* 5.9 Anelastic correction and pressure:
+!
+IF (.NOT.LOCEAN) THEN
+ CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+ IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
+ CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+END IF
+!
+!
+!* 5.10 Compute THETA, vapor and cloud mixing ratio
+!
+IF (CIDEAL == 'RSOU') THEN
+ ALLOCATE(ZEXN(NIU,NJU,NKU))
+ ALLOCATE(ZT(NIU,NJU,NKU))
+ ALLOCATE(ZTHL(NIU,NJU,NKU))
+ ALLOCATE(ZRT(NIU,NJU,NKU))
+ ALLOCATE(ZCPH(NIU,NJU,NKU))
+ ALLOCATE(ZLVOCPEXN(NIU,NJU,NKU))
+ ALLOCATE(ZLSOCPEXN(NIU,NJU,NKU))
+ ALLOCATE(ZFRAC_ICE(NIU,NJU,NKU))
+ ALLOCATE(ZRSATW(NIU,NJU,NKU))
+ ALLOCATE(ZRSATI(NIU,NJU,NKU))
+ 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_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
+ XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI)
+END IF
+ DEALLOCATE(ZEXN)
+ DEALLOCATE(ZT)
+ DEALLOCATE(ZCPH)
+ DEALLOCATE(ZLVOCPEXN)
+ DEALLOCATE(ZLSOCPEXN)
+ DEALLOCATE(ZTHL)
+ DEALLOCATE(ZRT)
+! 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)
+!
+!-------------------------------------------------------------------------------
+!
+!* 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()
+!
+END PROGRAM PREP_IDEAL_CASE
diff --git a/src/mesonh/ext/set_rsou.f90 b/src/mesonh/ext/set_rsou.f90
new file mode 100644
index 000000000..c0aca1504
--- /dev/null
+++ b/src/mesonh/ext/set_rsou.f90
@@ -0,0 +1,1633 @@
+!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_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_TH_R_FROM_THL_RT_1D
+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
+!
+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))
+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_1D('T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
+ ZRSATW, ZRSATI)
+ 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)
+!-------------------------------------------------------------------------------
+!
+!* 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
+!
+END SUBROUTINE SET_RSOU
diff --git a/src/mesonh/ext/shallow_mf_pack.f90 b/src/mesonh/ext/shallow_mf_pack.f90
new file mode 100644
index 000000000..d5c0bbdfe
--- /dev/null
+++ b/src/mesonh/ext/shallow_mf_pack.f90
@@ -0,0 +1,481 @@
+!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, &
+ HMF_UPDRAFT, HMF_CLOUD, OMIXUV, &
+ OMF_FLX,TPFILE,PTIME_LES, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXN, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PWM,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.
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT! Type of Mass Flux Scheme
+ ! 'NONE' if no parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
+ ! scheme
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: OMF_FLX ! switch to write the
+ ! MF fluxes in the synchronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function at t-dt
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(:,:,:,:),INTENT(IN):: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke at t-dt
+
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(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
+
+
+END SUBROUTINE SHALLOW_MF_PACK
+
+END INTERFACE
+!
+END MODULE MODI_SHALLOW_MF_PACK
+
+! #################################################################
+ SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
+ HMF_UPDRAFT, HMF_CLOUD, OMIXUV, &
+ OMF_FLX,TPFILE,PTIME_LES, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXN, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PWM,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_budget, only: lbudget_u, lbudget_v, lbudget_th, lbudget_rv, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_TH, NBUDGET_RV, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_IO, ONLY: TFILEDATA
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY: CFRAC_ICE_SHALLOW_MF
+USE MODD_PARAM_MFSHALL_n
+use modd_precision, only: MNHTIME
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+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.
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT! Type of Mass Flux Scheme
+ ! 'NONE' if no parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
+ ! scheme
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: OMF_FLX ! switch to write the
+ ! MF fluxes in the synchronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height of flux point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function at t-dt
+
+REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at t-dt
+REAL, DIMENSION(:,:,:,:),INTENT(IN):: PRM ! water var. at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke at t-dt
+
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
+
+REAL, DIMENSION(:,:,:), INTENT(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
+!
+! 0.2 Declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZZZ ! Height of flux point
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDZZ ! Metric coefficients
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRHODJ ! dry density * Grid size
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZPABSM ! Pressure at time t-1
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZEXN ! Exner function at t-dt
+
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTHM ! Theta at t-dt
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PRM,4)) :: ZRM ! water var. at t-dt
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZUM,ZVM,ZWM ! wind components at t-dt
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTKEM ! tke at t-dt
+
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PSVM,4)) :: ZSVM ! scalar variable a t-dt
+
+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)) :: ZTHL_DO ! downdraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTHV_DO ! downdraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRT_DO ! downdraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZU_DO ! downdraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZV_DO ! downdraft 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
+INTEGER,DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2)) :: IKLCL,IKETL,IKCTL ! level of LCL,ETL and CTL
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2)) :: ZSFTH ! Surface sensible heat flux
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2)) :: ZSFRV ! Surface latent heat flux
+!
+!
+!* 3D arrays
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZWORK ! work array
+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
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZWMM ! wind on mass point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDUDT ! tendency of U by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDVDT ! tendency of V by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDTHLDT ! tendency of thl by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDRTDT ! tendency of Rt by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PSVM,4)) :: ZDSVDT ! tendency of Sv by massflux scheme
+
+INTEGER :: IIU, IJU, IKU, IKB, IKE, IRR, ISV
+INTEGER :: JK,JRR,JSV ! Loop counters
+
+TYPE(TFIELDDATA) :: TZFIELD
+!------------------------------------------------------------------------
+
+!!! 1. Initialisation
+
+! 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)
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'MAFL', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'MAFL', prvs (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'MAFL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'MAFL', prrs (:, :, :, 1) )
+if ( lbudget_sv ) then
+ do jsv = 1, isv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'MAFL', prsvs(:, :, :, jsv) )
+ end do
+end if
+
+ZSVM(:,:,:) = 0.
+!
+!
+! wind on mass points
+ZUMM=MXF(PUM)
+ZVMM=MYF(PVM)
+ZWMM=MZF(PWM)
+!
+!!! 2. Pack input variables
+!
+DO JK=1,IKU
+ ZZZ (:,JK) = RESHAPE(PZZ (:,:,JK),(/ IIU*IJU /) )
+ ZDZZ (:,JK) = RESHAPE(PDZZ (:,:,JK),(/ IIU*IJU /) )
+ ZRHODJ (:,JK) = RESHAPE(PRHODJ (:,:,JK),(/ IIU*IJU /) )
+ ZTHM (:,JK) = RESHAPE(PTHM (:,:,JK),(/ IIU*IJU /) )
+ ZTKEM (:,JK) = RESHAPE(PTKEM (:,:,JK),(/ IIU*IJU /) )
+ ZPABSM (:,JK) = RESHAPE(PPABSM (:,:,JK),(/ IIU*IJU /) )
+ ZEXN (:,JK) = RESHAPE(PEXN (:,:,JK),(/ IIU*IJU /) )
+ ZRHODJ (:,JK) = RESHAPE(PRHODJ (:,:,JK),(/ IIU*IJU /) )
+ ZRHODREF(:,JK) = RESHAPE(PRHODREF(:,:,JK),(/ IIU*IJU /) )
+ ZUM (:,JK) = RESHAPE(ZUMM (:,:,JK),(/ IIU*IJU /) )
+ ZVM (:,JK) = RESHAPE(ZVMM (:,:,JK),(/ IIU*IJU /) )
+ ZWM (:,JK) = RESHAPE(ZWMM (:,:,JK),(/ IIU*IJU /) )
+ DO JRR=1,IRR
+ ZRM (:,JK,JRR) = RESHAPE(PRM (:,:,JK,JRR),(/ IIU*IJU /) )
+ END DO
+ DO JSV=1,ISV
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ ZSVM(:,JK,JSV) = RESHAPE(PSVM (:,:,JK,JSV),(/ IIU*IJU /) )
+ END DO
+END DO
+
+ZSFTH(:)=RESHAPE(PSFTH(:,:),(/ IIU*IJU /) )
+ZSFRV(:)=RESHAPE(PSFRV(:,:),(/ IIU*IJU /) )
+
+!!! 3. Call of the physical parameterization of massflux vertical transport
+
+CALL SHALLOW_MF(1,IKU,1,KRR,KRRL,KRRI, &
+ HMF_UPDRAFT, HMF_CLOUD, CFRAC_ICE_SHALLOW_MF, OMIXUV, &
+ LNOMIXLG,NSV_LGBEG,NSV_LGEND, &
+ PIMPL_MF, PTSTEP, &
+ ZDZZ, ZZZ, &
+ ZRHODJ,ZRHODREF, &
+ ZPABSM, ZEXN, &
+ ZSFTH,ZSFRV, &
+ ZTHM,ZRM,ZUM,ZVM,ZWM,ZTKEM,ZSVM, &
+ 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, &
+ ZTHL_DO,ZTHV_DO,ZRT_DO,ZU_DO, ZV_DO, &
+ ZFRAC_UP,ZEMF,ZDETR,ZENTR, &
+ IKLCL,IKETL,IKCTL )
+
+!!! 4. Unpack output variables
+
+ZDTHLDT(:,:,:)=RESHAPE(ZDTHLDT_MF(:,:),(/ IIU,IJU,IKU /) )
+ZDRTDT(:,:,:)=RESHAPE(ZDRTDT_MF(:,:),(/ IIU,IJU,IKU /) )
+ZDUDT(:,:,:)=RESHAPE(ZDUDT_MF(:,:),(/ IIU,IJU,IKU /) )
+ZDVDT(:,:,:)=RESHAPE(ZDVDT_MF(:,:),(/ IIU,IJU,IKU /) )
+PSIGMF(:,:,:)=RESHAPE(ZSIGMF(:,:),(/ IIU,IJU,IKU /) )
+PRC_MF(:,:,:)=RESHAPE(ZRC_MF(:,:),(/ IIU,IJU,IKU /) )
+PRI_MF(:,:,:)=RESHAPE(ZRI_MF(:,:),(/ IIU,IJU,IKU /) )
+PCF_MF(:,:,:)=RESHAPE(ZCF_MF(:,:),(/ IIU,IJU,IKU /) )
+PFLXZTHVMF(:,:,:)=RESHAPE(ZFLXZTHVMF(:,:),(/ IIU,IJU,IKU /) )
+DO JSV=1,ISV
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ ZDSVDT(:,:,:,JSV) = RESHAPE(ZDSVDT_MF(:,:,JSV),(/ IIU,IJU,IKU /) )
+END DO
+!
+!!! 5. 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(:,:,:)
+PRRS(:,:,:,1) = PRRS(:,:,:,1) + &
+ PRHODJ(:,:,:)*ZDRTDT(:,:,:)
+PRUS(:,:,:) = PRUS(:,:,:) +MXM( &
+ PRHODJ(:,:,:)*ZDUDT(:,:,:))
+PRVS(:,:,:) = PRVS(:,:,:) +MYM( &
+ PRHODJ(:,:,:)*ZDVDT(:,:,:))
+
+DO JSV=1,ISV
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ PRSVS(:,:,:,JSV) = MAX((PRSVS(:,:,:,JSV) + &
+ PRHODJ(:,:,:)*ZDSVDT(:,:,:,JSV)),XSVMIN(JSV))
+END DO
+
+!!! 7. call to MesoNH budgets
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'MAFL', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'MAFL', prvs (:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'MAFL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'MAFL', prrs (:, :, :, 1) )
+if ( lbudget_sv ) then
+ do jsv = 1, isv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'MAFL', prsvs(:, :, :, jsv) )
+ end do
+end if
+
+!!! 8. Prints the fluxes in output file
+!
+IF ( OMF_FLX .AND. tpfile%lopened ) THEN
+ ! stores the conservative potential temperature vertical flux
+ ZWORK(:,:,:)=RESHAPE(ZFLXZTHMF (:,:),(/ IIU,IJU,IKU /) )
+ TZFIELD%CMNHNAME = 'MF_THW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_THW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_THW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
+ !
+ ! stores the conservative mixing ratio vertical flux
+ ZWORK(:,:,:)=RESHAPE(ZFLXZRMF(:,:),(/ IIU,IJU,IKU /) )
+ TZFIELD%CMNHNAME = 'MF_RCONSW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_RCONSW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_RCONSW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
+ !
+ ! stores the theta_v vertical flux
+ TZFIELD%CMNHNAME = 'MF_THVW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_THVW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_THVW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PFLXZTHVMF)
+ !
+ IF (OMIXUV) THEN
+ ! stores the U momentum vertical flux
+ ZWORK(:,:,:)=RESHAPE(ZFLXZUMF(:,:),(/ IIU,IJU,IKU /) )
+ TZFIELD%CMNHNAME = 'MF_UW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_UW_FLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_UW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
+ !
+ ! stores the V momentum vertical flux
+ ZWORK(:,:,:)=RESHAPE(ZFLXZVMF(:,:),(/ IIU,IJU,IKU /) )
+ TZFIELD%CMNHNAME = 'MF_VW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_VW_FLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_VW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
+ !
+ END IF
+END IF
+
+!!! 9. 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
--
GitLab