From 5be77485d17e3c84a665d06ca4624837311ae29c Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Fri, 29 Sep 2023 11:30:02 +0200
Subject: [PATCH] Quentin 29/09/2023: fix remove of nested WHERE
---
src/common/turb/mode_compute_updraft.F90 | 21 ++++++++++++++-----
src/common/turb/mode_compute_updraft_raha.F90 | 6 +-----
2 files changed, 17 insertions(+), 10 deletions(-)
diff --git a/src/common/turb/mode_compute_updraft.F90 b/src/common/turb/mode_compute_updraft.F90
index caf7c4081..e9554a42f 100644
--- a/src/common/turb/mode_compute_updraft.F90
+++ b/src/common/turb/mode_compute_updraft.F90
@@ -588,7 +588,7 @@ DO JK=IKB,IKE-IKL,IKL
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
-
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
DO JIJ=IIJB,IIJE
IF(GTEST(JIJ)) THEN
@@ -609,14 +609,17 @@ DO JK=IKB,IKE-IKL,IKL
END DO
! Test if the updraft has reach the ETL
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (GTEST(IIJB:IIJE).AND.(PBUO_INTEG(IIJB:IIJE,JK)<=0.))
KKETL(IIJB:IIJE) = JK+IKL
GTESTETL(IIJB:IIJE)=.TRUE.
ELSEWHERE
GTESTETL(IIJB:IIJE)=.FALSE.
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! Test is we have reached the top of the updraft
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
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.
@@ -630,28 +633,36 @@ DO JK=IKB,IKE-IKL,IKL
PFRAC_UP(IIJB:IIJE,JK+IKL)=0.
KKCTL(IIJB:IIJE)=JK+IKL
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! compute frac_up at JK+KKL
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (GTEST(IIJB:IIJE))
PFRAC_UP(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK+IKL)/&
&(SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))*ZRHO_F(IIJB:IIJE,JK+IKL))
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! Updraft fraction must be smaller than XFRAC_UP_MAX
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (GTEST(IIJB:IIJE))
PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(IIJB:IIJE,JK+IKL))
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! When cloudy and non-buoyant, updraft fraction must decrease
+ !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE ((GTEST(IIJB:IIJE).AND.GTESTETL(IIJB:IIJE)).AND.GTESTLCL(IIJB:IIJE))
PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PFRAC_UP(IIJB:IIJE,JK+IKL),PFRAC_UP(IIJB:IIJE,JK))
ENDWHERE
+ !$mnh_end_expand_where(JIJ=IIJB:IIJE)
! Mass flux is updated with the new updraft fraction
+
+ !$mnh_expand_array(JIJ=IIJB:IIJE)
IF (OENTR_DETR) PEMF(IIJB:IIJE,JK+IKL)=PFRAC_UP(IIJB:IIJE,JK+IKL)*SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))* &
&ZRHO_F(IIJB:IIJE,JK+IKL)
- !$mnh_end_expand_where(JIJ=IIJB:IIJE)
-
+ !$mnh_end_expand_array(JIJ=IIJB:IIJE)
END IF !OENTR_DETR
ENDDO
@@ -695,8 +706,6 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',1,ZHOOK_HANDLE)
CONTAINS
-INCLUDE "th_r_from_thl_rt.func.h"
-INCLUDE "compute_frac_ice.func.h"
SUBROUTINE COMPUTE_ENTR_DETR(D, CST, NEBN, PARAMMF,&
KK,KKB,KKE,KKL,OTEST,OTESTLCL,&
PFRAC_ICE,PRHODREF,&
@@ -1106,6 +1115,8 @@ DO JIJ=IIJB,IIJE
ENDDO
END SUBROUTINE COMPUTE_ENTR_DETR
+INCLUDE "th_r_from_thl_rt.func.h"
+INCLUDE "compute_frac_ice.func.h"
END SUBROUTINE COMPUTE_UPDRAFT
END MODULE MODE_COMPUTE_UPDRAFT
diff --git a/src/common/turb/mode_compute_updraft_raha.F90 b/src/common/turb/mode_compute_updraft_raha.F90
index b6f611720..a92c40616 100644
--- a/src/common/turb/mode_compute_updraft_raha.F90
+++ b/src/common/turb/mode_compute_updraft_raha.F90
@@ -581,11 +581,8 @@ PEMF(IIJB:IIJE,IKB+IKL) = ZRHO_F(IIJB:IIJE,IKB+IKL)*PFRAC_UP(IIJB:IIJE,IKB+IKL)*
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
DO JK=IKB+IKL,IKE-IKL,IKL ! Vertical loop
- !$mnh_expand_where(JIJ=IIJB:IIJE)
-
- GTEST(IIJB:IIJE) = (ZW_UP2(IIJB:IIJE,JK) > ZEPS)
-
DO JIJ=IIJB,IIJE
+ GTEST(JIJ) = (ZW_UP2(JIJ,JK) > ZEPS)
IF(GTEST(JIJ)) THEN
IF(JK<IALIM(JIJ)) THEN
PEMF(JIJ,JK+IKL) = MAX(0.,PEMF(JIJ,JK) + ZPHI(JIJ)*ZZDZ(JIJ,JK)* &
@@ -603,7 +600,6 @@ DO JK=IKB+IKL,IKE-IKL,IKL ! Vertical loop
& SQRT(ZW_UP2(JIJ,JK+IKL))
END IF
END DO
- !$mnh_end_expand_where(JIJ=IIJB:IIJE)
ENDDO
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
--
GitLab