diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files
index bbf18295df5a8af4e471dcc740d58fafb6729a33..cca761ab08eebf3dd23dba956f58c7c0949c92dd 100644
--- a/src/arome/gmkpack_ignored_files
+++ b/src/arome/gmkpack_ignored_files
@@ -24,3 +24,13 @@ phyex/micro/ice4_fast_ri.F90
phyex/micro/modi_ice4_fast_ri.F90
phyex/micro/ice4_rsrimcg_old.F90
phyex/micro/modi_ice4_rsrimcg_old.F90
+phyex/micro/ice4_warm.F90
+phyex/micro/modi_ice4_warm.F90
+phyex/micro/ice4_fast_rg.F90
+phyex/micro/ice4_fast_rh.F90
+phyex/micro/ice4_fast_rs.F90
+phyex/micro/ice4_slow.F90
+phyex/micro/modi_ice4_fast_rg.F90
+phyex/micro/modi_ice4_fast_rh.F90
+phyex/micro/modi_ice4_fast_rs.F90
+phyex/micro/modi_ice4_slow.F90
diff --git a/src/arome/micro/ice4_fast_rg.F90 b/src/arome/micro/ice4_fast_rg.F90
deleted file mode 100644
index e6f47e1ad7887845987ca60bc5b86cba1241846b..0000000000000000000000000000000000000000
--- a/src/arome/micro/ice4_fast_rg.F90
+++ /dev/null
@@ -1,496 +0,0 @@
-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
-!! -------------
-!!
-!
-!
-!* 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 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
-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(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(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
-!
-LOGICAL, DIMENSION(KSIZE) :: GDRY
-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
-INTEGER :: IRCDRYG, IRIDRYG, IRIWETG, IRSDRYG, IRSWETG, IRRDRYG, &
- & IFREEZ1, IFREEZ2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RG', 0, ZHOOK_HANDLE)
-!
-IRCDRYG=1
-IRIDRYG=2
-IRIWETG=3
-IRSDRYG=4
-IRSWETG=5
-IRRDRYG=6
-IFREEZ1=7
-IFREEZ2=8
-!
-!-------------------------------------------------------------------------------
-!
-!* 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)
-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)
-ENDDO
-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.
- 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(:))
- !
- !* 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, &
- XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
- IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY) )
- ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-FLOAT(IVEC1(1:IGDRY))
- !
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( FLOAT(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))
- !
- !* 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(:)=UNPACK(VECTOR=ZVEC3(1:IGDRY), MASK=GDRY(:), FIELD=0.0)
- !
- 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
-!
-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)
-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(:))
- !
- !* 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, &
- XDRYINTP1G*LOG(ZVEC1(1:IGDRY))+XDRYINTP2G))
- IVEC1(1:IGDRY)=INT(ZVEC1(1:IGDRY))
- ZVEC1(1:IGDRY)=ZVEC1(1:IGDRY)-FLOAT(IVEC1(1:IGDRY))
- !
- ZVEC2(1:IGDRY)=MAX(1.00001, MIN( FLOAT(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))
- !
- !* 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(:)=UNPACK(VECTOR=ZVEC3(1:IGDRY), MASK=GDRY, FIELD=0.)
- !
- 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., -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
-
-IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RG', 1, ZHOOK_HANDLE)
-!
-END SUBROUTINE ICE4_FAST_RG
diff --git a/src/arome/micro/ice4_fast_rh.F90 b/src/arome/micro/ice4_fast_rh.F90
deleted file mode 100644
index 86ac7d99740058dc81e7cfad6910e008a00878c0..0000000000000000000000000000000000000000
--- a/src/arome/micro/ice4_fast_rh.F90
+++ /dev/null
@@ -1,502 +0,0 @@
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the fast rh process
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR
-USE MODD_PARAM_ICE, ONLY : LEVLIMIT, LNULLWETH, LWETHPOST, LCONVHG
-USE 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
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-!
-!* 0.2 declaration of local variables
-!
-LOGICAL, DIMENSION(KSIZE) :: GWET
-REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
-INTEGER :: IHAIL, IGWET
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, &
- ZRDRYH_INIT, ZRWETH_INIT, &
- ZRDRYHG
-INTEGER :: JJ, JL
-INTEGER :: IRCWETH, IRRWETH, IRIDRYH, IRIWETH, IRSDRYH, IRSWETH, IRGDRYH, IRGWETH, &
- & IFREEZ1, IFREEZ2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RH',0,ZHOOK_HANDLE)
-!
-IRCWETH=1
-IRRWETH=2
-IRIDRYH=3
-IRIWETH=4
-IRSDRYH=5
-IRSWETH=6
-IRGDRYH=7
-IRGWETH=8
-IFREEZ1=9
-IFREEZ2=10
-!
-!
-!
-!* 7.2 compute the Wet and Dry growth of hail
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRCWETH)=ZMASK(JL) * PRH_TEND(JL, IRCWETH)
- ENDDO
-ELSE
- PRH_TEND(:, IRCWETH)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRIWETH)=ZMASK(JL) * PRH_TEND(JL, IRIWETH)
- PRH_TEND(JL, IRIDRYH)=ZMASK(JL) * PRH_TEND(JL, IRIDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRIWETH)=0.
- PRH_TEND(:, IRIDRYH)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH
- PRH_TEND(:, IRIDRYH)=PRH_TEND(:, IRIWETH)*(XCOLIH*EXP(XCOLEXIH*(PT(:)-XTT))) ! RIDRYH
- END WHERE
-ENDIF
-
-!
-!* 7.2.1 accretion of aggregates on the hailstones
-!
-DO JL=1, KSIZE
- ZWET(JL) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRSWETH)=ZWET(JL) * PRH_TEND(JL, IRSWETH)
- PRH_TEND(JL, IRSDRYH)=ZWET(JL) * PRH_TEND(JL, IRSDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRSWETH)=0.
- PRH_TEND(:, IRSDRYH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
- IF(IGWET>0)THEN
- !
- !* 7.2.3 select the (PLBDAH,PLBDAS) couplet
- !
- ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(1:IGWET) = PACK( PLBDAS(:),MASK=GWET(:) )
- !
- !* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
- ! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
- ! tabulate the SWETH-kernel
- !
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
- !
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAS)-0.00001, &
- XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
- !
- !* 7.2.5 perform the bilinear interpolation of the normalized
- ! SWETH-kernel
- !
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRSWETH)=XFSWETH*ZZW(:) & ! RSWETH
- *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSWETH1/( PLBDAH(:)**2 ) + &
- XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + &
- XLBSWETH3/( PLBDAS(:)**2) )
- PRH_TEND(:, IRSDRYH)=PRH_TEND(:, IRSWETH)*(XCOLSH*EXP(XCOLEXSH*(PT(:)-XTT)))
- END WHERE
- ENDIF
-ENDIF
-!
-!* 7.2.6 accretion of graupeln on the hailstones
-!
-DO JL=1, KSIZE
- ZWET(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRGWETH)=ZWET(JL) * PRH_TEND(JL, IRGWETH)
- PRH_TEND(JL, IRGDRYH)=ZWET(JL) * PRH_TEND(JL, IRGDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRGWETH)=0.
- PRH_TEND(:, IRGDRYH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
- IF(IGWET>0)THEN
- !
- !* 7.2.8 select the (PLBDAH,PLBDAG) couplet
- !
- ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(1:IGWET) = PACK( PLBDAG(:),MASK=GWET(:) )
- !
- !* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
- ! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
- ! tabulate the GWETH-kernel
- !
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
- !
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
- XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
- !
- !* 7.2.10 perform the bilinear interpolation of the normalized
- ! GWETH-kernel
- !
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRGWETH)=XFGWETH*ZZW(:) & ! RGWETH
- *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBGWETH1/( PLBDAH(:)**2 ) + &
- XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + &
- XLBGWETH3/( PLBDAG(:)**2) )
- PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH)
- END WHERE
- !When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same
- WHERE(GWET(:) .AND. .NOT. PWETG(:)==1.)
- PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT)))
- END WHERE
- END IF
-ENDIF
-!
-!* 7.2.11 accretion of raindrops on the hailstones
-!
-DO JL=1, KSIZE
- ZWET(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRRWETH)=ZWET(JL) * PRH_TEND(JL, IRRWETH)
- ENDDO
-ELSE
- PRH_TEND(:, IRRWETH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
- IF(IGWET>0)THEN
- !
- !* 7.2.12 select the (PLBDAH,PLBDAR) couplet
- !
- ZVEC1(1:IGWET)=PACK(PLBDAH(:), MASK=GWET(:))
- ZVEC2(1:IGWET)=PACK(PLBDAR(:), MASK=GWET(:))
- !
- !* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
- ! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
- ! tabulate the RWETH-kernel
- !
- ZVEC1(1:IGWET)=MAX(1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
- XWETINTP1H*LOG(ZVEC1(1:IGWET))+XWETINTP2H))
- IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET))
- ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-FLOAT(IVEC1(1:IGWET))
- !
- ZVEC2(1:IGWET)=MAX(1.00001, MIN( FLOAT(NWETLBDAR)-0.00001, &
- XWETINTP1R*LOG(ZVEC2(1:IGWET))+XWETINTP2R))
- IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET))
- ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-FLOAT(IVEC2(1:IGWET))
- !
- !* 7.2.14 perform the bilinear interpolation of the normalized
- ! RWETH-kernel
- !
- DO JJ=1, IGWET
- ZVEC3(JJ)= ( XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- *(ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGWET), MASK=GWET, FIELD=0.)
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRRWETH) = XFRWETH*ZZW(:) & ! RRWETH
- *( PLBDAR(:)**(-4) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRWETH1/( PLBDAH(:)**2 ) + &
- XLBRWETH2/( PLBDAH(:) * PLBDAR(:) ) + &
- XLBRWETH3/( PLBDAR(:)**2) )
- END WHERE
- ENDIF
-ENDIF
-!
-DO JL=1, KSIZE
- ZRDRYH_INIT(JL)=PRH_TEND(JL, IRCWETH)+PRH_TEND(JL, IRIDRYH)+ &
- &PRH_TEND(JL, IRSDRYH)+PRH_TEND(JL, IRRWETH)+PRH_TEND(JL, IRGDRYH)
-ENDDO
-!
-!* 7.3 compute the Wet growth of hail
-!
-DO JL=1, KSIZE
- ZHAIL(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IFREEZ1)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ1)
- PRH_TEND(JL, IFREEZ2)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ2)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZHAIL(:)==1.)
- PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
- END WHERE
- ENDIF
- PRH_TEND(:, IFREEZ2)=0.
- WHERE(ZHAIL(:)==1.)
- PRH_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-PRH_TEND(:, IFREEZ1))/(XRV*PT(:)) )
- PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH )/ &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- PRH_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- !We must agregate, at least, the cold species
- ZRWETH_INIT(JL)=ZHAIL(JL) * MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
- &MAX(0., PRH_TEND(JL, IFREEZ1) + &
- &PRH_TEND(JL, IFREEZ2) * ( &
- &PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH) )))
-ENDDO
-!
-!* 7.4 Select Wet or Dry case
-!
-!Wet case
-DO JL=1, KSIZE
- ZWETH(JL) = ZHAIL(JL) * &
- & MAX(0., SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH)) - &
- &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))))
-ENDDO
-IF(LNULLWETH) THEN
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) ! WHERE(ZRDRYH_INIT(:)>0.)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRWETH_INIT(JL))) ! WHERE(ZRWETH_INIT(:)>0.)
- ENDDO
-ENDIF
-IF(.NOT. LWETHPOST) THEN
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
- ENDDO
-ENDIF
-DO JL=1, KSIZE
- ZDRYH(JL) = ZHAIL(JL) * &
- & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
- & MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
- & MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
- &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
-ENDDO
-!
-ZRDRYHG(:)=0.
-IF(LCONVHG)THEN
- WHERE(ZDRYH(:)==1.)
- ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:))
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PRCWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRCWETH)
- PRIWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRIWETH)
- PRSWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRSWETH)
- PRGWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRGWETH)
- !Collected minus aggregated
- PRRWETH(JL) = ZWETH(JL) * (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
- PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
- PRH_TEND(JL, IRCWETH))
-
- PRCDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRCWETH)
- PRIDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRIDRYH)
- PRSDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRSDRYH)
- PRRDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRRWETH)
- PRGDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRGDRYH)
- PRDRYHG(JL) = ZDRYH(JL) * ZRDRYHG(JL)
-
- PA_RC(JL) = PA_RC(JL) - PRCWETH(JL)
- PA_RI(JL) = PA_RI(JL) - PRIWETH(JL)
- PA_RS(JL) = PA_RS(JL) - PRSWETH(JL)
- PA_RG(JL) = PA_RG(JL) - PRGWETH(JL)
- PA_RH(JL) = PA_RH(JL) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
- PA_RR(JL) = PA_RR(JL) - PRRWETH(JL)
- PA_TH(JL) = PA_TH(JL) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA_RC(JL) = PA_RC(JL) - PRCDRYH(JL)
- PA_RI(JL) = PA_RI(JL) - PRIDRYH(JL)
- PA_RS(JL) = PA_RS(JL) - PRSDRYH(JL)
- PA_RR(JL) = PA_RR(JL) - PRRDRYH(JL)
- PA_RG(JL) = PA_RG(JL) - PRGDRYH(JL) + PRDRYHG(JL)
- PA_RH(JL) = PA_RH(JL) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
- &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!* 7.5 Melting of the hailstones
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRHMLTR(JL)=ZMASK(JL)*PRHMLTR(JL)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRHMLTR(JL) = ZMASK(JL)* PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
- END WHERE
- ENDIF
- DO JL=1, KSIZE
- PRHMLTR(JL) = ZMASK(JL)* (PKA(JL)*(XTT-PT(JL)) + &
- ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
- *(XESTT-PRHMLTR(JL))/(XRV*PT(JL)) ))
- ENDDO
- WHERE(ZMASK(:)==1.)
- !
- ! compute RHMLTR
- !
- PRHMLTR(:) = MAX( 0.0,( -PRHMLTR(:) * &
- ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - &
- ( PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRRWETH) )* &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- END WHERE
-END IF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) + PRHMLTR(JL)
- PA_RH(JL) = PA_RH(JL) - PRHMLTR(JL)
- PA_TH(JL) = PA_TH(JL) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RH', 1, ZHOOK_HANDLE)
-!
-END SUBROUTINE ICE4_FAST_RH
diff --git a/src/arome/micro/ice4_fast_rs.F90 b/src/arome/micro/ice4_fast_rs.F90
deleted file mode 100644
index 90159d294eea80aaa496006634c8b5b7fc95c547..0000000000000000000000000000000000000000
--- a/src/arome/micro/ice4_fast_rs.F90
+++ /dev/null
@@ -1,440 +0,0 @@
-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
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR
-USE MODD_PARAM_ICE, ONLY : LEVLIMIT, CSNOWRIMING
-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
-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(INOUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSS ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: 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
-!
-REAL, DIMENSION(KSIZE) :: ZRIM, ZACC, ZMASK
-LOGICAL, DIMENSION(KSIZE) :: GRIM, GACC
-INTEGER :: IGRIM, IGACC
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
-INTEGER :: JJ, JL
-INTEGER :: IRCRIMS, IRCRIMSS, IRSRIMCG, IRRACCS, IRRACCSS, IRSACCRG, &
- IFREEZ1, IFREEZ2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RS', 0, ZHOOK_HANDLE)
-!
-IRCRIMS=1
-IRCRIMSS=2
-IRSRIMCG=3
-IRRACCS=4
-IRRACCSS=5
-IRSACCRG=6
-IFREEZ1=7
-IFREEZ2=8
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 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
-!
-DO JL=1, KSIZE
- ZRIM(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & !WHERE(PRCT(:)>XRTMIN(2))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JL)
-ENDDO
-!
-! 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.
- GRIM(:)=ZRIM(:)==1.
- IGRIM = COUNT(GRIM(:))
- !
- IF(IGRIM>0) THEN
- !
- ! 5.1.1 select the PLBDAS
- !
- ZVEC1(1:IGRIM) = PACK( PLBDAS(:),MASK=GRIM(:) )
- !
- ! 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( FLOAT(NGAMINC)-0.00001, &
- XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
- IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
- ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - FLOAT( 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(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 )
- !
- ! 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(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 )
-
- ZVEC1(1:IGRIM) = XGAMINC_RIM4( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM4( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW2(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0)
- !
- ! 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
-!
-DO JL=1, KSIZE
- ZACC(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & !WHERE(PRRT(:)>XRTMIN(3))
- &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, 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.
- GACC(:)=ZACC(:)==1.
- IGACC = COUNT(GACC(:))
- IF(IGACC>0)THEN
- !
- !
- ! 5.2.1 select the (PLBDAS,PLBDAR) couplet
- !
- ZVEC1(1:IGACC) = PACK( PLBDAS(:),MASK=GACC(:) )
- ZVEC2(1:IGACC) = PACK( PLBDAR(:),MASK=GACC(:) )
- !
- ! 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( FLOAT(NACCLBDAS)-0.00001, &
- XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
- IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
- ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - FLOAT( IVEC1(1:IGACC) )
- !
- ZVEC2(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAR)-0.00001, &
- XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
- IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
- ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - FLOAT( 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(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 )
- !
- ! 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(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC(:),FIELD=0.0 )
- 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(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 )
- !
- ! 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
-
-IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RS', 1, ZHOOK_HANDLE)
-!
-END SUBROUTINE ICE4_FAST_RS
diff --git a/src/arome/micro/ice4_tendencies.F90 b/src/arome/micro/ice4_tendencies.F90
index d51e07a908c107535ec7b52ae761a7f57f796310..aac00c1c76c1f7c2a583f459cf2fe69f8a307c1c 100644
--- a/src/arome/micro/ice4_tendencies.F90
+++ b/src/arome/micro/ice4_tendencies.F90
@@ -47,11 +47,11 @@ USE MODI_ICE4_RIMLTC
USE MODE_ICE4_RSRIMCG_OLD, ONLY: ICE4_RSRIMCG_OLD
USE MODI_ICE4_COMPUTE_PDF
USE MODI_ICE4_RAINFR_VERT
-USE MODI_ICE4_SLOW
-USE MODI_ICE4_WARM
-USE MODI_ICE4_FAST_RS
-USE MODI_ICE4_FAST_RG
-USE MODI_ICE4_FAST_RH
+USE MODE_ICE4_SLOW, ONLY: ICE4_SLOW
+USE MODE_ICE4_WARM, ONLY: ICE4_WARM
+USE MODE_ICE4_FAST_RS, ONLY: ICE4_FAST_RS
+USE MODE_ICE4_FAST_RG, ONLY: ICE4_FAST_RG
+USE MODE_ICE4_FAST_RH, ONLY: ICE4_FAST_RH
USE MODE_ICE4_FAST_RI, ONLY: ICE4_FAST_RI
USE PARKIND1, ONLY : JPRB
@@ -174,6 +174,7 @@ REAL, DIMENSION(KSIZE) :: ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
& ZRF, &
& ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
& ZRGSI, ZRGSI_MR
+REAL, DIMENSION(KSIZE) :: PHLI_HCF
REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D
INTEGER :: JL
REAL, DIMENSION(KSIZE) :: ZWETG ! 1. if graupel growths in wet mode, 0. otherwise
@@ -343,11 +344,12 @@ IF(KSIZE>0) THEN
ENDIF
!
!
+PHLI_HCF=1
CALL ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, ZT, &
&PSSI, PLVFACT, PLSFACT, &
&ZRVT, ZRCT, ZRIT, ZRST, ZRGT, &
&ZLBDAS, ZLBDAG, &
- &ZAI, ZCJ, &
+ &ZAI, ZCJ, PHLI_HCF, ZRIT, & !!!!!!! en attendant phasage plus complet
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
!
@@ -380,7 +382,7 @@ END IF
!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
! ----------------------------------------------
!
-CALL ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
+CALL ICE4_FAST_RS(KSIZE, KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAR, ZLBDAS, &
@@ -403,7 +405,7 @@ DO JL=1, KSIZE
& PRSACCRG(JL) + PRCRIMSG(JL) + PRSRIMCG(JL)
ZRGSI_MR(JL) = PRRHONG_MR(JL) + PRSRIMCG_MR(JL)
ENDDO
-CALL ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
+CALL ICE4_FAST_RG(KSIZE, KSIZE, LDSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, PCIT, &
&ZLBDAR, ZLBDAS, ZLBDAG, &
@@ -422,7 +424,7 @@ CALL ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
! ----------------------------------------------
!
IF (KRR==7) THEN
- CALL ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, ZWETG, &
+ CALL ICE4_FAST_RH(KSIZE, KSIZE, LDSOFT, PCOMPUTE, ZWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, &
diff --git a/src/arome/micro/ice4_warm.F90 b/src/arome/micro/ice4_warm.F90
deleted file mode 100644
index e08ff2a6c4db60fd3b14ba17ad78bb11bfba9e06..0000000000000000000000000000000000000000
--- a/src/arome/micro/ice4_warm.F90
+++ /dev/null
@@ -1,274 +0,0 @@
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- &PRHODREF, PLVFACT, PT, PPRES, PTHT, &
- &PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
- &PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- &PCF, PRF, &
- &PRVT, PRCT, PRRT, &
- &PRCAUTR, PRCACCR, PRREVAV, &
- &PA_TH, PA_RV, PA_RC, PA_RR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the warm process
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the plitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR
-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
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
-CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction
-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(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
-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_RR
-!
-!* 0.2 declaration of local variables
-!
-REAL, DIMENSION(KSIZE) :: ZZW2, ZZW3, ZZW4
-REAL, DIMENSION(KSIZE) :: ZUSW ! Undersaturation over water
-REAL, DIMENSION(KSIZE) :: ZTHLT ! Liquid potential temperature
-REAL :: ZTIMAUTIC
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-REAL, DIMENSION(KSIZE) :: ZMASK, ZMASK1, ZMASK2
-INTEGER :: JL
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_WARM', 0, ZHOOK_HANDLE)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., -PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCAUTR(JL)=PRCAUTR(JL)*ZMASK(JL)
- ENDDO
-ELSE
- PRCAUTR(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCAUTR(:) = XTIMAUTC*MAX(PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:), 0.0)
- PRCAUTR(:) = PHLC_HCF(:)*PRCAUTR(:)
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RC(JL) = PA_RC(JL) - PRCAUTR(JL)
- PA_RR(JL) = PA_RR(JL) + PRCAUTR(JL)
-ENDDO
-!
-!
-!* 4.3 compute the accretion of r_c for r_r production: RCACCR
-!
-IF (HSUBG_RC_RR_ACCR=='NONE') THEN
- !CLoud water and rain are diluted over the grid box
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
- ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCACCR(JL)=PRCACCR(JL) * ZMASK(JL)
- ENDDO
- ELSE
- PRCACCR(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCACCR(:) = XFCACCR * PRCT(:) &
- * PLBDAR(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT)
- END WHERE
- ENDIF
-
-ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
- !Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion
- !Rain is concnetrated over its fraction
- !Rain in high content area fraction: PHLC_HCF
- !Rain in low content area fraction:
- ! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
- ! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
- ! => min(PCF, PRF)-PHLC_HCF
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
- ZMASK1(JL)=ZMASK(JL) * &
- &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., -PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
- ZMASK2(JL)=ZMASK(JL) * &
- &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., -PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
- ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCACCR(JL)=PRCACCR(JL) * MIN(1., ZMASK1(JL)+ZMASK2(JL))
- ENDDO
- ELSE
- PRCACCR(:)=0.
- WHERE(ZMASK1(:)==1.)
- !Accretion due to rain falling in high cloud content
- PRCACCR(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
- * PLBDAR_RF(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT) &
- * PHLC_HCF
- END WHERE
- WHERE(ZMASK2(:)==1.)
- !We add acrretion due to rain falling in low cloud content
- PRCACCR(:) = PRCACCR(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
- * PLBDAR_RF(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT) &
- * (MIN(PCF(:), PRF(:))-PHLC_HCF(:))
- END WHERE
- ENDIF
-ELSE
- !wrong HSUBG_RC_RR_ACCR case
- CALL ABORT
- STOP 'wrong HSUBG_RC_RR_ACCR case'
-ENDIF
-DO JL=1, KSIZE
- PA_RC(JL) = PA_RC(JL) - PRCACCR(JL)
- PA_RR(JL) = PA_RR(JL) + PRCACCR(JL)
-ENDDO
-!
-!* 4.4 compute the evaporation of r_r: RREVAV
-!
-IF (HSUBG_RR_EVAP=='NONE') THEN
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &MAX(0., SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)<=XRTMIN(2)
- &PCOMPUTE(JL)
- ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
- ENDDO
- ELSE
- PRREVAV(:) = 0.
- !Evaporation only when there's no cloud (RC must be 0)
- WHERE(ZMASK(:)==1.)
- PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
- ! Undersaturation over water
- PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) &
- + ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
- PRREVAV(:) = ( MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) ) * &
- ( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR )
- END WHERE
- ENDIF
-
-ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
- !Evaporation in clear sky part
- !With CLFR, rain is diluted over the grid box
- !With PRFR, rain is concentrated in its fraction
- !Use temperature and humidity in clear sky part like Bechtold et al. (1993)
- IF (HSUBG_RR_EVAP=='CLFR') THEN
- ZZW4(:)=1. !Precipitation fraction
- ZZW3(:)=PLBDAR(:)
- ELSE
- ZZW4(:)=PRF(:) !Precipitation fraction
- ZZW3(:)=PLBDAR_RF(:)
- ENDIF
-
- !ATTENTION
- !Il faudrait recalculer les variables PKA, PDV, PCJ en tenant compte de la température T^u
- !Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
- !et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
- !On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &MAX(0., -SIGN(1., PCF(JL)-ZZW4(JL))) * & ! ZZW4(:) > PCF(:)
- &PCOMPUTE(JL)
- ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
- ENDDO
- ELSE
- PRREVAV(:) = 0.
- WHERE(ZMASK(:)==1)
- ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
- ! Bechtold et al. 1993
- !
- ! T_l
- ZTHLT(:) = PTHT(:) - XLVTT*PTHT(:)/XCPD/PT(:)*PRCT(:)
- !
- ! T^u = T_l = theta_l * (T/theta)
- ZZW2(:) = ZTHLT(:) * PT(:) / PTHT(:)
- !
- ! es_w with new T^u
- PRREVAV(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
- !
- ! S, Undersaturation over water (with new theta^u)
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
- !
- PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
- + ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) )
- !
- PRREVAV(:) = MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) * &
- ( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR )
- !
- PRREVAV(:) = PRREVAV(:)*(ZZW4(:)-PCF(:))
- END WHERE
- ENDIF
-
-ELSE
- !wrong HSUBG_RR_EVAP case
- CALL ABORT
- STOP 'wrong HSUBG_RR_EVAP case'
-END IF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) - PRREVAV(JL)
- PA_RV(JL) = PA_RV(JL) + PRREVAV(JL)
- PA_TH(JL) = PA_TH(JL) - PRREVAV(JL)*PLVFACT(JL)
-ENDDO
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_WARM', 1, ZHOOK_HANDLE)
-!
-END SUBROUTINE ICE4_WARM
diff --git a/src/arome/micro/modi_ice4_fast_rg.F90 b/src/arome/micro/modi_ice4_fast_rg.F90
deleted file mode 100644
index 801d8c2d1bb8afcaaa8c064c7d93720b5f5ccbd7..0000000000000000000000000000000000000000
--- a/src/arome/micro/modi_ice4_fast_rg.F90
+++ /dev/null
@@ -1,66 +0,0 @@
-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(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(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
diff --git a/src/arome/micro/modi_ice4_fast_rh.F90 b/src/arome/micro/modi_ice4_fast_rh.F90
deleted file mode 100644
index 5cd5bc4ded74b0f9851930f69cd80e272bf1987b..0000000000000000000000000000000000000000
--- a/src/arome/micro/modi_ice4_fast_rh.F90
+++ /dev/null
@@ -1,58 +0,0 @@
-MODULE MODI_ICE4_FAST_RH
-INTERFACE
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-END SUBROUTINE ICE4_FAST_RH
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RH
diff --git a/src/arome/micro/modi_ice4_fast_rs.F90 b/src/arome/micro/modi_ice4_fast_rs.F90
deleted file mode 100644
index f27c670521e618f2df3b5e3208b8bd3694190c81..0000000000000000000000000000000000000000
--- a/src/arome/micro/modi_ice4_fast_rs.F90
+++ /dev/null
@@ -1,49 +0,0 @@
-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(INOUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSS ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: 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
diff --git a/src/arome/micro/modi_ice4_warm.F90 b/src/arome/micro/modi_ice4_warm.F90
deleted file mode 100644
index 4e6e5c4c7db149b654d2d4eac9ea2d59b5647c1d..0000000000000000000000000000000000000000
--- a/src/arome/micro/modi_ice4_warm.F90
+++ /dev/null
@@ -1,45 +0,0 @@
-MODULE MODI_ICE4_WARM
-INTERFACE
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- &PRHODREF, PLVFACT, PT, PPRES, PTHT, &
- &PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
- &PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- &PCF, PRF, &
- &PRVT, PRCT, PRRT, &
- &PRCAUTR, PRCACCR, PRREVAV, &
- &PA_TH, PA_RV, PA_RC, PA_RR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
-CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction
-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(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
-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_RR
-END SUBROUTINE ICE4_WARM
-END INTERFACE
-END MODULE MODI_ICE4_WARM
diff --git a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rg.F90 b/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rg.F90
deleted file mode 100644
index 98fd4c7484036e911ee74001ffde5d78970fcd52..0000000000000000000000000000000000000000
--- a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rg.F90
+++ /dev/null
@@ -1,66 +0,0 @@
-MODULE MODI_ICE4_FAST_RG
-INTERFACE
-SUBROUTINE ICE4_FAST_RG(KPROMA,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) :: KPROMA,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(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(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KPROMA, 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
diff --git a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rh.F90 b/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rh.F90
deleted file mode 100644
index a0d8e04b16271f2cb9f745ffe87badfa2d5bd18c..0000000000000000000000000000000000000000
--- a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rh.F90
+++ /dev/null
@@ -1,58 +0,0 @@
-MODULE MODI_ICE4_FAST_RH
-INTERFACE
-SUBROUTINE ICE4_FAST_RH(KPROMA,KSIZE, LDSOFT, PCOMPUTE, PWETG, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KPROMA,KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-END SUBROUTINE ICE4_FAST_RH
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RH
diff --git a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rs.F90 b/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rs.F90
deleted file mode 100644
index 4f16b6e1e6083d2807bc7ecd40d5703ee8ed18b0..0000000000000000000000000000000000000000
--- a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_fast_rs.F90
+++ /dev/null
@@ -1,49 +0,0 @@
-MODULE MODI_ICE4_FAST_RS
-INTERFACE
-SUBROUTINE ICE4_FAST_RS(KPROMA,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) :: KPROMA,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(INOUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSS ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: 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(KPROMA, 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
diff --git a/src/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rg.F90 b/src/common/micro/mode_ice4_fast_rg.F90
similarity index 83%
rename from src/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rg.F90
rename to src/common/micro/mode_ice4_fast_rg.F90
index efe09f5c70b66796b0e4a10f606ae25f480237f8..c55e068823b4dd9599b28bfc0f127434071979da 100644
--- a/src/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rg.F90
+++ b/src/common/micro/mode_ice4_fast_rg.F90
@@ -1,3 +1,10 @@
+!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_FAST_RG
+IMPLICIT NONE
+CONTAINS
SUBROUTINE ICE4_FAST_RG(KPROMA,KSIZE, LDSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, PCIT, &
@@ -21,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
!
@@ -66,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
@@ -90,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
@@ -99,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
!-------------------------------------------------------------------------------
@@ -202,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
@@ -215,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
@@ -249,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
@@ -266,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
@@ -312,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
@@ -392,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
@@ -496,3 +531,4 @@ ENDDO
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RG', 1, ZHOOK_HANDLE)
END SUBROUTINE ICE4_FAST_RG
+END MODULE MODE_ICE4_FAST_RG
diff --git a/src/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rh.F90 b/src/common/micro/mode_ice4_fast_rh.F90
similarity index 79%
rename from src/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rh.F90
rename to src/common/micro/mode_ice4_fast_rh.F90
index 5bcc5de79ebd88284e880f85aa96f0000975fc3e..dc6ed246c540116021fbf3b0f8431269f924d4ff 100644
--- a/src/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rh.F90
+++ b/src/common/micro/mode_ice4_fast_rh.F90
@@ -1,3 +1,10 @@
+!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_FAST_RH
+IMPLICIT NONE
+CONTAINS
SUBROUTINE ICE4_FAST_RH(KPROMA,KSIZE, LDSOFT, PCOMPUTE, PWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
@@ -19,16 +26,25 @@ SUBROUTINE ICE4_FAST_RH(KPROMA,KSIZE, LDSOFT, PCOMPUTE, PWETG, &
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!! R. El Khatib 24-Aug-2021 Optimizations
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR
-USE MODD_PARAM_ICE, ONLY : LEVLIMIT, LNULLWETH, LWETHPOST, LCONVHG
+USE MODD_CST, ONLY: XALPI, XALPW, XBETAI, XBETAW, XGAMW, XCI, XCL, XCPV, XESTT, XGAMI, XLMTT, &
+ & XLVTT, XMD, XMV, XRV, XTT, XEPSILO
+USE MODD_PARAM_ICE, ONLY: LCONVHG, LEVLIMIT, LNULLWETH, LWETHPOST
+USE MODD_RAIN_ICE_DESCR, ONLY: XBG, XBS, XCEXVT, XCXG, XCXH, XCXS, XDH, XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG, NWETLBDAH, NWETLBDAR, NWETLBDAS, X0DEPH, X1DEPH, XCOLEXGH, XCOLEXIH, &
+ & XCOLGH, XCOLIH, XCOLEXSH, XCOLSH, XEX0DEPH, XEX1DEPH, XFGWETH, XFRWETH, &
+ & XFSWETH, XFWETH, XKER_GWETH, XKER_RWETH, XKER_SWETH, XLBGWETH1, XLBGWETH2, &
+ & XLBGWETH3, XLBRWETH1, XLBRWETH2, XLBRWETH3, XLBSWETH1, XLBSWETH2, XLBSWETH3, &
+ & XWETINTP1G, XWETINTP1H, XWETINTP1R, XWETINTP1S, XWETINTP2G, XWETINTP2H, &
+ & XWETINTP2R, XWETINTP2S
+!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -59,17 +75,17 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
@@ -82,34 +98,23 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
!
!* 0.2 declaration of local variables
!
+INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
+ & IFREEZ1=9, IFREEZ2=10
LOGICAL, DIMENSION(KSIZE) :: GWET
REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
INTEGER :: IHAIL, IGWET
+INTEGER, DIMENSION(KSIZE) :: I1
REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
REAL, DIMENSION(KSIZE) :: ZZW, &
ZRDRYH_INIT, ZRWETH_INIT, &
ZRDRYHG
INTEGER :: JJ, JL
-INTEGER :: IRCWETH, IRRWETH, IRIDRYH, IRIWETH, IRSDRYH, IRSWETH, IRGDRYH, IRGWETH, &
- & IFREEZ1, IFREEZ2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RH',0,ZHOOK_HANDLE)
!
-IRCWETH=1
-IRRWETH=2
-IRIDRYH=3
-IRIWETH=4
-IRSDRYH=5
-IRSWETH=6
-IRGDRYH=7
-IRGWETH=8
-IFREEZ1=9
-IFREEZ2=10
-!
-!
!
!* 7.2 compute the Wet and Dry growth of hail
!
@@ -152,10 +157,18 @@ ENDIF
!
!* 7.2.1 accretion of aggregates on the hailstones
!
-DO JL=1, KSIZE
- ZWET(JL) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JL)
+IGWET = 0
+DO JJ = 1, KSIZE
+ ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ ENDIF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -165,28 +178,28 @@ IF(LDSOFT) THEN
ELSE
PRH_TEND(:, IRSWETH)=0.
PRH_TEND(:, IRSDRYH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
IF(IGWET>0)THEN
!
!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
!
- ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(1:IGWET) = PACK( PLBDAS(:),MASK=GWET(:) )
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAS(I1(JJ))
+ ENDDO
!
!* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
! tabulate the SWETH-kernel
!
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
!
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAS)-0.00001, &
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
!
!* 7.2.5 perform the bilinear interpolation of the normalized
! SWETH-kernel
@@ -199,7 +212,10 @@ ELSE
- XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRSWETH)=XFSWETH*ZZW(1:KSIZE) & ! RSWETH
@@ -215,10 +231,18 @@ ENDIF
!
!* 7.2.6 accretion of graupeln on the hailstones
!
-DO JL=1, KSIZE
- ZWET(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JL)
+IGWET = 0
+DO JJ = 1, KSIZE
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ END IF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -228,28 +252,28 @@ IF(LDSOFT) THEN
ELSE
PRH_TEND(:, IRGWETH)=0.
PRH_TEND(:, IRGDRYH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
IF(IGWET>0)THEN
!
!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
!
- ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(1:IGWET) = PACK( PLBDAG(:),MASK=GWET(:) )
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAG(I1(JJ))
+ END DO
!
!* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
! tabulate the GWETH-kernel
!
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
!
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
!
!* 7.2.10 perform the bilinear interpolation of the normalized
! GWETH-kernel
@@ -262,7 +286,10 @@ ELSE
- XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRGWETH)=XFGWETH*ZZW(1:KSIZE) & ! RGWETH
@@ -282,10 +309,18 @@ ENDIF
!
!* 7.2.11 accretion of raindrops on the hailstones
!
-DO JL=1, KSIZE
- ZWET(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &PCOMPUTE(JL)
+IGWET = 0
+DO JJ = 1, KSIZE
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
+ IGWET = IGWET + 1
+ I1(IGWET) = JJ
+ GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
+ ENDIF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -293,28 +328,28 @@ IF(LDSOFT) THEN
ENDDO
ELSE
PRH_TEND(:, IRRWETH)=0.
- GWET(:)=ZWET(:)==1.
- IGWET=COUNT(GWET(:))
IF(IGWET>0)THEN
!
!* 7.2.12 select the (PLBDAH,PLBDAR) couplet
!
- ZVEC1(1:IGWET)=PACK(PLBDAH(:), MASK=GWET(:))
- ZVEC2(1:IGWET)=PACK(PLBDAR(:), MASK=GWET(:))
+ DO JJ = 1, IGWET
+ ZVEC1(JJ) = PLBDAH(I1(JJ))
+ ZVEC2(JJ) = PLBDAR(I1(JJ))
+ ENDDO
!
!* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
! tabulate the RWETH-kernel
!
- ZVEC1(1:IGWET)=MAX(1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
+ ZVEC1(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
XWETINTP1H*LOG(ZVEC1(1:IGWET))+XWETINTP2H))
IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET))
- ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-FLOAT(IVEC1(1:IGWET))
+ ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-REAL(IVEC1(1:IGWET))
!
- ZVEC2(1:IGWET)=MAX(1.00001, MIN( FLOAT(NWETLBDAR)-0.00001, &
+ ZVEC2(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAR)-0.00001, &
XWETINTP1R*LOG(ZVEC2(1:IGWET))+XWETINTP2R))
IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET))
- ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-FLOAT(IVEC2(1:IGWET))
+ ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-REAL(IVEC2(1:IGWET))
!
!* 7.2.14 perform the bilinear interpolation of the normalized
! RWETH-kernel
@@ -327,7 +362,10 @@ ELSE
- XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
- ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGWET), MASK=GWET, FIELD=0.)
+ ZZW(:) = 0.
+ DO JJ = 1, IGWET
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
WHERE(GWET(1:KSIZE))
PRH_TEND(1:KSIZE, IRRWETH) = XFRWETH*ZZW(1:KSIZE) & ! RRWETH
@@ -410,7 +448,7 @@ ENDIF
DO JL=1, KSIZE
ZDRYH(JL) = ZHAIL(JL) * &
& MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
- & MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
& MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
&MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
ENDDO
@@ -501,3 +539,4 @@ ENDDO
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RH', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_FAST_RH
+END MODULE MODE_ICE4_FAST_RH
diff --git a/src/common/micro/mode_ice4_fast_ri.F90 b/src/common/micro/mode_ice4_fast_ri.F90
index 3315e03df3bc775a08dbd2ccd761a40d3abbba6c..0e1e1e0ff5042d73efa6574eea56b073ed4567db 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/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rs.F90 b/src/common/micro/mode_ice4_fast_rs.F90
similarity index 83%
rename from src/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rs.F90
rename to src/common/micro/mode_ice4_fast_rs.F90
index bf90be02a2da8983eaf4a543acdd3abe4d5d78ed..9775ff1559937c0570f62c9124247c474aeb2d5b 100644
--- a/src/arome/modset_Ryad/mpa/micro/internals/ice4_fast_rs.F90
+++ b/src/common/micro/mode_ice4_fast_rs.F90
@@ -1,3 +1,10 @@
+!MNH_LIC Copyright 1994-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_ICE4_FAST_RS
+IMPLICIT NONE
+CONTAINS
SUBROUTINE ICE4_FAST_RS(KPROMA,KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
@@ -21,16 +28,24 @@ SUBROUTINE ICE4_FAST_RS(KPROMA,KSIZE, LDSOFT, PCOMPUTE, &
!! 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, CSNOWRIMING
+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
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -56,12 +71,12 @@ 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(INOUT) :: PRCRIMSS ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCRIMSG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSRIMCG ! Cloud droplet riming of the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSS ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRACCSG ! Rain accretion onto the aggregates
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSACCRG ! Rain accretion onto the aggregates
+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(KPROMA, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
@@ -73,28 +88,21 @@ 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
-INTEGER :: IRCRIMS, IRCRIMSS, IRSRIMCG, IRRACCS, IRRACCSS, IRSACCRG, &
- IFREEZ1, IFREEZ2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RS', 0, ZHOOK_HANDLE)
!
-IRCRIMS=1
-IRCRIMSS=2
-IRSRIMCG=3
-IRRACCS=4
-IRRACCSS=5
-IRSACCRG=6
-IFREEZ1=7
-IFREEZ2=8
!
!-------------------------------------------------------------------------------
!
@@ -141,10 +149,18 @@ ENDDO
!
!* 5.1 cloud droplet riming of the aggregates
!
+IGRIM = 0
DO JL=1, KSIZE
ZRIM(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & !WHERE(PRCT(:)>XRTMIN(2))
&MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !WHERE(PRST(:)>XRTMIN(5))
&PCOMPUTE(JL)
+ IF (ZRIM(JL)>0) THEN
+ IGRIM = IGRIM + 1
+ I1(IGRIM) = JL
+ GRIM(JL) = .TRUE.
+ ELSE
+ GRIM(JL) = .FALSE.
+ ENDIF
ENDDO
!
! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0)
@@ -158,30 +174,33 @@ ELSE
PRS_TEND(:, IRCRIMS)=0.
PRS_TEND(:, IRCRIMSS)=0.
PRS_TEND(:, IRSRIMCG)=0.
- GRIM(:)=ZRIM(:)==1.
- IGRIM = COUNT(GRIM(:))
!
IF(IGRIM>0) THEN
!
! 5.1.1 select the PLBDAS
!
- ZVEC1(1:IGRIM) = PACK( PLBDAS(:),MASK=GRIM(:) )
+ 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( FLOAT(NGAMINC)-0.00001, &
+ 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) - FLOAT( IVEC2(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(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 )
+ ZZW(:) = 0.
+ DO JJ = 1, IGRIM
+ ZZW(I1(JJ)) = ZVEC1(JJ)
+ END DO
!
! 5.1.4 riming of the small sized aggregates
!
@@ -197,11 +216,17 @@ ELSE
!
ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.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(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.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
!
@@ -246,10 +271,18 @@ ENDDO
!
!* 5.2 rain accretion onto the aggregates
!
-DO JL=1, KSIZE
- ZACC(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & !WHERE(PRRT(:)>XRTMIN(3))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JL)
+IGACC = 0
+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)
+ IF (ZACC(JJ)>0) THEN
+ IGACC = IGACC + 1
+ I1(IGACC) = JJ
+ GACC(JJ) = .TRUE.
+ ELSE
+ GACC(JJ) = .FALSE.
+ END IF
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -261,29 +294,29 @@ ELSE
PRS_TEND(:, IRRACCS)=0.
PRS_TEND(:, IRRACCSS)=0.
PRS_TEND(:, IRSACCRG)=0.
- GACC(:)=ZACC(:)==1.
- IGACC = COUNT(GACC(:))
IF(IGACC>0)THEN
!
!
! 5.2.1 select the (PLBDAS,PLBDAR) couplet
!
- ZVEC1(1:IGACC) = PACK( PLBDAS(:),MASK=GACC(:) )
- ZVEC2(1:IGACC) = PACK( PLBDAR(:),MASK=GACC(:) )
+ DO JJ = 1, IGACC
+ ZVEC1(JJ) = PLBDAS(I1(JJ))
+ ZVEC2(JJ) = PLBDAR(I1(JJ))
+ ENDDO
!
! 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( FLOAT(NACCLBDAS)-0.00001, &
+ 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) - FLOAT( IVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
!
- ZVEC2(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAR)-0.00001, &
+ 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) - FLOAT( IVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
!
! 5.2.3 perform the bilinear interpolation of the normalized
! RACCSS-kernel
@@ -296,7 +329,10 @@ ELSE
- XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 )
+ ZZW(:) = 0.
+ DO JJ = 1, IGACC
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
!
! 5.2.4 raindrop accretion on the small sized aggregates
!
@@ -320,7 +356,10 @@ ELSE
- XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC(:),FIELD=0.0 )
+ ZZW(:) = 0.
+ DO JJ = 1, IGACC
+ ZZW(I1(JJ)) = ZVEC3(JJ)
+ END DO
WHERE(GACC(1:KSIZE))
PRS_TEND(1:KSIZE, IRRACCS) = ZZW(1:KSIZE)*ZZW6(1:KSIZE)
END WHERE
@@ -335,7 +374,10 @@ ELSE
- XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* (ZVEC2(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 )
+ 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
@@ -441,3 +483,4 @@ ENDDO
IF (LHOOK) CALL DR_HOOK('ICE4_FAST_RS', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_FAST_RS
+END MODULE MODE_ICE4_FAST_RS
diff --git a/src/arome/modset_Ryad/mpa/micro/internals/ice4_slow.F90 b/src/common/micro/mode_ice4_slow.F90
similarity index 83%
rename from src/arome/modset_Ryad/mpa/micro/internals/ice4_slow.F90
rename to src/common/micro/mode_ice4_slow.F90
index 054e9d9ed4fcbe2ff9a89489f157729792baba0c..813138b9daa905df8fa831b10d4f60d982e0daec 100644
--- a/src/arome/modset_Ryad/mpa/micro/internals/ice4_slow.F90
+++ b/src/common/micro/mode_ice4_slow.F90
@@ -1,8 +1,15 @@
+!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_SLOW
+IMPLICIT NONE
+CONTAINS
SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT, &
&PLBDAS, PLBDAG, &
- &PAI, PCJ, &
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
!!
@@ -23,9 +30,11 @@ SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR
+USE MODD_CST, ONLY: XTT
+USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT, XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA3, XBCRIAUTI, XBETA3, &
+ & XCOLEXIS, XCRIAUTI, XEX0DEPG, XEX0DEPS, XEX1DEPG, XEX1DEPS, XEXIAGGS, &
+ & XFIAGGS, XHON, XTEXAUTI, XTIMAUTI
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -50,6 +59,8 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -64,11 +75,10 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(KSIZE) :: ZCRIAUTI
-REAL :: ZTIMAUTIC
+REAL, DIMENSION(KSIZE) :: ZCRIAUTI, ZMASK
+REAL :: ZTIMAUTIC
+INTEGER :: JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-REAL, DIMENSION(KSIZE) :: ZMASK
-INTEGER :: JL
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_SLOW', 0, ZHOOK_HANDLE)
@@ -90,8 +100,13 @@ IF(LDSOFT) THEN
ELSE
PRCHONI(:) = 0.
WHERE(ZMASK(:)==1.)
+#ifdef REPRO48
PRCHONI(:) = XHON*PRHODREF(:)*PRCT(:) &
*EXP( XALPHA3*(PT(:)-XTT)-XBETA3 )
+#else
+ PRCHONI(:) = MIN(1000.,XHON*PRHODREF(:)*PRCT(:) &
+ *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ))
+#endif
ENDWHERE
ENDIF
!
@@ -152,7 +167,8 @@ ENDIF
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PHLI_HRI(JL))) * & ! PHLI_HRI(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PHLI_HCF(JL))) * & ! PHLI_HCF(:) .GT. 0.
&PCOMPUTE(JL)
ENDDO
IF(LDSOFT) THEN
@@ -165,7 +181,8 @@ ELSE
ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
WHERE(ZMASK(:)==1.)
PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) &
- * MAX( PRIT(:)-ZCRIAUTI(:),0.0 )
+ * MAX( PHLI_HRI(:)/PHLI_HCF(:)-ZCRIAUTI(:),0.0 )
+ PRIAUTS(:) = PHLI_HCF(:)*PRIAUTS(:)
END WHERE
ENDIF
!
@@ -207,3 +224,4 @@ ENDDO
IF (LHOOK) CALL DR_HOOK('ICE4_SLOW', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_SLOW
+END MODULE MODE_ICE4_SLOW
diff --git a/src/arome/modset_Ryad/mpa/micro/internals/ice4_warm.F90 b/src/common/micro/mode_ice4_warm.F90
similarity index 89%
rename from src/arome/modset_Ryad/mpa/micro/internals/ice4_warm.F90
rename to src/common/micro/mode_ice4_warm.F90
index 05a6f687833cb25448e9ea65e5c027740dbe8c4a..8c844f09292f070d1fa220b6c3df93268549b5bc 100644
--- a/src/arome/modset_Ryad/mpa/micro/internals/ice4_warm.F90
+++ b/src/common/micro/mode_ice4_warm.F90
@@ -1,3 +1,11 @@
+!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_WARM
+IMPLICIT NONE
+CONTAINS
SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
&PRHODREF, PLVFACT, PT, PPRES, PTHT, &
&PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
@@ -24,9 +32,11 @@ SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM
-USE MODD_RAIN_ICE_DESCR
+USE MODD_CST, ONLY: XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT, XEPSILO
+USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT, XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: X0EVAR, X1EVAR, XCRIAUTC, XEX0EVAR, XEX1EVAR, XEXCACCR, XFCACCR, XTIMAUTC
+!
+USE MODE_MSG
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -37,8 +47,8 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
-CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
@@ -71,7 +81,6 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
REAL, DIMENSION(KSIZE) :: ZZW2, ZZW3, ZZW4
REAL, DIMENSION(KSIZE) :: ZUSW ! Undersaturation over water
REAL, DIMENSION(KSIZE) :: ZTHLT ! Liquid potential temperature
-REAL :: ZTIMAUTIC
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL, DIMENSION(KSIZE) :: ZMASK, ZMASK1, ZMASK2
INTEGER :: JL
@@ -86,7 +95,11 @@ IF (LHOOK) CALL DR_HOOK('ICE4_WARM', 0, ZHOOK_HANDLE)
!
DO JL=1, KSIZE
ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+#ifdef REPRO48
&MAX(0., -SIGN(1., -PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
+#else
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 1.E-20
+#endif
&PCOMPUTE(JL)
ENDDO
IF(LDSOFT) THEN
@@ -138,10 +151,18 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
&PCOMPUTE(JL)
ZMASK1(JL)=ZMASK(JL) * &
&MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+#ifdef REPRO48
&MAX(0., -SIGN(1., -PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
+#else
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) ! PHLC_HCF(:)>1.E-20
+#endif
ZMASK2(JL)=ZMASK(JL) * &
&MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
+#ifdef REPRO48
&MAX(0., -SIGN(1., -PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
+#else
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_LCF(JL))) ! PHLC_LCF(:)>1.E-20
+#endif
ENDDO
IF(LDSOFT) THEN
DO JL=1, KSIZE
@@ -165,9 +186,7 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
END WHERE
ENDIF
ELSE
- !wrong HSUBG_RC_RR_ACCR case
- CALL ABORT
- STOP 'wrong HSUBG_RC_RR_ACCR case'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RC_RR_ACCR case')
ENDIF
!
!* 4.4 compute the evaporation of r_r: RREVAV
@@ -252,9 +271,7 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
ENDIF
ELSE
- !wrong HSUBG_RR_EVAP case
- CALL ABORT
- STOP 'wrong HSUBG_RR_EVAP case'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RR_EVAP case')
END IF
!
DO JL=1, KSIZE
@@ -270,5 +287,6 @@ DO JL=1, KSIZE
ENDDO
!
IF (LHOOK) CALL DR_HOOK('ICE4_WARM', 1, ZHOOK_HANDLE)
-
+!
END SUBROUTINE ICE4_WARM
+END MODULE MODE_ICE4_WARM
diff --git a/src/mesonh/micro/ice4_fast_rg.f90 b/src/mesonh/micro/ice4_fast_rg.f90
deleted file mode 100644
index b84dda857e7a679561f062eabbe0570f7fc22408..0000000000000000000000000000000000000000
--- 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_rh.f90 b/src/mesonh/micro/ice4_fast_rh.f90
deleted file mode 100644
index fcac937485414ba29fd691cb0774a32cb3ea4a3c..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/ice4_fast_rh.f90
+++ /dev/null
@@ -1,593 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-MODULE MODI_ICE4_FAST_RH
-INTERFACE
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-END SUBROUTINE ICE4_FAST_RH
-END INTERFACE
-END MODULE MODI_ICE4_FAST_RH
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
- &PRHODREF, PLVFACT, PLSFACT, PPRES, &
- &PDV, PKA, PCJ, &
- &PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
- &PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- &PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
- &PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
- &PRH_TEND, &
- &PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the fast rh process
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
-USE MODD_PARAM_ICE, ONLY: LCONVHG,LEVLIMIT,LNULLWETH,LWETHPOST
-USE MODD_RAIN_ICE_DESCR, ONLY: XBG,XBS,XCEXVT,XCXG,XCXH,XCXS,XDH,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG,NWETLBDAH,NWETLBDAR,NWETLBDAS,X0DEPH,X1DEPH,XCOLEXGH,XCOLEXIH,XCOLGH,XCOLIH,XCOLEXSH, &
- XCOLSH,XEX0DEPH,XEX1DEPH,XFGWETH,XFRWETH,XFSWETH,XFWETH,XKER_GWETH,XKER_RWETH,XKER_SWETH, &
- XLBGWETH1,XLBGWETH2,XLBGWETH3,XLBRWETH1,XLBRWETH2,XLBRWETH3,XLBSWETH1,XLBSWETH2,XLBSWETH3, &
- XWETINTP1G,XWETINTP1H,XWETINTP1R,XWETINTP1S,XWETINTP2G,XWETINTP2H,XWETINTP2R,XWETINTP2S
-!
-USE MODE_MPPDB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the rain distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAH ! Slope parameter of the hail distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRRT ! Rain m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRWETH ! Dry growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRCDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
-!
-!* 0.2 declaration of local variables
-!
-INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
- & IFREEZ1=9, IFREEZ2=10
-!
-LOGICAL, DIMENSION(KSIZE) :: GWET
-REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
-INTEGER :: IHAIL, IGWET
-INTEGER, DIMENSION(KSIZE) :: I1
-REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
-REAL, DIMENSION(KSIZE) :: ZZW, &
- ZRDRYH_INIT, ZRWETH_INIT, &
- ZRDRYHG
-INTEGER :: JJ, JL
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 7.2 compute the Wet and Dry growth of hail
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRCWETH)=ZMASK(JL) * PRH_TEND(JL, IRCWETH)
- ENDDO
-ELSE
- PRH_TEND(:, IRCWETH)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRIWETH)=ZMASK(JL) * PRH_TEND(JL, IRIWETH)
- PRH_TEND(JL, IRIDRYH)=ZMASK(JL) * PRH_TEND(JL, IRIDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRIWETH)=0.
- PRH_TEND(:, IRIDRYH)=0.
- WHERE(ZMASK(:)==1.)
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH
- PRH_TEND(:, IRIDRYH)=PRH_TEND(:, IRIWETH)*(XCOLIH*EXP(XCOLEXIH*(PT(:)-XTT))) ! RIDRYH
- END WHERE
-ENDIF
-
-!
-!* 7.2.1 accretion of aggregates on the hailstones
-!
-IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
- ELSE
- GWET(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRSWETH)=ZWET(JL) * PRH_TEND(JL, IRSWETH)
- PRH_TEND(JL, IRSDRYH)=ZWET(JL) * PRH_TEND(JL, IRSDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRSWETH)=0.
- PRH_TEND(:, IRSDRYH)=0.
- IF(IGWET>0)THEN
- !
- !* 7.2.3 select the (PLBDAH,PLBDAS) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAS(I1(JJ))
- END DO
- !
- !* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
- ! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
- ! tabulate the SWETH-kernel
- !
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
- !
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
- XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
- !
- !* 7.2.5 perform the bilinear interpolation of the normalized
- ! SWETH-kernel
- !
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRSWETH)=XFSWETH*ZZW(:) & ! RSWETH
- *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSWETH1/( PLBDAH(:)**2 ) + &
- XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + &
- XLBSWETH3/( PLBDAS(:)**2) )
- PRH_TEND(:, IRSDRYH)=PRH_TEND(:, IRSWETH)*(XCOLSH*EXP(XCOLEXSH*(PT(:)-XTT)))
- END WHERE
- ENDIF
-ENDIF
-!
-!* 7.2.6 accretion of graupeln on the hailstones
-!
-IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
- ELSE
- GWET(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRGWETH)=ZWET(JL) * PRH_TEND(JL, IRGWETH)
- PRH_TEND(JL, IRGDRYH)=ZWET(JL) * PRH_TEND(JL, IRGDRYH)
- ENDDO
-ELSE
- PRH_TEND(:, IRGWETH)=0.
- PRH_TEND(:, IRGDRYH)=0.
- IF(IGWET>0)THEN
- !
- !* 7.2.8 select the (PLBDAH,PLBDAG) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAG(I1(JJ))
- END DO
- !
- !* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
- ! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
- ! tabulate the GWETH-kernel
- !
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
- !
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
- XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
- !
- !* 7.2.10 perform the bilinear interpolation of the normalized
- ! GWETH-kernel
- !
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRGWETH)=XFGWETH*ZZW(:) & ! RGWETH
- *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBGWETH1/( PLBDAH(:)**2 ) + &
- XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + &
- XLBGWETH3/( PLBDAG(:)**2) )
- PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH)
- END WHERE
- !When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same
- WHERE(GWET(:) .AND. .NOT. PWETG(:)==1.)
- PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT)))
- END WHERE
- END IF
-ENDIF
-!
-!* 7.2.11 accretion of raindrops on the hailstones
-!
-IGWET = 0
-DO JJ = 1, SIZE(GWET)
- ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
- &PCOMPUTE(JJ)
- IF (ZWET(JJ)>0) THEN
- IGWET = IGWET + 1
- I1(IGWET) = JJ
- GWET(JJ) = .TRUE.
- ELSE
- GWET(JJ) = .FALSE.
- END IF
-END DO
-
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IRRWETH)=ZWET(JL) * PRH_TEND(JL, IRRWETH)
- ENDDO
-ELSE
- PRH_TEND(:, IRRWETH)=0.
- IF(IGWET>0)THEN
- !
- !* 7.2.12 select the (PLBDAH,PLBDAR) couplet
- !
- DO JJ = 1, IGWET
- ZVEC1(JJ) = PLBDAH(I1(JJ))
- ZVEC2(JJ) = PLBDAR(I1(JJ))
- END DO
- !
- !* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
- ! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
- ! tabulate the RWETH-kernel
- !
- ZVEC1(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
- XWETINTP1H*LOG(ZVEC1(1:IGWET))+XWETINTP2H))
- IVEC1(1:IGWET)=INT(ZVEC1(1:IGWET))
- ZVEC1(1:IGWET)=ZVEC1(1:IGWET)-REAL(IVEC1(1:IGWET))
- !
- ZVEC2(1:IGWET)=MAX(1.00001, MIN( REAL(NWETLBDAR)-0.00001, &
- XWETINTP1R*LOG(ZVEC2(1:IGWET))+XWETINTP2R))
- IVEC2(1:IGWET)=INT(ZVEC2(1:IGWET))
- ZVEC2(1:IGWET)=ZVEC2(1:IGWET)-REAL(IVEC2(1:IGWET))
- !
- !* 7.2.14 perform the bilinear interpolation of the normalized
- ! RWETH-kernel
- !
- DO JJ=1, IGWET
- ZVEC3(JJ)= ( XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- *(ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = 0.
- DO JJ = 1, IGWET
- ZZW(I1(JJ)) = ZVEC3(JJ)
- END DO
- !
- WHERE(GWET(:))
- PRH_TEND(:, IRRWETH) = XFRWETH*ZZW(:) & ! RRWETH
- *( PLBDAR(:)**(-4) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRWETH1/( PLBDAH(:)**2 ) + &
- XLBRWETH2/( PLBDAH(:) * PLBDAR(:) ) + &
- XLBRWETH3/( PLBDAR(:)**2) )
- END WHERE
- ENDIF
-ENDIF
-!
-DO JL=1, KSIZE
- ZRDRYH_INIT(JL)=PRH_TEND(JL, IRCWETH)+PRH_TEND(JL, IRIDRYH)+ &
- &PRH_TEND(JL, IRSDRYH)+PRH_TEND(JL, IRRWETH)+PRH_TEND(JL, IRGDRYH)
-ENDDO
-!
-!* 7.3 compute the Wet growth of hail
-!
-DO JL=1, KSIZE
- ZHAIL(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRH_TEND(JL, IFREEZ1)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ1)
- PRH_TEND(JL, IFREEZ2)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ2)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZHAIL(:)==1.)
- PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
- END WHERE
- ENDIF
- PRH_TEND(:, IFREEZ2)=0.
- WHERE(ZHAIL(:)==1.)
- PRH_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-PRH_TEND(:, IFREEZ1))/(XRV*PT(:)) )
- PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH )/ &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- PRH_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- !We must agregate, at least, the cold species
- ZRWETH_INIT(JL)=ZHAIL(JL) * MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
- &MAX(0., PRH_TEND(JL, IFREEZ1) + &
- &PRH_TEND(JL, IFREEZ2) * ( &
- &PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH) )))
-ENDDO
-!
-!* 7.4 Select Wet or Dry case
-!
-!Wet case
-DO JL=1, KSIZE
- ZWETH(JL) = ZHAIL(JL) * &
- & MAX(0., SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH)) - &
- &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))))
-ENDDO
-IF(LNULLWETH) THEN
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) ! WHERE(ZRDRYH_INIT(:)>0.)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRWETH_INIT(JL))) ! WHERE(ZRWETH_INIT(:)>0.)
- ENDDO
-ENDIF
-IF(.NOT. LWETHPOST) THEN
- DO JL=1, KSIZE
- ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
- ENDDO
-ENDIF
-DO JL=1, KSIZE
- ZDRYH(JL) = ZHAIL(JL) * &
- & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
- & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
- & MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
- &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
-ENDDO
-!
-ZRDRYHG(:)=0.
-IF(LCONVHG)THEN
- WHERE(ZDRYH(:)==1.)
- ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:))
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PRCWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRCWETH)
- PRIWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRIWETH)
- PRSWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRSWETH)
- PRGWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRGWETH)
- !Collected minus aggregated
- PRRWETH(JL) = ZWETH(JL) * (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
- PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
- PRH_TEND(JL, IRCWETH))
-
- PRCDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRCWETH)
- PRIDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRIDRYH)
- PRSDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRSDRYH)
- PRRDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRRWETH)
- PRGDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRGDRYH)
- PRDRYHG(JL) = ZDRYH(JL) * ZRDRYHG(JL)
-
- PA_RC(JL) = PA_RC(JL) - PRCWETH(JL)
- PA_RI(JL) = PA_RI(JL) - PRIWETH(JL)
- PA_RS(JL) = PA_RS(JL) - PRSWETH(JL)
- PA_RG(JL) = PA_RG(JL) - PRGWETH(JL)
- PA_RH(JL) = PA_RH(JL) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
- PA_RR(JL) = PA_RR(JL) - PRRWETH(JL)
- PA_TH(JL) = PA_TH(JL) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
- PA_RC(JL) = PA_RC(JL) - PRCDRYH(JL)
- PA_RI(JL) = PA_RI(JL) - PRIDRYH(JL)
- PA_RS(JL) = PA_RS(JL) - PRSDRYH(JL)
- PA_RR(JL) = PA_RR(JL) - PRRDRYH(JL)
- PA_RG(JL) = PA_RG(JL) - PRGDRYH(JL) + PRDRYHG(JL)
- PA_RH(JL) = PA_RH(JL) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
- &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
- PA_TH(JL) = PA_TH(JL) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!* 7.5 Melting of the hailstones
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
- &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRHMLTR(JL)=ZMASK(JL)*PRHMLTR(JL)
- ENDDO
-ELSE
- DO JL=1, KSIZE
- PRHMLTR(JL) = ZMASK(JL)* PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
- ENDDO
- IF(LEVLIMIT) THEN
- WHERE(ZMASK(:)==1.)
- PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
- END WHERE
- ENDIF
- DO JL=1, KSIZE
- PRHMLTR(JL) = ZMASK(JL)* (PKA(JL)*(XTT-PT(JL)) + &
- ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
- *(XESTT-PRHMLTR(JL))/(XRV*PT(JL)) ))
- ENDDO
- WHERE(ZMASK(:)==1.)
- !
- ! compute RHMLTR
- !
- PRHMLTR(:) = MAX( 0.0,( -PRHMLTR(:) * &
- ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - &
- ( PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRRWETH) )* &
- ( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) )
- END WHERE
-END IF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) + PRHMLTR(JL)
- PA_RH(JL) = PA_RH(JL) - PRHMLTR(JL)
- PA_TH(JL) = PA_TH(JL) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!
-END SUBROUTINE ICE4_FAST_RH
diff --git a/src/mesonh/micro/ice4_fast_rs.f90 b/src/mesonh/micro/ice4_fast_rs.f90
deleted file mode 100644
index 6d71c7b61b8188969aa488a3b22d65ad15d7cc26..0000000000000000000000000000000000000000
--- 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
diff --git a/src/mesonh/micro/ice4_slow.f90 b/src/mesonh/micro/ice4_slow.f90
deleted file mode 100644
index 15d0cd78e495cb255015fb6ed29fbfdb5361c748..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/ice4_slow.f90
+++ /dev/null
@@ -1,263 +0,0 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-MODULE MODI_ICE4_SLOW
-INTERFACE
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT,&
- &PSSI, PLVFACT, PLSFACT, &
- &PRVT, PRCT, PRIT, PRST, PRGT,&
- &PLBDAS, PLBDAG,&
- &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-END SUBROUTINE ICE4_SLOW
-END INTERFACE
-END MODULE MODI_ICE4_SLOW
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
- &PSSI, PLVFACT, PLSFACT, &
- &PRVT, PRCT, PRIT, PRST, PRGT, &
- &PLBDAS, PLBDAG, &
- &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
- &PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
- &PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the slow process
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XTT
-USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPG,X0DEPS,X1DEPG,X1DEPS,XACRIAUTI,XALPHA3,XBCRIAUTI,XBETA3,XCOLEXIS,XCRIAUTI, &
- XEX0DEPG,XEX0DEPS,XEX1DEPG,XEX1DEPS,XEXIAGGS,XFIAGGS,XHON,XTEXAUTI,XTIMAUTI
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAUTS ! Autoconversion of r_i for r_s production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPG ! Deposition on r_g
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
-!
-!* 0.2 declaration of local variables
-!
-REAL, DIMENSION(KSIZE) :: ZCRIAUTI, ZMASK
-REAL :: ZTIMAUTIC
-INTEGER :: JL
-!-------------------------------------------------------------------------------
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3.2 compute the homogeneous nucleation source: RCHONI
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
- &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCHONI(JL) = PRCHONI(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRCHONI(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCHONI(:) = MIN(1000.,XHON*PRHODREF(:)*PRCT(:) &
- *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ))
- ENDWHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RI(JL) = PA_RI(JL) + PRCHONI(JL)
- PA_RC(JL) = PA_RC(JL) - PRCHONI(JL)
- PA_TH(JL) = PA_TH(JL) + PRCHONI(JL)*(PLSFACT(JL)-PLVFACT(JL))
-ENDDO
-!
-!* 3.4 compute the deposition, aggregation and autoconversion sources
-!
-!
-!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
-!
-! ZZW(:) = 0.0
-! ZTIMAUTIC = SQRT( XTIMAUTI*XTIMAUTC )
-! WHERE ( (PRCT(:)>0.0) .AND. (PRIT(:)>0.0) .AND. (PRCS(:)>0.0) )
-! ZZW(:) = MIN( PRCS(:),ZTIMAUTIC * MAX( SQRT( PRIT(:)*PRCT(:) ),0.0 ) )
-! PRIS(:) = PRIS(:) + ZZW(:)
-! PRCS(:) = PRCS(:) - ZZW(:)
-! PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCAUTI))
-! END WHERE
-!
-!* 3.4.3 compute the deposition on r_s: RVDEPS
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & !PRVT(:)>XRTMIN(1)
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !PRST(:)>XRTMIN(5)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRVDEPS(JL)=PRVDEPS(JL)*ZMASK(JL)
- ENDDO
-ELSE
- PRVDEPS(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRVDEPS(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
- ( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRVDEPS(JL)
- PA_RV(JL) = PA_RV(JL) - PRVDEPS(JL)
- PA_TH(JL) = PA_TH(JL) + PRVDEPS(JL)*PLSFACT(JL)
-ENDDO
-!
-!* 3.4.4 compute the aggregation on r_s: RIAGGS
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
- &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! PRST(:)>XRTMIN(5)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRIAGGS(JL)=PRIAGGS(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRIAGGS(:) = 0.
- WHERE(ZMASK(:)==1)
- PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
- * PRIT(:) &
- * PLBDAS(:)**XEXIAGGS &
- * PRHODREF(:)**(-XCEXVT)
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRIAGGS(JL)
- PA_RI(JL) = PA_RI(JL) - PRIAGGS(JL)
-ENDDO
-!
-!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PHLI_HRI(JL))) * & ! PHLI_HRI(:)>XRTMIN(4)
- &MAX(0., -SIGN(1., 1.E-20-PHLI_HCF(JL))) * & ! PHLI_HCF(:) .GT. 0.
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRIAUTS(JL) = PRIAUTS(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRIAUTS(:) = 0.
- !ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PT(:)-XTT)-3.5))
- ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
- WHERE(ZMASK(:)==1.)
- PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) &
- * MAX( PHLI_HRI(:)/PHLI_HCF(:)-ZCRIAUTI(:),0.0 )
- PRIAUTS(:) = PHLI_HCF(:)*PRIAUTS(:)
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RS(JL) = PA_RS(JL) + PRIAUTS(JL)
- PA_RI(JL) = PA_RI(JL) - PRIAUTS(JL)
-ENDDO
-!
-!* 3.4.6 compute the deposition on r_g: RVDEPG
-!
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & ! PRVT(:)>XRTMIN(1)
- &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! PRGT(:)>XRTMIN(6)
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRVDEPG(JL) = PRVDEPG(JL) * ZMASK(JL)
- ENDDO
-ELSE
- PRVDEPG(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRVDEPG(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
- ( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RG(JL) = PA_RG(JL) + PRVDEPG(JL)
- PA_RV(JL) = PA_RV(JL) - PRVDEPG(JL)
- PA_TH(JL) = PA_TH(JL) + PRVDEPG(JL)*PLSFACT(JL)
-ENDDO
-!
-!
-END SUBROUTINE ICE4_SLOW
diff --git a/src/mesonh/micro/ice4_warm.f90 b/src/mesonh/micro/ice4_warm.f90
deleted file mode 100644
index aa61b1dac3ee676c3ec2ecca6d2af30c1ec9b8a5..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/ice4_warm.f90
+++ /dev/null
@@ -1,316 +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_WARM
-INTERFACE
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- PRHODREF, PLVFACT, PT, PPRES, PTHT, &
- PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
- PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- PCF, PRF, &
- PRVT, PRCT, PRRT, &
- PRCAUTR, PRCACCR, PRREVAV, &
- PA_TH, PA_RV, PA_RC, PA_RR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction
-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(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
-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_RR
-END SUBROUTINE ICE4_WARM
-END INTERFACE
-END MODULE MODI_ICE4_WARM
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
- PRHODREF, PLVFACT, PT, PPRES, PTHT, &
- PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
- PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
- PCF, PRF, &
- PRVT, PRCT, PRRT, &
- PRCAUTR, PRCACCR, PRREVAV, &
- PA_TH, PA_RV, PA_RC, PA_RR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the warm process
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the plitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
-USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: X0EVAR,X1EVAR,XCRIAUTC,XEX0EVAR,XEX1EVAR,XEXCACCR,XFCACCR,XTIMAUTC
-!
-USE MODE_MSG
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
-CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR ! Slope parameter of the raindrop distribution
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAR_RF!like PLBDAR but for the Rain Fraction part
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PKA ! Thermal conductivity of the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRF ! Rain fraction
-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(INOUT) :: PRCAUTR ! Autoconversion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCACCR ! Accretion of r_c for r_r production
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRREVAV ! Evaporation of r_r
-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_RR
-!
-!* 0.2 declaration of local variables
-!
-REAL, DIMENSION(KSIZE) :: ZZW2, ZZW3, ZZW4
-REAL, DIMENSION(KSIZE) :: ZUSW ! Undersaturation over water
-REAL, DIMENSION(KSIZE) :: ZTHLT ! Liquid potential temperature
-REAL, DIMENSION(KSIZE) :: ZMASK, ZMASK1, ZMASK2
-INTEGER :: JL
-!-------------------------------------------------------------------------------
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
-!
-DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
- &PCOMPUTE(JL)
-ENDDO
-IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCAUTR(JL)=PRCAUTR(JL)*ZMASK(JL)
- ENDDO
-ELSE
- PRCAUTR(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCAUTR(:) = XTIMAUTC*MAX(PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:), 0.0)
- PRCAUTR(:) = PHLC_HCF(:)*PRCAUTR(:)
- END WHERE
-ENDIF
-DO JL=1, KSIZE
- PA_RC(JL) = PA_RC(JL) - PRCAUTR(JL)
- PA_RR(JL) = PA_RR(JL) + PRCAUTR(JL)
-ENDDO
-!
-!
-!* 4.3 compute the accretion of r_c for r_r production: RCACCR
-!
-IF (HSUBG_RC_RR_ACCR=='NONE') THEN
- !CLoud water and rain are diluted over the grid box
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
- ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCACCR(JL)=PRCACCR(JL) * ZMASK(JL)
- ENDDO
- ELSE
- PRCACCR(:) = 0.
- WHERE(ZMASK(:)==1.)
- PRCACCR(:) = XFCACCR * PRCT(:) &
- * PLBDAR(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT)
- END WHERE
- ENDIF
-
-ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
- !Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion
- !Rain is concnetrated over its fraction
- !Rain in high content area fraction: PHLC_HCF
- !Rain in low content area fraction:
- ! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
- ! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
- ! => min(PCF, PRF)-PHLC_HCF
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &PCOMPUTE(JL)
- ZMASK1(JL)=ZMASK(JL) * &
- &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
- ZMASK2(JL)=ZMASK(JL) * &
- &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
- &MAX(0., -SIGN(1., 1.E-20-PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
- ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRCACCR(JL)=PRCACCR(JL) * MIN(1., ZMASK1(JL)+ZMASK2(JL))
- ENDDO
- ELSE
- PRCACCR(:)=0.
- WHERE(ZMASK1(:)==1.)
- !Accretion due to rain falling in high cloud content
- PRCACCR(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
- * PLBDAR_RF(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT) &
- * PHLC_HCF
- END WHERE
- WHERE(ZMASK2(:)==1.)
- !We add acrretion due to rain falling in low cloud content
- PRCACCR(:) = PRCACCR(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
- * PLBDAR_RF(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT) &
- * (MIN(PCF(:), PRF(:))-PHLC_HCF(:))
- END WHERE
- ENDIF
-ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RC_RR_ACCR case')
-ENDIF
-DO JL=1, KSIZE
- PA_RC(JL) = PA_RC(JL) - PRCACCR(JL)
- PA_RR(JL) = PA_RR(JL) + PRCACCR(JL)
-ENDDO
-!
-!* 4.4 compute the evaporation of r_r: RREVAV
-!
-IF (HSUBG_RR_EVAP=='NONE') THEN
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &MAX(0., SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)<=XRTMIN(2)
- &PCOMPUTE(JL)
- ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
- ENDDO
- ELSE
- PRREVAV(:) = 0.
- !Evaporation only when there's no cloud (RC must be 0)
- WHERE(ZMASK(:)==1.)
- PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
- ! Undersaturation over water
- PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) &
- + ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
- PRREVAV(:) = ( MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) ) * &
- ( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR )
- END WHERE
- ENDIF
-
-ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
- !Evaporation in clear sky part
- !With CLFR, rain is diluted over the grid box
- !With PRFR, rain is concentrated in its fraction
- !Use temperature and humidity in clear sky part like Bechtold et al. (1993)
- IF (HSUBG_RR_EVAP=='CLFR') THEN
- ZZW4(:)=1. !Precipitation fraction
- ZZW3(:)=PLBDAR(:)
- ELSE
- ZZW4(:)=PRF(:) !Precipitation fraction
- ZZW3(:)=PLBDAR_RF(:)
- ENDIF
-
- !ATTENTION
- !Il faudrait recalculer les variables PKA, PDV, PCJ en tenant compte de la température T^u
- !Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
- !et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
- !On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
- DO JL=1, KSIZE
- ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
- &MAX(0., -SIGN(1., PCF(JL)-ZZW4(JL))) * & ! ZZW4(:) > PCF(:)
- &PCOMPUTE(JL)
- ENDDO
- IF(LDSOFT) THEN
- DO JL=1, KSIZE
- PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
- ENDDO
- ELSE
- PRREVAV(:) = 0.
- WHERE(ZMASK(:)==1)
- ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
- ! Bechtold et al. 1993
- !
- ! T_l
- ZTHLT(:) = PTHT(:) - XLVTT*PTHT(:)/XCPD/PT(:)*PRCT(:)
- !
- ! T^u = T_l = theta_l * (T/theta)
- ZZW2(:) = ZTHLT(:) * PT(:) / PTHT(:)
- !
- ! es_w with new T^u
- PRREVAV(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
- !
- ! S, Undersaturation over water (with new theta^u)
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
- !
- PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
- + ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) )
- !
- PRREVAV(:) = MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) * &
- ( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR )
- !
- PRREVAV(:) = PRREVAV(:)*(ZZW4(:)-PCF(:))
- END WHERE
- ENDIF
-
-ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RR_EVAP case')
-END IF
-DO JL=1, KSIZE
- PA_RR(JL) = PA_RR(JL) - PRREVAV(JL)
- PA_RV(JL) = PA_RV(JL) + PRREVAV(JL)
- PA_TH(JL) = PA_TH(JL) - PRREVAV(JL)*PLVFACT(JL)
-ENDDO
-!
-!
-END SUBROUTINE ICE4_WARM