From 5e5d89b091748cf25c5c743268e17412da42e401 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Riette?= <sebastien.riette@meteo.fr>
Date: Fri, 26 Nov 2021 14:46:41 +0100
Subject: [PATCH] =?UTF-8?q?S=C3=A9bastien=2026/11/2021=20Merge=20AROME->CO?=
=?UTF-8?q?MMON=20nucleation?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
merge AROME, Meso-NH and Ryad's version
cleaning of forgotten modi
tools.f90 added from Meso-NH package
---
docs/TODO | 12 ++
src/arome/gmkpack_ignored_files | 4 +
src/arome/micro/ice4_nucleation.F90 | 125 --------------
src/arome/micro/ice4_nucleation_wrapper.F90 | 124 --------------
src/arome/micro/ice4_tendencies.F90 | 22 ++-
src/arome/micro/modi_ice4_compute_pdf.F90 | 23 ---
src/arome/micro/modi_ice4_nucleation.F90 | 25 ---
.../micro/modi_ice4_nucleation_wrapper.F90 | 21 ---
src/arome/micro/modi_ice4_rainfr_vert.F90 | 10 --
src/arome/micro/modi_ice4_rimltc.F90 | 24 ---
src/arome/micro/modi_ice4_rrhong.F90 | 24 ---
src/arome/micro/modi_ice4_slow.F90 | 41 -----
src/arome/micro/rain_ice.F90 | 4 +-
.../internals/ice4_nucleation_wrapper.F90 | 123 --------------
.../mpa/micro/module/modi_ice4_nucleation.F90 | 21 ---
src/common/aux/tools.f90 | 139 ++++++++++++++++
.../micro/mode_ice4_nucleation.F90} | 31 ++--
.../micro/mode_ice4_nucleation_wrapper.F90} | 114 ++++++-------
src/common/micro/mode_ice4_rimltc.F90 | 25 ++-
src/common/micro/mode_ice4_rrhong.F90 | 23 ++-
src/mesonh/micro/ice4_nucleation.f90 | 152 ------------------
21 files changed, 269 insertions(+), 818 deletions(-)
delete mode 100644 src/arome/micro/ice4_nucleation.F90
delete mode 100644 src/arome/micro/ice4_nucleation_wrapper.F90
delete mode 100644 src/arome/micro/modi_ice4_compute_pdf.F90
delete mode 100644 src/arome/micro/modi_ice4_nucleation.F90
delete mode 100644 src/arome/micro/modi_ice4_nucleation_wrapper.F90
delete mode 100644 src/arome/micro/modi_ice4_rainfr_vert.F90
delete mode 100644 src/arome/micro/modi_ice4_rimltc.F90
delete mode 100644 src/arome/micro/modi_ice4_rrhong.F90
delete mode 100644 src/arome/micro/modi_ice4_slow.F90
delete mode 100644 src/arome/modset_Ryad/mpa/micro/internals/ice4_nucleation_wrapper.F90
delete mode 100644 src/arome/modset_Ryad/mpa/micro/module/modi_ice4_nucleation.F90
create mode 100644 src/common/aux/tools.f90
rename src/{arome/modset_Ryad/mpa/micro/internals/ice4_nucleation.F90 => common/micro/mode_ice4_nucleation.F90} (79%)
rename src/{mesonh/micro/ice4_nucleation_wrapper.f90 => common/micro/mode_ice4_nucleation_wrapper.F90} (56%)
delete mode 100644 src/mesonh/micro/ice4_nucleation.f90
diff --git a/docs/TODO b/docs/TODO
index eb46ff8bb..554b8b70b 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -14,3 +14,15 @@ Clé de compilation REPRO48 ajoutée pour permettre de reproduire le cycle 48, e
- contourne des corrections de bug
- modifie l'organisation de calculs
Cette clé devra être supprimée
+
+Merge pb:
+- ice4_nucleation_wrapper:
+ Tableaux allocatable introduits par Philippe dans meso-nh.
+ Pas introduits (pour l'instant?) dans version common.
+ Ryad doit faire des tests pour regarder impact des allaocatble sur CPU.
+ si test OK, on passe en alloacatble
+ si test KO, arbitrage entre Philippe et Riad
+
+Etape 2: array syntax -> loop
+- en profiter pour supprimer args PA/PB des routines appelées depuis ice4_tendencies, comme pour nucleation
+- si possible, modifier ice4_sedimentation_split* dans le même esprit que stat
diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files
index c6c3c26b9..af931924e 100644
--- a/src/arome/gmkpack_ignored_files
+++ b/src/arome/gmkpack_ignored_files
@@ -42,3 +42,7 @@ phyex/micro/ice4_rimltc.F90
phyex/micro/modi_ice4_rimltc.F90
phyex/micro/ice4_rrhong.F90
phyex/micro/modi_ice4_rrhong.F90
+phyex/micro/ice4_nucleation.F90
+phyex/micro/modi_ice4_nucleation.F90
+phyex/micro/ice4_nucleation_wrapper.F90
+phyex/micro/modi_ice4_nucleation_wrapper.F90
diff --git a/src/arome/micro/ice4_nucleation.F90 b/src/arome/micro/ice4_nucleation.F90
deleted file mode 100644
index d60dd6f92..000000000
--- a/src/arome/micro/ice4_nucleation.F90
+++ /dev/null
@@ -1,125 +0,0 @@
-SUBROUTINE ICE4_NUCLEATION(KSIZE, LDSOFT, LDCOMPUTE, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the nucleation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
-USE MODD_PARAM_ICE, ONLY : LFEEDBACKT
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
-!
-!* 0.2 declaration of local variables
-!
-REAL, DIMENSION(KSIZE) :: ZW ! work array
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
-REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
- ZUSW, & ! Undersaturation over water
- ZSSI ! Supersaturation over ice
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 0, ZHOOK_HANDLE)!
-!
-PRVHENI_MR(:)=0.
-IF(.NOT. LDSOFT) THEN
- GNEGT(:)=PT(:)<XTT .AND. PRVT>XRTMIN(1) .AND. LDCOMPUTE(:)
- PRVHENI_MR(:)=0.
- ZSSI(:)=0.
- ZUSW(:)=0.
- ZZW(:)=0.
- WHERE(GNEGT(:))
- ZZW(:)=ALOG(PT(:))
- ZUSW(:)=EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w
- ZZW(:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
- END WHERE
- WHERE(GNEGT(:))
- ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
- ! Supersaturation over ice
- ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
- ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
- ! Supersaturation of saturated water vapor over ice
- !
- !* 3.1 compute the heterogeneous nucleation source RVHENI
- !
- !* 3.1.1 compute the cloud ice concentration
- !
- ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
- END WHERE
- ZZW(:)=0.
- WHERE(GNEGT(:) .AND. PT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
- ZZW(:)=XNU20*EXP(XALPHA2*ZSSI(:)-XBETA2)
- ELSEWHERE(GNEGT(:) .AND. PT(:)<=XTT-2.0 .AND. PT(:)>=XTT-5.0 .AND. ZSSI(:)>0.0)
- ZZW(:)=MAX(XNU20*EXP(-XBETA2 ), &
- XNU10*EXP(-XBETA1*(PT(:)-XTT))*(ZSSI(:)/ZUSW(:))**XALPHA1)
- END WHERE
- WHERE(GNEGT(:))
- ZZW(:)=ZZW(:)-PCIT(:)
- ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
- END WHERE
- WHERE(GNEGT(:))
- !
- !* 3.1.2 update the r_i and r_v mixing ratios
- !
- PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*XMNU0/PRHODREF(:)
- PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
- END WHERE
- !Limitation due to 0 crossing of temperature
- IF(LFEEDBACKT) THEN
- ZW(:)=0.
- WHERE(GNEGT(:))
- ZW(:)=MIN(PRVHENI_MR(:), &
- MAX(0., (XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
- MAX(PRVHENI_MR(:), 1.E-20)
- END WHERE
- ELSE
- ZW(:)=1.
- ENDIF
- PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
- PCIT(:)=MAX(ZZW(:)*ZW(:)+PCIT(:), PCIT(:))
- !
- PB_RI(:)=PB_RI(:) + PRVHENI_MR(:)
- PB_RV(:)=PB_RV(:) - PRVHENI_MR(:)
- PB_TH(:)=PB_TH(:) + PRVHENI_MR(:)*PLSFACT(:)
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 1, ZHOOK_HANDLE)
-END SUBROUTINE ICE4_NUCLEATION
diff --git a/src/arome/micro/ice4_nucleation_wrapper.F90 b/src/arome/micro/ice4_nucleation_wrapper.F90
deleted file mode 100644
index b1d401f38..000000000
--- a/src/arome/micro/ice4_nucleation_wrapper.F90
+++ /dev/null
@@ -1,124 +0,0 @@
-SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the nucleation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KIT, KJT, KKT
-LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JL ! and PACK intrinsics
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-LOGICAL, DIMENSION(KIT, KJT, KKT) :: GNEGT ! Test where to compute the HEN process
-INTEGER :: INEGT
-INTEGER, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: I1,I2,I3 ! Used to replace the COUNT
-REAL, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZRVT, & ! Water vapor m.r. at t
- ZCIT, & ! Pristine ice conc. at t
- ZTHT, & ! Theta at t
- ZRHODREF, &
- ZEXN, &
- ZLSFACT, &
- ZRVHENI_MR, &
- ZB_TH, ZB_RV, ZB_RI
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER', 0, ZHOOK_HANDLE)!
-!
-!
-! optimization by looking for locations where
-! the temperature is negative only !!!
-!
-GNEGT(:,:,:)=PT(:,:,:)<XTT .AND. LDMASK
-INEGT=0
-IF(COUNT(GNEGT)/=0) INEGT=ICE4_NUCLEATION_COUNTJV(GNEGT(:,:,:), KIT, KJT, KKT, SIZE(I1), I1(:), I2(:), I3(:))
-PRVHENI_MR(:,:,:)=0.
-IF(INEGT>=1) THEN
- DO JL=1, INEGT
- ZRVT(JL)=PRVT(I1(JL), I2(JL), I3(JL))
- ZCIT(JL)=PCIT(I1(JL), I2(JL), I3(JL))
- ZZT(JL)=PT(I1(JL), I2(JL), I3(JL))
- ZPRES(JL)=PPABST(I1(JL), I2(JL), I3(JL))
- ZTHT(JL)=PTHT(I1(JL), I2(JL), I3(JL))
- ZRHODREF(JL)=PRHODREF(I1(JL), I2(JL), I3(JL))
- ZEXN(JL)=PEXN(I1(JL), I2(JL), I3(JL))
- ZLSFACT(JL)=PLSFACT(I1(JL), I2(JL), I3(JL))
- ENDDO
- ZB_TH(:)=0.
- ZB_RV(:)=0.
- ZB_RI(:)=0.
- CALL ICE4_NUCLEATION(INEGT, .FALSE., ZZT(:)<XTT, &
- ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
- ZRVT, &
- ZCIT, ZRVHENI_MR, ZB_TH, ZB_RV, ZB_RI)
- PRVHENI_MR(:,:,:)=UNPACK(ZRVHENI_MR(:), MASK=GNEGT(:,:,:), FIELD=0.0)
- PCIT(:,:,:)=UNPACK(ZCIT(:), MASK=GNEGT(:,:,:), FIELD=PCIT(:,:,:))
-END IF
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER', 1, ZHOOK_HANDLE)
-
-CONTAINS
- FUNCTION ICE4_NUCLEATION_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC)
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- IMPLICIT NONE
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KSIZE
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1, I2, I3 ! Used to replace the COUNT and PACK
- INTEGER :: IC
- INTEGER :: JI, JJ, JK
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- !
- IF(LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER:ICE4_NUCLEATION_COUNTJV', 0, ZHOOK_HANDLE)
- IC=0
- DO JK=1, SIZE(LTAB,3)
- DO JJ=1, SIZE(LTAB,2)
- DO JI=1, SIZE(LTAB,1)
- IF(LTAB(JI,JJ,JK)) THEN
- IC=IC+1
- I1(IC)=JI
- I2(IC)=JJ
- I3(IC)=JK
- END IF
- END DO
- END DO
- END DO
- IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER:ICE4_NUCLEATION_COUNTJV', 1, ZHOOK_HANDLE)
- END FUNCTION ICE4_NUCLEATION_COUNTJV
- !
-END SUBROUTINE ICE4_NUCLEATION_WRAPPER
diff --git a/src/arome/micro/ice4_tendencies.F90 b/src/arome/micro/ice4_tendencies.F90
index 23d6bf57d..32fdfd6ce 100644
--- a/src/arome/micro/ice4_tendencies.F90
+++ b/src/arome/micro/ice4_tendencies.F90
@@ -1,3 +1,18 @@
+!
+!
+!
+!
+!
+!
+!!! NOTE: quand l'array syntax sera remplacée par des boucles, en profiter
+!!! pour supprimer les arguments PA et PB des différentes routines
+!!! pour calquer le fonctionnement de nucleation, rimltc et rrhong
+!
+!
+!
+!
+!
+!
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
&KRR, LDSOFT, PCOMPUTE, &
&OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
@@ -223,6 +238,9 @@ ELSE
ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
ZRVT, &
PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+ PB_RI(:)=PB_RI(:) + PRVHENI_MR(:)
+ PB_RV(:)=PB_RV(:) - PRVHENI_MR(:)
+ PB_TH(:)=PB_TH(:) + PRVHENI_MR(:)*PLSFACT(:)
DO JL=1, KSIZE
ZRIT(JL)=ZRIT(JL) + PRVHENI_MR(JL)
ZRVT(JL)=ZRVT(JL) - PRVHENI_MR(JL)
@@ -232,7 +250,7 @@ ELSE
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
- CALL ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
+ CALL ICE4_RRHONG(KSIZE, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&ZT, ZRRT, &
&ZTHT, &
@@ -251,7 +269,7 @@ ELSE
!
!* 7.1 cloud ice melting
!
- CALL ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
+ CALL ICE4_RIMLTC(KSIZE, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&ZT, &
&ZTHT, ZRIT, &
diff --git a/src/arome/micro/modi_ice4_compute_pdf.F90 b/src/arome/micro/modi_ice4_compute_pdf.F90
deleted file mode 100644
index 389362917..000000000
--- a/src/arome/micro/modi_ice4_compute_pdf.F90
+++ /dev/null
@@ -1,23 +0,0 @@
-MODULE MODI_ICE4_COMPUTE_PDF
-INTERFACE
-SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method
-CHARACTER*80, INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
- ! note that PCF = PHLC_HCF + PHLC_LCF
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
- ! note that PRC = PHLC_HRC + PHLC_LRC
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction
-END SUBROUTINE ICE4_COMPUTE_PDF
-END INTERFACE
-END MODULE MODI_ICE4_COMPUTE_PDF
diff --git a/src/arome/micro/modi_ice4_nucleation.F90 b/src/arome/micro/modi_ice4_nucleation.F90
deleted file mode 100644
index 82db29ac7..000000000
--- a/src/arome/micro/modi_ice4_nucleation.F90
+++ /dev/null
@@ -1,25 +0,0 @@
-MODULE MODI_ICE4_NUCLEATION
-INTERFACE
-SUBROUTINE ICE4_NUCLEATION(KSIZE, LDSOFT, LDCOMPUTE, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
-END SUBROUTINE ICE4_NUCLEATION
-END INTERFACE
-END MODULE MODI_ICE4_NUCLEATION
diff --git a/src/arome/micro/modi_ice4_nucleation_wrapper.F90 b/src/arome/micro/modi_ice4_nucleation_wrapper.F90
deleted file mode 100644
index 264f6f935..000000000
--- a/src/arome/micro/modi_ice4_nucleation_wrapper.F90
+++ /dev/null
@@ -1,21 +0,0 @@
-MODULE MODI_ICE4_NUCLEATION_WRAPPER
-INTERFACE
-SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT,KKT, LDMASK, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIT, KJT, KKT
-LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-END SUBROUTINE ICE4_NUCLEATION_WRAPPER
-END INTERFACE
-END MODULE MODI_ICE4_NUCLEATION_WRAPPER
diff --git a/src/arome/micro/modi_ice4_rainfr_vert.F90 b/src/arome/micro/modi_ice4_rainfr_vert.F90
deleted file mode 100644
index 2ec6cd0ff..000000000
--- a/src/arome/micro/modi_ice4_rainfr_vert.F90
+++ /dev/null
@@ -1,10 +0,0 @@
-MODULE MODI_ICE4_RAINFR_VERT
-INTERFACE
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PPRFR !Precipitation fraction
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
-END SUBROUTINE ICE4_RAINFR_VERT
-END INTERFACE
-END MODULE MODI_ICE4_RAINFR_VERT
diff --git a/src/arome/micro/modi_ice4_rimltc.F90 b/src/arome/micro/modi_ice4_rimltc.F90
deleted file mode 100644
index 2a3e6ddc5..000000000
--- a/src/arome/micro/modi_ice4_rimltc.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-MODULE MODI_ICE4_RIMLTC
-INTERFACE
-SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &PT, &
- &PTHT, PRIT, &
- &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Cloud ice at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIMLTC_MR ! Mixing ratio change due to cloud ice melting
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
-END SUBROUTINE ICE4_RIMLTC
-END INTERFACE
-END MODULE MODI_ICE4_RIMLTC
diff --git a/src/arome/micro/modi_ice4_rrhong.F90 b/src/arome/micro/modi_ice4_rrhong.F90
deleted file mode 100644
index 41e74d22a..000000000
--- a/src/arome/micro/modi_ice4_rrhong.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-MODULE MODI_ICE4_RRHONG
-INTERFACE
-SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &PT, PRRT, &
- &PTHT, &
- &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRHONG_MR ! Mixing ratio change due to spontaneous freezing
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
-END SUBROUTINE ICE4_RRHONG
-END INTERFACE
-END MODULE MODI_ICE4_RRHONG
diff --git a/src/arome/micro/modi_ice4_slow.F90 b/src/arome/micro/modi_ice4_slow.F90
deleted file mode 100644
index 0ef803021..000000000
--- a/src/arome/micro/modi_ice4_slow.F90
+++ /dev/null
@@ -1,41 +0,0 @@
-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,&
- &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(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
diff --git a/src/arome/micro/rain_ice.F90 b/src/arome/micro/rain_ice.F90
index 5d6581159..74496592a 100644
--- a/src/arome/micro/rain_ice.F90
+++ b/src/arome/micro/rain_ice.F90
@@ -166,7 +166,7 @@ USE MODI_BUDGET
USE MODI_ICE4_RAINFR_VERT
USE MODI_ICE4_SEDIMENTATION_STAT
USE MODI_ICE4_SEDIMENTATION_SPLIT
-USE MODI_ICE4_NUCLEATION_WRAPPER
+USE MODE_ICE4_NUCLEATION_WRAPPER, ONLY: ICE4_NUCLEATION_WRAPPER
USE MODI_ICE4_TENDENCIES
USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
@@ -1032,7 +1032,7 @@ ENDIF
! ----------------------------------------------------------------
!
CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. LDMICRO, &
- PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT/PEXN, ZT, &
+ PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT, ZT, &
PRVT, &
PCIT, ZZ_RVHENI_MR)
DO JK = 1, KKT
diff --git a/src/arome/modset_Ryad/mpa/micro/internals/ice4_nucleation_wrapper.F90 b/src/arome/modset_Ryad/mpa/micro/internals/ice4_nucleation_wrapper.F90
deleted file mode 100644
index 0c4c433b1..000000000
--- a/src/arome/modset_Ryad/mpa/micro/internals/ice4_nucleation_wrapper.F90
+++ /dev/null
@@ -1,123 +0,0 @@
-SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the nucleation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! R. El Khatib 24-Aug-2021 Optimizations
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XTT
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KIT, KJT, KKT
-LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JL ! and PACK intrinsics
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-LOGICAL, DIMENSION(KIT, KJT, KKT) :: GNEGT ! Test where to compute the HEN process
-INTEGER :: INEGT
-LOGICAL, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: LLCOMPUTE ! computation criterium
-INTEGER, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: I1,I2,I3 ! Used to replace the COUNT
-REAL, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZRVT, & ! Water vapor m.r. at t
- ZCIT, & ! Pristine ice conc. at t
- ZTHT, & ! Theta at t
- ZRHODREF, &
- ZEXN, &
- ZLSFACT, &
- ZRVHENI_MR
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER', 0, ZHOOK_HANDLE)!
-!
-!
-! optimization by looking for locations where
-! the temperature is negative only !!!
-!
-GNEGT(:,:,:)=PT(:,:,:)<XTT .AND. LDMASK
-INEGT=0
-IF(COUNT(GNEGT)/=0) INEGT=ICE4_NUCLEATION_COUNTJV(GNEGT(:,:,:), KIT, KJT, KKT, SIZE(I1), I1(:), I2(:), I3(:))
-PRVHENI_MR(:,:,:)=0.
-IF(INEGT>=1) THEN
- DO JL=1, INEGT
- ZRVT(JL)=PRVT(I1(JL), I2(JL), I3(JL))
- ZCIT(JL)=PCIT(I1(JL), I2(JL), I3(JL))
- ZZT(JL)=PT(I1(JL), I2(JL), I3(JL))
- ZPRES(JL)=PPABST(I1(JL), I2(JL), I3(JL))
- ZTHT(JL)=PTHT(I1(JL), I2(JL), I3(JL))
- ZRHODREF(JL)=PRHODREF(I1(JL), I2(JL), I3(JL))
- ZEXN(JL)=PEXN(I1(JL), I2(JL), I3(JL))
- ZLSFACT(JL)=PLSFACT(I1(JL), I2(JL), I3(JL))
- ENDDO
- LLCOMPUTE(:)=(ZZT(:)<XTT)
- CALL ICE4_NUCLEATION(INEGT, LLCOMPUTE, &
- ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
- ZRVT, &
- ZCIT, ZRVHENI_MR)
- PRVHENI_MR(:,:,:)=UNPACK(ZRVHENI_MR(:), MASK=GNEGT(:,:,:), FIELD=0.0)
- PCIT(:,:,:)=UNPACK(ZCIT(:), MASK=GNEGT(:,:,:), FIELD=PCIT(:,:,:))
-END IF
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER', 1, ZHOOK_HANDLE)
-
-CONTAINS
- FUNCTION ICE4_NUCLEATION_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC)
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- IMPLICIT NONE
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KSIZE
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1, I2, I3 ! Used to replace the COUNT and PACK
- INTEGER :: IC
- INTEGER :: JI, JJ, JK
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- !
- IF(LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER:ICE4_NUCLEATION_COUNTJV', 0, ZHOOK_HANDLE)
- IC=0
- DO JK=1, SIZE(LTAB,3)
- DO JJ=1, SIZE(LTAB,2)
- DO JI=1, SIZE(LTAB,1)
- IF(LTAB(JI,JJ,JK)) THEN
- IC=IC+1
- I1(IC)=JI
- I2(IC)=JJ
- I3(IC)=JK
- END IF
- END DO
- END DO
- END DO
- IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER:ICE4_NUCLEATION_COUNTJV', 1, ZHOOK_HANDLE)
- END FUNCTION ICE4_NUCLEATION_COUNTJV
- !
-END SUBROUTINE ICE4_NUCLEATION_WRAPPER
diff --git a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_nucleation.F90 b/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_nucleation.F90
deleted file mode 100644
index bdb9ebf10..000000000
--- a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_nucleation.F90
+++ /dev/null
@@ -1,21 +0,0 @@
-MODULE MODI_ICE4_NUCLEATION
-INTERFACE
-SUBROUTINE ICE4_NUCLEATION(KSIZE, LDCOMPUTE, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-END SUBROUTINE ICE4_NUCLEATION
-END INTERFACE
-END MODULE MODI_ICE4_NUCLEATION
diff --git a/src/common/aux/tools.f90 b/src/common/aux/tools.f90
new file mode 100644
index 000000000..5ecd4e2f8
--- /dev/null
+++ b/src/common/aux/tools.f90
@@ -0,0 +1,139 @@
+!MNH_LIC Copyright 2019-2020 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 mode_tools
+!################
+!
+! Purpose
+! -------
+!
+! The Purpose of this module is to provide useful tools for MesoNH
+!
+! Author
+! ------
+! P. Wautelet 14/02/2019
+!
+! Modifications:
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 17/01/2020: move Quicksort to tools.f90
+
+implicit none
+
+private
+
+public :: Countjv
+public :: Quicksort
+public :: Upcase
+
+interface Countjv
+ module procedure Countjv2d, Countjv3d
+end interface
+
+
+contains
+
+function Countjv2d(ltab,i1,i2) result(ic)
+ logical, dimension(:,:), intent(in) :: ltab ! Mask
+ integer, dimension(:), intent(out) :: i1, i2 ! Positions of elements with 'true' value
+ integer :: ic ! Total number of 'true' values
+
+ integer :: ji, jj
+
+ ic = 0
+
+ do jj = 1, size( ltab, 2 )
+ do ji = 1, size( ltab, 1 )
+ if ( ltab(ji, jj ) ) then
+ ic = ic +1
+ i1(ic) = ji
+ i2(ic) = jj
+ end if
+ end do
+ end do
+end function Countjv2d
+
+
+function Countjv3d(ltab,i1,i2,i3) result(ic)
+ logical, dimension(:,:,:), intent(in) :: ltab ! Mask
+ integer, dimension(:), intent(out) :: i1, i2, i3 ! Positions of elements with 'true' value
+ integer :: ic ! Total number of 'true' values
+
+ integer :: ji, jj, jk
+
+ ic = 0
+
+ do jk = 1, size( ltab, 3 )
+ do jj = 1, size( ltab, 2 )
+ do ji = 1, size( ltab, 1 )
+ if ( ltab(ji, jj, jk ) ) then
+ ic = ic +1
+ i1(ic) = ji
+ i2(ic) = jj
+ i3(ic) = jk
+ end if
+ end do
+ end do
+ end do
+end function Countjv3d
+
+
+recursive subroutine Quicksort( ka, kbeg, kend, kpos )
+ integer, dimension(:), intent(inout) :: ka
+ integer, intent(in) :: kbeg, kend
+ integer, dimension(:), optional, intent(inout) :: kpos
+
+ integer :: ji, jj
+ integer :: itmp, itmp2, ival
+
+ ival = ka( ( kbeg + kend ) / 2 )
+ ji = kbeg
+ jj = kend
+ do
+ do while ( ka(ji) < ival )
+ ji = ji + 1
+ end do
+ do while ( ival < ka(jj) )
+ jj = jj - 1
+ end do
+ if ( ji >= jj ) exit
+
+ itmp = ka(ji)
+ ka(ji) = ka(jj)
+ ka(jj) = itmp
+
+ if ( present( kpos ) ) then
+ itmp2 = kpos(ji)
+ kpos(ji) = kpos(jj)
+ kpos(jj) = itmp2
+ end if
+
+ ji=ji+1
+ jj=jj-1
+ end do
+ if ( kbeg < ji - 1 ) call Quicksort( ka, kbeg, ji - 1, kpos )
+ if ( jj + 1 < kend ) call Quicksort( ka, jj + 1, kend, kpos )
+end subroutine Quicksort
+
+
+function Upcase(hstring)
+ character(len=*), intent(in) :: hstring
+ character(len=len(hstring)) :: upcase
+
+ integer :: jc
+ integer, parameter :: iamin = iachar("a")
+ integer, parameter :: iamaj = iachar("A")
+
+ do jc = 1,len(hstring)
+ if ( hstring(jc:jc) >= "a" .and. hstring(jc:jc) <= "z" ) then
+ upcase(jc:jc) = achar( iachar( hstring(jc:jc) ) - iamin + iamaj )
+ else
+ upcase(jc:jc) = hstring(jc:jc)
+ end if
+ end do
+end function Upcase
+
+end module mode_tools
diff --git a/src/arome/modset_Ryad/mpa/micro/internals/ice4_nucleation.F90 b/src/common/micro/mode_ice4_nucleation.F90
similarity index 79%
rename from src/arome/modset_Ryad/mpa/micro/internals/ice4_nucleation.F90
rename to src/common/micro/mode_ice4_nucleation.F90
index cef11b2a1..7d5423327 100644
--- a/src/arome/modset_Ryad/mpa/micro/internals/ice4_nucleation.F90
+++ b/src/common/micro/mode_ice4_nucleation.F90
@@ -1,4 +1,12 @@
-SUBROUTINE ICE4_NUCLEATION(KSIZE, LDCOMPUTE, &
+!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 MODE_ICE4_NUCLEATION
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE ICE4_NUCLEATION(KSIZE, ODCOMPUTE, &
PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
PRVT, &
PCIT, PRVHENI_MR)
@@ -20,10 +28,10 @@ SUBROUTINE ICE4_NUCLEATION(KSIZE, LDCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
-USE MODD_PARAM_ICE, ONLY : LFEEDBACKT
+USE MODD_CST, ONLY: XALPI, XALPW, XBETAI, XBETAW, XGAMI, XGAMW, XMD, XMV, XTT, XEPSILO
+USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
+USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -32,7 +40,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
@@ -55,14 +63,14 @@ REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
!
IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 0, ZHOOK_HANDLE)!
!
-GNEGT(:)=PT(:)<XTT .AND. PRVT(:)>XRTMIN(1) .AND. LDCOMPUTE(:)
+GNEGT(:)=PT(:)<XTT .AND. PRVT(:)>XRTMIN(1) .AND. ODCOMPUTE(:)
ZUSW(:)=0.
ZZW(:)=0.
WHERE(GNEGT(:))
ZZW(:)=ALOG(PT(:))
ZUSW(:)=EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w
- ZZW (:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
+ ZZW(:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
END WHERE
ZSSI(:)=0.
@@ -110,11 +118,10 @@ IF(LFEEDBACKT) THEN
MAX(PRVHENI_MR(:), 1.E-20)
END WHERE
PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
- PCIT(:)=MAX(ZZW(:)*ZW(:)+PCIT(:), PCIT(:))
-ELSE
- ZW(:)=1.
- PCIT(:)=MAX(ZZW(:)+PCIT(:), PCIT(:))
+ ZZW(:)=ZZW(:)*ZW(:)
ENDIF
+PCIT(:)=MAX(ZZW(:)+PCIT(:), PCIT(:))
!
IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 1, ZHOOK_HANDLE)
END SUBROUTINE ICE4_NUCLEATION
+END MODULE MODE_ICE4_NUCLEATION
diff --git a/src/mesonh/micro/ice4_nucleation_wrapper.f90 b/src/common/micro/mode_ice4_nucleation_wrapper.F90
similarity index 56%
rename from src/mesonh/micro/ice4_nucleation_wrapper.f90
rename to src/common/micro/mode_ice4_nucleation_wrapper.F90
index 2e08a2cd7..f16f02255 100644
--- a/src/mesonh/micro/ice4_nucleation_wrapper.f90
+++ b/src/common/micro/mode_ice4_nucleation_wrapper.F90
@@ -3,27 +3,9 @@
!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_NUCLEATION_WRAPPER
-INTERFACE
-SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT,KKT, LDMASK, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR)
+MODULE MODE_ICE4_NUCLEATION_WRAPPER
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIT, KJT, KKT
-LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-END SUBROUTINE ICE4_NUCLEATION_WRAPPER
-END INTERFACE
-END MODULE MODI_ICE4_NUCLEATION_WRAPPER
+CONTAINS
SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
PRVT, &
@@ -41,16 +23,18 @@ SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
!! -------------
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
-!
+!! R. El Khatib 24-Aug-2021 Optimizations
!
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST, ONLY: XTT
-
-use mode_tools, only: Countjv
-
+USE MODE_TOOLS, ONLY: COUNTJV
+USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -69,14 +53,13 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio chang
!
!* 0.2 declaration of local variables
!
-INTEGER :: IDX, JI, JJ, JK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JL
-INTEGER :: INEGT, INEGT_TMP
-INTEGER, DIMENSION(:), ALLOCATABLE :: I1,I2,I3
-LOGICAL :: GDSOFT
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GLDCOMPUTE
-LOGICAL, DIMENSION(KIT,KJT,KKT) :: GNEGT ! Test where to compute the HEN process
-REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
+INTEGER :: INEGT
+INTEGER, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: I1,I2,I3
+LOGICAL, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: GLDCOMPUTE ! computation criterium
+LOGICAL, DIMENSION(KIT, KJT, KKT) :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: ZZT, & ! Temperature
ZPRES, & ! Pressure
ZRVT, & ! Water vapor m.r. at t
ZCIT, & ! Pristine ice conc. at t
@@ -84,11 +67,23 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
ZRHODREF, &
ZEXN, &
ZLSFACT, &
- ZRVHENI_MR, &
- ZB_TH, ZB_RV, ZB_RI
+ ZRVHENI_MR
+!! MNH version INTEGER, DIMENSION(:), ALLOCATABLE :: I1,I2,I3
+!! MNH version LOGICAL, DIMENSION(:), ALLOCATABLE :: GLDCOMPUTE
+!! MNH version LOGICAL, DIMENSION(KIT,KJT,KKT) :: GNEGT ! Test where to compute the HEN process
+!! MNH version REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
+!! MNH version ZPRES, & ! Pressure
+!! MNH version ZRVT, & ! Water vapor m.r. at t
+!! MNH version ZCIT, & ! Pristine ice conc. at t
+!! MNH version ZTHT, & ! Theta at t
+!! MNH version ZRHODREF, &
+!! MNH version ZEXN, &
+!! MNH version ZLSFACT, &
+!! MNH version ZRVHENI_MR
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER', 0, ZHOOK_HANDLE)!
!
!
! optimization by looking for locations where
@@ -97,53 +92,48 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
GNEGT(:,:,:)=PT(:,:,:)<XTT .AND. LDMASK
INEGT = COUNT(GNEGT(:,:,:))
!
-ALLOCATE(GLDCOMPUTE(INEGT))
-ALLOCATE(I1(INEGT),I2(INEGT),I3(INEGT))
-ALLOCATE(ZZT(INEGT))
-ALLOCATE(ZPRES(INEGT))
-ALLOCATE(ZRVT(INEGT))
-ALLOCATE(ZCIT(INEGT))
-ALLOCATE(ZTHT(INEGT))
-ALLOCATE(ZRHODREF(INEGT))
-ALLOCATE(ZEXN(INEGT))
-ALLOCATE(ZLSFACT(INEGT))
-ALLOCATE(ZRVHENI_MR(INEGT))
-ALLOCATE(ZB_TH(INEGT))
-ALLOCATE(ZB_RV(INEGT))
-ALLOCATE(ZB_RI(INEGT))
-!
-IF(INEGT>0) INEGT_TMP=COUNTJV(GNEGT(:,:,:), I1(:), I2(:), I3(:))
+!! MNH version ALLOCATE(GLDCOMPUTE(INEGT))
+!! MNH version ALLOCATE(I1(INEGT),I2(INEGT),I3(INEGT))
+!! MNH version ALLOCATE(ZZT(INEGT))
+!! MNH version ALLOCATE(ZPRES(INEGT))
+!! MNH version ALLOCATE(ZRVT(INEGT))
+!! MNH version ALLOCATE(ZCIT(INEGT))
+!! MNH version ALLOCATE(ZTHT(INEGT))
+!! MNH version ALLOCATE(ZRHODREF(INEGT))
+!! MNH version ALLOCATE(ZEXN(INEGT))
+!! MNH version ALLOCATE(ZLSFACT(INEGT))
+!! MNH version ALLOCATE(ZRVHENI_MR(INEGT))
+!
+IF(INEGT>0) INEGT=COUNTJV(GNEGT(:,:,:), I1(:), I2(:), I3(:))
!
PRVHENI_MR(:,:,:)=0.
IF(INEGT>0) THEN
DO JL=1, INEGT
ZRVT(JL)=PRVT(I1(JL), I2(JL), I3(JL))
ZCIT(JL)=PCIT(I1(JL), I2(JL), I3(JL))
- ZZT(JL)=PT(I1(JL), I2(JL), I3(JL))
ZPRES(JL)=PPABST(I1(JL), I2(JL), I3(JL))
ZTHT(JL)=PTHT(I1(JL), I2(JL), I3(JL))
ZRHODREF(JL)=PRHODREF(I1(JL), I2(JL), I3(JL))
ZEXN(JL)=PEXN(I1(JL), I2(JL), I3(JL))
- ZLSFACT(JL)=PLSFACT(I1(JL), I2(JL), I3(JL))
+ ZLSFACT(JL)=PLSFACT(I1(JL), I2(JL), I3(JL)) / ZEXN(JL)
+ ZZT(JL)=PT(I1(JL), I2(JL), I3(JL))
+ GLDCOMPUTE(JL)=ZZT(JL)<XTT
ENDDO
- GDSOFT = .FALSE.
- GLDCOMPUTE(:) = ZZT(:)<XTT
- ZB_TH(:) = 0.
- ZB_RV(:) = 0.
- ZB_RI(:) = 0.
- CALL ICE4_NUCLEATION(INEGT, GDSOFT, GLDCOMPUTE, &
+ CALL ICE4_NUCLEATION(INEGT, GLDCOMPUTE, &
ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
ZRVT, &
- ZCIT, ZRVHENI_MR, ZB_TH, ZB_RV, ZB_RI)
- PRVHENI_MR(:,:,:)= 0.0
+ ZCIT, ZRVHENI_MR)
DO JL=1, INEGT
PRVHENI_MR(I1(JL), I2(JL), I3(JL)) = ZRVHENI_MR(JL)
PCIT (I1(JL), I2(JL), I3(JL)) = ZCIT (JL)
END DO
END IF
!
-DEALLOCATE(GLDCOMPUTE)
-DEALLOCATE(I1,I2,I3)
-DEALLOCATE(ZZT,ZPRES,ZRVT,ZCIT,ZTHT,ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR,ZB_TH,ZB_RV,ZB_RI)
+!! MNH versionDEALLOCATE(GLDCOMPUTE)
+!! MNH versionDEALLOCATE(I1,I2,I3)
+!! MNH versionDEALLOCATE(ZZT,ZPRES,ZRVT,ZCIT,ZTHT,ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR)
!
+IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER', 1, ZHOOK_HANDLE)
+
END SUBROUTINE ICE4_NUCLEATION_WRAPPER
+END MODULE MODE_ICE4_NUCLEATION_WRAPPER
diff --git a/src/common/micro/mode_ice4_rimltc.F90 b/src/common/micro/mode_ice4_rimltc.F90
index 9a6e7f077..eec978566 100644
--- a/src/common/micro/mode_ice4_rimltc.F90
+++ b/src/common/micro/mode_ice4_rimltc.F90
@@ -7,7 +7,7 @@ MODULE MODE_ICE4_RIMLTC
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
+SUBROUTINE ICE4_RIMLTC(KSIZE, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
@@ -39,7 +39,6 @@ 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) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
@@ -61,20 +60,18 @@ IF (LHOOK) CALL DR_HOOK('ICE4_RIMLTC',0,ZHOOK_HANDLE)
!* 7.1 cloud ice melting
!
PRIMLTC_MR(:)=0.
-IF(.NOT. LDSOFT) THEN
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PRIT(JL))) * & ! PRIT(:)>0.
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! PT(:)>XTT
+ &PCOMPUTE(JL)
+ PRIMLTC_MR(JL)=PRIT(JL) * ZMASK(JL)
+ENDDO
+
+IF(LFEEDBACKT) THEN
+ !Limitation due to 0 crossing of temperature
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., -PRIT(JL))) * & ! PRIT(:)>0.
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! PT(:)>XTT
- &PCOMPUTE(JL)
- PRIMLTC_MR(JL)=PRIT(JL) * ZMASK(JL)
+ PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
ENDDO
-
- IF(LFEEDBACKT) THEN
- !Limitation due to 0 crossing of temperature
- DO JL=1, KSIZE
- PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
- ENDDO
- ENDIF
ENDIF
IF (LHOOK) CALL DR_HOOK('ICE4_RIMLTC', 1, ZHOOK_HANDLE)
diff --git a/src/common/micro/mode_ice4_rrhong.F90 b/src/common/micro/mode_ice4_rrhong.F90
index 942e4e328..0dde40628 100644
--- a/src/common/micro/mode_ice4_rrhong.F90
+++ b/src/common/micro/mode_ice4_rrhong.F90
@@ -6,7 +6,7 @@
MODULE MODE_ICE4_RRHONG
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
+SUBROUTINE ICE4_RRHONG(KSIZE, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
@@ -39,7 +39,6 @@ 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) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
@@ -61,19 +60,17 @@ IF (LHOOK) CALL DR_HOOK('ICE4_RRHONG',0,ZHOOK_HANDLE)
!* 3.3 compute the spontaneous freezing source: RRHONG
!
PRRHONG_MR(:) = 0.
-IF(.NOT. LDSOFT) THEN
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ PRRHONG_MR(JL)=PRRT(JL) * ZMASK(JL)
+ENDDO
+IF(LFEEDBACKT) THEN
+ !Limitation due to -35 crossing of temperature
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
- PRRHONG_MR(JL)=PRRT(JL) * ZMASK(JL)
+ PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
ENDDO
- IF(LFEEDBACKT) THEN
- !Limitation due to -35 crossing of temperature
- DO JL=1, KSIZE
- PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
- ENDDO
- ENDIF
ENDIF
!
IF (LHOOK) CALL DR_HOOK('ICE4_RRHONG', 1, ZHOOK_HANDLE)
diff --git a/src/mesonh/micro/ice4_nucleation.f90 b/src/mesonh/micro/ice4_nucleation.f90
deleted file mode 100644
index 98459b317..000000000
--- a/src/mesonh/micro/ice4_nucleation.f90
+++ /dev/null
@@ -1,152 +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_NUCLEATION
-INTERFACE
-SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
-END SUBROUTINE ICE4_NUCLEATION
-END INTERFACE
-END MODULE MODI_ICE4_NUCLEATION
-SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the nucleation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT,XEPSILO
-USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
-USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1,XALPHA2,XBETA1,XBETA2,XMNU0,XNU10,XNU20
-USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-!
-USE MODE_MPPDB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
-!
-!* 0.2 declaration of local variables
-!
-REAL, DIMENSION(KSIZE) :: ZW ! work array
-LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
-REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
- ZUSW, & ! Undersaturation over water
- ZSSI ! Supersaturation over ice
-!-------------------------------------------------------------------------------
-!
-!
-PRVHENI_MR(:)=0.
-IF(.NOT. ODSOFT) THEN
- GNEGT(:)=PT(:)<XTT .AND. PRVT>XRTMIN(1) .AND. ODCOMPUTE(:)
- PRVHENI_MR(:)=0.
- ZSSI(:)=0.
- ZUSW(:)=0.
- ZZW(:)=0.
- WHERE(GNEGT(:))
- ZZW(:)=ALOG(PT(:))
- ZUSW(:)=EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w
- ZZW(:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
- END WHERE
- WHERE(GNEGT(:))
- ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
- ! Supersaturation over ice
- ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
- ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
- ! Supersaturation of saturated water vapor over ice
- !
- !* 3.1 compute the heterogeneous nucleation source RVHENI
- !
- !* 3.1.1 compute the cloud ice concentration
- !
- ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
- END WHERE
- ZZW(:)=0.
- WHERE(GNEGT(:) .AND. PT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
- ZZW(:)=XNU20*EXP(XALPHA2*ZSSI(:)-XBETA2)
- ELSEWHERE(GNEGT(:) .AND. PT(:)<=XTT-2.0 .AND. PT(:)>=XTT-5.0 .AND. ZSSI(:)>0.0)
- ZZW(:)=MAX(XNU20*EXP(-XBETA2 ), &
- XNU10*EXP(-XBETA1*(PT(:)-XTT))*(ZSSI(:)/ZUSW(:))**XALPHA1)
- END WHERE
- WHERE(GNEGT(:))
- ZZW(:)=ZZW(:)-PCIT(:)
- ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
- END WHERE
- WHERE(GNEGT(:))
- !
- !* 3.1.2 update the r_i and r_v mixing ratios
- !
- PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*XMNU0/PRHODREF(:)
- PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
- END WHERE
- !Limitation due to 0 crossing of temperature
- IF(LFEEDBACKT) THEN
- ZW(:)=0.
- WHERE(GNEGT(:))
- ZW(:)=MIN(PRVHENI_MR(:), &
- MAX(0., (XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
- MAX(PRVHENI_MR(:), 1.E-20)
- END WHERE
- ELSE
- ZW(:)=1.
- ENDIF
- PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
- PCIT(:)=MAX(ZZW(:)*ZW(:)+PCIT(:), PCIT(:))
- !
- PB_RI(:)=PB_RI(:) + PRVHENI_MR(:)
- PB_RV(:)=PB_RV(:) - PRVHENI_MR(:)
- PB_TH(:)=PB_TH(:) + PRVHENI_MR(:)*PLSFACT(:)
-ENDIF
-!
-END SUBROUTINE ICE4_NUCLEATION
--
GitLab