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

Quentin 09/08/2022: Packing mode_bl_depth_diag and mode_sbl_depth

parent 47b6f1b8
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/common/turb/mode_bl_depth_diag.F90
+ 24
− 28
View file @ ca315023
......@@ -55,19 +55,19 @@ USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PSURF ! surface flux
REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PZS ! orography
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PFLUX ! flux
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux points
REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
REAL, DIMENSION(D%NIT,D%NJT), INTENT(OUT) :: BL_DEPTH_DIAG3D
TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, DIMENSION(D%NIJT), INTENT(IN) :: PSURF ! surface flux
REAL, DIMENSION(D%NIJT), INTENT(IN) :: PZS ! orography
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLUX ! flux
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux points
REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: BL_DEPTH_DIAG3D
!
!
! 0.2 declaration of local variables
!
INTEGER :: JI,JJ,JK ! loop counters
INTEGER :: IKB,IKE,IIB,IIE,IJB,IJE ! index value for the Beginning
INTEGER :: JIJ,JK ! loop counters
INTEGER :: IKB,IKE,IIJB,IIJE ! index value for the Beginning
REAL :: ZFLX ! flux at top of BL
!
!----------------------------------------------------------------------------
......@@ -76,34 +76,30 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_3D',0,ZHOOK_HANDLE)
IKB=D%NKTB
IKE=D%NKTE
IIE=D%NIEC
IIB=D%NIBC
IJE=D%NJEC
IJB=D%NJBC
IIJE=D%NIJE
IIJB=D%NIJB
!
BL_DEPTH_DIAG3D(:,:) = 0.
BL_DEPTH_DIAG3D(:) = 0.
!
DO JJ=1,IJE
DO JI=1,IIE
IF (PSURF(JI,JJ)==0.) CYCLE
DO JIJ=IIJB,IIJE
IF (PSURF(JIJ)==0.) CYCLE
DO JK=IKB,IKE,D%NKL
IF (PZZ(JI,JJ,JK-D%NKL)<=PZS(JI,JJ)) CYCLE
ZFLX = PSURF(JI,JJ) * PFTOP_O_FSURF
IF ( (PFLUX(JI,JJ,JK)-ZFLX)*(PFLUX(JI,JJ,JK-D%NKL)-ZFLX) <= 0. ) THEN
BL_DEPTH_DIAG3D(JI,JJ) = (PZZ (JI,JJ,JK-D%NKL) - PZS(JI,JJ)) &
+ (PZZ (JI,JJ,JK) - PZZ (JI,JJ,JK-D%NKL)) &
* (ZFLX - PFLUX(JI,JJ,JK-D%NKL) ) &
/ (PFLUX(JI,JJ,JK) - PFLUX(JI,JJ,JK-D%NKL) )
IF (PZZ(JIJ,JK-D%NKL)<=PZS(JIJ)) CYCLE
ZFLX = PSURF(JIJ) * PFTOP_O_FSURF
IF ( (PFLUX(JIJ,JK)-ZFLX)*(PFLUX(JIJ,JK-D%NKL)-ZFLX) <= 0. ) THEN
BL_DEPTH_DIAG3D(JIJ) = (PZZ (JIJ,JK-D%NKL) - PZS(JIJ)) &
+ (PZZ (JIJ,JK) - PZZ (JIJ,JK-D%NKL)) &
* (ZFLX - PFLUX(JIJ,JK-D%NKL) ) &
/ (PFLUX(JIJ,JK) - PFLUX(JIJ,JK-D%NKL) )
EXIT
END IF
END DO
END DO
END DO
!
!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
BL_DEPTH_DIAG3D(IIB:IIE,IJB:IJE) = BL_DEPTH_DIAG3D(IIB:IIE,IJB:IJE) / (1. - PFTOP_O_FSURF)
!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_expand_array(JIJ=IIJB:IIJE)
BL_DEPTH_DIAG3D(IIJB:IIJE) = BL_DEPTH_DIAG3D(IIJB:IIJE) / (1. - PFTOP_O_FSURF)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_3D',1,ZHOOK_HANDLE)
END SUBROUTINE BL_DEPTH_DIAG_3D
......
src/common/turb/mode_sbl_depth.F90
+ 62
− 64
View file @ ca315023
......@@ -58,29 +58,29 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux levels
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PFLXU ! u'w'
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PFLXV ! v'w'
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PWTHV ! buoyancy flux
REAL, DIMENSION(D%NIT,D%NJT), INTENT(IN) :: PLMO ! Monin-Obukhov length
REAL, DIMENSION(D%NIT,D%NJT), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZZ ! altitude of flux levels
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLXU ! u'w'
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PFLXV ! v'w'
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PWTHV ! buoyancy flux
REAL, DIMENSION(D%NIJT), INTENT(IN) :: PLMO ! Monin-Obukhov length
REAL, DIMENSION(D%NIJT), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
!
INTEGER :: JLOOP,JI,JJ,JK ! loop counter
INTEGER :: IKB,IKE,IIB,IIE,IJB,IJE ! index value for the Beginning
REAL, DIMENSION(D%NIT,D%NJT) :: ZQ0 ! surface buoyancy flux
REAL, DIMENSION(D%NIT,D%NJT) :: ZWU ! surface friction u'w'
REAL, DIMENSION(D%NIT,D%NJT) :: ZWV ! surface friction v'w'
REAL, DIMENSION(D%NIT,D%NJT) :: ZUSTAR2 ! surface friction
REAL, DIMENSION(D%NIT,D%NJT) :: ZSBL_DYN ! SBL wih dynamical criteria
REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWIND
INTEGER :: JLOOP,JIJ,JK ! loop counter
INTEGER :: IKB,IKE,IIJB,IIJE ! index value for the Beginning
REAL, DIMENSION(D%NIJT) :: ZQ0 ! surface buoyancy flux
REAL, DIMENSION(D%NIJT) :: ZWU ! surface friction u'w'
REAL, DIMENSION(D%NIJT) :: ZWV ! surface friction v'w'
REAL, DIMENSION(D%NIJT) :: ZUSTAR2 ! surface friction
REAL, DIMENSION(D%NIJT) :: ZSBL_DYN ! SBL wih dynamical criteria
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWIND
! intermediate wind for SBL calculation
REAL, DIMENSION(D%NIT,D%NJT) :: ZSBL_THER! SBL wih thermal criteria
REAL, DIMENSION(D%NIT,D%NJT) :: ZA ! ponderation coefficient
REAL, DIMENSION(D%NIJT) :: ZSBL_THER! SBL wih thermal criteria
REAL, DIMENSION(D%NIJT) :: ZA ! ponderation coefficient
!----------------------------------------------------------------------------
!
!* initialisations
......@@ -91,82 +91,80 @@ IF (LHOOK) CALL DR_HOOK('SBL_DEPTH',0,ZHOOK_HANDLE)
!
IKB=D%NKTB
IKE=D%NKTE
IIE=D%NIEC
IIB=D%NIBC
IJE=D%NJEC
IJB=D%NJBC
IIJE=D%NIJE
IIJB=D%NIJB
!
!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
ZWU(IIB:IIE,IJB:IJE) = PFLXU(IIB:IIE,IJB:IJE,IKB)
ZWV(IIB:IIE,IJB:IJE) = PFLXV(IIB:IIE,IJB:IJE,IKB)
ZQ0(IIB:IIE,IJB:IJE) = PWTHV(IIB:IIE,IJB:IJE,IKB)
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZWU(IIJB:IIJE) = PFLXU(IIJB:IIJE,IKB)
ZWV(IIJB:IIJE) = PFLXV(IIJB:IIJE,IKB)
ZQ0(IIJB:IIJE) = PWTHV(IIJB:IIJE,IKB)
!
ZUSTAR2(IIB:IIE,IJB:IJE) = SQRT(ZWU(IIB:IIE,IJB:IJE)**2+ZWV(IIB:IIE,IJB:IJE)**2)
ZUSTAR2(IIJB:IIJE) = SQRT(ZWU(IIJB:IIJE)**2+ZWV(IIJB:IIJE)**2)
!
!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!----------------------------------------------------------------------------
!
!* BL and SBL diagnosed with friction criteria
!
!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT)
ZWIND(IIB:IIE,IJB:IJE,:)=SQRT(PFLXU(IIB:IIE,IJB:IJE,:)**2+PFLXV(IIB:IIE,IJB:IJE,:)**2)
!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT)
CALL BL_DEPTH_DIAG(D,ZUSTAR2,PZZ(:,:,IKB),ZWIND,PZZ,CSTURB%XFTOP_O_FSURF,ZSBL_DYN)
!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
ZSBL_DYN(IIB:IIE,IJB:IJE) = CSTURB%XSBL_O_BL * ZSBL_DYN(IIB:IIE,IJB:IJE)
!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT)
ZWIND(IIJB:IIJE,1:D%NKT)=SQRT(PFLXU(IIJB:IIJE,1:D%NKT)**2+PFLXV(IIJB:IIJE,1:D%NKT)**2)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT)
CALL BL_DEPTH_DIAG(D,ZUSTAR2,PZZ(:,IKB),ZWIND,PZZ,CSTURB%XFTOP_O_FSURF,ZSBL_DYN)
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZSBL_DYN(IIJB:IIJE) = CSTURB%XSBL_O_BL * ZSBL_DYN(IIJB:IIJE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!----------------------------------------------------------------------------
!
!* BL and SBL diagnosed with buoyancy flux criteria
!
CALL BL_DEPTH_DIAG(D,ZQ0,PZZ(:,:,IKB),PWTHV,PZZ,CSTURB%XFTOP_O_FSURF,ZSBL_THER)
!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
ZSBL_THER(IIB:IIE,IJB:IJE)= CSTURB%XSBL_O_BL * ZSBL_THER(IIB:IIE,IJB:IJE)
!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE)
CALL BL_DEPTH_DIAG(D,ZQ0,PZZ(:,IKB),PWTHV,PZZ,CSTURB%XFTOP_O_FSURF,ZSBL_THER)
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZSBL_THER(IIJB:IIJE)= CSTURB%XSBL_O_BL * ZSBL_THER(IIJB:IIJE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!
!----------------------------------------------------------------------------
!
!* SBL depth
!
PSBL_DEPTH(:,:) = 0.
!$mnh_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
WHERE (ZSBL_THER(IIB:IIE,IJB:IJE)> 0. .AND. ZSBL_DYN(IIB:IIE,IJB:IJE)> 0.)
PSBL_DEPTH = MIN(ZSBL_THER(IIB:IIE,IJB:IJE),ZSBL_DYN(IIB:IIE,IJB:IJE))
PSBL_DEPTH(:) = 0.
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (ZSBL_THER(IIJB:IIJE)> 0. .AND. ZSBL_DYN(IIJB:IIJE)> 0.)
PSBL_DEPTH = MIN(ZSBL_THER(IIJB:IIJE),ZSBL_DYN(IIJB:IIJE))
END WHERE
!$mnh_end_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
!$mnh_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
WHERE (ZSBL_THER(IIB:IIE,IJB:IJE)> 0. .AND. ZSBL_DYN(IIB:IIE,IJB:IJE)==0.)
PSBL_DEPTH(IIB:IIE,IJB:IJE) = ZSBL_THER(IIB:IIE,IJB:IJE)
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (ZSBL_THER(IIJB:IIJE)> 0. .AND. ZSBL_DYN(IIJB:IIJE)==0.)
PSBL_DEPTH(IIJB:IIJE) = ZSBL_THER(IIJB:IIJE)
END WHERE
!$mnh_end_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
!$mnh_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
WHERE (ZSBL_THER(IIB:IIE,IJB:IJE)==0. .AND. ZSBL_DYN(IIB:IIE,IJB:IJE)> 0.)
PSBL_DEPTH(IIB:IIE,IJB:IJE) = ZSBL_DYN(IIB:IIE,IJB:IJE)
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (ZSBL_THER(IIJB:IIJE)==0. .AND. ZSBL_DYN(IIJB:IIJE)> 0.)
PSBL_DEPTH(IIJB:IIJE) = ZSBL_DYN(IIJB:IIJE)
END WHERE
!$mnh_end_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
DO JLOOP=1,5
!$mnh_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
WHERE (PLMO(IIB:IIE,IJB:IJE)/=XUNDEF .AND. ABS(PLMO(IIB:IIE,IJB:IJE))>=0.01 )
ZA(IIB:IIE,IJB:IJE) = TANH(2.*PSBL_DEPTH(IIB:IIE,IJB:IJE)/PLMO(IIB:IIE,IJB:IJE))**2
PSBL_DEPTH(IIB:IIE,IJB:IJE) = 0.2 * PSBL_DEPTH(IIB:IIE,IJB:IJE) + 0.8 * ((1.-ZA(IIB:IIE,IJB:IJE)) &
* ZSBL_DYN(IIB:IIE,IJB:IJE) + ZA(IIB:IIE,IJB:IJE) * ZSBL_THER(IIB:IIE,IJB:IJE) )
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (PLMO(IIJB:IIJE)/=XUNDEF .AND. ABS(PLMO(IIJB:IIJE))>=0.01 )
ZA(IIJB:IIJE) = TANH(2.*PSBL_DEPTH(IIJB:IIJE)/PLMO(IIJB:IIJE))**2
PSBL_DEPTH(IIJB:IIJE) = 0.2 * PSBL_DEPTH(IIJB:IIJE) + 0.8 * ((1.-ZA(IIJB:IIJE)) &
* ZSBL_DYN(IIJB:IIJE) + ZA(IIJB:IIJE) * ZSBL_THER(IIJB:IIJE) )
END WHERE
!$mnh_end_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
END DO
!$mnh_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
WHERE (ABS(PLMO(IIB:IIE,IJB:IJE))<=0.01 )
PSBL_DEPTH(IIB:IIE,IJB:IJE) = ZSBL_THER(IIB:IIE,IJB:IJE)
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (ABS(PLMO(IIJB:IIJE))<=0.01 )
PSBL_DEPTH(IIJB:IIJE) = ZSBL_THER(IIJB:IIJE)
END WHERE
!$mnh_end_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
WHERE (PLMO(IIB:IIE,IJB:IJE)==XUNDEF)
PSBL_DEPTH(IIB:IIE,IJB:IJE) = ZSBL_DYN(IIB:IIE,IJB:IJE)
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (PLMO(IIJB:IIJE)==XUNDEF)
PSBL_DEPTH(IIJB:IIJE) = ZSBL_DYN(IIJB:IIJE)
END WHERE
!$mnh_end_expand_where(JI=IIB:IIE,JJ=IJB:IJE)
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
!----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SBL_DEPTH',1,ZHOOK_HANDLE)
......
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