From b1268737cd277a51632e87ab39f8aa07c27ae801 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:01:16 +0100
Subject: [PATCH] =?UTF-8?q?S=C3=A9bastien=2024/11/2021=20Merge=20AROME->CO?=
=?UTF-8?q?MMON=20fast=5Frg?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
src/common/micro/mode_ice4_fast_rg.F90 | 126 +++---
src/common/micro/mode_ice4_fast_ri.F90 | 4 +
src/common/micro/mode_ice4_fast_rs.F90 | 2 +-
src/mesonh/micro/ice4_fast_rg.f90 | 582 -------------------------
src/mesonh/micro/ice4_fast_rs.f90 | 521 ----------------------
5 files changed, 82 insertions(+), 1153 deletions(-)
delete mode 100644 src/mesonh/micro/ice4_fast_rg.f90
delete mode 100644 src/mesonh/micro/ice4_fast_rs.f90
diff --git a/src/common/micro/mode_ice4_fast_rg.F90 b/src/common/micro/mode_ice4_fast_rg.F90
index 101a10ca2..c55e06882 100644
--- a/src/common/micro/mode_ice4_fast_rg.F90
+++ b/src/common/micro/mode_ice4_fast_rg.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.
@@ -28,16 +28,23 @@ SUBROUTINE ICE4_FAST_RG(KPROMA,KSIZE, LDSOFT, PCOMPUTE, KRR, &
!! 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, LNULLWETG, LWETGPOST, LCRFLIMIT
+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: LCRFLIMIT, LEVLIMIT, LNULLWETG, LWETGPOST
+USE MODD_RAIN_ICE_DESCR, ONLY: XBS, XCEXVT, XCXG, XCXS, XDG, XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: NDRYLBDAG, NDRYLBDAR, NDRYLBDAS, X0DEPG, X1DEPG, XCOLEXIG, XCOLEXSG, XCOLIG, &
+ & XCOLSG, XDRYINTP1G, XDRYINTP1R, XDRYINTP1S, XDRYINTP2G, XDRYINTP2R, XDRYINTP2S, &
+ & XEX0DEPG, XEX1DEPG, XEXICFRR, XEXRCFRI, XFCDRYG, XFIDRYG, XFRDRYG, &
+ & XFSDRYG, XICFRR, XKER_RDRYG, XKER_SDRYG, XLBRDRYG1, XLBRDRYG2, XLBRDRYG3, &
+ & XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XRCFRI
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -73,16 +80,16 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH ! Conversion of graupel into hail
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG ! Graupel wet growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
@@ -97,7 +104,10 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
!
!* 0.2 declaration of local variables
!
+INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6, &
+ & IFREEZ1=7, IFREEZ2=8
LOGICAL, DIMENSION(KSIZE) :: GDRY
+INTEGER, DIMENSION(KSIZE) :: I1
REAL, DIMENSION(KSIZE) :: ZDRY, ZDRYG, ZMASK
INTEGER :: IGDRY
REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
@@ -106,14 +116,6 @@ REAL, DIMENSION(KSIZE) :: ZZW, &
ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
ZRWETG_INIT !Initial wet growth rate of the graupeln
INTEGER :: JJ, JL
-INTEGER, PARAMETER :: IRCDRYG=1
-INTEGER, PARAMETER :: IRIDRYG=2
-INTEGER, PARAMETER :: IRIWETG=3
-INTEGER, PARAMETER :: IRSDRYG=4
-INTEGER, PARAMETER :: IRSWETG=5
-INTEGER, PARAMETER :: IRRDRYG=6
-INTEGER, PARAMETER :: IFREEZ1=7
-INTEGER, PARAMETER :: IFREEZ2=8
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -209,10 +211,18 @@ ELSE
ENDIF
! Wet and dry collection of rs on graupel (6.2.1)
-DO JL=1, KSIZE
- ZDRY(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JL)
+IGDRY = 0
+DO JJ = 1, KSIZE
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZDRY(JJ)>0) THEN
+ IGDRY = IGDRY + 1
+ I1(IGDRY) = JJ
+ GDRY(JJ) = .TRUE.
+ ELSE
+ GDRY(JJ) = .FALSE.
+ END IF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -222,28 +232,28 @@ IF(LDSOFT) THEN
ELSE
PRG_TEND(:, IRSDRYG)=0.
PRG_TEND(:, IRSWETG)=0.
- GDRY(:)=ZDRY(:)==1.
- IGDRY=COUNT(GDRY(:))
IF(IGDRY>0)THEN
!
!* 6.2.3 select the (PLBDAG,PLBDAS) couplet
!
- ZVEC1(1:IGDRY)=PACK(PLBDAG(:), MASK=GDRY(:))
- ZVEC2(1:IGDRY)=PACK(PLBDAS(:), MASK=GDRY(:))
+ DO JJ = 1, IGDRY
+ ZVEC1(JJ) = PLBDAG(I1(JJ))
+ ZVEC2(JJ) = PLBDAS(I1(JJ))
+ END DO
!
!* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
! tabulate the SDRYG-kernel
!
- ZVEC1(1:IGDRY)=MAX(1.00001, MIN(FLOAT(NDRYLBDAG)-0.00001, &
+ ZVEC1(1:IGDRY)=MAX(1.00001, MIN(REAL(NDRYLBDAG)-0.00001, &
XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY) )
- ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-FLOAT(IVEC1(1:IGDRY))
+ ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
!
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( FLOAT(NDRYLBDAS)-0.00001, &
+ ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
XDRYINTP1S*LOG(ZVEC2(1:IGDRY))+XDRYINTP2S))
IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
- ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-FLOAT(IVEC2(1:IGDRY))
+ ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
!
!* 6.2.5 perform the bilinear interpolation of the normalized
! SDRYG-kernel
@@ -256,7 +266,10 @@ ELSE
- XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
- ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGDRY), MASK=GDRY(:), FIELD=0.0)
+ ZZW(:) = 0.
+ DO JJ = 1, IGDRY
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
WHERE(GDRY(1:KSIZE))
PRG_TEND(1:KSIZE, IRSWETG)=XFSDRYG*ZZW(1:KSIZE) & ! RSDRYG
@@ -273,40 +286,48 @@ ENDIF
!
!* 6.2.6 accretion of raindrops on the graupeln
!
-DO JL=1, KSIZE
- ZDRY(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JL)
+IGDRY = 0
+DO JJ = 1, KSIZE
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZDRY(JJ)>0) THEN
+ IGDRY = IGDRY + 1
+ I1(IGDRY) = JJ
+ GDRY(JJ) = .TRUE.
+ ELSE
+ GDRY(JJ) = .FALSE.
+ ENDIF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
PRG_TEND(JL, IRRDRYG)=ZDRY(JL) * PRG_TEND(JL, IRRDRYG)
ENDDO
ELSE
- GDRY(:)=ZDRY(:)==1.
PRG_TEND(:, IRRDRYG)=0.
- IGDRY=COUNT(GDRY(:))
!
IF(IGDRY>0) THEN
!
!* 6.2.8 select the (PLBDAG,PLBDAR) couplet
!
- ZVEC1(1:IGDRY)=PACK(PLBDAG(:), MASK=GDRY(:))
- ZVEC2(1:IGDRY)=PACK(PLBDAR(:), MASK=GDRY(:))
+ DO JJ = 1, IGDRY
+ ZVEC1(JJ) = PLBDAG(I1(JJ))
+ ZVEC2(JJ) = PLBDAR(I1(JJ))
+ ENDDO
!
!* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
! tabulate the RDRYG-kernel
!
- ZVEC1(1:IGDRY)=MAX(1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
+ ZVEC1(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY))
- ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-FLOAT(IVEC1(1:IGDRY))
+ ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
!
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( FLOAT(NDRYLBDAR)-0.00001, &
+ ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
XDRYINTP1R*LOG(ZVEC2(1:IGDRY))+XDRYINTP2R))
IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
- ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-FLOAT(IVEC2(1:IGDRY))
+ ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
!
!* 6.2.10 perform the bilinear interpolation of the normalized
! RDRYG-kernel
@@ -319,7 +340,10 @@ ELSE
- XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
- ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGDRY), MASK=GDRY, FIELD=0.)
+ ZZW(:) = 0.
+ DO JJ = 1, IGDRY
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
WHERE(GDRY(1:KSIZE))
PRG_TEND(1:KSIZE, IRRDRYG) = XFRDRYG*ZZW(1:KSIZE) & ! RRDRYG
@@ -399,7 +423,11 @@ ENDIF
DO JL=1, KSIZE
ZDRYG(JL) = ZMASK(JL) * & !
& MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+#ifdef REPRO48
& MAX(0., -SIGN(1., -ZRDRYG_INIT(JL))) * & ! WHERE(ZRDRYG_INIT(:)>0.)
+#else
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYG_INIT(JL))) * & ! WHERE(ZRDRYG_INIT(:)>0.)
+#endif
& MAX(0., -SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
&MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
ENDDO
diff --git a/src/common/micro/mode_ice4_fast_ri.F90 b/src/common/micro/mode_ice4_fast_ri.F90
index 3315e03df..0e1e1e0ff 100644
--- a/src/common/micro/mode_ice4_fast_ri.F90
+++ b/src/common/micro/mode_ice4_fast_ri.F90
@@ -71,7 +71,11 @@ IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RI',0,ZHOOK_HANDLE)
!
DO JL=1, KSIZE
LMASK = PSSI(JL)>0. .AND. PRCT(JL)>XRTMIN(2) .AND. &
+#ifdef REPRO48
& PRIT(JL)>XRTMIN(4) .AND. PCIT(JL)>0. .AND. &
+#else
+ & PRIT(JL)>XRTMIN(4) .AND. PCIT(JL)>1.E-20 .AND. &
+#endif
& PCOMPUTE(JL)==1
IF(LMASK) THEN
IF(.NOT. LDSOFT) THEN
diff --git a/src/common/micro/mode_ice4_fast_rs.F90 b/src/common/micro/mode_ice4_fast_rs.F90
index 2d2d0c0a9..9775ff155 100644
--- a/src/common/micro/mode_ice4_fast_rs.F90
+++ b/src/common/micro/mode_ice4_fast_rs.F90
@@ -272,7 +272,7 @@ ENDDO
!* 5.2 rain accretion onto the aggregates
!
IGACC = 0
-DO JJ = 1, SIZE(GACC)
+DO JJ = 1, KSIZE
ZACC(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & !WHERE(PRRT(:)>XRTMIN(3))
&MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
&PCOMPUTE(JJ)
diff --git a/src/mesonh/micro/ice4_fast_rg.f90 b/src/mesonh/micro/ice4_fast_rg.f90
deleted file mode 100644
index b84dda857..000000000
--- a/src/mesonh/micro/ice4_fast_rg.f90
+++ /dev/null
@@ -1,582 +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_RG
-INTERFACE
-SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, PCIT, &
- &PLBDAR, PLBDAS, PLBDAG, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- &PRGSI, PRGSI_MR, &
- &PWETG, &
- &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
- &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
- &PRG_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-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) :: PCIT ! Pristine ice conc. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-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) :: 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 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 m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_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
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
-END SUBROUTINE ICE4_FAST_RG
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RG
-SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, PCIT, &
- &PLBDAR, PLBDAS, PLBDAG, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- &PRGSI, PRGSI_MR, &
- &PWETG, &
- &PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
- &PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
- &PRG_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the fast rg processes
-!!
-!! 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: LCRFLIMIT,LEVLIMIT,LNULLWETG,LWETGPOST
-USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXG,XCXS,XDG,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: NDRYLBDAG,NDRYLBDAR,NDRYLBDAS,X0DEPG,X1DEPG,XCOLEXIG,XCOLEXSG,XCOLIG,XCOLSG,XDRYINTP1G, &
- XDRYINTP1R,XDRYINTP1S,XDRYINTP2G,XDRYINTP2R,XDRYINTP2S,XEX0DEPG,XEX1DEPG,XEXICFRR, &
- XEXRCFRI,XFCDRYG,XFIDRYG,XFRDRYG,XFSDRYG,XICFRR,XKER_RDRYG,XKER_SDRYG,XLBRDRYG1, &
- XLBRDRYG2,XLBRDRYG3,XLBSDRYG1,XLBSDRYG2,XLBSDRYG3,XRCFRI
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-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) :: PCIT ! Pristine ice conc. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-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) :: 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 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 m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETG ! Graupel wet growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_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
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
-!
-!* 0.2 declaration of local variables
-!
-INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6, &
- & IFREEZ1=7, IFREEZ2=8
-!
-LOGICAL, DIMENSION(KSIZE) :: GDRY
-INTEGER, DIMENSION(KSIZE) :: I1
-REAL, DIMENSION(KSIZE) :: ZDRY, ZDRYG, ZMASK
-INTEGER :: IGDRY
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, &
- ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
- ZRWETG_INIT !Initial wet growth rate of the graupeln
-INTEGER :: JJ, JL
-!
-!-------------------------------------------------------------------------------
-!
-!* 6.1 rain contact freezing
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRICFRRG(JL)=ZMASK(JL) * PRICFRRG(JL)
- PRRCFRIG(JL)=ZMASK(JL) * PRRCFRIG(JL)
- PRICFRR(JL)=ZMASK(JL) * PRICFRR(JL)
- ENDDO
-ELSE
- PRICFRRG(:)=0.
- PRRCFRIG(:)=0.
- WHERE(ZMASK(:)==1.)
- PRICFRRG(:) = XICFRR*PRIT(:) & ! RICFRRG
- *PLBDAR(:)**XEXICFRR &
- *PRHODREF(:)**(-XCEXVT)
- PRRCFRIG(:) = XRCFRI*PCIT(:) & ! RRCFRIG
- * PLBDAR(:)**XEXRCFRI &
- * PRHODREF(:)**(-XCEXVT-1.)
- END WHERE
-
- IF(LCRFLIMIT) THEN
- DO JL=1, KSIZE
- !Comparison between heat to be released (to freeze rain) and heat sink (rain and ice temperature change)
- !ZZW is the proportion of process that can take place
- ZZW(JL)=(1.-ZMASK(JL)) + & ! 1. outside of mask
- ZMASK(JL) * MAX(0., MIN(1., (PRICFRRG(JL)*XCI+PRRCFRIG(JL)*XCL)*(XTT-PT(JL)) / &
- MAX(1.E-20, XLVTT*PRRCFRIG(JL))))
- ENDDO
- ELSE
- ZZW(:)=1.
- ENDIF
- DO JL=1, KSIZE
- PRRCFRIG(JL) = ZZW(JL) * PRRCFRIG(JL) !Part of rain that can be freezed
- PRICFRR(JL) = (1.-ZZW(JL)) * PRICFRRG(JL) !Part of collected pristine ice converted to rain
- PRICFRRG(JL) = ZZW(JL) * PRICFRRG(JL) !Part of collected pristine ice that lead to graupel
- ENDDO
-ENDIF
-DO JL=1, KSIZE
- PA_RI(JL) = PA_RI(JL) - PRICFRRG(JL) - PRICFRR(JL)
- PA_RR(JL) = PA_RR(JL) - PRRCFRIG(JL) + PRICFRR(JL)
- PA_RG(JL) = PA_RG(JL) + PRICFRRG(JL) + PRRCFRIG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRRCFRIG(JL) - PRICFRR(JL))*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!
-!* 6.3 compute the graupel growth
-!
-! Wet and dry collection of rc and ri on graupel
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*PRG_TEND(JL, IRCDRYG)
- ENDDO
-ELSE
- ZZW(:)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
- END WHERE
- DO JL=1, KSIZE
- PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*XFCDRYG * PRCT(JL) * ZZW(JL)
- ENDDO
-ENDIF
-
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IRIDRYG)=ZMASK(JL) * PRG_TEND(JL, IRIDRYG)
- PRG_TEND(JL, IRIWETG)=ZMASK(JL) * PRG_TEND(JL, IRIWETG)
- ENDDO
-ELSE
- PRG_TEND(:, IRIDRYG)=0.
- PRG_TEND(:, IRIWETG)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
- PRG_TEND(:, IRIDRYG)=XFIDRYG*EXP(XCOLEXIG*(PT(:)-XTT))*PRIT(:)*ZZW(:)
- PRG_TEND(:, IRIWETG)=PRG_TEND(:, IRIDRYG) / (XCOLIG*EXP(XCOLEXIG*(PT(:)-XTT)))
- END WHERE
-ENDIF
-
-! Wet and dry collection of rs on graupel (6.2.1)
-IGDRY = 0
-DO JJ = 1, SIZE(GDRY)
- ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JJ)
- IF (ZDRY(JJ)>0) THEN
- IGDRY = IGDRY + 1
- I1(IGDRY) = JJ
- GDRY(JJ) = .TRUE.
- ELSE
- GDRY(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IRSDRYG)=ZDRY(JL) * PRG_TEND(JL, IRSDRYG)
- PRG_TEND(JL, IRSWETG)=ZDRY(JL) * PRG_TEND(JL, IRSWETG)
- ENDDO
-ELSE
- PRG_TEND(:, IRSDRYG)=0.
- PRG_TEND(:, IRSWETG)=0.
- IF(IGDRY>0)THEN
- !
- !* 6.2.3 select the (PLBDAG,PLBDAS) couplet
- !
- DO JJ = 1, IGDRY
- ZVEC1(JJ) = PLBDAG(I1(JJ))
- ZVEC2(JJ) = PLBDAS(I1(JJ))
- END DO
- !
- !* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
- ! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
- ! tabulate the SDRYG-kernel
- !
- ZVEC1(1:IGDRY)=MAX(1.00001, MIN(REAL(NDRYLBDAG)-0.00001, &
- XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
- IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY) )
- ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
- !
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
- XDRYINTP1S*LOG(ZVEC2(1:IGDRY))+XDRYINTP2S))
- IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
- ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
- !
- !* 6.2.5 perform the bilinear interpolation of the normalized
- ! SDRYG-kernel
- !
- DO JJ=1, IGDRY
- ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- *(ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGDRY
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- WHERE(GDRY(:))
- PRG_TEND(:, IRSWETG)=XFSDRYG*ZZW(:) & ! RSDRYG
- / XCOLSG &
- *(PLBDAS(:)**(XCXS-XBS))*( PLBDAG(:)**XCXG ) &
- *(PRHODREF(:)**(-XCEXVT-1.)) &
- *( XLBSDRYG1/( PLBDAG(:)**2 ) + &
- XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + &
- XLBSDRYG3/( PLBDAS(:)**2))
- PRG_TEND(:, IRSDRYG)=PRG_TEND(:, IRSWETG)*XCOLSG*EXP(XCOLEXSG*(PT(:)-XTT))
- END WHERE
- ENDIF
-ENDIF
-!
-!* 6.2.6 accretion of raindrops on the graupeln
-!
-IGDRY = 0
-DO JJ = 1, SIZE(GDRY)
- ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JJ)
- IF (ZDRY(JJ)>0) THEN
- IGDRY = IGDRY + 1
- I1(IGDRY) = JJ
- GDRY(JJ) = .TRUE.
- ELSE
- GDRY(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IRRDRYG)=ZDRY(JL) * PRG_TEND(JL, IRRDRYG)
- ENDDO
-ELSE
- PRG_TEND(:, IRRDRYG)=0.
- !
- IF(IGDRY>0) THEN
- !
- !* 6.2.8 select the (PLBDAG,PLBDAR) couplet
- !
- DO JJ = 1, IGDRY
- ZVEC1(JJ) = PLBDAG(I1(JJ))
- ZVEC2(JJ) = PLBDAR(I1(JJ))
- END DO
- !
- !* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
- ! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
- ! tabulate the RDRYG-kernel
- !
- ZVEC1(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
- XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
- IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY))
- ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-REAL(IVEC1(1:IGDRY))
- !
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
- XDRYINTP1R*LOG(ZVEC2(1:IGDRY))+XDRYINTP2R))
- IVEC2(1:IGDRY)=INT(ZVEC2(1:IGDRY))
- ZVEC2(1:IGDRY)=ZVEC2(1:IGDRY)-REAL(IVEC2(1:IGDRY))
- !
- !* 6.2.10 perform the bilinear interpolation of the normalized
- ! RDRYG-kernel
- !
- DO JJ=1, IGDRY
- ZVEC3(JJ)= ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- *(ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGDRY
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- WHERE(GDRY(:))
- PRG_TEND(:, IRRDRYG) = XFRDRYG*ZZW(:) & ! RRDRYG
- *( PLBDAR(:)**(-4) )*( PLBDAG(:)**XCXG ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRDRYG1/( PLBDAG(:)**2 ) + &
- XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + &
- XLBRDRYG3/( PLBDAR(:)**2) )
- END WHERE
- ENDIF
-ENDIF
-
-DO JL=1, KSIZE
- ZRDRYG_INIT(JL)=PRG_TEND(JL, IRCDRYG)+PRG_TEND(JL, IRIDRYG)+ &
- &PRG_TEND(JL, IRSDRYG)+PRG_TEND(JL, IRRDRYG)
-ENDDO
-
-!Freezing rate
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRG_TEND(JL, IFREEZ1)
- PRG_TEND(JL, IFREEZ2)=ZMASK(JL) * PRG_TEND(JL, IFREEZ2)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRG_TEND(:, IFREEZ1)=MIN(PRG_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
- END WHERE
- ENDIF
- PRG_TEND(:, IFREEZ2)=0.
- WHERE(ZMASK(:)==1.)
- PRG_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-PRG_TEND(:, IFREEZ1))/(XRV*PT(:)) )
- PRG_TEND(:, IFREEZ1)=PRG_TEND(:, IFREEZ1)* ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )/ &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- PRG_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
- ZRWETG_INIT(JL)=ZMASK(JL) * MAX(PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG), &
- &MAX(0., PRG_TEND(JL, IFREEZ1) + &
- &PRG_TEND(JL, IFREEZ2) * ( &
- &PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG) )))
-ENDDO
-
-!Growth mode
-DO JL=1, KSIZE
- PWETG(JL) = ZMASK(JL) * & !
- & MAX(0., SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
- &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
-ENDDO
-IF(LNULLWETG) THEN
- DO JL=1, KSIZE
- PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRDRYG_INIT(JL)))
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRWETG_INIT(JL)))
- ENDDO
-ENDIF
-IF(.NOT. LWETGPOST) THEN
- DO JL=1, KSIZE
- PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., PT(JL)-XTT))
- ENDDO
-ENDIF
-DO JL=1, KSIZE
- ZDRYG(JL) = ZMASK(JL) * & !
- & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
- & MAX(0., -SIGN(1., 1.E-20-ZRDRYG_INIT(JL))) * & ! WHERE(ZRDRYG_INIT(:)>0.)
- & MAX(0., -SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
- &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
-ENDDO
-
-! Part of ZRWETG to be converted into hail
-! Graupel can be produced by other processes instantaneously (inducing a mixing ratio change, PRGSI_MR) or
-! as a tendency (PRWETGH)
-PRWETGH(:)=0.
-PRWETGH_MR(:)=0.
-IF(KRR==7) THEN
- WHERE(PWETG(:)==1.)
- !assume a linear percent of conversion of produced graupel into hail
- PRWETGH(:)=(MAX(0., PRGSI(:)+PRICFRRG(:)+PRRCFRIG(:))+ZRWETG_INIT(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
- PRWETGH_MR(:)=MAX(0., PRGSI_MR(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
- END WHERE
-ENDIF
-
-DO JL=1, KSIZE
- !Aggregated minus collected
- PRRWETG(JL)=-PWETG(JL) * (PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG)+&
- &PRG_TEND(JL, IRCDRYG)-ZRWETG_INIT(JL))
- PRCWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRCDRYG)
- PRIWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRIWETG)
- PRSWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRSWETG)
-
- PRCDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRCDRYG)
- PRRDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRRDRYG)
- PRIDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRIDRYG)
- PRSDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRSDRYG)
-
- PA_RC(JL) = PA_RC(JL) - PRCWETG(JL)
- PA_RI(JL) = PA_RI(JL) - PRIWETG(JL)
- PA_RS(JL) = PA_RS(JL) - PRSWETG(JL)
- PA_RG(JL) = PA_RG(JL) + PRCWETG(JL) + PRIWETG(JL) + PRSWETG(JL) + PRRWETG(JL)
- PA_RR(JL) = PA_RR(JL) - PRRWETG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRCWETG(JL) + PRRWETG(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA_RG(JL) = PA_RG(JL) - PRWETGH(JL)
- PA_RH(JL) = PA_RH(JL) + PRWETGH(JL)
- PB_RG(JL) = PB_RG(JL) - PRWETGH_MR(JL)
- PB_RH(JL) = PB_RH(JL) + PRWETGH_MR(JL)
- PA_RC(JL) = PA_RC(JL) - PRCDRYG(JL)
- PA_RI(JL) = PA_RI(JL) - PRIDRYG(JL)
- PA_RS(JL) = PA_RS(JL) - PRSDRYG(JL)
- PA_RR(JL) = PA_RR(JL) - PRRDRYG(JL)
- PA_RG(JL) = PA_RG(JL) + PRCDRYG(JL) + PRIDRYG(JL) + PRSDRYG(JL) + PRRDRYG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRCDRYG(JL)+PRRDRYG(JL))*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!* 6.5 Melting of the graupeln
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRGMLTR(JL)=ZMASK(JL) * PRGMLTR(JL)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRGMLTR(JL)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRGMLTR(:)=MIN(PRGMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
- END WHERE
- ENDIF
- DO JL=1, KSIZE
- PRGMLTR(JL)=ZMASK(JL) * (PKA(JL)*(XTT-PT(JL)) + &
- ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
- *(XESTT-PRGMLTR(JL))/(XRV*PT(JL)) ))
- ENDDO
- WHERE(ZMASK(:)==1.)
- !
- ! compute RGMLTR
- !
- PRGMLTR(:) = MAX( 0.0,( -PRGMLTR(:) * &
- ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - &
- ( PRG_TEND(:, IRCDRYG)+PRG_TEND(:, IRRDRYG) ) * &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) + PRGMLTR(JL)
- PA_RG(JL) = PA_RG(JL) - PRGMLTR(JL)
- PA_TH(JL) = PA_TH(JL) - PRGMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-END SUBROUTINE ICE4_FAST_RG
diff --git a/src/mesonh/micro/ice4_fast_rs.f90 b/src/mesonh/micro/ice4_fast_rs.f90
deleted file mode 100644
index 6d71c7b61..000000000
--- a/src/mesonh/micro/ice4_fast_rs.f90
+++ /dev/null
@@ -1,521 +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_RS
-INTERFACE
-SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAR, PLBDAS, &
- &PT, PRVT, PRCT, PRRT, PRST, &
- &PRIAGGS, &
- &PRCRIMSS, PRCRIMSG, PRSRIMCG, &
- &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
- &PRCMLTSR, &
- &PRS_TEND, &
- &PA_TH, PA_RC, PA_RR, 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) :: 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) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate 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 water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_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_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-END SUBROUTINE ICE4_FAST_RS
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RS
-SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAR, PLBDAS, &
- &PT, PRVT, PRCT, PRRT, PRST, &
- &PRIAGGS, &
- &PRCRIMSS, PRCRIMSG, PRSRIMCG, &
- &PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, &
- &PRCMLTSR, &
- &PRS_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RS, PA_RG)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the fast rs processes
-!!
-!! 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,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
- XEPSILO
-USE MODD_PARAM_ICE, ONLY: LEVLIMIT, CSNOWRIMING
-USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXS,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: NACCLBDAR,NACCLBDAS,NGAMINC,X0DEPS,X1DEPS,XACCINTP1R,XACCINTP1S,XACCINTP2R,XACCINTP2S, &
- XCRIMSG,XCRIMSS,XEX0DEPS,XEX1DEPS,XEXCRIMSG,XEXCRIMSS,XEXSRIMCG,XEXSRIMCG2,XFRACCSS, &
- XFSACCRG,XFSCVMG,XGAMINC_RIM1,XGAMINC_RIM1,XGAMINC_RIM2,XGAMINC_RIM4,XKER_RACCS, &
- XKER_RACCSS,XKER_SACCRG,XLBRACCS1,XLBRACCS2,XLBRACCS3,XLBSACCR1,XLBSACCR2,XLBSACCR3, &
- XRIMINTP1,XRIMINTP2,XSRIMCG,XSRIMCG2,XSRIMCG3
-!
-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) :: 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) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate 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 water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIAGGS ! r_i aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSS ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_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_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-!
-!* 0.2 declaration of local variables
-!
-INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6, &
- & IFREEZ1=7, IFREEZ2=8
-!
-REAL, DIMENSION(KSIZE) :: ZRIM, ZACC, ZMASK
-LOGICAL, DIMENSION(KSIZE) :: GRIM, GACC
-INTEGER :: IGRIM, IGACC
-INTEGER, DIMENSION(KSIZE) :: I1
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
-INTEGER :: JJ, JL
-!-------------------------------------------------------------------------------
-!
-!
-!* 5.0 maximum freezing rate
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRS_TEND(JL, IFREEZ1)
- PRS_TEND(JL, IFREEZ2)=ZMASK(JL) * PRS_TEND(JL, IFREEZ2)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRS_TEND(:, IFREEZ1)=MIN(PRS_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
- END WHERE
- ENDIF
- PRS_TEND(:, IFREEZ2)=0.
- WHERE(ZMASK(:)==1.)
- PRS_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-PRS_TEND(:, IFREEZ1))/(XRV*PT(:)) )
- PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
- X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )/ &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- PRS_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
- !And we are only interested by the freezing rate of liquid species
- ZFREEZ_RATE(JL)=ZMASK(JL) * MAX(0., MAX(0., PRS_TEND(JL, IFREEZ1) + &
- &PRS_TEND(JL, IFREEZ2) * PRIAGGS(JL)) - &
- PRIAGGS(JL))
-ENDDO
-!
-!* 5.1 cloud droplet riming of the aggregates
-!
-IGRIM = 0
-DO JJ = 1, SIZE(GRIM)
- ZRIM(JJ)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JJ))) * & !WHERE(PRCT(:)>XRTMIN(2))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JJ)
- IF (ZRIM(JJ)>0) THEN
- IGRIM = IGRIM + 1
- I1(IGRIM) = JJ
- GRIM(JJ) = .TRUE.
- ELSE
- GRIM(JJ) = .FALSE.
- END IF
-END DO
-!
-! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0)
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRS_TEND(JL, IRCRIMS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMS)
- PRS_TEND(JL, IRCRIMSS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMSS)
- PRS_TEND(JL, IRSRIMCG)=ZRIM(JL) * PRS_TEND(JL, IRSRIMCG)
- ENDDO
-ELSE
- PRS_TEND(:, IRCRIMS)=0.
- PRS_TEND(:, IRCRIMSS)=0.
- PRS_TEND(:, IRSRIMCG)=0.
- !
- IF(IGRIM>0) THEN
- !
- ! 5.1.1 select the PLBDAS
- !
- DO JJ = 1, IGRIM
- ZVEC1(JJ) = PLBDAS(I1(JJ))
- END DO
- !
- ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
- ! set of Lbda_s used to tabulate some moments of the incomplete
- ! gamma function
- !
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
- XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
- IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
- ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
- !
- ! 5.1.3 perform the linear interpolation of the normalized
- ! "2+XDS"-moment of the incomplete gamma function
- !
- ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW(:) = 0.
- DO JJ = 1, IGRIM
- ZZW(I1(JJ)) = ZVEC1(JJ)
- END DO
- !
- ! 5.1.4 riming of the small sized aggregates
- !
- WHERE (GRIM(:))
- PRS_TEND(:, IRCRIMSS) = XCRIMSS * ZZW(:) * PRCT(:) & ! RCRIMSS
- * PLBDAS(:)**XEXCRIMSS &
- * PRHODREF(:)**(-XCEXVT)
- END WHERE
- !
- ! 5.1.5 perform the linear interpolation of the normalized
- ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2) and
- ! "XBG"-moment of the incomplete gamma function (XGAMINC_RIM4)
- !
- ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW(:) = 0.
- DO JJ = 1, IGRIM
- ZZW(I1(JJ)) = ZVEC1(JJ)
- END DO
-
- ZVEC1(1:IGRIM) = XGAMINC_RIM4( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM4( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW2(:) = 0.
- DO JJ = 1, IGRIM
- ZZW2(I1(JJ)) = ZVEC1(JJ)
- END DO
- !
- ! 5.1.6 riming-conversion of the large sized aggregates into graupeln
- !
- !
- WHERE(GRIM(:))
- PRS_TEND(:, IRCRIMS)=XCRIMSG * PRCT(:) & ! RCRIMS
- * PLBDAS(:)**XEXCRIMSG &
- * PRHODREF(:)**(-XCEXVT)
- ZZW6(:) = PRS_TEND(:, IRCRIMS) - PRS_TEND(:, IRCRIMSS) ! RCRIMSG
- END WHERE
-
- IF(CSNOWRIMING=='M90 ')THEN
- !Murakami 1990
- WHERE(GRIM(:))
- PRS_TEND(:, IRSRIMCG)=XSRIMCG * PLBDAS(:)**XEXSRIMCG*(1.0-ZZW(:))
- PRS_TEND(:, IRSRIMCG)=ZZW6(:)*PRS_TEND(:, IRSRIMCG)/ &
- MAX(1.E-20, &
- XSRIMCG3*XSRIMCG2*PLBDAS(:)**XEXSRIMCG2*(1.-ZZW2(:)) - &
- XSRIMCG3*PRS_TEND(:, IRSRIMCG))
- END WHERE
- ELSE
- PRS_TEND(:, IRSRIMCG)=0.
- END IF
- ENDIF
-ENDIF
-!
-DO JL=1, KSIZE
- ! More restrictive RIM mask to be used for riming by negative temperature only
- ZRIM(JL)=ZRIM(JL) * &
- &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
- PRCRIMSS(JL)=ZRIM(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRCRIMSS))
- ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSS(JL))
- ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
- PRCRIMSG(JL) = ZRIM(JL) * ZZW(JL) * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
- ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSG(JL))
- PRSRIMCG(JL) = ZRIM(JL) * ZZW(JL) * PRS_TEND(JL, IRSRIMCG)
-
- PRSRIMCG(JL) = PRSRIMCG(JL) * MAX(0., -SIGN(1., -PRCRIMSG(JL)))
- PRCRIMSG(JL)=MAX(0., PRCRIMSG(JL))
-
- PA_RC(JL) = PA_RC(JL) - PRCRIMSS(JL)
- PA_RS(JL) = PA_RS(JL) + PRCRIMSS(JL)
- PA_TH(JL) = PA_TH(JL) + PRCRIMSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA_RC(JL) = PA_RC(JL) - PRCRIMSG(JL)
- PA_RS(JL) = PA_RS(JL) - PRSRIMCG(JL)
- PA_RG(JL) = PA_RG(JL) + PRCRIMSG(JL)+PRSRIMCG(JL)
- PA_TH(JL) = PA_TH(JL) + PRCRIMSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!* 5.2 rain accretion onto the aggregates
-!
-IGACC = 0
-DO JJ = 1, SIZE(GACC)
- ZACC(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & !WHERE(PRRT(:)>XRTMIN(3))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JJ)
- IF (ZACC(JJ)>0) THEN
- IGACC = IGACC + 1
- I1(IGACC) = JJ
- GACC(JJ) = .TRUE.
- ELSE
- GACC(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRS_TEND(JL, IRRACCS)=ZACC(JL) * PRS_TEND(JL, IRRACCS)
- PRS_TEND(JL, IRRACCSS)=ZACC(JL) * PRS_TEND(JL, IRRACCSS)
- PRS_TEND(JL, IRSACCRG)=ZACC(JL) * PRS_TEND(JL, IRSACCRG)
- ENDDO
-ELSE
- PRS_TEND(:, IRRACCS)=0.
- PRS_TEND(:, IRRACCSS)=0.
- PRS_TEND(:, IRSACCRG)=0.
- IF(IGACC>0)THEN
- !
- !
- ! 5.2.1 select the (PLBDAS,PLBDAR) couplet
- !
- DO JJ = 1, IGACC
- ZVEC1(JJ) = PLBDAS(I1(JJ))
- ZVEC2(JJ) = PLBDAR(I1(JJ))
- END DO
- !
- ! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR
- ! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
- ! tabulate the RACCSS-kernel
- !
- ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, &
- XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
- IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
- ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
- !
- ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
- XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
- IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
- ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
- !
- ! 5.2.3 perform the bilinear interpolation of the normalized
- ! RACCSS-kernel
- !
- DO JJ = 1, IGACC
- ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGACC
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- ! 5.2.4 raindrop accretion on the small sized aggregates
- !
- WHERE(GACC(:))
- ZZW6(:) = & !! coef of RRACCS
- XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRACCS1/((PLBDAS(:)**2) ) + &
- XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + &
- XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**4
- PRS_TEND(:, IRRACCSS) =ZZW(:)*ZZW6(:)
- END WHERE
- !
- ! 5.2.4b perform the bilinear interpolation of the normalized
- ! RACCS-kernel
- !
- DO JJ = 1, IGACC
- ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGACC
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- WHERE(GACC(:))
- PRS_TEND(:, IRRACCS) = ZZW(:)*ZZW6(:)
- END WHERE
- ! 5.2.5 perform the bilinear interpolation of the normalized
- ! SACCRG-kernel
- !
- DO JJ = 1, IGACC
- ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * ZVEC2(JJ) &
- - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * (ZVEC2(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGACC
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- ! 5.2.6 raindrop accretion-conversion of the large sized aggregates
- ! into graupeln
- !
- WHERE(GACC(:))
- PRS_TEND(:, IRSACCRG) = XFSACCRG*ZZW(:)* & ! RSACCRG
- ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSACCR1/((PLBDAR(:)**2) ) + &
- XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + &
- XLBSACCR3/( (PLBDAS(:)**2)) )/PLBDAR(:)
- END WHERE
- ENDIF
-ENDIF
-!
-DO JL=1, KSIZE
- ! More restrictive ACC mask to be used for accretion by negative temperature only
- ZACC(JL) = ZACC(JL) * &
- &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
- PRRACCSS(JL)=ZACC(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRRACCSS))
- ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRRACCSS(JL))
- ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))) ! proportion we are able to freeze
- PRRACCSG(JL)=ZACC(JL)*ZZW(JL) * MAX(0., PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))
- ZFREEZ_RATE(JL) = MAX(0., ZFREEZ_RATE(JL)-PRRACCSG(JL))
- PRSACCRG(JL)=ZACC(JL)*ZZW(JL) * PRS_TEND(JL, IRSACCRG)
-
- PRSACCRG(JL) = PRSACCRG(JL) * MAX(0., -SIGN(1., -PRRACCSG(JL)))
- PRRACCSG(JL)=MAX(0., PRRACCSG(JL))
-
- PA_RR(JL) = PA_RR(JL) - PRRACCSS(JL)
- PA_RS(JL) = PA_RS(JL) + PRRACCSS(JL)
- PA_TH(JL) = PA_TH(JL) + PRRACCSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
- PA_RR(JL) = PA_RR(JL) - PRRACCSG(JL)
- PA_RS(JL) = PA_RS(JL) - PRSACCRG(JL)
- PA_RG(JL) = PA_RG(JL) + PRRACCSG(JL)+PRSACCRG(JL)
- PA_TH(JL) = PA_TH(JL) + PRRACCSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!
-!* 5.3 Conversion-Melting of the aggregates
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRSMLTG(JL)=ZMASK(JL)*PRSMLTG(JL)
- PRCMLTSR(JL)=ZMASK(JL)*PRCMLTSR(JL)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRSMLTG(JL)=ZMASK(JL)*PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRSMLTG(:)=MIN(PRSMLTG(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
- END WHERE
- ENDIF
- DO JL=1, KSIZE
- PRSMLTG(JL)=ZMASK(JL)*( &
- & PKA(JL)*(XTT-PT(JL)) + &
- & ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
- & *(XESTT-PRSMLTG(JL))/(XRV*PT(JL)) ) &
- &)
- ENDDO
- PRCMLTSR(:) = 0.
- WHERE(ZMASK(:)==1.)
- !
- ! compute RSMLT
- !
- PRSMLTG(:) = XFSCVMG*MAX( 0.0,( -PRSMLTG(:) * &
- ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
- X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - &
- ( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS) ) * &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- ! When T < XTT, rc is collected by snow (riming) to produce snow and graupel
- ! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting)
- ! To insure consistency when crossing T=XTT, rc collected with T>XTT must be transformed in rain.
- ! rc cannot produce iced species with a positive temperature but is still collected with a good efficiency by snow
- PRCMLTSR(:) = PRS_TEND(:, IRCRIMS) ! both species are liquid, no heat is exchanged
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
- ! because the graupeln produced by this process are still icy!!!
- PA_RS(JL) = PA_RS(JL) - PRSMLTG(JL)
- PA_RG(JL) = PA_RG(JL) + PRSMLTG(JL)
- PA_RC(JL) = PA_RC(JL) - PRCMLTSR(JL)
- PA_RR(JL) = PA_RR(JL) + PRCMLTSR(JL)
-ENDDO
-
-!
-END SUBROUTINE ICE4_FAST_RS
--
GitLab