From be031d48d05d11f47818af44f297cd74e627e9fa Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Thu, 15 Jun 2023 16:31:12 +0200
Subject: [PATCH] Quentin 15/06/2023: remove nested WHERE
---
src/common/turb/mode_compute_updraft.F90 | 32 ++++++++++---------
src/common/turb/mode_compute_updraft_raha.F90 | 30 +++++++++--------
2 files changed, 33 insertions(+), 29 deletions(-)
diff --git a/src/common/turb/mode_compute_updraft.F90 b/src/common/turb/mode_compute_updraft.F90
index 825ef4c6e..caf7c4081 100644
--- a/src/common/turb/mode_compute_updraft.F90
+++ b/src/common/turb/mode_compute_updraft.F90
@@ -590,21 +590,23 @@ DO JK=IKB,IKE-IKL,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)
- ELSEWHERE
- ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(IIJB:IIJE,JK)
- ENDWHERE
- 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)))
- ENDWHERE
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ PTHV_UP(JIJ,JK+IKL) = ZTH_UP(JIJ,JK+IKL)* &
+ & ((1+ZRVORD*PRV_UP(JIJ,JK+IKL))/(1+PRT_UP(JIJ,JK+IKL)))
+ IF (ZBUO_INTEG_DRY(JIJ,JK)>0.) THEN
+ ZW_UP2(JIJ,JK+IKL) = ZW_UP2(JIJ,JK) + 2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)* &
+ &ZBUO_INTEG_DRY(JIJ,JK)
+ ELSE
+ ZW_UP2(JIJ,JK+IKL) = ZW_UP2(JIJ,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(JIJ,JK)
+ END IF
+ ZW_UP2(JIJ,JK+IKL) = ZW_UP2(JIJ,JK+IKL)*(1.-(PARAMMF%XBDETR*ZMIX3_CLD(JIJ)+ &
+ &PARAMMF%XBENTR*ZMIX2_CLD(JIJ)))&
+ /(1.+(PARAMMF%XBDETR*ZMIX3_CLD(JIJ)+PARAMMF%XBENTR*ZMIX2_CLD(JIJ))) &
+ +2.*(PARAMMF%XABUO)*ZBUO_INTEG_CLD(JIJ,JK)/ &
+ &(1.+(PARAMMF%XBDETR*ZMIX3_CLD(JIJ)+PARAMMF%XBENTR*ZMIX2_CLD(JIJ)))
+ END IF
+ END DO
! Test if the updraft has reach the ETL
WHERE (GTEST(IIJB:IIJE).AND.(PBUO_INTEG(IIJB:IIJE,JK)<=0.))
diff --git a/src/common/turb/mode_compute_updraft_raha.F90 b/src/common/turb/mode_compute_updraft_raha.F90
index 1c7731867..b6f611720 100644
--- a/src/common/turb/mode_compute_updraft_raha.F90
+++ b/src/common/turb/mode_compute_updraft_raha.F90
@@ -585,22 +585,24 @@ DO JK=IKB+IKL,IKE-IKL,IKL ! Vertical loop
GTEST(IIJB:IIJE) = (ZW_UP2(IIJB:IIJE,JK) > ZEPS)
- WHERE (GTEST(IIJB:IIJE))
- WHERE(JK<IALIM(IIJB:IIJE))
- PEMF(IIJB:IIJE,JK+IKL) = MAX(0.,PEMF(IIJB:IIJE,JK) + ZPHI(IIJB:IIJE)*ZZDZ(IIJB:IIJE,JK)* &
- & (PENTR(IIJB:IIJE,JK) - PDETR(IIJB:IIJE,JK)))
- ELSEWHERE
- ZMIX1(IIJB:IIJE)=ZZDZ(IIJB:IIJE,JK)*(PENTR(IIJB:IIJE,JK)-PDETR(IIJB:IIJE,JK))
- PEMF(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK)*EXP(ZMIX1(IIJB:IIJE))
- ENDWHERE
+ DO JIJ=IIJB,IIJE
+ IF(GTEST(JIJ)) THEN
+ IF(JK<IALIM(JIJ)) THEN
+ PEMF(JIJ,JK+IKL) = MAX(0.,PEMF(JIJ,JK) + ZPHI(JIJ)*ZZDZ(JIJ,JK)* &
+ & (PENTR(JIJ,JK) - PDETR(JIJ,JK)))
+ ELSE
+ ZMIX1(JIJ)=ZZDZ(JIJ,JK)*(PENTR(JIJ,JK)-PDETR(JIJ,JK))
+ PEMF(JIJ,JK+IKL)=PEMF(JIJ,JK)*EXP(ZMIX1(JIJ))
+ END IF
! Updraft fraction must be smaller than XFRAC_UP_MAX
- PFRAC_UP(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK+IKL)/&
- &(SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))*ZRHO_F(IIJB:IIJE,JK+IKL))
- PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(IIJB:IIJE,JK+IKL))
- PEMF(IIJB:IIJE,JK+IKL) = ZRHO_F(IIJB:IIJE,JK+IKL)*PFRAC_UP(IIJB:IIJE,JK+IKL)*&
- & SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))
- ENDWHERE
+ PFRAC_UP(JIJ,JK+IKL)=PEMF(JIJ,JK+IKL)/&
+ &(SQRT(ZW_UP2(JIJ,JK+IKL))*ZRHO_F(JIJ,JK+IKL))
+ PFRAC_UP(JIJ,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(JIJ,JK+IKL))
+ PEMF(JIJ,JK+IKL) = ZRHO_F(JIJ,JK+IKL)*PFRAC_UP(JIJ,JK+IKL)*&
+ & SQRT(ZW_UP2(JIJ,JK+IKL))
+ END IF
+ END DO
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
ENDDO
--
GitLab