Skip to content
Snippets Groups Projects
Commit 17bc3c35 authored by RODIER Quentin's avatar RODIER Quentin
Browse files

Quentin 13/12/2022: add new temporary files in mesonh/ext for future adaptation of PHYEX interface

parent cda6c2c2
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
src/mesonh/ext/ini_lesn.f90 0 → 100644
+ 2007
− 0
View file @ 17bc3c35
This diff is collapsed.
src/mesonh/ext/les_cloud_masksn.f90 0 → 100644
+ 419
− 0
View file @ 17bc3c35
!MNH_LIC Copyright 2006-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #######################
SUBROUTINE LES_CLOUD_MASKS_n
! #######################
!
!
!!**** *LES_MASKS_n* initializes the masks for clouds
!!
!!
!! PURPOSE
!! -------
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! V. Masson
!!
!! MODIFICATIONS
!! -------------
!! Original 07/2006
!! P. Aumond 10/2009 Add possibility of user maskS
!! F.Couvreux 06/2011 : Conditional sampling
!! C.Lac 10/2014 : Correction on user masks
!! Q.Rodier 05/2019 : Missing parallelization
!!
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_LES
USE MODD_LES_n
USE MODD_FIELD_n
USE MODD_CONF_n
USE MODD_CST , ONLY : XRD, XRV
USE MODD_NSV , ONLY : NSV_CSBEG, NSV_CSEND, NSV_CS
USE MODD_GRID_n , ONLY : XZHAT
USE MODD_CONDSAMP
!
USE MODE_ll
!
USE MODI_LES_VER_INT
USE MODI_LES_MEAN_ll
USE MODI_SHUMAN
!
IMPLICIT NONE
!
!
! 0.2 declaration of local variables
!
INTEGER :: JK ! vertical loop counter
INTEGER :: JI ! loop index on masks
INTEGER :: IIU, IJU,IIB,IJB,IIE,IJE ! hor. indices
INTEGER :: IKU, KBASE, KTOP ! ver. index
INTEGER :: IRR, IRRC, IRRR, IRRI, IRRS, IRRG ! moist variables indices
INTEGER :: JSV ! ind of scalars
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT ! total water
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV ! Virtual potential temperature
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW_LES ! W on LES vertical grid
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_LES ! Rc on LES vertical grid
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_LES ! Ri on LES vertical grid
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT_LES ! Rt on LES vertical grid
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LES ! thv on LES vertical grid
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_LES ! thv on LES vertical grid
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_ANOM ! thv-thv_mean on LES vertical grid
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_ANOM ! sv-sv_mean
REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTD_SV
REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTD_SVTRES ! threshold of sv
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D,ZWORK3DB
REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1D
REAL, DIMENSION(:), ALLOCATABLE :: ZMEANRC
!
!
!-------------------------------------------------------------------------------
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
IKU = SIZE(XTHT,3)
!
!-------------------------------------------------------------------------------
!
!* 1.0 Thermodynamical computations
! ----------------------------
!
ALLOCATE(ZRT (IIU,IJU,IKU))
ALLOCATE(ZMEANRC (IKU))
ZRT = 0.
!
IRR=0
IF (LUSERV) THEN
IRR=IRR+1
ZRT = ZRT + XRT(:,:,:,1)
END IF
IF (LUSERC) THEN
IRR=IRR+1
IRRC=IRR
ZRT = ZRT + XRT(:,:,:,IRRC)
END IF
IF (LUSERR) THEN
IRR=IRR+1
IRRR=IRR
ZRT = ZRT + XRT(:,:,:,IRRR)
END IF
IF (LUSERI) THEN
IRR=IRR+1
IRRI=IRR
ZRT = ZRT + XRT(:,:,:,IRRI)
END IF
IF (LUSERS) THEN
IRR=IRR+1
IRRS=IRR
ZRT = ZRT + XRT(:,:,:,IRRS)
END IF
IF (LUSERG) THEN
IRR=IRR+1
IRRG=IRR
ZRT = ZRT + XRT(:,:,:,IRRG)
END IF
!
!
!* computes fields on the LES grid in order to compute masks
!
ALLOCATE(ZTHV (IIU,IJU,IKU))
ZTHV = XTHT
IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRT(:,:,:,1))/(1.+ZRT(:,:,:))
!
!-------------------------------------------------------------------------------
!
!* 2.0 Fields on LES grid
! ------------------
!
!* allocates fields on the LES grid
!
!
ALLOCATE(ZW_LES (IIU,IJU,NLES_K))
ALLOCATE(ZRC_LES (IIU,IJU,NLES_K))
ALLOCATE(ZRI_LES (IIU,IJU,NLES_K))
ALLOCATE(ZRT_LES (IIU,IJU,NLES_K))
ALLOCATE(ZTHV_LES (IIU,IJU,NLES_K))
ALLOCATE(ZTHV_ANOM(IIU,IJU,NLES_K))
ALLOCATE(ZSV_LES (IIU,IJU,NLES_K,NSV_CS))
ALLOCATE(ZSV_ANOM(IIU,IJU,NLES_K,NSV_CS))
ALLOCATE(ZSTD_SV(NLES_K,NSV_CS))
ALLOCATE(ZSTD_SVTRES(NLES_K,NSV_CS))
ALLOCATE(ZWORK1D(NLES_K))
ALLOCATE(ZWORK3D(IIU,IJU,IKU))
ALLOCATE(ZWORK3DB(IIU,IJU,NLES_K))
!
ZWORK1D=0.
ZWORK3D=0.
ZWORK3DB=0.
!
CALL LES_VER_INT(MZF(XWT), ZW_LES)
IF (NSV_CS>0) THEN
DO JSV=NSV_CSBEG, NSV_CSEND
CALL LES_VER_INT( XSVT(:,:,:,JSV), &
ZSV_LES(:,:,:,JSV-NSV_CSBEG+1) )
END DO
END IF
IF (LUSERC) THEN
CALL LES_VER_INT(XRT(:,:,:,IRRC), ZRC_LES)
ELSE
ZRC_LES = 0.
END IF
IF (LUSERI) THEN
CALL LES_VER_INT(XRT(:,:,:,IRRI), ZRI_LES)
ELSE
ZRI_LES = 0.
END IF
CALL LES_VER_INT(ZRT, ZRT_LES)
CALL LES_VER_INT(ZTHV, ZTHV_LES)
CALL LES_ANOMALY_FIELD(ZTHV,ZTHV_ANOM)
!
IF (NSV_CS>0) THEN
DO JSV=NSV_CSBEG, NSV_CSEND
ZWORK3D(:,:,:)=XSVT(:,:,:,JSV)
CALL LES_ANOMALY_FIELD(ZWORK3D,ZWORK3DB)
ZSV_ANOM(:,:,:,JSV-NSV_CSBEG+1)=ZWORK3DB(:,:,:)
CALL LES_STDEV(ZWORK3DB,ZWORK1D)
ZSTD_SV(:,JSV-NSV_CSBEG+1)=ZWORK1D(:)
DO JK=1,NLES_K
ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)=SUM(ZSTD_SV(1:JK,JSV-NSV_CSBEG+1))/(1.*JK)
END DO
END DO
END IF
!
DEALLOCATE(ZTHV )
DEALLOCATE(ZWORK3D)
DEALLOCATE(ZWORK3DB)
DEALLOCATE(ZWORK1D)
!
!-------------------------------------------------------------------------------
!
!* 3.0 Cloud mask
! ----------
!
IF (LLES_NEB_MASK) THEN
ALLOCATE(LLES_CURRENT_NEB_MASK(IIU,IJU,NLES_K))
LLES_CURRENT_NEB_MASK (:,:,:) = .FALSE.
WHERE ((ZRC_LES(IIB:IIE,IJB:IJE,:)>1.E-6 .OR. ZRI_LES(IIB:IIE,IJB:IJE,:)>1.E-6) .AND. ZW_LES(IIB:IIE,IJB:IJE,:)>0.)
LLES_CURRENT_NEB_MASK (IIB:IIE,IJB:IJE,:) = .TRUE.
END WHERE
END IF
!
!-------------------------------------------------------------------------------
!
!* 4.0 Cloud core mask
! ---------------
!
IF (LLES_CORE_MASK) THEN
ALLOCATE(LLES_CURRENT_CORE_MASK(IIU,IJU,NLES_K))
LLES_CURRENT_CORE_MASK (:,:,:) = .FALSE.
WHERE ((ZRC_LES(IIB:IIE,IJB:IJE,:)>1.E-6 .OR. ZRI_LES(IIB:IIE,IJB:IJE,:)>1.E-6) &
.AND. ZW_LES(IIB:IIE,IJB:IJE,:)>0. .AND. ZTHV_ANOM(IIB:IIE,IJB:IJE,:)>0.)
LLES_CURRENT_CORE_MASK (IIB:IIE,IJB:IJE,:) = .TRUE.
END WHERE
END IF
!
!-------------------------------------------------------------------------------
!
!* 4.0 Conditional sampling mask
! -------------------------
!
IF (LLES_CS_MASK) THEN
!
CALL LES_MEAN_ll(ZRC_LES, LLES_CURRENT_CART_MASK, ZMEANRC )
ALLOCATE(LLES_CURRENT_CS1_MASK(IIU,IJU,NLES_K))
LLES_CURRENT_CS1_MASK(:,:,:) = .FALSE.
IF (NSV_CS >= 2) THEN
ALLOCATE(LLES_CURRENT_CS2_MASK(IIU,IJU,NLES_K))
LLES_CURRENT_CS2_MASK(:,:,:) = .FALSE.
IF (NSV_CS == 3) THEN
ALLOCATE(LLES_CURRENT_CS3_MASK(IIU,IJU,NLES_K))
LLES_CURRENT_CS3_MASK (:,:,:) = .FALSE.
END IF
END IF
!
! Cloud top and base computation
!
KBASE=2
KTOP=NLES_K
DO JK=2,NLES_K
IF ((ZMEANRC(JK) > 1.E-7) .AND. (KBASE == 2)) KBASE=JK
IF ((ZMEANRC(JK) < 1.E-7) .AND. (KBASE > 2) .AND. (KTOP == NLES_K)) &
KTOP=JK-1
END DO
!
DO JSV=NSV_CSBEG, NSV_CSEND
DO JK=2,NLES_K
IF (ZSTD_SV(JK,JSV-NSV_CSBEG+1) < 0.05*ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)) &
ZSTD_SV(JK,JSV-NSV_CSBEG+1)=0.05*ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)
! case no cloud top and base
IF (JSV == NSV_CSBEG) THEN
IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
!
! case cloud top and base defined
!
IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
!
IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1) .AND. &
ZRC_LES(IIB:IIE,IJB:IJE,JK)>1.E-6)
LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
ELSE IF ( JSV == NSV_CSBEG + 1 ) THEN
IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
WHERE ( ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
!
! case cloud top and base defined
!
IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
!
IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
!
ELSE
IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
WHERE ( ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
!
! case cloud top and base defined
!
IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
!
IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
END WHERE
END IF
END IF
END DO
END DO
END IF
!
!-------------------------------------------------------------------------------
!
!* 5.0 User mask
! ---------
!
IF (LLES_MY_MASK) THEN
ALLOCATE(LLES_CURRENT_MY_MASKS(IIU,IJU,NLES_K,NLES_MASKS_USER))
DO JI=1,NLES_MASKS_USER
LLES_CURRENT_MY_MASKS (IIB:IIE,IJB:IJE,:,JI) = .FALSE.
END DO
! WHERE ((ZRC_LES + ZRI_LES) > 1.E-06)
! LLES_CURRENT_MY_MASKS (:,:,:,1) = .TRUE.
! END WHERE
!
END IF
!-------------------------------------------------------------------------------
!
DEALLOCATE(ZW_LES )
DEALLOCATE(ZRC_LES )
DEALLOCATE(ZRI_LES )
DEALLOCATE(ZRT_LES )
DEALLOCATE(ZTHV_LES )
DEALLOCATE(ZSV_LES )
DEALLOCATE(ZTHV_ANOM)
DEALLOCATE(ZSV_ANOM)
DEALLOCATE(ZSTD_SV)
DEALLOCATE(ZSTD_SVTRES)
!-------------------------------------------------------------------------------
DEALLOCATE(ZRT )
DEALLOCATE(ZMEANRC)
!--------------------------------------------------------------------------------
!
CONTAINS
!
!--------------------------------------------------------------------------------
!
SUBROUTINE LES_ANOMALY_FIELD(PF,PF_ANOM)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PF
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_ANOM
REAL, DIMENSION(SIZE(PF_ANOM,3)) :: ZMEAN
INTEGER :: JI, JJ
CALL LES_VER_INT(PF, PF_ANOM)
CALL LES_MEAN_ll(PF_ANOM, LLES_CURRENT_CART_MASK, ZMEAN )
DO JJ=1,SIZE(PF_ANOM,2)
DO JI=1,SIZE(PF_ANOM,1)
PF_ANOM(JI,JJ,:) = PF_ANOM(JI,JJ,:) - ZMEAN(:)
END DO
END DO
END SUBROUTINE LES_ANOMALY_FIELD
!--------------------------------------------------------------------------------
!
!--------------------------------------------------------------------------------
!
SUBROUTINE LES_STDEV(PF_ANOM,PF_STD)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PF_ANOM
REAL, DIMENSION(:), INTENT(OUT) :: PF_STD
REAL, DIMENSION(SIZE(PF_ANOM,1),SIZE(PF_ANOM,2),SIZE(PF_ANOM,3)) :: Z2
INTEGER :: JK
Z2(:,:,:)=PF_ANOM(:,:,:)*PF_ANOM(:,:,:)
CALL LES_MEAN_ll(Z2, LLES_CURRENT_CART_MASK, PF_STD )
DO JK=1,SIZE(PF_ANOM,3)
PF_STD(JK)=SQRT(PF_STD(JK))
END DO
END SUBROUTINE LES_STDEV
!-------------------------------------------------------------------------------
!
END SUBROUTINE LES_CLOUD_MASKS_n
src/mesonh/ext/les_ini_timestepn.f90 0 → 100644
+ 407
− 0
View file @ 17bc3c35
!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #######################
MODULE MODI_LES_INI_TIMESTEP_n
! #######################
!
!
INTERFACE LES_INI_TIMESTEP_n
!
SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT)
!
INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
!
END SUBROUTINE LES_INI_TIMESTEP_n
!
END INTERFACE
!
END MODULE MODI_LES_INI_TIMESTEP_n
! ##############################
SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT)
! ##############################
!
!
!!**** *LES_INI_TIMESTEP_n* initializes the LES variables for
!! the current time-step of model _n
!!
!!
!! PURPOSE
!! -------
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! V. Masson
!!
!! MODIFICATIONS
!! -------------
!! Original 06/11/02
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST
USE MODD_NSV
USE MODD_LES
USE MODD_LES_n
USE MODD_FIELD_n
USE MODD_METRICS_n
USE MODD_REF_n
USE MODD_CONF_n
USE MODD_TIME_n
USE MODD_DYN_n
USE MODD_TIME
USE MODD_CONF
USE MODD_LES_BUDGET
!
use mode_datetime, only: Datetime_distance
USE MODE_ll
USE MODE_MODELN_HANDLER
!
USE MODI_LES_VER_INT
USE MODI_THL_RT_FROM_TH_R
USE MODI_LES_MEAN_ll
USE MODI_SHUMAN
!
USE MODI_SECOND_MNH
USE MODI_LES_CLOUD_MASKS_N
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
!
INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
!
!
! 0.2 declaration of local variables
!
INTEGER :: IXOR_ll, IYOR_ll ! origine point coordinates
! ! of current processor domain
! ! on model domain on all
! ! processors
INTEGER :: IIB_ll, IJB_ll ! SO point coordinates of
! ! current processor phys. domain
! ! on model domain on all
! ! processors
INTEGER :: IIE_ll, IJE_ll ! NE point coordinates of
! ! current processor phys. domain
! ! on model domain on all
! ! processors
INTEGER :: IIINF_MASK, IISUP_MASK ! cart. mask local proc. limits
INTEGER :: IJINF_MASK, IJSUP_MASK ! cart. mask local proc. limits
!
INTEGER :: JK ! vertical loop counter
INTEGER :: IIB, IJB, IIE, IJE ! hor. indices
INTEGER :: IIU, IJU ! hor. indices
INTEGER :: IKU ! ver. index
INTEGER :: IRR, IRRC, IRRR, IRRI, IRRS, IRRG ! moist variables indices
!
INTEGER :: JSV ! scalar variables counter
!
REAL :: ZTIME1, ZTIME2 ! CPU time counters
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL ! theta_l
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT ! total water
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZL ! Latent heat of vaporization
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCP ! Cp
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN ! Exner function
INTEGER :: IMI ! current model index
!-------------------------------------------------------------------------------
!
!* 1. Does current time-step is a LES time-step?
! -----------------------------------------
!
LLES_CALL= .FALSE.
!
CALL SECOND_MNH(ZTIME1)
!
IF (NLES_TCOUNT==NLES_TIMES) LLES_CALL=.FALSE.
!
IF ( KTCOUNT>1 .AND. MOD (KTCOUNT-1,NLES_DTCOUNT)==0) LLES_CALL=.TRUE.
!
IF (.NOT. LLES_CALL) RETURN
!
CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
LUSERI, LUSERS, LUSERG, LUSERH )
!
NLES_TCOUNT = NLES_TCOUNT + 1
!
NLES_CURRENT_TCOUNT = NLES_TCOUNT
!
tles_dates(nles_tcount) = tdtcur
call Datetime_distance( tdtseg, tdtcur, xles_times(nles_tcount) )
!
!* forward-in-time time-step
!
XCURRENT_TSTEP = XTSTEP
!
!-------------------------------------------------------------------------------
!
CALL GET_OR_ll ('B',IXOR_ll,IYOR_ll)
CALL GET_DIM_EXT_ll('B',IIU,IJU)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
IIB_ll=IXOR_ll+IIB-1
IJB_ll=IYOR_ll+IJB-1
IIE_ll=IXOR_ll+IIE-1
IJE_ll=IYOR_ll+IJE-1
!
IKU = SIZE(XTHT,3)
!
IMI = GET_CURRENT_MODEL_INDEX()
!
!-------------------------------------------------------------------------------
!
!* 2. Definition of masks
! -------------------
!
!* 2.1 Cartesian (sub-)domain (on local processor)
! ----------------------
!
ALLOCATE(LLES_CURRENT_CART_MASK(IIU,IJU,NLES_K))
!
IIINF_MASK = MAX(IIB, NLESn_IINF(IMI)+JPHEXT-(IIB_ll-1-JPHEXT))
IJINF_MASK = MAX(IJB, NLESn_JINF(IMI)+JPHEXT-(IJB_ll-1-JPHEXT))
IISUP_MASK = MIN(IIE, NLESn_ISUP(IMI)+JPHEXT-(IIB_ll-1-JPHEXT))
IJSUP_MASK = MIN(IJE, NLESn_JSUP(IMI)+JPHEXT-(IJB_ll-1-JPHEXT))
!
!
LLES_CURRENT_CART_MASK(:,:,:) = .FALSE.
LLES_CURRENT_CART_MASK(IIINF_MASK:IISUP_MASK,IJINF_MASK:IJSUP_MASK,:) = .TRUE.
!
CLES_CURRENT_LBCX(:) = CLES_LBCX(:,IMI)
CLES_CURRENT_LBCY(:) = CLES_LBCY(:,IMI)
!
!-------------------------------------------------------------------------------
!
!* 3. Definition of LES vertical grid for this model
! ----------------------------------------------
!
IF (CLES_LEVEL_TYPE=='Z') THEN
IF (ALLOCATED(XCOEFLIN_CURRENT_LES)) DEALLOCATE(XCOEFLIN_CURRENT_LES)
IF (ALLOCATED(NKLIN_CURRENT_LES )) DEALLOCATE(NKLIN_CURRENT_LES )
!
ALLOCATE(XCOEFLIN_CURRENT_LES(IIU,IJU,NLES_K))
ALLOCATE(NKLIN_CURRENT_LES (IIU,IJU,NLES_K))
!
XCOEFLIN_CURRENT_LES(:,:,:) = XCOEFLIN_LES(:,:,:)
NKLIN_CURRENT_LES (:,:,:) = NKLIN_LES (:,:,:)
END IF
!
!-------------------------------------------------------------------------------
!
!* 4. Definition of variables used in budgets for current model
! ---------------------------------------------------------
!
IF (LUSERC) THEN
ALLOCATE(XCURRENT_L_O_EXN_CP (IIU,IJU,IKU))
ELSE
ALLOCATE(XCURRENT_L_O_EXN_CP (0,0,0))
END IF
ALLOCATE(XCURRENT_RHODJ (IIU,IJU,IKU))
!
!* coefficients for Th to Thl conversion
!
IF (LUSERC) THEN
ALLOCATE(ZL (IIU,IJU,IKU))
ALLOCATE(ZEXN(IIU,IJU,IKU))
ALLOCATE(ZCP (IIU,IJU,IKU))
!
!* Exner function
!
ZEXN(:,:,:) = (XPABST/XP00)**(XRD/XCPD)
!
!* Latent heat of vaporization
!
ZL(:,:,:) = XLVTT + (XCPD-XCL) * (XTHT(:,:,:)*ZEXN(:,:,:)-XTT)
!
!* heat capacity at constant pressure of the humid air
!
ZCP(:,:,:) = XCPD
IRR=2
ZCP(:,:,:) = ZCP(:,:,:) + XCPV * XRT(:,:,:,1)
ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRT(:,:,:,2)
IF (LUSERR) THEN
IRR=IRR+1
ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRT(:,:,:,IRR)
END IF
IF (LUSERI) THEN
IRR=IRR+1
ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
END IF
IF (LUSERS) THEN
IRR=IRR+1
ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
END IF
IF (LUSERG) THEN
IRR=IRR+1
ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
END IF
IF (LUSERH) THEN
IRR=IRR+1
ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
END IF
!
!* L / (Exn * Cp)
!
XCURRENT_L_O_EXN_CP(:,:,:) = ZL(:,:,:) / ZEXN(:,:,:) / ZCP(:,:,:)
!
DEALLOCATE(ZL )
DEALLOCATE(ZEXN)
DEALLOCATE(ZCP )
END IF
!
!* other initializations
!
XCURRENT_RHODJ=XRHODJ
!
LCURRENT_USERV=LUSERV
LCURRENT_USERC=LUSERC
LCURRENT_USERR=LUSERR
LCURRENT_USERI=LUSERI
LCURRENT_USERS=LUSERS
LCURRENT_USERG=LUSERG
LCURRENT_USERH=LUSERH
!
NCURRENT_RR = NRR
!
ALLOCATE(XCURRENT_RUS (IIU,IJU,IKU))
ALLOCATE(XCURRENT_RVS (IIU,IJU,IKU))
ALLOCATE(XCURRENT_RWS (IIU,IJU,IKU))
ALLOCATE(XCURRENT_RTHS (IIU,IJU,IKU))
ALLOCATE(XCURRENT_RTKES(IIU,IJU,IKU))
ALLOCATE(XCURRENT_RRS (IIU,IJU,IKU,NRR))
ALLOCATE(XCURRENT_RSVS (IIU,IJU,IKU,NSV))
ALLOCATE(XCURRENT_RTHLS(IIU,IJU,IKU))
ALLOCATE(XCURRENT_RRTS (IIU,IJU,IKU))
!
XCURRENT_RUS =XRUS
XCURRENT_RVS =XRVS
XCURRENT_RWS =XRWS
XCURRENT_RTHS =XRTHS
XCURRENT_RTKES=XRTKES
XCURRENT_RRS =XRRS
XCURRENT_RSVS =XRSVS
CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
LUSERI, LUSERS, LUSERG, LUSERH, &
XCURRENT_L_O_EXN_CP, &
XCURRENT_RTHS, XCURRENT_RRS, &
XCURRENT_RTHLS, XCURRENT_RRTS )
ALLOCATE(X_LES_BU_RES_KE (NLES_K,NLES_TOT))
ALLOCATE(X_LES_BU_RES_WThl (NLES_K,NLES_TOT))
ALLOCATE(X_LES_BU_RES_Thl2 (NLES_K,NLES_TOT))
ALLOCATE(X_LES_BU_SBG_Tke (NLES_K,NLES_TOT))
ALLOCATE(X_LES_BU_RES_WRt (NLES_K,NLES_TOT))
ALLOCATE(X_LES_BU_RES_Rt2 (NLES_K,NLES_TOT))
ALLOCATE(X_LES_BU_RES_ThlRt(NLES_K,NLES_TOT))
ALLOCATE(X_LES_BU_RES_Sv2 (NLES_K,NLES_TOT,NSV))
ALLOCATE(X_LES_BU_RES_WSv (NLES_K,NLES_TOT,NSV))
X_LES_BU_RES_KE = 0.
X_LES_BU_RES_WThl = 0.
X_LES_BU_RES_Thl2 = 0.
X_LES_BU_SBG_Tke = 0.
X_LES_BU_RES_WRt = 0.
X_LES_BU_RES_Rt2 = 0.
X_LES_BU_RES_ThlRt= 0.
X_LES_BU_RES_Sv2 = 0.
X_LES_BU_RES_WSv = 0.
!
!-------------------------------------------------------------------------------
!
!* 4. Definition of anomaly fields
! ----------------------------
!
ALLOCATE (XU_ANOM (IIU,IJU,NLES_K))
ALLOCATE (XV_ANOM (IIU,IJU,NLES_K))
ALLOCATE (XW_ANOM (IIU,IJU,NLES_K))
ALLOCATE (XTHL_ANOM(IIU,IJU,NLES_K))
IF (LUSERV) THEN
ALLOCATE (XRT_ANOM (IIU,IJU,NLES_K))
ELSE
ALLOCATE (XRT_ANOM (0,0,0))
END IF
ALLOCATE (XSV_ANOM (IIU,IJU,NLES_K,NSV))
!
!* 4.1 conservative variables
! ----------------------
!
ALLOCATE(ZTHL(IIU,IJU,IKU))
ALLOCATE(ZRT (IIU,IJU,IKU))
CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
LUSERI, LUSERS, LUSERG, LUSERH, &
XCURRENT_L_O_EXN_CP, &
XTHT, XRT, &
ZTHL, ZRT )
!
!* 4.2 anomaly fields on the LES grid
! ------------------------------
!
CALL LES_ANOMALY_FIELD(MXF(XUT),XU_ANOM)
CALL LES_ANOMALY_FIELD(MYF(XVT),XV_ANOM)
CALL LES_ANOMALY_FIELD(MZF(XWT),XW_ANOM)
CALL LES_ANOMALY_FIELD(ZTHL,XTHL_ANOM)
IF (LUSERV) CALL LES_ANOMALY_FIELD(ZRT,XRT_ANOM)
DO JSV=1,NSV
CALL LES_ANOMALY_FIELD(XSVT(:,:,:,JSV),XSV_ANOM(:,:,:,JSV))
END DO
!
!-------------------------------------------------------------------------------
!
DEALLOCATE(ZTHL)
DEALLOCATE(ZRT )
!-------------------------------------------------------------------------------
!
!* 6.0 Nebulosity masks
! ----------------
!
CALL LES_CLOUD_MASKS_n
!
!-------------------------------------------------------------------------------
CALL SECOND_MNH(ZTIME2)
XTIME_LES_BU = XTIME_LES_BU + ZTIME2 - ZTIME1
!--------------------------------------------------------------------------------
!
CONTAINS
!
!--------------------------------------------------------------------------------
!
SUBROUTINE LES_ANOMALY_FIELD(PF,PF_ANOM)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PF
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_ANOM
REAL, DIMENSION(SIZE(PF_ANOM,3)) :: ZMEAN
INTEGER :: JI, JJ
CALL LES_VER_INT(PF, PF_ANOM)
CALL LES_MEAN_ll(PF_ANOM, LLES_CURRENT_CART_MASK, ZMEAN )
DO JJ=1,SIZE(PF_ANOM,2)
DO JI=1,SIZE(PF_ANOM,1)
PF_ANOM(JI,JJ,:) = PF_ANOM(JI,JJ,:) - ZMEAN(:)
END DO
END DO
END SUBROUTINE LES_ANOMALY_FIELD
!--------------------------------------------------------------------------------
!
END SUBROUTINE LES_INI_TIMESTEP_n
src/mesonh/ext/switch_sbg_lesn.f90 0 → 100644
+ 589
− 0
View file @ 17bc3c35
This diff is collapsed.
src/mesonh/ext/write_lesn.f90 0 → 100644
+ 1318
− 0
View file @ 17bc3c35
This diff is collapsed.
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme