From 5c82b4ce0cfd4bf1d1908424d355d19b87e84063 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Riette?= <sebastien.riette@meteo.fr>
Date: Wed, 24 Nov 2021 16:23:45 +0100
Subject: [PATCH] =?UTF-8?q?S=C3=A9bastien=2024/11/2021=20Merge=20AROME->CO?=
=?UTF-8?q?MMON=20fast=5Frh?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
src/common/micro/mode_ice4_fast_rh.F90 | 171 ++++---
src/common/micro/mode_ice4_warm.F90 | 12 +
src/mesonh/micro/ice4_fast_rh.f90 | 593 -------------------------
src/mesonh/micro/ice4_slow.f90 | 263 -----------
4 files changed, 113 insertions(+), 926 deletions(-)
delete mode 100644 src/mesonh/micro/ice4_fast_rh.f90
delete mode 100644 src/mesonh/micro/ice4_slow.f90
diff --git a/src/common/micro/mode_ice4_fast_rh.F90 b/src/common/micro/mode_ice4_fast_rh.F90
index b45cd8fe1..dc6ed246c 100644
--- a/src/common/micro/mode_ice4_fast_rh.F90
+++ b/src/common/micro/mode_ice4_fast_rh.F90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -26,16 +26,25 @@ SUBROUTINE ICE4_FAST_RH(KPROMA,KSIZE, LDSOFT, PCOMPUTE, PWETG, &
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!! R. El Khatib 24-Aug-2021 Optimizations
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR
-USE MODD_PARAM_ICE, ONLY : LEVLIMIT, LNULLWETH, LWETHPOST, LCONVHG
+USE MODD_CST, ONLY: XALPI, XALPW, XBETAI, XBETAW, XGAMW, XCI, XCL, XCPV, XESTT, XGAMI, XLMTT, &
+ & XLVTT, XMD, XMV, XRV, XTT, XEPSILO
+USE MODD_PARAM_ICE, ONLY: LCONVHG, LEVLIMIT, LNULLWETH, LWETHPOST
+USE MODD_RAIN_ICE_DESCR, ONLY: XBG, XBS, XCEXVT, XCXG, XCXH, XCXS, XDH, XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG, NWETLBDAH, NWETLBDAR, NWETLBDAS, X0DEPH, X1DEPH, XCOLEXGH, XCOLEXIH, &
+ & XCOLGH, XCOLIH, XCOLEXSH, XCOLSH, XEX0DEPH, XEX1DEPH, XFGWETH, XFRWETH, &
+ & XFSWETH, XFWETH, XKER_GWETH, XKER_RWETH, XKER_SWETH, XLBGWETH1, XLBGWETH2, &
+ & XLBGWETH3, XLBRWETH1, XLBRWETH2, XLBRWETH3, XLBSWETH1, XLBSWETH2, XLBSWETH3, &
+ & XWETINTP1G, XWETINTP1H, XWETINTP1R, XWETINTP1S, XWETINTP2G, XWETINTP2H, &
+ & XWETINTP2R, XWETINTP2S
+!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -66,17 +75,17 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
@@ -89,34 +98,23 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
!
!* 0.2 declaration of local variables
!
+INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
+ & IFREEZ1=9, IFREEZ2=10
LOGICAL, DIMENSION(KSIZE) :: GWET
REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
INTEGER :: IHAIL, IGWET
+INTEGER, DIMENSION(KSIZE) :: I1
REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
REAL, DIMENSION(KSIZE) :: ZZW, &
ZRDRYH_INIT, ZRWETH_INIT, &
ZRDRYHG
INTEGER :: JJ, JL
-INTEGER :: IRCWETH, IRRWETH, IRIDRYH, IRIWETH, IRSDRYH, IRSWETH, IRGDRYH, IRGWETH, &
- & IFREEZ1, IFREEZ2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RH',0,ZHOOK_HANDLE)
!
-IRCWETH=1
-IRRWETH=2
-IRIDRYH=3
-IRIWETH=4
-IRSDRYH=5
-IRSWETH=6
-IRGDRYH=7
-IRGWETH=8
-IFREEZ1=9
-IFREEZ2=10
-!
-!
!
!* 7.2 compute the Wet and Dry growth of hail
!
@@ -159,10 +157,18 @@ ENDIF
!
!* 7.2.1 accretion of aggregates on the hailstones
!
-DO JL=1, KSIZE
- ZWET(JL) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JL)
+IGWET = 0
+DO JJ = 1, KSIZE
+ ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ ENDIF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -172,28 +178,28 @@ IF(LDSOFT) THEN
ELSE
PRH_TEND(:, IRSWETH)=0.
PRH_TEND(:, IRSDRYH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
IF(IGWET>0)THEN
!
!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
!
- ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(1:IGWET) = PACK( PLBDAS(:),MASK=GWET(:) )
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAS(I1(JJ))
+ ENDDO
!
!* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
! tabulate the SWETH-kernel
!
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
!
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAS)-0.00001, &
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
!
!* 7.2.5 perform the bilinear interpolation of the normalized
! SWETH-kernel
@@ -206,7 +212,10 @@ ELSE
- XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRSWETH)=XFSWETH*ZZW(1:KSIZE) & ! RSWETH
@@ -222,10 +231,18 @@ ENDIF
!
!* 7.2.6 accretion of graupeln on the hailstones
!
-DO JL=1, KSIZE
- ZWET(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JL)
+IGWET = 0
+DO JJ = 1, KSIZE
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ END IF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -235,28 +252,28 @@ IF(LDSOFT) THEN
ELSE
PRH_TEND(:, IRGWETH)=0.
PRH_TEND(:, IRGDRYH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
IF(IGWET>0)THEN
!
!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
!
- ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(1:IGWET) = PACK( PLBDAG(:),MASK=GWET(:) )
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAG(I1(JJ))
+ END DO
!
!* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
! tabulate the GWETH-kernel
!
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
!
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
!
!* 7.2.10 perform the bilinear interpolation of the normalized
! GWETH-kernel
@@ -269,7 +286,10 @@ ELSE
- XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRGWETH)=XFGWETH*ZZW(1:KSIZE) & ! RGWETH
@@ -289,10 +309,18 @@ ENDIF
!
!* 7.2.11 accretion of raindrops on the hailstones
!
-DO JL=1, KSIZE
- ZWET(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &PCOMPUTE(JL)
+IGWET = 0
+DO JJ = 1, KSIZE
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ ENDIF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -300,28 +328,28 @@ IF(LDSOFT) THEN
ENDDO
ELSE
PRH_TEND(:, IRRWETH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
IF(IGWET>0)THEN
!
!* 7.2.12 select the (PLBDAH,PLBDAR) couplet
!
- ZVEC1(1:IGWET)=PACK(PLBDAH(:), MASK=GWET(:))
- ZVEC2(1:IGWET)=PACK(PLBDAR(:), MASK=GWET(:))
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAR(I1(JJ))
+ ENDDO
!
!* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
! tabulate the RWETH-kernel
!
- ZVEC1(1:IGWET)=MAX(1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
+ ZVEC1(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
XWETINTP1H*LOG(ZVEC1(1:IGWET))+XWETINTP2H))
IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET))
- ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-FLOAT(IVEC1(1:IGWET))
+ ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-REAL(IVEC1(1:IGWET))
!
- ZVEC2(1:IGWET)=MAX(1.00001, MIN( FLOAT(NWETLBDAR)-0.00001, &
+ ZVEC2(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAR)-0.00001, &
XWETINTP1R*LOG(ZVEC2(1:IGWET))+XWETINTP2R))
IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET))
- ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-FLOAT(IVEC2(1:IGWET))
+ ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-REAL(IVEC2(1:IGWET))
!
!* 7.2.14 perform the bilinear interpolation of the normalized
! RWETH-kernel
@@ -334,7 +362,10 @@ ELSE
- XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
- ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGWET), MASK=GWET, FIELD=0.)
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRRWETH) = XFRWETH*ZZW(1:KSIZE) & ! RRWETH
@@ -417,7 +448,7 @@ ENDIF
DO JL=1, KSIZE
ZDRYH(JL) = ZHAIL(JL) * &
& MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
- & MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
& MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
&MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
ENDDO
diff --git a/src/common/micro/mode_ice4_warm.F90 b/src/common/micro/mode_ice4_warm.F90
index 39c43c573..8c844f092 100644
--- a/src/common/micro/mode_ice4_warm.F90
+++ b/src/common/micro/mode_ice4_warm.F90
@@ -95,7 +95,11 @@ IF (LHOOK) CALL DR_HOOK('ICE4_WARM', 0, ZHOOK_HANDLE)
!
DO JL=1, KSIZE
ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+#ifdef REPRO48
+ &MAX(0., -SIGN(1., -PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
+#else
&MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 1.E-20
+#endif
&PCOMPUTE(JL)
ENDDO
IF(LDSOFT) THEN
@@ -147,10 +151,18 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
&PCOMPUTE(JL)
ZMASK1(JL)=ZMASK(JL) * &
&MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+#ifdef REPRO48
+ &MAX(0., -SIGN(1., -PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
+#else
&MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) ! PHLC_HCF(:)>1.E-20
+#endif
ZMASK2(JL)=ZMASK(JL) * &
&MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
+#ifdef REPRO48
+ &MAX(0., -SIGN(1., -PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
+#else
&MAX(0., -SIGN(1., 1.E-20-PHLC_LCF(JL))) ! PHLC_LCF(:)>1.E-20
+#endif
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
diff --git a/src/mesonh/micro/ice4_fast_rh.f90 b/src/mesonh/micro/ice4_fast_rh.f90
deleted file mode 100644
index fcac93748..000000000
--- a/src/mesonh/micro/ice4_fast_rh.f90
+++ /dev/null
@@ -1,593 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-MODULE MODI_ICE4_FAST_RH
-INTERFACE
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-END SUBROUTINE ICE4_FAST_RH
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RH
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the fast rh process
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
-USE MODD_PARAM_ICE, ONLY: LCONVHG,LEVLIMIT,LNULLWETH,LWETHPOST
-USE MODD_RAIN_ICE_DESCR, ONLY: XBG,XBS,XCEXVT,XCXG,XCXH,XCXS,XDH,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG,NWETLBDAH,NWETLBDAR,NWETLBDAS,X0DEPH,X1DEPH,XCOLEXGH,XCOLEXIH,XCOLGH,XCOLIH,XCOLEXSH, &
- XCOLSH,XEX0DEPH,XEX1DEPH,XFGWETH,XFRWETH,XFSWETH,XFWETH,XKER_GWETH,XKER_RWETH,XKER_SWETH, &
- XLBGWETH1,XLBGWETH2,XLBGWETH3,XLBRWETH1,XLBRWETH2,XLBRWETH3,XLBSWETH1,XLBSWETH2,XLBSWETH3, &
- XWETINTP1G,XWETINTP1H,XWETINTP1R,XWETINTP1S,XWETINTP2G,XWETINTP2H,XWETINTP2R,XWETINTP2S
-!
-USE MODE_MPPDB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-!
-!* 0.2 declaration of local variables
-!
-INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
- & IFREEZ1=9, IFREEZ2=10
-!
-LOGICAL, DIMENSION(KSIZE) :: GWET
-REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
-INTEGER :: IHAIL, IGWET
-INTEGER, DIMENSION(KSIZE) :: I1
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, &
- ZRDRYH_INIT, ZRWETH_INIT, &
- ZRDRYHG
-INTEGER :: JJ, JL
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 7.2 compute the Wet and Dry growth of hail
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRCWETH)=ZMASK(JL) * PRH_TEND(JL, IRCWETH)
- ENDDO
-ELSE
- PRH_TEND(:, IRCWETH)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRIWETH)=ZMASK(JL) * PRH_TEND(JL, IRIWETH)
- PRH_TEND(JL, IRIDRYH)=ZMASK(JL) * PRH_TEND(JL, IRIDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRIWETH)=0.
- PRH_TEND(:, IRIDRYH)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH
- PRH_TEND(:, IRIDRYH)=PRH_TEND(:, IRIWETH)*(XCOLIH*EXP(XCOLEXIH*(PT(:)-XTT))) ! RIDRYH
- END WHERE
-ENDIF
-
-!
-!* 7.2.1 accretion of aggregates on the hailstones
-!
-IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
- ELSE
- GWET(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRSWETH)=ZWET(JL) * PRH_TEND(JL, IRSWETH)
- PRH_TEND(JL, IRSDRYH)=ZWET(JL) * PRH_TEND(JL, IRSDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRSWETH)=0.
- PRH_TEND(:, IRSDRYH)=0.
- IF(IGWET>0)THEN
- !
- !* 7.2.3 select the (PLBDAH,PLBDAS) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAS(I1(JJ))
- END DO
- !
- !* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
- ! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
- ! tabulate the SWETH-kernel
- !
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
- !
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
- XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
- !
- !* 7.2.5 perform the bilinear interpolation of the normalized
- ! SWETH-kernel
- !
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRSWETH)=XFSWETH*ZZW(:) & ! RSWETH
- *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSWETH1/( PLBDAH(:)**2 ) + &
- XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + &
- XLBSWETH3/( PLBDAS(:)**2) )
- PRH_TEND(:, IRSDRYH)=PRH_TEND(:, IRSWETH)*(XCOLSH*EXP(XCOLEXSH*(PT(:)-XTT)))
- END WHERE
- ENDIF
-ENDIF
-!
-!* 7.2.6 accretion of graupeln on the hailstones
-!
-IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
- ELSE
- GWET(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRGWETH)=ZWET(JL) * PRH_TEND(JL, IRGWETH)
- PRH_TEND(JL, IRGDRYH)=ZWET(JL) * PRH_TEND(JL, IRGDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRGWETH)=0.
- PRH_TEND(:, IRGDRYH)=0.
- IF(IGWET>0)THEN
- !
- !* 7.2.8 select the (PLBDAH,PLBDAG) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAG(I1(JJ))
- END DO
- !
- !* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
- ! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
- ! tabulate the GWETH-kernel
- !
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
- !
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
- XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
- !
- !* 7.2.10 perform the bilinear interpolation of the normalized
- ! GWETH-kernel
- !
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRGWETH)=XFGWETH*ZZW(:) & ! RGWETH
- *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBGWETH1/( PLBDAH(:)**2 ) + &
- XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + &
- XLBGWETH3/( PLBDAG(:)**2) )
- PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH)
- END WHERE
- !When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same
- WHERE(GWET(:) .AND. .NOT. PWETG(:)==1.)
- PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT)))
- END WHERE
- END IF
-ENDIF
-!
-!* 7.2.11 accretion of raindrops on the hailstones
-!
-IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
- ELSE
- GWET(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRRWETH)=ZWET(JL) * PRH_TEND(JL, IRRWETH)
- ENDDO
-ELSE
- PRH_TEND(:, IRRWETH)=0.
- IF(IGWET>0)THEN
- !
- !* 7.2.12 select the (PLBDAH,PLBDAR) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAR(I1(JJ))
- END DO
- !
- !* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
- ! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
- ! tabulate the RWETH-kernel
- !
- ZVEC1(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
- XWETINTP1H*LOG(ZVEC1(1:IGWET))+XWETINTP2H))
- IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET))
- ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-REAL(IVEC1(1:IGWET))
- !
- ZVEC2(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAR)-0.00001, &
- XWETINTP1R*LOG(ZVEC2(1:IGWET))+XWETINTP2R))
- IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET))
- ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-REAL(IVEC2(1:IGWET))
- !
- !* 7.2.14 perform the bilinear interpolation of the normalized
- ! RWETH-kernel
- !
- DO JJ=1, IGWET
- ZVEC3(JJ)= ( XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- *(ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRRWETH) = XFRWETH*ZZW(:) & ! RRWETH
- *( PLBDAR(:)**(-4) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRWETH1/( PLBDAH(:)**2 ) + &
- XLBRWETH2/( PLBDAH(:) * PLBDAR(:) ) + &
- XLBRWETH3/( PLBDAR(:)**2) )
- END WHERE
- ENDIF
-ENDIF
-!
-DO JL=1, KSIZE
- ZRDRYH_INIT(JL)=PRH_TEND(JL, IRCWETH)+PRH_TEND(JL, IRIDRYH)+ &
- &PRH_TEND(JL, IRSDRYH)+PRH_TEND(JL, IRRWETH)+PRH_TEND(JL, IRGDRYH)
-ENDDO
-!
-!* 7.3 compute the Wet growth of hail
-!
-DO JL=1, KSIZE
- ZHAIL(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IFREEZ1)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ1)
- PRH_TEND(JL, IFREEZ2)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ2)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZHAIL(:)==1.)
- PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
- END WHERE
- ENDIF
- PRH_TEND(:, IFREEZ2)=0.
- WHERE(ZHAIL(:)==1.)
- PRH_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-PRH_TEND(:, IFREEZ1))/(XRV*PT(:)) )
- PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH )/ &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- PRH_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- !We must agregate, at least, the cold species
- ZRWETH_INIT(JL)=ZHAIL(JL) * MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
- &MAX(0., PRH_TEND(JL, IFREEZ1) + &
- &PRH_TEND(JL, IFREEZ2) * ( &
- &PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH) )))
-ENDDO
-!
-!* 7.4 Select Wet or Dry case
-!
-!Wet case
-DO JL=1, KSIZE
- ZWETH(JL) = ZHAIL(JL) * &
- & MAX(0., SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH)) - &
- &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))))
-ENDDO
-IF(LNULLWETH) THEN
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) ! WHERE(ZRDRYH_INIT(:)>0.)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRWETH_INIT(JL))) ! WHERE(ZRWETH_INIT(:)>0.)
- ENDDO
-ENDIF
-IF(.NOT. LWETHPOST) THEN
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
- ENDDO
-ENDIF
-DO JL=1, KSIZE
- ZDRYH(JL) = ZHAIL(JL) * &
- & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
- & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
- & MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
- &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
-ENDDO
-!
-ZRDRYHG(:)=0.
-IF(LCONVHG)THEN
- WHERE(ZDRYH(:)==1.)
- ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:))
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PRCWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRCWETH)
- PRIWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRIWETH)
- PRSWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRSWETH)
- PRGWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRGWETH)
- !Collected minus aggregated
- PRRWETH(JL) = ZWETH(JL) * (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
- PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
- PRH_TEND(JL, IRCWETH))
-
- PRCDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRCWETH)
- PRIDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRIDRYH)
- PRSDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRSDRYH)
- PRRDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRRWETH)
- PRGDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRGDRYH)
- PRDRYHG(JL) = ZDRYH(JL) * ZRDRYHG(JL)
-
- PA_RC(JL) = PA_RC(JL) - PRCWETH(JL)
- PA_RI(JL) = PA_RI(JL) - PRIWETH(JL)
- PA_RS(JL) = PA_RS(JL) - PRSWETH(JL)
- PA_RG(JL) = PA_RG(JL) - PRGWETH(JL)
- PA_RH(JL) = PA_RH(JL) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
- PA_RR(JL) = PA_RR(JL) - PRRWETH(JL)
- PA_TH(JL) = PA_TH(JL) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA_RC(JL) = PA_RC(JL) - PRCDRYH(JL)
- PA_RI(JL) = PA_RI(JL) - PRIDRYH(JL)
- PA_RS(JL) = PA_RS(JL) - PRSDRYH(JL)
- PA_RR(JL) = PA_RR(JL) - PRRDRYH(JL)
- PA_RG(JL) = PA_RG(JL) - PRGDRYH(JL) + PRDRYHG(JL)
- PA_RH(JL) = PA_RH(JL) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
- &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!* 7.5 Melting of the hailstones
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRHMLTR(JL)=ZMASK(JL)*PRHMLTR(JL)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRHMLTR(JL) = ZMASK(JL)* PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
- END WHERE
- ENDIF
- DO JL=1, KSIZE
- PRHMLTR(JL) = ZMASK(JL)* (PKA(JL)*(XTT-PT(JL)) + &
- ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
- *(XESTT-PRHMLTR(JL))/(XRV*PT(JL)) ))
- ENDDO
- WHERE(ZMASK(:)==1.)
- !
- ! compute RHMLTR
- !
- PRHMLTR(:) = MAX( 0.0,( -PRHMLTR(:) * &
- ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - &
- ( PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRRWETH) )* &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- END WHERE
-END IF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) + PRHMLTR(JL)
- PA_RH(JL) = PA_RH(JL) - PRHMLTR(JL)
- PA_TH(JL) = PA_TH(JL) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!
-END SUBROUTINE ICE4_FAST_RH
diff --git a/src/mesonh/micro/ice4_slow.f90 b/src/mesonh/micro/ice4_slow.f90
deleted file mode 100644
index 15d0cd78e..000000000
--- a/src/mesonh/micro/ice4_slow.f90
+++ /dev/null
@@ -1,263 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-MODULE MODI_ICE4_SLOW
-INTERFACE
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT,&
- &PSSI, PLVFACT, PLSFACT, &
- &PRVT, PRCT, PRIT, PRST, PRGT,&
- &PLBDAS, PLBDAG,&
- &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-END SUBROUTINE ICE4_SLOW
-END INTERFACE
-END MODULE MODI_ICE4_SLOW
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
- &PSSI, PLVFACT, PLSFACT, &
- &PRVT, PRCT, PRIT, PRST, PRGT, &
- &PLBDAS, PLBDAG, &
- &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the slow process
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XTT
-USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPG,X0DEPS,X1DEPG,X1DEPS,XACRIAUTI,XALPHA3,XBCRIAUTI,XBETA3,XCOLEXIS,XCRIAUTI, &
- XEX0DEPG,XEX0DEPS,XEX1DEPG,XEX1DEPS,XEXIAGGS,XFIAGGS,XHON,XTEXAUTI,XTIMAUTI
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-!
-!* 0.2 declaration of local variables
-!
-REAL, DIMENSION(KSIZE) :: ZCRIAUTI, ZMASK
-REAL :: ZTIMAUTIC
-INTEGER :: JL
-!-------------------------------------------------------------------------------
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3.2 compute the homogeneous nucleation source: RCHONI
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCHONI(JL) = PRCHONI(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRCHONI(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCHONI(:) = MIN(1000.,XHON*PRHODREF(:)*PRCT(:) &
- *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ))
- ENDWHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RI(JL) = PA_RI(JL) + PRCHONI(JL)
- PA_RC(JL) = PA_RC(JL) - PRCHONI(JL)
- PA_TH(JL) = PA_TH(JL) + PRCHONI(JL)*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!* 3.4 compute the deposition, aggregation and autoconversion sources
-!
-!
-!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
-!
-! ZZW(:) = 0.0
-! ZTIMAUTIC = SQRT( XTIMAUTI*XTIMAUTC )
-! WHERE ( (PRCT(:)>0.0) .AND. (PRIT(:)>0.0) .AND. (PRCS(:)>0.0) )
-! ZZW(:) = MIN( PRCS(:),ZTIMAUTIC * MAX( SQRT( PRIT(:)*PRCT(:) ),0.0 ) )
-! PRIS(:) = PRIS(:) + ZZW(:)
-! PRCS(:) = PRCS(:) - ZZW(:)
-! PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCAUTI))
-! END WHERE
-!
-!* 3.4.3 compute the deposition on r_s: RVDEPS
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & !PRVT(:)>XRTMIN(1)
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !PRST(:)>XRTMIN(5)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRVDEPS(JL)=PRVDEPS(JL)*ZMASK(JL)
- ENDDO
-ELSE
- PRVDEPS(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRVDEPS(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
- ( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRVDEPS(JL)
- PA_RV(JL) = PA_RV(JL) - PRVDEPS(JL)
- PA_TH(JL) = PA_TH(JL) + PRVDEPS(JL)*PLSFACT(JL)
-ENDDO
-!
-!* 3.4.4 compute the aggregation on r_s: RIAGGS
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! PRST(:)>XRTMIN(5)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRIAGGS(JL)=PRIAGGS(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRIAGGS(:) = 0.
- WHERE(ZMASK(:)==1)
- PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
- * PRIT(:) &
- * PLBDAS(:)**XEXIAGGS &
- * PRHODREF(:)**(-XCEXVT)
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRIAGGS(JL)
- PA_RI(JL) = PA_RI(JL) - PRIAGGS(JL)
-ENDDO
-!
-!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PHLI_HRI(JL))) * & ! PHLI_HRI(:)>XRTMIN(4)
- &MAX(0., -SIGN(1., 1.E-20-PHLI_HCF(JL))) * & ! PHLI_HCF(:) .GT. 0.
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRIAUTS(JL) = PRIAUTS(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRIAUTS(:) = 0.
- !ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PT(:)-XTT)-3.5))
- ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
- WHERE(ZMASK(:)==1.)
- PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) &
- * MAX( PHLI_HRI(:)/PHLI_HCF(:)-ZCRIAUTI(:),0.0 )
- PRIAUTS(:) = PHLI_HCF(:)*PRIAUTS(:)
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRIAUTS(JL)
- PA_RI(JL) = PA_RI(JL) - PRIAUTS(JL)
-ENDDO
-!
-!* 3.4.6 compute the deposition on r_g: RVDEPG
-!
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & ! PRVT(:)>XRTMIN(1)
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! PRGT(:)>XRTMIN(6)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRVDEPG(JL) = PRVDEPG(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRVDEPG(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRVDEPG(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
- ( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RG(JL) = PA_RG(JL) + PRVDEPG(JL)
- PA_RV(JL) = PA_RV(JL) - PRVDEPG(JL)
- PA_TH(JL) = PA_TH(JL) + PRVDEPG(JL)*PLSFACT(JL)
-ENDDO
-!
-!
-END SUBROUTINE ICE4_SLOW
--
GitLab