From 19fa4d7b35bcee7d5e8d3ddfad6e6924a5770a52 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Riette?= <sebastien.riette@meteo.fr>
Date: Thu, 17 Feb 2022 17:58:59 +0100
Subject: [PATCH] =?UTF-8?q?S=C3=A9bastien=20Riette=2017/02/2022=20rimltc,?=
=?UTF-8?q?=20rrhong=20and=20rsrimcg=5Fold?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Suppression of ZMASK (DO with IF tests)
Arrays declared with KPROMA size
WHERE statement decorated with mnh_expand directives
---
docs/TODO | 1 -
src/common/micro/mode_ice4_rimltc.F90 | 42 ++++++++++-----------
src/common/micro/mode_ice4_rrhong.F90 | 41 ++++++++++-----------
src/common/micro/mode_ice4_rsrimcg_old.F90 | 43 ++++++++++++----------
src/common/micro/mode_ice4_tendencies.F90 | 6 +--
5 files changed, 64 insertions(+), 69 deletions(-)
diff --git a/docs/TODO b/docs/TODO
index cf5bc5727..f288b16de 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -24,7 +24,6 @@ Merge pb:
- compute_updraft_rhcj10: en attente retour de Rachel et/ou Yves pour faire le merge
Etape 2: array syntax -> loop
-- en profiter pour supprimer args PA/PB des routines appelées depuis ice4_tendencies, comme pour nucleation
- regarder si pcompute et llcompute sont toujours tous deux nécessaires dans les mode_ice4* avec le passage en do
- si possible, modifier ice4_sedimentation_split* dans le même esprit que stat
- transformer sedimentation_split_momentum comme sedimentation_split
diff --git a/src/common/micro/mode_ice4_rimltc.F90 b/src/common/micro/mode_ice4_rimltc.F90
index d8957254c..012add3b4 100644
--- a/src/common/micro/mode_ice4_rimltc.F90
+++ b/src/common/micro/mode_ice4_rimltc.F90
@@ -7,7 +7,7 @@ MODULE MODE_ICE4_RIMLTC
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_RIMLTC(CST, PARAMI, KSIZE, PCOMPUTE, &
+SUBROUTINE ICE4_RIMLTC(CST, PARAMI, KPROMA, KSIZE, LDCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
@@ -40,20 +40,19 @@ IMPLICIT NONE
!
TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
-INTEGER, INTENT(IN) :: KSIZE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Cloud ice at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRIT ! Cloud ice at t
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting
!
!* 0.2 declaration of local variables
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-REAL, DIMENSION(KSIZE) :: ZMASK
INTEGER :: JL
!
!-------------------------------------------------------------------------------
@@ -61,21 +60,18 @@ IF (LHOOK) CALL DR_HOOK('ICE4_RIMLTC',0,ZHOOK_HANDLE)
!
!* 7.1 cloud ice melting
!
-PRIMLTC_MR(:)=0.
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., -PRIT(JL))) * & ! PRIT(:)>0.
- &MAX(0., -SIGN(1., CST%XTT-PT(JL))) * & ! PT(:)>XTT
- &PCOMPUTE(JL)
- PRIMLTC_MR(JL)=PRIT(JL) * ZMASK(JL)
+ IF(PRIT(JL)>0. .AND. PT(JL)>CST%XTT .AND. LDCOMPUTE(JL)) THEN
+ PRIMLTC_MR(JL)=PRIT(JL)
+ IF(PARAMI%LFEEDBACKT) THEN
+ !Limitation due to 0 crossing of temperature
+ PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-CST%XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
+ ENDIF
+ ELSE
+ PRIMLTC_MR(JL)=0.
+ ENDIF
ENDDO
-IF(PARAMI%LFEEDBACKT) THEN
- !Limitation due to 0 crossing of temperature
- DO JL=1, KSIZE
- PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-CST%XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
- ENDDO
-ENDIF
-
IF (LHOOK) CALL DR_HOOK('ICE4_RIMLTC', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_RIMLTC
diff --git a/src/common/micro/mode_ice4_rrhong.F90 b/src/common/micro/mode_ice4_rrhong.F90
index bd1fcd413..ba318d1d6 100644
--- a/src/common/micro/mode_ice4_rrhong.F90
+++ b/src/common/micro/mode_ice4_rrhong.F90
@@ -6,7 +6,7 @@
MODULE MODE_ICE4_RRHONG
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_RRHONG(CST, PARAMI, ICED, KSIZE, PCOMPUTE, &
+SUBROUTINE ICE4_RRHONG(CST, PARAMI, ICED, KPROMA, KSIZE, LDCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
@@ -41,19 +41,18 @@ IMPLICIT NONE
TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
-INTEGER, INTENT(IN) :: KSIZE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(KSIZE) :: ZMASK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JL
!
@@ -62,19 +61,17 @@ IF (LHOOK) CALL DR_HOOK('ICE4_RRHONG',0,ZHOOK_HANDLE)
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
-PRRHONG_MR(:) = 0.
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(CST%XTT-35.0))) * & ! PT(:)<XTT-35.0
- &MAX(0., -SIGN(1., ICED%XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
- PRRHONG_MR(JL)=PRRT(JL) * ZMASK(JL)
+ IF(PT(JL)<CST%XTT-35.0 .AND. PRRT(JL)>ICED%XRTMIN(3) .AND. LDCOMPUTE(JL)) THEN
+ PRRHONG_MR(JL)=PRRT(JL)
+ IF(PARAMI%LFEEDBACKT) THEN
+ !Limitation due to -35 crossing of temperature
+ PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((CST%XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
+ ENDIF
+ ELSE
+ PRRHONG_MR(JL)=0.
+ ENDIF
ENDDO
-IF(PARAMI%LFEEDBACKT) THEN
- !Limitation due to -35 crossing of temperature
- DO JL=1, KSIZE
- PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((CST%XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
- ENDDO
-ENDIF
!
IF (LHOOK) CALL DR_HOOK('ICE4_RRHONG', 1, ZHOOK_HANDLE)
!
diff --git a/src/common/micro/mode_ice4_rsrimcg_old.F90 b/src/common/micro/mode_ice4_rsrimcg_old.F90
index c833ca45f..9ee32f9ae 100644
--- a/src/common/micro/mode_ice4_rsrimcg_old.F90
+++ b/src/common/micro/mode_ice4_rsrimcg_old.F90
@@ -6,7 +6,7 @@
MODULE MODE_ICE4_RSRIMCG_OLD
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, &
&PRHODREF, &
&PLBDAS, &
&PT, PRCT, PRST, &
@@ -43,23 +43,23 @@ IMPLICIT NONE
TYPE(CST_t), INTENT(IN) :: CST
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates
+INTEGER, INTENT(IN) :: KPROMA, KSIZE
+LOGICAL, INTENT(IN) :: LDSOFT
+LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to cloud droplet riming of the aggregates
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(KSIZE) :: GRIM
+LOGICAL, DIMENSION(KPROMA) :: GRIM
INTEGER :: IGRIM
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW
+REAL, DIMENSION(KPROMA) :: ZVEC1, ZVEC2
+INTEGER, DIMENSION(KPROMA) :: IVEC1, IVEC2
+REAL, DIMENSION(KPROMA) :: ZZW
INTEGER :: JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -74,12 +74,13 @@ PRSRIMCG_MR(:)=0.
!
IF(.NOT. LDSOFT) THEN
IGRIM = 0
- GRIM(:) = .FALSE.
- DO JL = 1, SIZE(GRIM)
+ DO JL = 1, KSIZE
IF(PRCT(JL)>ICED%XRTMIN(2) .AND. PRST(JL)>ICED%XRTMIN(5) .AND. LDCOMPUTE(JL) .AND. PT(JL)<CST%XTT) THEN
IGRIM = IGRIM + 1
IVEC1(IGRIM) = JL
GRIM(JL) = .TRUE.
+ ELSE
+ GRIM(JL) = .FALSE.
ENDIF
ENDDO
!
@@ -115,11 +116,13 @@ IF(.NOT. LDSOFT) THEN
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
!
- WHERE(GRIM(:))
- PRSRIMCG_MR(:) = ICEP%XSRIMCG * PLBDAS(:)**ICEP%XEXSRIMCG & ! RSRIMCG
- * (1.0 - ZZW(:) )/PRHODREF(:)
- PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
+ !$mnh_expand_where(JL=1:KSIZE)
+ WHERE(GRIM(1:KSIZE))
+ PRSRIMCG_MR(1:KSIZE) = ICEP%XSRIMCG * PLBDAS(1:KSIZE)**ICEP%XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZZW(1:KSIZE) )/PRHODREF(1:KSIZE)
+ PRSRIMCG_MR(1:KSIZE)=MIN(PRST(1:KSIZE), PRSRIMCG_MR(1:KSIZE))
END WHERE
+ !$mnh_end_expand_where(JL=1:KSIZE)
END IF
ENDIF
!
diff --git a/src/common/micro/mode_ice4_tendencies.F90 b/src/common/micro/mode_ice4_tendencies.F90
index 0a8fac640..fa06bbf44 100644
--- a/src/common/micro/mode_ice4_tendencies.F90
+++ b/src/common/micro/mode_ice4_tendencies.F90
@@ -229,7 +229,7 @@ ELSE
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
- CALL ICE4_RRHONG(CST, PARAMI, ICED, KSIZE, PCOMPUTE, &
+ CALL ICE4_RRHONG(CST, PARAMI, ICED, KPROMA, KSIZE, LLCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&ZT, ZVART(:,IRR), &
&ZVART(:,ITH), &
@@ -243,7 +243,7 @@ ELSE
!
!* 7.1 cloud ice melting
!
- CALL ICE4_RIMLTC(CST, PARAMI, KSIZE, PCOMPUTE, &
+ CALL ICE4_RIMLTC(CST, PARAMI, KPROMA, KSIZE, LLCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&ZT, &
&ZVART(:,ITH), ZVART(:,IRI), &
@@ -262,7 +262,7 @@ ELSE
WHERE(ZVART(1:KSIZE,IRS)>0.)
ZLBDAS(1:KSIZE) = MIN(ICED%XLBDAS_MAX, ICED%XLBS*(PRHODREF(1:KSIZE)*MAX(ZVART(1:KSIZE,IRS), ICED%XRTMIN(5)))**ICED%XLBEXS)
END WHERE
- CALL ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KSIZE, ODSOFT, LLCOMPUTE, &
+ CALL ICE4_RSRIMCG_OLD(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LLCOMPUTE, &
&PRHODREF, &
&ZLBDAS, &
&ZT, ZVART(:,IRC), ZVART(:,IRS), &
--
GitLab