Newer
Older
!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
MODULE MODE_COMPUTE_UPDRAFT
! ###########################
!
IMPLICIT NONE
CONTAINS
SUBROUTINE COMPUTE_UPDRAFT(D,CST,NEBN,PARAMMF,TURBN,CSTURB, &
RODIER Quentin
committed
OENTR_DETR, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
PPABSM,PRHODREF,PUM,PVM, PTKEM, &
PTHM,PRVM,PTHLM,PRTM, &
PSVM,PTHL_UP,PRT_UP, &
PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
PW_UP,PU_UP, PV_UP, PSV_UP, &
PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
PEMF,PDETR,PENTR, &
PBUO_INTEG,KKLCL,KKETL,KKCTL, &
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
! #################################################################
!!
!!**** *COMPUTE_UPDRAFT* - calculates caracteristics of the updraft
!!
!!
!! PURPOSE
!! -------
!!**** The purpose of this routine is to build the updraft model
!!
!
!!** METHOD
!! ------
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! !! REFERENCE
!! ---------
!! Book 1 of Meso-NH documentation (chapter Turbulence)
!! Soares et al. 2004 QJ
!!
!! AUTHOR
!! ------
!! J.Pergaud
!! V.Masson : Optimization 07/2010
!! S. Riette : 07/2010 : modification for reproducibility
!! S. Riette may 2011: ice added, interface modified
!! S. Riette Jan 2012: support for both order of vertical levels
!! V.Masson, C.Lac : 02/2011 : SV_UP initialized by a non-zero value
!! S. Riette Apr 2013: improvement of continuity at the condensation level
!! R.Honnert Oct 2016 : Add ZSURF and Update with AROME
!! Q.Rodier 01/2019 : support RM17 mixing length
!! R.Honnert 01/2019 : add LGZ (reduction of the mass-flux surface closure with the resolution)
!! S. Riette 06/2022: compute_entr_detr is inlined
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALL_t
USE MODD_TURB_n, ONLY: TURB_t
RIETTE Sébastien
committed
USE MODD_CTURB, ONLY: CSTURB_t
USE MODI_SHUMAN_MF, ONLY: MZM_MF, MZF_MF, GZ_M_W_MF
USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
IMPLICIT NONE
!* 1.1 Declaration of Arguments
!
!
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_MFSHALL_t), INTENT(IN) :: PARAMMF
RODIER Quentin
committed
TYPE(TURB_t), INTENT(IN) :: TURBN
RIETTE Sébastien
committed
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
INTEGER, INTENT(IN) :: KSV
CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! Height at the flux point
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Metrics coefficient
REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSFTH,PSFRV
! normal surface fluxes of theta,rv,(u,v) parallel to the orography
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABSM ! Pressure at t-dt
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! dry density of the
! reference state
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PUM ! u mean wind
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PVM ! v mean wind
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKEM ! TKE at t-dt
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(IN) :: PSVM ! scalar var. at t-dt
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
PRI_UP,PTHV_UP,& ! updraft ri, THv
PW_UP,PFRAC_UP,& ! updraft w, fraction
PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
PRSAT_UP ! Rsat
REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT) :: PSV_UP ! updraft scalar var.
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
! detrainment,entrainment
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
INTEGER, DIMENSION(D%NIJT), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PDEPTH ! Deepness of cloud
! 1.2 Declaration of local variables
!
!
! Mean environment variables at t-dt at flux point
REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZTHM_F,ZRVM_F ! Theta,rv of
! updraft environnement
REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZRTM_F, ZTHLM_F, ZTKEM_F,& ! rt, thetal,TKE,pressure,
ZUM_F,ZVM_F,ZRHO_F, & ! density,momentum
ZPRES_F,ZTHVM_F,ZTHVM, & ! interpolated at the flux point
ZG_O_THVREF, & ! g*ThetaV ref
ZW_UP2, & ! w**2 of the updraft
ZBUO_INTEG_DRY, ZBUO_INTEG_CLD,&! Integrated Buoyancy
ZENTR_CLD,ZDETR_CLD ! wet entrainment and detrainment
REAL, DIMENSION(D%NIJT,D%NKT,KSV) :: &
ZSVM_F ! scalar variables
REAL, DIMENSION(D%NIJT,D%NKT) :: &
ZTH_UP, & ! updraft THETA
ZRC_MIX, ZRI_MIX ! guess of Rc and Ri for KF mixture
REAL, DIMENSION(D%NIJT,D%NKT) :: ZCOEF ! diminution coefficient for too high clouds
REAL, DIMENSION(D%NIJT) :: ZWTHVSURF ! Surface w'thetav'
REAL :: ZRDORV ! RD/RV
REAL :: ZRVORD ! RV/RD
REAL, DIMENSION(D%NIJT) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD
REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground
INTEGER :: JK,JIJ,JSV ! loop counters
LOGICAL, DIMENSION(D%NIJT) :: GTEST,GTESTLCL,GTESTETL
! Test if the ascent continue, if LCL or ETL is reached
LOGICAL :: GLMIX
! To choose upward or downward mixing length
LOGICAL, DIMENSION(D%NIJT) :: GWORK1
LOGICAL, DIMENSION(D%NIJT,D%NKT) :: GWORK2
INTEGER :: ITEST
REAL, DIMENSION(D%NIJT) :: ZRC_UP, ZRI_UP, ZRV_UP,&
ZRSATW, ZRSATI,&
ZPART_DRY
REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
REAL :: ZTMAX,ZRMAX ! control value
REAL, DIMENSION(D%NIJT) :: ZSURF
REAL, DIMENSION(D%NIJT,D%NKT) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK
REAL, DIMENSION(D%NIJT,16) :: ZBUF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
! 1.3 Declaration of additional local variables for compute_entr_detr
!
! Variables for cloudy part
REAL, DIMENSION(D%NIJT) :: ZKIC, ZKIC_F2 ! fraction of env. mass in the muxtures
REAL, DIMENSION(D%NIJT) :: ZEPSI,ZDELTA ! factor entrainment detrainment
REAL :: ZEPSI_CLOUD ! factor entrainment detrainment
REAL :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr.
REAL, DIMENSION(D%NIJT) :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures
REAL, DIMENSION(D%NIJT) :: ZTHMIX ! Theta and Thetav of mixtures
REAL, DIMENSION(D%NIJT) :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures
REAL, DIMENSION(D%NIJT) :: ZTHVMIX, ZTHVMIX_F2 ! Theta and Thetav of mixtures
REAL, DIMENSION(D%NIJT) :: ZTHV_UP_F2 ! thv_up at flux point kk+kkl
REAL, DIMENSION(D%NIJT) :: ZRSATW_ED, ZRSATI_ED ! working arrays (mixing ratio at saturation)
REAL, DIMENSION(D%NIJT) :: ZTHV ! theta V of environment at the bottom of cloudy part
REAL :: ZKIC_INIT !Initial value of ZKIC
REAL :: ZCOTHVU ! Variation of Thvup between bottom and top of cloudy part
! Variables for dry part
REAL :: ZFOESW, ZFOESI ! saturating vapor pressure
REAL :: ZDRSATODP ! d.Rsat/dP
REAL :: ZT ! Temperature
REAL :: ZWK0D ! Work array
! Variables for dry and cloudy parts
REAL, DIMENSION(D%NIJT) :: ZCOEFF_MINUS_HALF,& ! Variation of Thv between mass points kk-kkl and kk
ZCOEFF_PLUS_HALF ! Variation of Thv between mass points kk and kk+kkl
REAL, DIMENSION(D%NIJT) :: ZPRE ! pressure at the bottom of the cloudy part
REAL, DIMENSION(D%NIJT) :: ZG_O_THVREF_ED
REAL, DIMENSION(D%NIJT) :: ZFRAC_ICE ! fraction of ice
REAL, DIMENSION(D%NIJT) :: ZDZ_STOP,& ! Exact Height of the LCL above flux level KK
ZTHV_MINUS_HALF,& ! Thv at flux point(kk)
ZTHV_PLUS_HALF ! Thv at flux point(kk+kkl)
REAL :: ZDZ ! Delta Z used in computations
INTEGER :: JKLIM
INTEGER :: IIJB,IIJE ! physical horizontal domain indices
INTEGER :: IKT,IKB,IKE,IKL
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',0,ZHOOK_HANDLE)
!
IIJE=D%NIJE
IIJB=D%NIJB
IKT=D%NKT
IKB=D%NKB
IKE=D%NKE
IKL=D%NKL
!
! Thresholds for the perturbation of
! theta_l and r_t at the first level of the updraft
ZTMAX=2.0
ZRMAX=1.E-3
!------------------------------------------------------------------------
! INITIALISATION
! Initialisation of the constants
ZRDORV = CST%XRD / CST%XRV !=0.622
ZRVORD = (CST%XRV / CST%XRD)
ZDEPTH_MAX1=3000. ! clouds with depth inferior to this value are keeped untouched
ZDEPTH_MAX2=4000. ! clouds with depth superior to this value are suppressed
! Local variables, internal domain
IF (OENTR_DETR) THEN
! Initialisation of intersesting Level :LCL,ETL,CTL
KKLCL(:)=IKE
KKETL(:)=IKE
KKCTL(:)=IKE
!
! Initialisation
!* udraft governing variables
PEMF(:,:)=0.
PDETR(:,:)=0.
PENTR(:,:)=0.
! Initialisation
!* updraft core variables
PRV_UP(:,:)=0.
PRC_UP(:,:)=0.
PRI_UP(:,:)=0.
PW_UP(:,:)=0.
ZTH_UP(:,:)=0.
PFRAC_UP(:,:)=0.
PTHV_UP(:,:)=0.
PBUO_INTEG=0.
PFRAC_ICE_UP(:,:)=0.
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PRSAT_UP(IIJB:IIJE,1:IKT)=PRVM(IIJB:IIJE,1:IKT) ! should be initialised correctly but is (normaly) not used
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!cloud/dry air mixture cloud content
ZRC_MIX = 0.
ZRI_MIX = 0.
END IF
! Initialisation of environment variables at t-dt
! variables at flux level
CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:))
CALL MZM_MF(D, PRTM(:,:), ZRTM_F (:,:))
CALL MZM_MF(D, PUM(:,:), ZUM_F (:,:))
CALL MZM_MF(D, PVM(:,:), ZVM_F (:,:))
CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:))
RIETTE Sébastien
committed
DO JSV=1,KSV
IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
CALL MZM_MF(D, PSVM(:,:,JSV), ZSVM_F(:,:,JSV))
END DO
!
! Initialisation of updraft characteristics
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
PTHL_UP(IIJB:IIJE,1:IKT)=ZTHLM_F(IIJB:IIJE,1:IKT)
PRT_UP(IIJB:IIJE,1:IKT)=ZRTM_F(IIJB:IIJE,1:IKT)
PU_UP(IIJB:IIJE,1:IKT)=ZUM_F(IIJB:IIJE,1:IKT)
PV_UP(IIJB:IIJE,1:IKT)=ZVM_F(IIJB:IIJE,1:IKT)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV)
PSV_UP(IIJB:IIJE,1:IKT,:)=ZSVM_F(IIJB:IIJE,1:IKT,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV)
! Computation or initialisation of updraft characteristics at the KKB level
! thetal_up,rt_up,thetaV_up, w2,Buoyancy term and mass flux (PEMF)
!$mnh_expand_array(JIJ=IIJB:IIJE)
PTHL_UP(IIJB:IIJE,IKB)= ZTHLM_F(IIJB:IIJE,IKB)+ &
& MAX(0.,MIN(ZTMAX,(PSFTH(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))* PARAMMF%XALP_PERT))
PRT_UP(IIJB:IIJE,IKB) = ZRTM_F(IIJB:IIJE,IKB)+ &
& MAX(0.,MIN(ZRMAX,(PSFRV(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))* PARAMMF%XALP_PERT))
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
IF (OENTR_DETR) THEN
CALL MZM_MF(D, PTHM (:,:), ZTHM_F (:,:))
CALL MZM_MF(D, PPABSM(:,:), ZPRES_F(:,:))
CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F (:,:))
CALL MZM_MF(D, PRVM(:,:), ZRVM_F (:,:))
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! thetav at mass and flux levels
ZTHVM_F(IIJB:IIJE,1:IKT)=ZTHM_F(IIJB:IIJE,1:IKT)* &
&((1.+ZRVORD*ZRVM_F(IIJB:IIJE,1:IKT))/(1.+ZRTM_F(IIJB:IIJE,1:IKT)))
ZTHVM(IIJB:IIJE,1:IKT)=PTHM(IIJB:IIJE,1:IKT)* &
&((1.+ZRVORD*PRVM(IIJB:IIJE,1:IKT))/(1.+PRTM(IIJB:IIJE,1:IKT)))
PTHV_UP(IIJB:IIJE,1:IKT)=ZTHVM_F(IIJB:IIJE,1:IKT)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZW_UP2(:,:)=0.
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZW_UP2(IIJB:IIJE,IKB) = MAX(0.0001,(2./3.)*ZTKEM_F(IIJB:IIJE,IKB))
! Computation of non conservative variable for the KKB level of the updraft
! (all or nothing ajustement)
PRC_UP(:,IKB)=0.
PRI_UP(:,IKB)=0.
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
CALL TH_R_FROM_THL_RT(CST, NEBN, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,IKB),ZPRES_F(:,IKB), &
PTHL_UP(:,IKB),PRT_UP(:,IKB),ZTH_UP(:,IKB), &
PRV_UP(:,IKB),PRC_UP(:,IKB),PRI_UP(:,IKB),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., &
PBUF=ZBUF(:,:), KB=D%NIJB, KE=D%NIJE)
!$mnh_expand_array(JIJ=IIJB:IIJE)
! compute updraft thevav and buoyancy term at KKB level
PTHV_UP(IIJB:IIJE,IKB) = ZTH_UP(IIJB:IIJE,IKB)*&
& ((1+ZRVORD*PRV_UP(IIJB:IIJE,IKB))/(1+PRT_UP(IIJB:IIJE,IKB)))
! compute mean rsat in updraft
PRSAT_UP(IIJB:IIJE,IKB) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,IKB)) + &
& ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,IKB)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
! Closure assumption for mass flux at KKB level
!
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZG_O_THVREF(IIJB:IIJE,1:IKT)=CST%XG/ZTHVM_F(IIJB:IIJE,1:IKT)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
! compute L_up
GLMIX=.TRUE.
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZTKEM_F(IIJB:IIJE,IKB)=0.
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
RODIER Quentin
committed
IF(TURBN%CTURBLEN=='RM17') THEN
CALL GZ_M_W_MF(D, PUM, PDZZ, ZWK)
CALL MZF_MF(D, ZWK, ZDUDZ)
CALL GZ_M_W_MF(D, PVM, PDZZ, ZWK)
CALL MZF_MF(D, ZWK, ZDVDZ)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)**2 + ZDVDZ(IIJB:IIJE,1:IKT)**2)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
ELSE
ZSHEAR = 0. !no shear in bl89 mixing length
END IF
RODIER Quentin
committed
#ifdef REPRO48
CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,IKB),&
&ZG_O_THVREF(:,IKB),ZTHVM,IKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
RODIER Quentin
committed
#else
CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,IKB),&
&ZG_O_THVREF(:,IKB),ZTHVM,IKB,GLMIX,.FALSE.,ZSHEAR,ZLUP)
RODIER Quentin
committed
#endif
!$mnh_expand_where(JIJ=IIJB:IIJE)
ZLUP(IIJB:IIJE)=MAX(ZLUP(IIJB:IIJE),1.E-10)
! Compute Buoyancy flux at the ground
ZWTHVSURF(IIJB:IIJE) = (ZTHVM_F(IIJB:IIJE,IKB)/ZTHM_F(IIJB:IIJE,IKB))*PSFTH(IIJB:IIJE)+ &
(0.61*ZTHM_F(IIJB:IIJE,IKB))*PSFRV(IIJB:IIJE)
! Mass flux at KKB level (updraft triggered if PSFTH>0.)
IF (PARAMMF%LGZ) THEN
IF(PDX==0. .OR. PDY==0.) THEN
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'COMPUTE_UPDRAFT', 'PDX or PDY is NULL with option LGZ!')
ZSURF(IIJB:IIJE)=TANH(PARAMMF%XGZ*SQRT(PDX*PDY)/ZLUP(IIJB:IIJE))
ZSURF(IIJB:IIJE)=1.
WHERE (ZWTHVSURF(IIJB:IIJE)>0.)
PEMF(IIJB:IIJE,IKB) = PARAMMF%XCMF * ZSURF(IIJB:IIJE) * ZRHO_F(IIJB:IIJE,IKB) * &
((ZG_O_THVREF(IIJB:IIJE,IKB))*ZWTHVSURF(IIJB:IIJE)*ZLUP(IIJB:IIJE))**(1./3.)
PFRAC_UP(IIJB:IIJE,IKB)=MIN(PEMF(IIJB:IIJE,IKB)/(SQRT(ZW_UP2(IIJB:IIJE,IKB))*ZRHO_F(IIJB:IIJE,IKB)), &
&PARAMMF%XFRAC_UP_MAX)
ZW_UP2(IIJB:IIJE,IKB)=(PEMF(IIJB:IIJE,IKB)/(PFRAC_UP(IIJB:IIJE,IKB)*ZRHO_F(IIJB:IIJE,IKB)))**2
GTEST(IIJB:IIJE)=.TRUE.
ELSEWHERE
PEMF(IIJB:IIJE,IKB) =0.
GTEST(IIJB:IIJE)=.FALSE.
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!$mnh_expand_array(JIJ=IIJB:IIJE)
GTEST(IIJB:IIJE)=PEMF(IIJB:IIJE,IKB+IKL)>0.
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF
!--------------------------------------------------------------------------
! 3. Vertical ascending loop
! -----------------------
!
! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F
!
!
GTESTLCL(:)=.FALSE.
GTESTETL(:)=.FALSE.
! Loop on vertical level
DO JK=IKB,IKE-IKL,IKL
! IF the updraft top is reached for all column, stop the loop on levels
ITEST=COUNT(GTEST(IIJB:IIJE))
IF (ITEST==0) CYCLE
! Computation of entrainment and detrainment with KF90
! parameterization in clouds and LR01 in subcloud layer
! to find the LCL (check if JK is LCL or not)
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE ((PRC_UP(IIJB:IIJE,JK)+PRI_UP(IIJB:IIJE,JK)>0.).AND.(.NOT.(GTESTLCL(IIJB:IIJE))))
KKLCL(IIJB:IIJE) = JK
GTESTLCL(IIJB:IIJE)=.TRUE.
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
! COMPUTE PENTR and PDETR at mass level JK
IF (OENTR_DETR) THEN
IF(JK/=IKB) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZRC_MIX(IIJB:IIJE,JK) = ZRC_MIX(IIJB:IIJE,JK-IKL) ! guess of Rc of mixture
ZRI_MIX(IIJB:IIJE,JK) = ZRI_MIX(IIJB:IIJE,JK-IKL) ! guess of Ri of mixture
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
CALL COMPUTE_ENTR_DETR(D, CST, NEBN, PARAMMF, JK,IKB,IKE,IKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+IKL),&
PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), &
PTHLM(:,:),PRTM(:,:),ZW_UP2(:,:),ZTH_UP(:,JK), &
PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), &
PRC_UP(:,JK),PRI_UP(:,JK),PTHV_UP(:,JK),&
PRSAT_UP(:,JK),ZRC_MIX(:,JK),ZRI_MIX(:,JK), &
PENTR(:,JK),PDETR(:,JK),ZENTR_CLD(:,JK),ZDETR_CLD(:,JK),&
ZBUO_INTEG_DRY(:,JK), ZBUO_INTEG_CLD(:,JK), &
ZPART_DRY(:) )
!$mnh_expand_where(JIJ=IIJB:IIJE)
PBUO_INTEG(IIJB:IIJE,JK)=ZBUO_INTEG_DRY(IIJB:IIJE,JK)+ZBUO_INTEG_CLD(IIJB:IIJE,JK)
IF (JK==IKB) THEN
PDETR(IIJB:IIJE,JK)=0.
ZDETR_CLD(IIJB:IIJE,JK)=0.
ENDIF
! Computation of updraft characteristics at level JK+KKL
WHERE(GTEST(IIJB:IIJE))
ZMIX1(IIJB:IIJE)=0.5*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
&(PENTR(IIJB:IIJE,JK)-PDETR(IIJB:IIJE,JK))
PEMF(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK)*EXP(2*ZMIX1(IIJB:IIJE))
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
ELSE !OENTR_DETR
!$mnh_expand_array(JIJ=IIJB:IIJE)
GTEST(IIJB:IIJE) = (PEMF(IIJB:IIJE,JK+IKL)>0.)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF !OENTR_DETR
! stop the updraft if MF becomes negative
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (GTEST(IIJB:IIJE).AND.(PEMF(IIJB:IIJE,JK+IKL)<=0.))
PEMF(IIJB:IIJE,JK+IKL)=0.
KKCTL(IIJB:IIJE) = JK+IKL
GTEST(IIJB:IIJE)=.FALSE.
PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)=PFRAC_ICE_UP(IIJB:IIJE,JK)
PRSAT_UP(IIJB:IIJE,JK+IKL)=PRSAT_UP(IIJB:IIJE,JK)
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
! If the updraft did not stop, compute cons updraft characteritics at jk+KKL
RODIER Quentin
committed
DO JIJ=IIJB,IIJE
IF(GTEST(JIJ)) THEN
ZMIX2(JIJ) = (PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*PENTR(JIJ,JK) !&
ZMIX3_CLD(JIJ) = (PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*(1.-ZPART_DRY(JIJ))*ZDETR_CLD(JIJ,JK) !&
ZMIX2_CLD(JIJ) = (PZZ(JIJ,JK+IKL)-PZZ(JIJ,JK))*(1.-ZPART_DRY(JIJ))*ZENTR_CLD(JIJ,JK)
RODIER Quentin
committed
#ifdef REPRO48
RODIER Quentin
committed
PTHL_UP(JIJ,JK+IKL)=(PTHL_UP(JIJ,JK)*(1.-0.5*ZMIX2(JIJ)) + PTHLM(JIJ,JK)*ZMIX2(JIJ)) &
/(1.+0.5*ZMIX2(JIJ))
PRT_UP(JIJ,JK+IKL) =(PRT_UP (JIJ,JK)*(1.-0.5*ZMIX2(JIJ)) + PRTM(JIJ,JK)*ZMIX2(JIJ)) &
/(1.+0.5*ZMIX2(JIJ))
RODIER Quentin
committed
#else
RODIER Quentin
committed
PTHL_UP(JIJ,JK+IKL)=PTHL_UP(JIJ,JK)*EXP(-ZMIX2(JIJ)) + PTHLM(JIJ,JK)*(1-EXP(-ZMIX2(JIJ)))
PRT_UP(JIJ,JK+IKL) =PRT_UP (JIJ,JK)*EXP(-ZMIX2(JIJ)) + PRTM(JIJ,JK)*(1-EXP(-ZMIX2(JIJ)))
RODIER Quentin
committed
#endif
RODIER Quentin
committed
IF(PARAMMF%LMIXUV) THEN
IF(JK/=IKB) THEN
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE(GTEST(IIJB:IIJE))
PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
&PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+&
(PUM(IIJB:IIJE,JK)-PUM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) &
/(1+0.5*ZMIX2(IIJB:IIJE))
PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
&PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+&
(PVM(IIJB:IIJE,JK)-PVM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) &
/(1+0.5*ZMIX2(IIJB:IIJE))
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE(GTEST(IIJB:IIJE))
PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
&PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) &
/(1+0.5*ZMIX2(IIJB:IIJE))
PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
&PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ &
0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*&
((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) &
/(1+0.5*ZMIX2(IIJB:IIJE))
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
RODIER Quentin
committed
ENDIF !PARAMMF%LMIXUV
RIETTE Sébastien
committed
DO JSV=1,KSV
IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE(GTEST(IIJB:IIJE))
PSV_UP(IIJB:IIJE,JK+IKL,JSV) = (PSV_UP(IIJB:IIJE,JK,JSV)*(1-0.5*ZMIX2(IIJB:IIJE)) + &
PSVM(IIJB:IIJE,JK,JSV)*ZMIX2(IIJB:IIJE)) /(1+0.5*ZMIX2(IIJB:IIJE))
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
IF (OENTR_DETR) THEN
! Compute non cons. var. at level JK+KKL
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZRC_UP(IIJB:IIJE)=PRC_UP(IIJB:IIJE,JK) ! guess = level just below
ZRI_UP(IIJB:IIJE)=PRI_UP(IIJB:IIJE,JK) ! guess = level just below
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
CALL TH_R_FROM_THL_RT(CST, NEBN, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+IKL),ZPRES_F(:,JK+IKL), &
PTHL_UP(:,JK+IKL),PRT_UP(:,JK+IKL),ZTH_UP(:,JK+IKL), &
ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., &
PBUF=ZBUF(:,:), KB=D%NIJB, KE=D%NIJE)
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE(GTEST(IIJB:IIJE))
PRC_UP(IIJB:IIJE,JK+IKL)=ZRC_UP(IIJB:IIJE)
PRV_UP(IIJB:IIJE,JK+IKL)=ZRV_UP(IIJB:IIJE)
PRI_UP(IIJB:IIJE,JK+IKL)=ZRI_UP(IIJB:IIJE)
PRSAT_UP(IIJB:IIJE,JK+IKL) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)) + &
& ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)
ENDWHERE
! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
WHERE(GTEST(IIJB:IIJE))
PTHV_UP(IIJB:IIJE,JK+IKL) = ZTH_UP(IIJB:IIJE,JK+IKL)* &
& ((1+ZRVORD*PRV_UP(IIJB:IIJE,JK+IKL))/(1+PRT_UP(IIJB:IIJE,JK+IKL)))
WHERE (ZBUO_INTEG_DRY(IIJB:IIJE,JK)>0.)
ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK) + 2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)* &
&ZBUO_INTEG_DRY(IIJB:IIJE,JK)
ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(IIJB:IIJE,JK)
ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK+IKL)*(1.-(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+ &
&PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE)))&
/(1.+(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE))) &
+2.*(PARAMMF%XABUO)*ZBUO_INTEG_CLD(IIJB:IIJE,JK)/ &
&(1.+(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE)))
! Test if the updraft has reach the ETL
WHERE (GTEST(IIJB:IIJE).AND.(PBUO_INTEG(IIJB:IIJE,JK)<=0.))
KKETL(IIJB:IIJE) = JK+IKL
GTESTETL(IIJB:IIJE)=.TRUE.
GTESTETL(IIJB:IIJE)=.FALSE.
! Test is we have reached the top of the updraft
WHERE (GTEST(IIJB:IIJE).AND.((ZW_UP2(IIJB:IIJE,JK+IKL)<=0.).OR.(PEMF(IIJB:IIJE,JK+IKL)<=0.)))
ZW_UP2(IIJB:IIJE,JK+IKL)=0.
PEMF(IIJB:IIJE,JK+IKL)=0.
GTEST(IIJB:IIJE)=.FALSE.
PTHL_UP(IIJB:IIJE,JK+IKL)=ZTHLM_F(IIJB:IIJE,JK+IKL)
PRT_UP(IIJB:IIJE,JK+IKL)=ZRTM_F(IIJB:IIJE,JK+IKL)
PRC_UP(IIJB:IIJE,JK+IKL)=0.
PRI_UP(IIJB:IIJE,JK+IKL)=0.
PRV_UP(IIJB:IIJE,JK+IKL)=0.
PTHV_UP(IIJB:IIJE,JK+IKL)=ZTHVM_F(IIJB:IIJE,JK+IKL)
PFRAC_UP(IIJB:IIJE,JK+IKL)=0.
KKCTL(IIJB:IIJE)=JK+IKL
Loading
Loading full blame...