From ca3150236905a46130c2a8c96faee78425eaf6c1 Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Tue, 9 Aug 2022 11:54:34 +0200
Subject: [PATCH] Quentin 09/08/2022: Packing mode_bl_depth_diag and
mode_sbl_depth
---
src/common/turb/mode_bl_depth_diag.F90 | 52 +++++-----
src/common/turb/mode_sbl_depth.F90 | 126 ++++++++++++-------------
2 files changed, 86 insertions(+), 92 deletions(-)
diff --git a/src/common/turb/mode_bl_depth_diag.F90 b/src/common/turb/mode_bl_depth_diag.F90
index 73c472275..b054c0b8b 100644
--- a/src/common/turb/mode_bl_depth_diag.F90
+++ b/src/common/turb/mode_bl_depth_diag.F90
@@ -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
diff --git a/src/common/turb/mode_sbl_depth.F90 b/src/common/turb/mode_sbl_depth.F90
index 93c7fd5c7..162575319 100644
--- a/src/common/turb/mode_sbl_depth.F90
+++ b/src/common/turb/mode_sbl_depth.F90
@@ -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)
--
GitLab