diff --git a/src/common/micro/mode_ice4_compute_pdf.F90 b/src/common/micro/mode_ice4_compute_pdf.F90
index 771d42c94ca8e72087891d2fcaf21ad5b222bfab..9730595978782948520fb7511a4b889c6e857c68 100644
--- a/src/common/micro/mode_ice4_compute_pdf.F90
+++ b/src/common/micro/mode_ice4_compute_pdf.F90
@@ -7,7 +7,7 @@ MODULE MODE_ICE4_COMPUTE_PDF
IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ LDMICRO, PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
!!
@@ -21,7 +21,7 @@ SUBROUTINE ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI
!!
!! MODIFICATIONS
!! -------------
-!!
+!! S. Riette Sept 23: LDMICRO mask
!
!
!* 0. DECLARATIONS
@@ -46,6 +46,7 @@ INTEGER, INTENT(IN) :: KSIZE
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method for cloud water
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method for cloud ice
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
+LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDMICRO ! Computation mask
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
@@ -83,16 +84,22 @@ INTEGER :: JI
IF (LHOOK) CALL DR_HOOK('ICE4_COMPUTE_PDF', 0, ZHOOK_HANDLE)!
!Cloud water split between high and low content part is done according to autoconversion option
-ZRCRAUTC(:)=ICEP%XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
+!$mnh_expand_where(JI=1:KSIZE)
+WHERE (LDMICRO(:))
+ ZRCRAUTC(:)=ICEP%XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
+ELSEWHERE
+ ZRCRAUTC(:)=0.
+END WHERE
+!$mnh_end_expand_where(JI=1:KSIZE)
IF(HSUBG_AUCV_RC=='NONE') THEN
!Cloud water is entirely in low or high part
!$mnh_expand_where(JI=1:KSIZE)
- WHERE(PRCT(:)>ZRCRAUTC(:))
+ WHERE(PRCT(:)>ZRCRAUTC(:) .AND. LDMICRO(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PRCT(:)>ICED%XRTMIN(2))
+ ELSEWHERE(PRCT(:)>ICED%XRTMIN(2) .AND. LDMICRO(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=1.
PHLC_HRC(:)=0.
@@ -108,12 +115,12 @@ IF(HSUBG_AUCV_RC=='NONE') THEN
ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
!Cloud water is only in the cloudy part and entirely in low or high part
!$mnh_expand_where(JI=1:KSIZE)
- WHERE(PCF(:)>0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:))
+ WHERE(PCF(:)>0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:) .AND. LDMICRO(:))
PHLC_HCF(:)=PCF(:)
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>ICED%XRTMIN(2))
+ ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>ICED%XRTMIN(2) .AND. LDMICRO(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.0
@@ -127,8 +134,12 @@ ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
!$mnh_end_expand_where(JI=1:KSIZE)
ELSEIF(HSUBG_AUCV_RC=='ADJU') THEN
!$mnh_expand_where(JI=1:KSIZE)
- ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
- WHERE(ZSUMRC(:) .GT. 0.)
+ WHERE(LDMICRO(:))
+ ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
+ ELSEWHERE
+ ZSUMRC(:)=0.
+ ENDWHERE
+ WHERE(ZSUMRC(:) .GT. 0. .AND. LDMICRO(:))
PHLC_LRC(:)=PHLC_LRC(:)*PRCT(:)/ZSUMRC(:)
PHLC_HRC(:)=PHLC_HRC(:)*PRCT(:)/ZSUMRC(:)
ELSEWHERE
@@ -146,12 +157,12 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
IF(HSUBG_PR_PDF=='SIGM') THEN
! Redelsperger and Sommeria (1986) but organised according to Turner (2011, 2012)
!$mnh_expand_where(JI=1:KSIZE)
- WHERE (PRCT(:)>ZRCRAUTC(:)+PSIGMA_RC(:))
+ WHERE (PRCT(:)>ZRCRAUTC(:)+PSIGMA_RC(:) .AND. LDMICRO(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
+ ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) .AND. LDMICRO(:))
PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ &
&(2.*PSIGMA_RC(:))
PHLC_LCF(:)=MAX(0., PCF(:)-PHLC_HCF(:))
@@ -159,7 +170,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
&(PRCT(:)+PSIGMA_RC(:)+ZRCRAUTC(:))/ &
&(4.*PSIGMA_RC(:))
PHLC_LRC(:)=MAX(0., PRCT(:)-PHLC_HRC(:))
- ELSEWHERE(PRCT(:)>ICED%XRTMIN(2) .AND. PCF(:)>0.)
+ ELSEWHERE(PRCT(:)>ICED%XRTMIN(2) .AND. PCF(:)>0. .AND. LDMICRO(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.
@@ -183,50 +194,64 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
ZCOEFFRCM=4.
END IF
!$mnh_expand_where(JI=1:KSIZE)
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0.)
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. LDMICRO(:))
ZHLC_RCMAX(:)=ZCOEFFRCM*PRCT(:)/PCF(:)
+ ELSEWHERE
+ ZHLC_RCMAX(:)=0.
END WHERE
! Split available water and cloud fraction in two parts
! Calculate local mean values int he low and high parts for the 3 PDF forms:
IF(HSUBG_PR_PDF=='HLCRECTPDF') THEN
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
ZHLC_LRCLOCAL(:)=0.5*ZRCRAUTC(:)
ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + ZRCRAUTC(:))/2.0
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=0.
+ ZHLC_HRCLOCAL(:)=0.
END WHERE
ELSE IF(HSUBG_PR_PDF=='HLCTRIANGPDF') THEN
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
ZHLC_LRCLOCAL(:)=( ZRCRAUTC(:) *(3.0 * ZHLC_RCMAX(:) - 2.0 * ZRCRAUTC(:) ) ) &
/ (3.0 * (2.0 * ZHLC_RCMAX(:) - ZRCRAUTC(:) ) )
ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 2.0*ZRCRAUTC(:)) / 3.0
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=0.
+ ZHLC_HRCLOCAL(:)=0.
END WHERE
ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
ZHLC_LRCLOCAL(:)=(3.0 *ZRCRAUTC(:)**3 - 8.0 *ZRCRAUTC(:)**2 * ZHLC_RCMAX(:) &
+ 6.0*ZRCRAUTC(:) *ZHLC_RCMAX(:)**2 ) &
/ &
(4.0* ZRCRAUTC(:)**2 -12.0*ZRCRAUTC(:) *ZHLC_RCMAX(:) &
+ 12.0 * ZHLC_RCMAX(:)**2 )
ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 3.0*ZRCRAUTC(:))/4.0
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=0.
+ ZHLC_HRCLOCAL(:)=0.
END WHERE
ELSE IF(HSUBG_PR_PDF=='HLCISOTRIPDF') THEN
- WHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
- WHERE((PRCT(:) / PCF(:)).LE.ZRCRAUTC(:))
- ZHLC_LRCLOCAL(:)=( (ZHLC_RCMAX(:))**3 &
- -(12.0 * (ZHLC_RCMAX(:))*(ZRCRAUTC(:))**2) &
- +(8.0 * ZRCRAUTC(:)**3) ) &
- /( (6.0 * (ZHLC_RCMAX(:))**2) &
- -(24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) &
- +(12.0 * ZRCRAUTC(:)**2) )
- ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + 2.0 * ZRCRAUTC(:) )/3.0
- ELSEWHERE
- ZHLC_LRCLOCAL(:)=(2.0/3.0) * ZRCRAUTC(:)
- ZHLC_HRCLOCAL(:)=(3.0*ZHLC_RCMAX(:)**3 - 8.0*ZRCRAUTC(:)**3) &
- / (6.0 * ZHLC_RCMAX(:)**2 - 12.0*ZRCRAUTC(:)**2)
- END WHERE
+ WHERE (PRCT(:).LE.ZRCRAUTC(:)*PCF(:) .AND. &
+ &PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. &
+ &ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
+ ZHLC_LRCLOCAL(:)=( (ZHLC_RCMAX(:))**3 &
+ -(12.0 * (ZHLC_RCMAX(:))*(ZRCRAUTC(:))**2) &
+ +(8.0 * ZRCRAUTC(:)**3) ) &
+ /( (6.0 * (ZHLC_RCMAX(:))**2) &
+ -(24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) &
+ +(12.0 * ZRCRAUTC(:)**2) )
+ ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + 2.0 * ZRCRAUTC(:) )/3.0
+ ELSEWHERE(PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
+ ZHLC_LRCLOCAL(:)=(2.0/3.0) * ZRCRAUTC(:)
+ ZHLC_HRCLOCAL(:)=(3.0*ZHLC_RCMAX(:)**3 - 8.0*ZRCRAUTC(:)**3) &
+ / (6.0 * ZHLC_RCMAX(:)**2 - 12.0*ZRCRAUTC(:)**2)
+ ELSEWHERE
+ ZHLC_LRCLOCAL(:)=0.
+ ZHLC_HRCLOCAL(:)=0.
END WHERE
END IF
! Compare r_cM to r_cR to know if cloud water content is high enough to split in two parts or not
- WHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:))
+ WHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).GT.ZRCRAUTC(:) .AND. LDMICRO(:))
! Calculate final values for LCF and HCF:
PHLC_LCF(:)=PCF(:) &
*(ZHLC_HRCLOCAL(:)- &
@@ -237,7 +262,7 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
! Calculate final values for LRC and HRC:
PHLC_LRC(:)=ZHLC_LRCLOCAL(:)*PHLC_LCF(:)
PHLC_HRC(:)=MAX(0., PRCT(:)-PHLC_LRC(:))
- ELSEWHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).LE.ZRCRAUTC(:))
+ ELSEWHERE (PRCT(:).GT.0. .AND. PCF(:).GT.0. .AND. ZHLC_RCMAX(:).LE.ZRCRAUTC(:) .AND. LDMICRO(:))
! Put all available cloud water and his fraction in the low part
PHLC_LCF(:)=PCF(:)
PHLC_HCF(:)=0.
@@ -259,17 +284,21 @@ ENDIF
!
!Ice water split between high and low content part is done according to autoconversion option
!$mnh_expand_where(JI=1:KSIZE)
+WHERE(LDMICRO(:))
ZCRIAUTI(:)=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(PT(:)-CST%XTT)+ICEP%XBCRIAUTI)) ! Autoconversion ri threshold
+ELSEWHERE
+ ZCRIAUTI(:)=0.
+ENDWHERE
!$mnh_end_expand_where(JI=1:KSIZE)
IF(HSUBG_AUCV_RI=='NONE') THEN
!$mnh_expand_where(JI=1:KSIZE)
!Cloud water is entirely in low or high part
- WHERE(PRIT(:)>ZCRIAUTI(:))
+ WHERE(PRIT(:)>ZCRIAUTI(:) .AND. LDMICRO(:))
PHLI_HCF(:)=1.
PHLI_LCF(:)=0.
PHLI_HRI(:)=PRIT(:)
PHLI_LRI(:)=0.
- ELSEWHERE(PRIT(:)>ICED%XRTMIN(4))
+ ELSEWHERE(PRIT(:)>ICED%XRTMIN(4) .AND. LDMICRO(:))
PHLI_HCF(:)=0.
PHLI_LCF(:)=1.
PHLI_HRI(:)=0.
@@ -284,12 +313,12 @@ IF(HSUBG_AUCV_RI=='NONE') THEN
ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
!Cloud water is only in the cloudy part and entirely in low or high part
!$mnh_expand_where(JI=1:KSIZE)
- WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:))
+ WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:) .AND. LDMICRO(:))
PHLI_HCF(:)=PCF(:)
PHLI_LCF(:)=0.
PHLI_HRI(:)=PRIT(:)
PHLI_LRI(:)=0.
- ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>ICED%XRTMIN(4))
+ ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>ICED%XRTMIN(4) .AND. LDMICRO(:))
PHLI_HCF(:)=0.
PHLI_LCF(:)=PCF(:)
PHLI_HRI(:)=0.0
@@ -303,8 +332,12 @@ ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
!$mnh_end_expand_where(JI=1:KSIZE)
ELSEIF(HSUBG_AUCV_RI=='ADJU') THEN
!$mnh_expand_where(JI=1:KSIZE)
- ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
- WHERE(ZSUMRI(:) .GT. 0.)
+ WHERE(LDMICRO(:))
+ ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
+ ELSEWHERE
+ ZSUMRI(:)=0.
+ ENDWHERE
+ WHERE(ZSUMRI(:) .GT. 0. .AND. LDMICRO(:))
PHLI_LRI(:)=PHLI_LRI(:)*PRIT(:)/ZSUMRI(:)
PHLI_HRI(:)=PHLI_HRI(:)*PRIT(:)/ZSUMRI(:)
ELSEWHERE
@@ -318,9 +351,14 @@ ELSE
ENDIF
!
!$mnh_expand_where(JI=1:KSIZE)
+WHERE(LDMICRO(:))
PRF(:)=MAX(PHLC_HCF(:),PHLI_HCF(:))
+ELSEWHERE
+ PRF(:)=0.
+ENDWHERE
!$mnh_end_expand_where(JI=1:KSIZE)
!
IF (LHOOK) CALL DR_HOOK('ICE4_COMPUTE_PDF', 1, ZHOOK_HANDLE)
END SUBROUTINE ICE4_COMPUTE_PDF
+
END MODULE MODE_ICE4_COMPUTE_PDF
diff --git a/src/common/micro/mode_ice4_pack.F90 b/src/common/micro/mode_ice4_pack.F90
index 747e98ab146259db76cfc2916e9a0e695d897aa7..627c92698cbf1064a9e57734670d2ff91cfbec59 100644
--- a/src/common/micro/mode_ice4_pack.F90
+++ b/src/common/micro/mode_ice4_pack.F90
@@ -36,6 +36,7 @@ SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
!! MODIFICATIONS
!! -------------
!! R. El Khatib 28-Apr-2023 Fix (and re-enable) the cache-blocking mechanism on top of phyex
+!! S. Riette Sept 23: all 3D arrays are suppressed from ice4_stepping
! -----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -161,6 +162,7 @@ REAL, DIMENSION(KPROMA) :: &
& ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
& ZHLI_HCF, &
& ZHLI_HRI, &
+ & ZRAINFR, &
& ZRREVAV
REAL, DIMENSION(KSIZE2) :: ZSIGMA_RC ! Standard deviation of rc at time t
LOGICAL, DIMENSION(KPROMA) :: LLMICRO
@@ -285,6 +287,7 @@ IF(PARAMI%LPACK_MICRO) THEN
ZHLI_HCF(IC) = PHLI_HCF(JIJ, JK)
ZHLI_HRI(IC) = PHLI_HRI(JIJ, JK)
ENDIF
+ ZRAINFR(IC)=PRAINFR(JIJ, JK)
! Save indices for later usages:
I1(IC) = JIJ
I2(IC) = JK
@@ -320,7 +323,7 @@ IF(PARAMI%LPACK_MICRO) THEN
!* 5. TENDENCIES COMPUTATION
! ----------------------
!
- CALL ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ CALL ICE4_STEPPING(CST, PARAMI, ICEP, ICED, BUCONF, &
&LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
&KPROMA, IMICRO, LLMICRO, PTSTEP, &
&KRR, &
@@ -329,7 +332,7 @@ IF(PARAMI%LPACK_MICRO) THEN
&ZCIT, &
&ZVART, &
&ZHLC_HCF, ZHLC_HRC, &
- &ZHLI_HCF, ZHLI_HRI, PRAINFR, &
+ &ZHLI_HCF, ZHLI_HRI, ZRAINFR, &
&ZEXTPK, ZBU_SUM, ZRREVAV)
!
!* 6. UNPACKING
@@ -349,6 +352,7 @@ IF(PARAMI%LPACK_MICRO) THEN
IF (KRR==7) THEN
PWR(I1(JL),I2(JL),IRH)=ZVART(JL, IRH)
ENDIF
+ PRAINFR(I1(JL),I2(JL))=ZRAINFR(JL)
ENDDO
IF(BUCONF%LBU_ENABLE) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
@@ -429,7 +433,7 @@ ELSE ! PARAMI%LPACK_MICRO
!* 5bis. TENDENCIES COMPUTATION
! ----------------------
!
- CALL ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ CALL ICE4_STEPPING(CST, PARAMI, ICEP, ICED, BUCONF, &
&LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
&KSIZE, KSIZE, ODMICRO, PTSTEP, &
&KRR, &
diff --git a/src/common/micro/mode_ice4_rainfr_vert.F90 b/src/common/micro/mode_ice4_rainfr_vert.F90
index 43d8410c8399c909602dc320f6479bf76ef6584a..ec35f0da57fb15ee58f57dc1322c43810e4665bb 100644
--- a/src/common/micro/mode_ice4_rainfr_vert.F90
+++ b/src/common/micro/mode_ice4_rainfr_vert.F90
@@ -20,6 +20,7 @@ SUBROUTINE ICE4_RAINFR_VERT(D, ICED, PPRFR, PRR, PRS, PRG, PRH)
!! -------------
!!
! P. Wautelet 13/02/2019: bugfix: intent of PPRFR OUT->INOUT
+! S. Riette 21/9/23: collapse JI/JJ
!
!
!* 0. DECLARATIONS
@@ -33,19 +34,19 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
-TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRR !Rain field
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRS !Snow field
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRG !Graupel field
-REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
!
-INTEGER :: IKB, IKE, IKL, IIE, IIB, IJB, IJE
+INTEGER :: IKB, IKE, IKL, IIJB, IIJE
!* 0.2 declaration of local variables
!
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
-INTEGER :: JI, JJ, JK
+INTEGER :: JIJ, JK
LOGICAL :: MASK
!
!-------------------------------------------------------------------------------
@@ -54,32 +55,28 @@ IF (LHOOK) CALL DR_HOOK('ICE4_RAINFR_VERT',0,ZHOOK_HANDLE)
IKB=D%NKB
IKE=D%NKE
IKL=D%NKL
-IIB=D%NIB
-IIE=D%NIE
-IJB=D%NJB
-IJE=D%NJE
+IIJB=D%NIJB
+IIJE=D%NIJE
!
!-------------------------------------------------------------------------------
-DO JI = IIB,IIE
- DO JJ = IJB, IJE
- PPRFR(JI,JJ,IKE)=0.
- DO JK=IKE-IKL, IKB, -IKL
- IF(PRESENT(PRH)) THEN
- MASK=PRR(JI,JJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. ICED%XRTMIN(5) &
- .OR. PRG(JI,JJ,JK) .GT. ICED%XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. ICED%XRTMIN(7)
- ELSE
- MASK=PRR(JI,JJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. ICED%XRTMIN(5) &
- .OR. PRG(JI,JJ,JK) .GT. ICED%XRTMIN(6)
+DO JIJ = IIJB,IIJE
+ PPRFR(JIJ,IKE)=0.
+ DO JK=IKE-IKL, IKB, -IKL
+ IF(PRESENT(PRH)) THEN
+ MASK=PRR(JIJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JIJ,JK) .GT. ICED%XRTMIN(5) &
+ .OR. PRG(JIJ,JK) .GT. ICED%XRTMIN(6) .OR. PRH(JIJ,JK) .GT. ICED%XRTMIN(7)
+ ELSE
+ MASK=PRR(JIJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JIJ,JK) .GT. ICED%XRTMIN(5) &
+ .OR. PRG(JIJ,JK) .GT. ICED%XRTMIN(6)
+ END IF
+ IF (MASK) THEN
+ PPRFR(JIJ,JK)=MAX(PPRFR(JIJ,JK),PPRFR(JIJ,JK+IKL))
+ IF (PPRFR(JIJ,JK)==0.) THEN
+ PPRFR(JIJ,JK)=1.
END IF
- IF (MASK) THEN
- PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+IKL))
- IF (PPRFR(JI,JJ,JK)==0) THEN
- PPRFR(JI,JJ,JK)=1.
- END IF
- ELSE
- PPRFR(JI,JJ,JK)=0.
- END IF
- END DO
+ ELSE
+ PPRFR(JIJ,JK)=0.
+ END IF
END DO
END DO
!
diff --git a/src/common/micro/mode_ice4_stepping.F90 b/src/common/micro/mode_ice4_stepping.F90
index 43604d778dd49d7da69518fc55b4ad0b608e4165..87672ceee708999656ebd52ac6ea7cfb6ff76e81 100644
--- a/src/common/micro/mode_ice4_stepping.F90
+++ b/src/common/micro/mode_ice4_stepping.F90
@@ -6,7 +6,7 @@
MODULE MODE_ICE4_STEPPING
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+SUBROUTINE ICE4_STEPPING(CST, PARAMI, ICEP, ICED, BUCONF, &
&LDSIGMA_RC, LDAUCV_ADJU, LDEXT_TEND, &
&KPROMA, KMICRO, LDMICRO, PTSTEP, &
&KRR, &
@@ -35,6 +35,7 @@ SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
!! MODIFICATIONS
!! -------------
!! R. El Khatib 03-May-2023 Replace OMP SIMD loops by explicit loops : more portable and even slightly faster
+!! S. Riette Sept 23: 3D arrays suppressed from ice4_tendencies
! -----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -42,7 +43,6 @@ SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
!
USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_BUDGET, ONLY: TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
@@ -68,7 +68,6 @@ IMPLICIT NONE
!
!
!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
@@ -95,7 +94,7 @@ REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRAINFR
REAL, DIMENSION(KPROMA,0:7), INTENT(INOUT) :: PEXTPK !To take into acount external tendencies inside the splitting
REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA),INTENT(OUT) :: PBU_SUM
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV
@@ -252,7 +251,7 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
!
!
! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ CALL ICE4_TENDENCIES(CST, PARAMI, ICEP, ICED, BUCONF, &
&KPROMA, KMICRO, &
&KRR, LSOFT, LLCOMPUTE, &
&PEXN, PRHODREF, ZLVFACT, ZLSFACT, K1, K2, &
diff --git a/src/common/micro/mode_ice4_tendencies.F90 b/src/common/micro/mode_ice4_tendencies.F90
index 0883b6c8fa9fc2e7bceb0216b00f48c84382b1f5..9395bf08fd0c026ad77a9a7776bfb41764af0d33 100644
--- a/src/common/micro/mode_ice4_tendencies.F90
+++ b/src/common/micro/mode_ice4_tendencies.F90
@@ -6,7 +6,7 @@
MODULE MODE_ICE4_TENDENCIES
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
+SUBROUTINE ICE4_TENDENCIES(CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
&KRR, ODSOFT, LDCOMPUTE, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
@@ -38,7 +38,6 @@ SUBROUTINE ICE4_TENDENCIES(D, CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
! ------------
!
USE MODD_BUDGET, ONLY: TBUDGETCONF_t
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
@@ -49,7 +48,6 @@ USE MODE_ICE4_RRHONG, ONLY: ICE4_RRHONG
USE MODE_ICE4_RIMLTC, ONLY: ICE4_RIMLTC
USE MODE_ICE4_RSRIMCG_OLD, ONLY: ICE4_RSRIMCG_OLD
USE MODE_ICE4_COMPUTE_PDF, ONLY: ICE4_COMPUTE_PDF
-USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
USE MODE_ICE4_SLOW, ONLY: ICE4_SLOW
USE MODE_ICE4_WARM, ONLY: ICE4_WARM
USE MODE_ICE4_FAST_RS, ONLY: ICE4_FAST_RS
@@ -64,7 +62,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
@@ -93,26 +90,26 @@ REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PSSI
REAL, DIMENSION(KPROMA,0:7), INTENT(OUT) :: PA
REAL, DIMENSION(KPROMA,0:7), INTENT(OUT) :: PB
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LCF
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LRC
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LCF
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LRI
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LRI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRAINFR ! Rain fraction
!
!* 0.2 declaration of local variables
!
REAL, DIMENSION(KPROMA,0:KRR) :: ZVART
-REAL, DIMENSION(KPROMA) :: ZT, ZRAINFR, &
+REAL, DIMENSION(KPROMA) :: ZT, &
& ZKA, ZDV, ZAI, ZCJ, &
& ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
- & ZRGSI, ZRGSI_MR
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZRRT3D, ZRST3D, ZRGT3D, ZRHT3D
+ & ZRGSI, ZRGSI_MR, ZRAINFR
INTEGER :: JL, JV
LOGICAL, DIMENSION(KPROMA) :: LLWETG ! .TRUE. if graupel growths in wet mode
+LOGICAL :: LLMASK
REAL :: ZZW
LOGICAL :: LLRFR
!
@@ -246,39 +243,31 @@ ENDIF ! ODSOFT
!
!Cloud water split between high and low content part is done here
CALL ICE4_COMPUTE_PDF(CST, ICEP, ICED, KSIZE, PARAMI%CSUBG_AUCV_RC, PARAMI%CSUBG_AUCV_RI, PARAMI%CSUBG_PR_PDF,&
- PRHODREF, ZVART(:,IRC), ZVART(:,IRI), PCF, ZT, PSIGMA_RC, &
+ LDCOMPUTE, PRHODREF, ZVART(:,IRC), ZVART(:,IRI), PCF, ZT, PSIGMA_RC, &
PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRAINFR)
LLRFR=PARAMI%CSUBG_RC_RR_ACCR=='PRFR' .OR. PARAMI%CSUBG_RR_EVAP=='PRFR'
IF (LLRFR) THEN
- !Diagnostic of precipitation fraction
- PRAINFR(:,:) = 0.
- ZRRT3D (:,:) = 0.
- ZRST3D (:,:) = 0.
- ZRGT3D (:,:) = 0.
- ZRHT3D (:,:) = 0.
- DO JL=1,KSIZE
- PRAINFR(K1(JL), K2(JL)) = ZRAINFR(JL)
- ZRRT3D (K1(JL), K2(JL)) = ZVART(JL,IRR)
- ZRST3D (K1(JL), K2(JL)) = ZVART(JL,IRS)
- ZRGT3D (K1(JL), K2(JL)) = ZVART(JL,IRG)
- END DO
- IF (KRR==7) THEN
- DO JL=1,KSIZE
- ZRHT3D (K1(JL), K2(JL)) = ZVART(JL,IRH)
- ENDDO
- CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR(:,:), &
- &ZRRT3D(:,:), ZRST3D(:,:), ZRGT3D(:,:), ZRHT3D(:,:))
- ELSE
- CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR(:,:), &
- &ZRRT3D(:,:), ZRST3D(:,:), ZRGT3D(:,:))
- ENDIF
- DO JL=1,KSIZE
- ZRAINFR(JL)=PRAINFR(K1(JL), K2(JL))
- END DO
+ !To be exact, ICE4_RAINFR_VERT should be called here with the updated PRAINFR
+ !But this call would require the full 3D arrays for rain, snow and graupel which
+ !are not available here (due to separation between 1D and 3D computation for GPU).
+ !
+ !We replace the full computation by a small update to ensure consistency
+ DO JL=1, KSIZE
+ PRAINFR(JL)=MAX(PRAINFR(JL), ZRAINFR(JL))
+ IF(KRR==7) THEN
+ LLMASK=ZVART(JL,IRR) .GT. ICED%XRTMIN(3) .OR. ZVART(JL,IRS) .GT. ICED%XRTMIN(5) .OR. &
+ &ZVART(JL,IRG) .GT. ICED%XRTMIN(6) .OR. ZVART(JL,IRH) .GT. ICED%XRTMIN(7)
+ ELSE
+ LLMASK=ZVART(JL,IRR) .GT. ICED%XRTMIN(3) .OR. ZVART(JL,IRS) .GT. ICED%XRTMIN(5) .OR. &
+ &ZVART(JL,IRG) .GT. ICED%XRTMIN(6)
+ ENDIF
+ IF(LLMASK .AND. PRAINFR(JL)==0.) THEN
+ PRAINFR(JL)=1.
+ ENDIF
+ ENDDO
ELSE
- PRAINFR(:,:)=1.
- ZRAINFR(:)=1.
+ PRAINFR(:)=1.
ENDIF
!
!* compute the slope parameters
@@ -292,8 +281,8 @@ DO JL=1, KSIZE
ENDIF
!ZLBDAR_RF is used when we consider rain concentrated in its fraction
IF(LLRFR) THEN
- IF(ZVART(JL,IRR)>0. .AND. ZRAINFR(JL)>0.) THEN
- ZLBDAR_RF(JL)=ICED%XLBR*(PRHODREF(JL)*MAX(ZVART(JL,IRR)/ZRAINFR(JL), ICED%XRTMIN(3)))**ICED%XLBEXR
+ IF(ZVART(JL,IRR)>0. .AND. PRAINFR(JL)>0.) THEN
+ ZLBDAR_RF(JL)=ICED%XLBR*(PRHODREF(JL)*MAX(ZVART(JL,IRR)/PRAINFR(JL), ICED%XRTMIN(3)))**ICED%XLBEXR
ELSE
ZLBDAR_RF(JL)=0.
ENDIF
@@ -351,7 +340,7 @@ IF(PARAMI%LWARM) THEN ! Check if the formation of the raindrops by the slow
&PRHODREF, PLVFACT, ZT, PPRES, ZVART(:,ITH),&
&ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, &
&PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- &PCF, ZRAINFR, &
+ &PCF, PRAINFR, &
&ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRR), &
&PBU_INST(:, IRCAUTR), PBU_INST(:, IRCACCR), PBU_INST(:, IRREVAV))
ELSE
diff --git a/src/common/micro/rain_ice.F90 b/src/common/micro/rain_ice.F90
index 18b10bb3de19c5c346847d2688fd77479c0c4a74..9e46de209a2bff34d62ea34cf6f50a7fc3eedc9f 100644
--- a/src/common/micro/rain_ice.F90
+++ b/src/common/micro/rain_ice.F90
@@ -163,14 +163,15 @@
!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
!! (S. Riette) Source code split into several files
!! 02/2019 C.Lac add rain fraction as an output field
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
-! P. Wautelet 17/01/2020: move Quicksort to tools.f90
-! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
-! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
+!! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!! P. Wautelet 17/01/2020: move Quicksort to tools.f90
+!! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
!! R. El Khatib 24-Aug-2021 Optimizations
-! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+!! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+!! S. Riette Sept 23: e from ice4_tendencies
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -199,6 +200,7 @@ USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
+USE MODE_ICE4_COMPUTE_PDF, ONLY: ICE4_COMPUTE_PDF
USE MODE_ICE4_SEDIMENTATION, ONLY: ICE4_SEDIMENTATION
USE MODE_ICE4_PACK, ONLY: ICE4_PACK
USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
@@ -273,13 +275,18 @@ REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air pr
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!
INTEGER :: JIJ, JK
-INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE
+INTEGER :: IKTB, IKTE, IKB, IKT, IIJB, IIJE, IIJT
!
LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLMICRO ! mask to limit computation
!Arrays for nucleation call outisde of LLMICRO points
REAL, DIMENSION(D%NIJT, D%NKT) :: ZT ! Temperature
REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_RVHENI ! heterogeneous nucleation
REAL, DIMENSION(D%NIJT, D%NKT) :: ZZ_LVFACT, ZZ_LSFACT
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZSIGMA_RC
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZHLC_LCF
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZHLC_LRC
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZHLI_LCF
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZHLI_LRI
!
REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
!For total tendencies computation
@@ -301,8 +308,10 @@ IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
IKTB=D%NKTB
IKTE=D%NKTE
IKB=D%NKB
+IKT=D%NKT
IIJB=D%NIJB
IIJE=D%NIJE
+IIJT=D%NIJT
!-------------------------------------------------------------------------------
!
IF(PARAMI%LOCND2) THEN
@@ -392,7 +401,7 @@ DO JK = IKTB,IKTE
ENDDO
!
!
-!* 4. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF LLMICRO POINTS
+!* 4.1 COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF LLMICRO POINTS
! -----------------------------------------------------------------
!
!The nucelation must be call everywhere
@@ -421,6 +430,66 @@ DO JK = IKTB, IKTE
ENDDO
!
!
+!* 4.2 COMPUTES PRECIPITATION FRACTION
+! -------------------------------
+!
+!The ICE4_RAINFR_VERT call was previously in ice4_tendencies to be computed again at each iteration.
+!The computation has been moved here to separate (for GPUs) the part of the code
+!where column computation can occur (here, alongside with the sedimentation) and
+!other routines where computation are only 0D (point by point).
+!This is not completly exact but we can think that the precipitation fraction
+!diagnostic does not evolve too much during a time-step.
+!ICE4_RAINFR_VERT needs the output of ICE4_COMPUTE_PDF; thus this routine
+!is called here but it's still called from within ice4_tendencies.
+IF (PARAMI%CSUBG_RC_RR_ACCR=='PRFR' .OR. PARAMI%CSUBG_RR_EVAP=='PRFR') THEN
+ IF (PARAMI%CSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM') THEN
+ DO JK = IKTB, IKTE
+ DO JIJ=IIJB, IIJE
+ ZSIGMA_RC(JIJ, JK)=PSIGS(JIJ, JK)**2
+ ENDDO
+ ENDDO
+ ENDIF
+ IF (PARAMI%CSUBG_AUCV_RC=='ADJU' .OR. PARAMI%CSUBG_AUCV_RI=='ADJU') THEN
+ DO JK = IKTB, IKTE
+ DO JIJ=IIJB, IIJE
+ ZHLC_LRC(JIJ, JK) = ZWR(JIJ, JK, IRC) - PHLC_HRC(JIJ, JK)
+ ZHLI_LRI(JIJ, JK) = ZWR(JIJ, JK, IRI) - PHLI_HRI(JIJ, JK)
+ IF(ZWR(JIJ, JK, IRC)>0.) THEN
+ ZHLC_LCF(JIJ, JK) = PCLDFR(JIJ, JK)- PHLC_HCF(JIJ, JK)
+ ELSE
+ ZHLC_LCF(JIJ, JK)=0.
+ ENDIF
+ IF(ZWR(JIJ, JK, IRI)>0.) THEN
+ ZHLI_LCF(JIJ, JK) = PCLDFR(JIJ, JK)- PHLI_HCF(JIJ, JK)
+ ELSE
+ ZHLI_LCF(JIJ, JK)=0.
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDIF
+ !We cannot use ZWR(:,IKTB:IKTE,IRC) which is not contiguous
+ CALL ICE4_COMPUTE_PDF(CST, ICEP, ICED, IIJT*(IKTE-IKTB+1), PARAMI%CSUBG_AUCV_RC, PARAMI%CSUBG_AUCV_RI, PARAMI%CSUBG_PR_PDF,&
+ LLMICRO(:,IKTB:IKTE), PRHODREF(:,IKTB:IKTE), PRCT(:,IKTB:IKTE), PRIT(:,IKTB:IKTE), &
+ PCLDFR(:,IKTB:IKTE), ZT(:,IKTB:IKTE), ZSIGMA_RC(:,IKTB:IKTE), &
+ PHLC_HCF(:,IKTB:IKTE), ZHLC_LCF(:,IKTB:IKTE), PHLC_HRC(:,IKTB:IKTE), ZHLC_LRC(:,IKTB:IKTE), &
+ PHLI_HCF(:,IKTB:IKTE), ZHLI_LCF(:,IKTB:IKTE), PHLI_HRI(:,IKTB:IKTE), ZHLI_LRI(:,IKTB:IKTE), &
+ PRAINFR(:,IKTB:IKTE))
+!CALL ICE4_COMPUTE_PDF2D(D, CST, ICEP, ICED, PARAMI%CSUBG_AUCV_RC, PARAMI%CSUBG_AUCV_RI, PARAMI%CSUBG_PR_PDF, &
+! LLMICRO, PRHODREF, ZWR(:,:,IRC), ZWR(:,:,IRI), PCLDFR, ZT, ZSIGMA_RC,&
+! PHLC_HCF, ZHLC_LCF, PHLC_HRC, ZHLC_LRC, &
+! PHLI_HCF, ZHLI_LCF, PHLI_HRI, ZHLI_LRI, PRAINFR)
+ IF (PRESENT(PRHS)) THEN
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, ZWR(:,:,IRR), &
+ &ZWR(:,:,IRS), ZWR(:,:,IRG), ZWR(:,:,IRH))
+ ELSE
+ CALL ICE4_RAINFR_VERT(D, ICED, PRAINFR, ZWR(:,:,IRR), &
+ &ZWR(:,:,IRS), ZWR(:,:,IRG))
+ ENDIF
+ELSE
+ PRAINFR(:,:)=1.
+ENDIF
+!
+!
!* 5. TENDENCIES COMPUTATION
! ----------------------
!