diff --git a/docs/TODO b/docs/TODO
index 554b8b70b9d34c97b6939622e2276ad8c6bd1c89..02d50d4cc3829797d16c16f4493add307bfc8432 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -22,7 +22,16 @@ Merge pb:
Ryad doit faire des tests pour regarder impact des allaocatble sur CPU.
si test OK, on passe en alloacatble
si test KO, arbitrage entre Philippe et Riad
+- ice4_sedimentation_*:
+ Philippe a déclaré PINPRC et PINDEP en (:,:) à la place de (KIT,KJT)
+ En commentaire (version split), il met "dimensions of PINPRC and PINDEP not necessarily KIT,KJT"
+ Comprendre pourquoi, comment ça peut marcher dans la sédimentation
+ Code dans common en (KIT,KJT)
+ repasser code en (:,:) si besoin, ou passer en arg les dimensions effectives
+ ou modifier MNH pour toujours avoir KIT,KJT
+ une partie du code est maintentant dans rain_ice (déposition)
Etape 2: array syntax -> loop
- en profiter pour supprimer args PA/PB des routines appelées depuis ice4_tendencies, comme pour nucleation
- si possible, modifier ice4_sedimentation_split* dans le même esprit que stat
+- transformer sedimentation_split_momentum comme sedimentation_split
diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files
index af931924e666f45f5bedc8ebe931c3b30bb8ccdd..45075fc85384251ba29db7e9f0da0200986082cd 100644
--- a/src/arome/gmkpack_ignored_files
+++ b/src/arome/gmkpack_ignored_files
@@ -46,3 +46,7 @@ phyex/micro/ice4_nucleation.F90
phyex/micro/modi_ice4_nucleation.F90
phyex/micro/ice4_nucleation_wrapper.F90
phyex/micro/modi_ice4_nucleation_wrapper.F90
+phyex/micro/ice4_sedimentation_stat.F90
+phyex/micro/modi_ice4_sedimentation_split.F90
+phyex/micro/ice4_sedimentation_split.F90
+phyex/micro/modi_ice4_sedimentation_stat.F90
diff --git a/src/arome/micro/ice4_sedimentation_split.F90 b/src/arome/micro/ice4_sedimentation_split.F90
deleted file mode 100644
index b4b1c15f878d1b4179717433107b386709f42cc2..0000000000000000000000000000000000000000
--- a/src/arome/micro/ice4_sedimentation_split.F90
+++ /dev/null
@@ -1,488 +0,0 @@
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, PINPRH, PRHT, PRHS, PFPR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the sedimentation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the plitting of rain_ice source code (nov. 2014)
-!! and modified for optimisation
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
-USE MODD_PARAM_ICE
-USE MODI_GAMMA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(KIT, KJT, KKT) &
- :: GSEDIM ! Test where to compute the SED processes
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-
-REAL, DIMENSION(KIT, KJT, KKT) :: ZCONC3D, & ! droplet condensation
- & ZRAY, & ! Cloud Mean radius
- & ZLBC, & ! XLBC weighted by sea fraction
- & ZFSEDC, &
- & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
- & ZW, & ! work array
- & ZRCT, &
- & ZRRT, &
- & ZRIT, &
- & ZRST, &
- & ZRGT, &
- & ZRHT
-REAL, DIMENSION(KIT, KJT,0:KKT+1) :: ZWSED ! sedimentation fluxes
-REAL, DIMENSION(KIT, KJT) :: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(KIT, KJT) :: ZREMAINT ! Remaining time until the timestep end
-REAL :: ZINVTSTEP
-INTEGER :: ISEDIM ! ! Case number of sedimentation
-INTEGER :: JK
-REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 0, ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-!
-! O. Initialization of for sedimentation
-!
-ZINVTSTEP=1./PTSTEP
-ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP
-IF (OSEDIC) PINPRC (:,:) = 0.
-PINPRR (:,:) = 0.
-PINPRI (:,:) = 0.
-PINPRS (:,:) = 0.
-PINPRG (:,:) = 0.
-IF ( KRR == 7 ) PINPRH (:,:) = 0.
-IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
-!
-!* 1. Parameters for cloud sedimentation
-!
-IF (OSEDIC) THEN
- IF(PRESENT(PSEA) .AND. PRESENT(PTOWN)) THEN
- ZRAY(:,:,:) = 0.
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
- DO JK=KKTB, KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
- ELSE
- ZLBC(:,:,:) = XLBC(1)
- ZFSEDC(:,:,:) = XFSEDC(1)
- ZCONC3D(:,:,:)= XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
- ENDIF
- ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
-ENDIF
-!
-!* 2. compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-! For optimization we consider each variable separately
-!
-! External tendecies
-IF (OSEDIC) ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP
-ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP
-IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP
-!
-! mr values inside the time-splitting loop
-ZRCT(:,:,:) = PRCT(:,:,:)
-ZRRT(:,:,:) = PRRT(:,:,:)
-ZRIT(:,:,:) = PRIT(:,:,:)
-ZRST(:,:,:) = PRST(:,:,:)
-ZRGT(:,:,:) = PRGT(:,:,:)
-IF (KRR==7) ZRHT(:,:,:) = PRHT(:,:,:)
-!
-DO JK = KKTB , KKTE
- ZW(:,:,JK) =1./(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
-END DO
-!
-!
-!* 2.1 for cloud
-!
-IF (OSEDIC) THEN
- ZREMAINT(:,:) = PTSTEP
- DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRCT(KIB:KIE,KJB:KJE,JK)>XRTMIN(2) .OR. &
- ZPRCS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(2)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &2, &
- &ZRCT, PRCS, ZWSED, PINPRC, ZPRCS, &
- &ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
- ENDDO
-ENDIF
-!
-!* 2.2 for rain
-!
-ZREMAINT(:,:) = PTSTEP
-DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRRT(KIB:KIE,KJB:KJE,JK)>XRTMIN(3) .OR. &
- ZPRRS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(3)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &3, &
- &ZRRT, PRRS, ZWSED, PINPRR, ZPRRS, &
- &PFPR=PFPR)
-ENDDO
-!
-!* 2.3 for pristine ice
-!
-ZREMAINT(:,:) = PTSTEP
-DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRIT(KIB:KIE,KJB:KJE,JK)>XRTMIN(4) .OR. &
- ZPRIS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(4)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &4, &
- &ZRIT, PRIS, ZWSED, PINPRI, ZPRIS, PFPR=PFPR)
-ENDDO
-!
-!* 2.4 for aggregates/snow
-!
-ZREMAINT(:,:) = PTSTEP
-DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRST(KIB:KIE,KJB:KJE,JK)>XRTMIN(5) .OR. &
- ZPRSS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(5)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &5, &
- &ZRST, PRSS, ZWSED, PINPRS, ZPRSS, PFPR=PFPR)
-ENDDO
-!
-!* 2.5 for graupeln
-!
-ZREMAINT(:,:) = PTSTEP
-DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRGT(KIB:KIE,KJB:KJE,JK)>XRTMIN(6) .OR. &
- ZPRGS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(6)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &6, &
- &ZRGT, PRGS, ZWSED, PINPRG, ZPRGS, PFPR=PFPR)
-ENDDO
-!
-!* 2.6 for hail
-!
-IF (KRR==7) THEN
- ZREMAINT(:,:) = PTSTEP
- DO WHILE (ANY(ZREMAINT>0.))
- GSEDIM(:,:,:)=.FALSE.
- DO JK = KKTB , KKTE
- GSEDIM(KIB:KIE,KJB:KJE,JK) = &
- (ZRHT(KIB:KIE,KJB:KJE,JK)>XRTMIN(7) .OR. &
- ZPRHS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(7)) .AND. &
- ZREMAINT(KIB:KIE,KJB:KJE)>0.
- ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
- &PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
- &7, &
- &ZRHT, PRHS, ZWSED, PINPRH, ZPRHS, PFPR=PFPR)
- END DO
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 1, ZHOOK_HANDLE)
-!
-CONTAINS
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
- &KSEDIM, LDSEDIM, I1, I2, I3, PMAXCFL, PREMAINT, &
- &PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PTSTEP, &
- &KSPE, &
- &PRXT, PRXS, PWSED, PINPRX, PPRXS, &
- &PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- USE MODD_RAIN_ICE_DESCR
- USE MODD_RAIN_ICE_PARAM
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of dummy arguments :
- !
- INTEGER, INTENT(IN) :: KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR
- INTEGER, INTENT(IN) :: KSEDIM
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDSEDIM
- INTEGER, DIMENSION(KSEDIM), INTENT(IN) :: I1, I2, I3
- REAL, INTENT(IN) :: PMAXCFL ! maximum CFL allowed
- REAL, DIMENSION(KIT,KJT), INTENT(INOUT) :: PREMAINT ! Time remaining until the end of the timestep
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! layer thikness (m)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
- REAL, INTENT(IN) :: PTSTEP ! total timestep
- INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXT ! mr of specy X
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
- REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux
- REAL, DIMENSION(KIT,KJT), INTENT(INOUT) :: PINPRX ! instant precip
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPRXS ! external tendencie
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
- REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(INOUT) :: PFPR ! upper-air precipitation fluxes
- !
- !* 0.2 declaration of local variables
- !
- !
- INTEGER :: JK, JL, JI, JJ
- REAL :: ZINVTSTEP
- REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
- REAL :: ZFSED, ZEXSED
- REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE
- REAL, DIMENSION(KIT, KJT) :: ZMAX_TSTEP ! Maximum CFL in column
- REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, ZHOOK_HANDLE)
- !
- !-------------------------------------------------------------------------------
- !
- !
- !* 1. Parameters for cloud sedimentation
- !
- !
- !* 2. compute the fluxes
- !
- !
- ZINVTSTEP = 1./PTSTEP
- ZRSMIN(:) = XRTMIN(:) * ZINVTSTEP
- IF(KSPE==2) THEN
- !******* for cloud
- PWSED(:,:,:) = 0.
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
- ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
- (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
- ZZWLBDC = ZZWLBDC**XLBEXC
- ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
- ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
- ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
- ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
- PWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * &
- ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
- ENDIF
- ENDDO
- ELSEIF(KSPE==4) THEN
- ! ******* for pristine ice
- PWSED(:,:,:) = 0.
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN
- PWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * &
- & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
- ENDIF
- ENDDO
- ELSE
- ! ******* for other species
- IF(KSPE==3) THEN
- ZFSED=XFSEDR
- ZEXSED=XEXSEDR
- ELSEIF(KSPE==5) THEN
- ZFSED=XFSEDS
- ZEXSED=XEXSEDS
- ELSEIF(KSPE==6) THEN
- ZFSED=XFSEDG
- ZEXSED=XEXSEDG
- ELSEIF(KSPE==7) THEN
- ZFSED=XFSEDH
- ZEXSED=XEXSEDH
- ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE
- CALL ABORT
- STOP
- ENDIF
- PWSED(:,:,:) = 0.
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
- PWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED * &
- PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
- ENDIF
- ENDDO
- ENDIF
- ZMAX_TSTEP(:,:) = PREMAINT(:,:)
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE) .AND. PWSED(JI, JJ, JK)>1.E-20) THEN
- ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PMAXCFL * PRHODREF(JI, JJ, JK) * &
- PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / PWSED(JI, JJ, JK))
- ENDIF
- ENDDO
- ZMRCHANGE(:,:) = 0.
- PREMAINT(:,:) = PREMAINT(:,:) - ZMAX_TSTEP(:,:)
- DO JK = KKTB , KKTE
- ZMRCHANGE(:,:) = ZMAX_TSTEP(:,:) * POORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))
- PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:) + PPRXS(:,:,JK) * ZMAX_TSTEP(:,:)
- PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTSTEP
- ENDDO
- PINPRX(:,:) = PINPRX(:,:) + ZWSED(:,:,KKB) / XRHOLW * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,KSPE) = PFPR(:,:,JK,KSPE) + ZWSED(:,:,JK) * (ZMAX_TSTEP(:,:) * ZINVTSTEP)
- ENDDO
- ENDIF
- !
- IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 1, ZHOOK_HANDLE)
- END SUBROUTINE INTERNAL_SEDIM_SPLI
- !
- FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- IMPLICIT NONE
- !
- !* 0.2 declaration of local variables
- !
- INTEGER, INTENT(IN) :: KIT,KJT,KKT,KSIZE
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
- INTEGER :: JI,JJ,JK,IC
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- !
- !-------------------------------------------------------------------------------
- !
- IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:ICE4_SEDIMENTATION_SPLIT_COUNTJV', 0, ZHOOK_HANDLE)
- IC = 0
- DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
- END DO
- !
- IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:ICE4_SEDIMENTATION_SPLIT_COUNTJV', 1, ZHOOK_HANDLE)
- END FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV
- !
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT
diff --git a/src/arome/micro/modi_ice4_sedimentation_split.F90 b/src/arome/micro/modi_ice4_sedimentation_split.F90
deleted file mode 100644
index 2bcea3b472f7c0fd96ccfd20fce5639e0d823a1a..0000000000000000000000000000000000000000
--- a/src/arome/micro/modi_ice4_sedimentation_split.F90
+++ /dev/null
@@ -1,44 +0,0 @@
-MODULE MODI_ICE4_SEDIMENTATION_SPLIT
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, PINPRH, PRHT, PRHS, PFPR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_SPLIT
diff --git a/src/arome/micro/modi_ice4_sedimentation_stat.F90 b/src/arome/micro/modi_ice4_sedimentation_stat.F90
deleted file mode 100644
index a6a4988a158df42174873897fbfcc64d57b4e076..0000000000000000000000000000000000000000
--- a/src/arome/micro/modi_ice4_sedimentation_stat.F90
+++ /dev/null
@@ -1,45 +0,0 @@
-MODULE MODI_ICE4_SEDIMENTATION_STAT
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT,&
- &PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, PINPRH, PRHT, PRHS, PFPR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_STAT
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_STAT
diff --git a/src/arome/micro/rain_ice.F90 b/src/arome/micro/rain_ice.F90
index 74496592a92b778164d80db44f8c4a59334d7d78..7b33f9f2a158a63c29309ec784d858feb50709be 100644
--- a/src/arome/micro/rain_ice.F90
+++ b/src/arome/micro/rain_ice.F90
@@ -164,8 +164,9 @@ USE MODD_BUDGET
USE MODD_LES
USE MODI_BUDGET
USE MODI_ICE4_RAINFR_VERT
-USE MODI_ICE4_SEDIMENTATION_STAT
-USE MODI_ICE4_SEDIMENTATION_SPLIT
+USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
+USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
+USE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM, ONLY: ICE4_SEDIMENTATION_SPLIT_MOMENTUM
USE MODE_ICE4_NUCLEATION_WRAPPER, ONLY: ICE4_NUCLEATION_WRAPPER
USE MODI_ICE4_TENDENCIES
USE DDH_MIX, ONLY : TYP_DDH
@@ -458,7 +459,6 @@ IF(.NOT. LSEDIM_AFTER) THEN
!* 2.1 sedimentation
!
IF(HSEDIM=='STAT') THEN
- !SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, &
@@ -483,11 +483,9 @@ IF(.NOT. LSEDIM_AFTER) THEN
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(HSEDIM=='SPLI') THEN
- !SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
@@ -495,8 +493,7 @@ IF(.NOT. LSEDIM_AFTER) THEN
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
@@ -524,6 +521,27 @@ IF(.NOT. LSEDIM_AFTER) THEN
CALL ABORT
STOP
END IF
+
+
+
+
+
+
+!!!!! ajouter momentum
+
+
+
+
+
+
+
+
+
+
+
+
+
+
!
!* 2.2 budget storage
!
@@ -1559,6 +1577,40 @@ IF (LDEPOSC) THEN !cloud water deposition on vegetation
PRCS(:,:,IKB) = PRCS(:,:,IKB) - XVDEPOSC * PRCT(:,:,IKB) / PDZZ(:,:,IKB)
PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB)/XRHOLW
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ !PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+
+
+
+
+
+
+
+
+
+
+
+
+
+
IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DEPO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ENDIF
diff --git a/src/mesonh/micro/ice4_sedimentation_split.f90 b/src/common/micro/mode_ice4_sedimentation_split.F90
similarity index 64%
rename from src/mesonh/micro/ice4_sedimentation_split.f90
rename to src/common/micro/mode_ice4_sedimentation_split.F90
index cb0a147d070b865e8e9391bacf7ef143c3727311..195a9e894917f8144b35a45c163d383328c62bec 100644
--- a/src/mesonh/micro/ice4_sedimentation_split.f90
+++ b/src/common/micro/mode_ice4_sedimentation_split.F90
@@ -3,58 +3,14 @@
!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_SEDIMENTATION_SPLIT
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
+MODULE MODE_ICE4_SEDIMENTATION_SPLIT
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
-REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_SPLIT
+CONTAINS
SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
&PSEA, PTOWN, &
&PINPRH, PRHT, PRHS, PFPR)
!!
@@ -70,16 +26,18 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB
!! MODIFICATIONS
!! -------------
!!
-! P. Wautelet 11/02/2019: dimensions of PINPRC and PINDEP not necessarily KIT,KJT
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
USE MODD_CST, ONLY: XRHOLW
USE MODD_PARAM_ICE, ONLY: XSPLIT_MAXCFL
-USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAC,XALPHAC2,XCONC_LAND,XCONC_SEA,XCONC_URBAN,XLBC,XNUC,XNUC2
+USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAC, XALPHAC2, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
+ & XLBC, XNUC, XNUC2
USE MODD_RAIN_ICE_PARAM, ONLY: XFSEDC
!
USE MODE_MSG
@@ -95,8 +53,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels t
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
-REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
@@ -112,14 +68,13 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregat
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL,INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
@@ -128,14 +83,14 @@ REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air
!* 0.2 declaration of local variables
!
!
-INTEGER :: JI,JJ,JK
+INTEGER :: JK
INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-LOGICAL :: GDEPOSC, GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
REAL :: ZINVTSTEP
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),KKTB:KKTE) :: ZW ! work array
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D, & ! droplet condensation
+REAL, DIMENSION(KIT, KJT) :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(KIT,KJT,KKTB:KKTE) :: ZW ! work array
+REAL, DIMENSION(KIT, KJT, KKT) :: ZCONC3D, & ! droplet condensation
& ZRAY, & ! Cloud Mean radius
& ZLBC, & ! XLBC weighted by sea fraction
& ZFSEDC, &
@@ -146,13 +101,13 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D,
& ZRST, &
& ZRGT, &
& ZRHT
-!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 0, ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
!
-GDEPOSC = ODEPOSC
GSEDIC = OSEDIC
IRR = KRR
!
@@ -184,19 +139,19 @@ IF (GSEDIC) THEN
ZCONC3D(:,:,:)= XCONC_LAND
ZCONC_TMP(:,:)= XCONC_LAND
IF (GPRESENT_PSEA) THEN
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
- DO JK=KKTB, KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
+ ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
+ DO JK=KKTB, KKTE
+ ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
+ & PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ END DO
ELSE
- ZCONC3D(:,:,:) = XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
- END IF
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ END IF
ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
ENDIF
@@ -235,7 +190,7 @@ ZW(:,:,KKTB:KKTE) =1./(PRHODREF(:,:,KKTB:KKTE)* PDZZ(:,:,KKTB:KKTE))
!* 2.1 for cloud
!
IF (GSEDIC) THEN
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&XSPLIT_MAXCFL, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&2, &
@@ -243,69 +198,54 @@ IF (GSEDIC) THEN
&ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
ENDIF
!
-!
-!* 2.1bis DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
-!
-IF (GDEPOSC) THEN
- PINDEP (:,:) = 0.
- DO JJ=KJB,KJE
- DO JI=KIB,KIE
- IF (PRCS(JI,JJ,KKB)>0.) THEN
- PRCS(JI,JJ,KKB) = PRCS(JI,JJ,KKB) - PVDEPOSC * PRCT(JI,JJ,KKB) / PDZZ(JI,JJ,KKB)
- PINPRC(JI,JJ) = PINPRC(JI,JJ) + PVDEPOSC * PRCT(JI,JJ,KKB) * PRHODREF(JI,JJ,KKB) /XRHOLW
- PINDEP(JI,JJ) = PVDEPOSC * PRCT(JI,JJ,KKB) * PRHODREF(JI,JJ,KKB) /XRHOLW
- END IF
- END DO
- END DO
-END IF
-!
!* 2.2 for rain
!
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&XSPLIT_MAXCFL, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&3, &
&ZRRT, PRRS, PINPRR, ZPRRS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
!
!* 2.3 for pristine ice
!
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&XSPLIT_MAXCFL, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&4, &
&ZRIT, PRIS, PINPRI, ZPRIS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
!
!* 2.4 for aggregates/snow
!
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&XSPLIT_MAXCFL, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&5, &
&ZRST, PRSS, PINPRS, ZPRSS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
!
!* 2.5 for graupeln
!
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&XSPLIT_MAXCFL, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&6, &
&ZRGT, PRGS, PINPRG, ZPRGS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
!
!* 2.6 for hail
!
IF (IRR==7) THEN
- CALL INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&XSPLIT_MAXCFL, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PTSTEP, &
&7, &
&ZRHT, PRHS, PINPRH, ZPRHS, &
- PFPR=PFPR)
+ &PFPR=PFPR)
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 1, ZHOOK_HANDLE)
!
CONTAINS
!
@@ -313,23 +253,24 @@ CONTAINS
!-------------------------------------------------------------------------------
!
!
-SUBROUTINE INTERNAL_SEDIM_SPLI(KIB,KIE,KIT,KJB,KJE,KJT,KKB,KKTB,KKTE,KKT,KKL,KRR, &
- &PMAXCFL,PRHODREF,POORHODZ,PDZZ,PPABST,PTHT,PTSTEP, &
- &KSPE,PRXT,PRXS,PINPRX,PPRXS, &
- &PRAY,PLBC,PFSEDC,PCONC3D,PFPR)
+SUBROUTINE INTERNAL_SEDIM_SPLI(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
+ &PMAXCFL, PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PTSTEP, &
+ &KSPE, PRXT, PRXS, PINPRX, PPRXS, &
+ &PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XCPD,XP00,XRD
-USE MODD_RAIN_ICE_DESCR, ONLY: XCC,XCEXVT,XDC,XLBEXC,XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: XEXCSEDI,XEXSEDG,XEXSEDH,XEXSEDR,XEXSEDS,XFSEDG,XFSEDH,XFSEDI,XFSEDR,XFSEDS
+USE MODD_CST, ONLY: XCPD, XP00, XRD
+USE MODD_RAIN_ICE_DESCR, ONLY: XCC, XCEXVT, XDC, XLBEXC, XRTMIN
+USE MODD_RAIN_ICE_PARAM, ONLY: XEXCSEDI, XEXSEDG, XEXSEDH, XEXSEDR, XEXSEDS, XFSEDG, &
+ & XFSEDH, XFSEDI, XFSEDR, XFSEDS
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KIB,KIE,KIT, KJB,KJE,KJT, KKB, KKTB, KKTE, KKT, KKL, KRR
+INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR
REAL, INTENT(IN) :: PMAXCFL ! maximum CFL allowed
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KIT,KJT,KKTB:KKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
@@ -347,10 +288,10 @@ REAL, DIMENSION(KIT,KJT,KKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air
!
!* 0.2 declaration of local variables
!
-character(len=10) :: yspe ! String for error message
+CHARACTER(LEN=10) :: yspe ! String for error message
INTEGER :: IDX, ISEDIM
INTEGER :: JI, JJ, JK, JL
-INTEGER, DIMENSION(KIT*KJT*KKT) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER, DIMENSION(KIT*KJT*KKT) :: I1,I2,I3 ! Used to replace the COUNT
LOGICAL :: GPRESENT_PFPR
REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
@@ -358,8 +299,10 @@ REAL :: ZFSED, ZEXSED
REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE
REAL, DIMENSION(KIT, KJT) :: ZMAX_TSTEP ! Maximum CFL in column
REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZREMAINT ! Remaining time until the timestep end
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) :: ZWSED ! Sedimentation fluxes
+REAL, DIMENSION(KIT, KJT) :: ZREMAINT ! Remaining time until the timestep end
+REAL, DIMENSION(KIT, KJT, 0:KKT+1) :: ZWSED ! Sedimentation fluxes
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
IF (KSPE<2 .OR. KSPE>7) CALL PRINT_MSG(NVERB_FATAL,'GEN','INTERNAL_SEDIM_SPLIT','invalid species (KSPE variable)')
@@ -409,14 +352,14 @@ DO WHILE (ANY(ZREMAINT>0.))
JK=I3(JL)
IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
- (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
+ &(PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
ZZWLBDC = ZZWLBDC**XLBEXC
ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
ZWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * &
- ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
+ &ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
ENDIF
ENDDO
ELSEIF(KSPE==4) THEN
@@ -460,7 +403,7 @@ DO WHILE (ANY(ZREMAINT>0.))
JK=I3(JL)
IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE)) THEN
ZWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED &
- * PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
+ & * PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
ENDIF
ENDDO
ENDIF
@@ -471,7 +414,7 @@ DO WHILE (ANY(ZREMAINT>0.))
JK=I3(JL)
IF(PRXT(JI,JJ,JK)>XRTMIN(KSPE) .AND. ZWSED(JI, JJ, JK)>1.E-20) THEN
ZMAX_TSTEP(JI, JJ) = MIN(ZMAX_TSTEP(JI, JJ), PMAXCFL * PRHODREF(JI, JJ, JK) * &
- PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / ZWSED(JI, JJ, JK))
+ & PRXT(JI, JJ, JK) * PDZZ(JI, JJ, JK) / ZWSED(JI, JJ, JK))
ENDIF
ENDDO
ZREMAINT(:,:) = ZREMAINT(:,:) - ZMAX_TSTEP(:,:)
@@ -489,6 +432,8 @@ DO WHILE (ANY(ZREMAINT>0.))
!
END DO
!
+IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 1, ZHOOK_HANDLE)
END SUBROUTINE INTERNAL_SEDIM_SPLI
!
END SUBROUTINE ICE4_SEDIMENTATION_SPLIT
+END MODULE MODE_ICE4_SEDIMENTATION_SPLIT
diff --git a/src/mesonh/micro/ice4_sedimentation_split_momentum.f90 b/src/common/micro/mode_ice4_sedimentation_split_momentum.f90
similarity index 86%
rename from src/mesonh/micro/ice4_sedimentation_split_momentum.f90
rename to src/common/micro/mode_ice4_sedimentation_split_momentum.f90
index 927eb8ba536c7a0c0d726272ee4acafd8594892a..43d3094e4790ba7eaa98dc0d445c70fd3626a867 100644
--- a/src/mesonh/micro/ice4_sedimentation_split_momentum.f90
+++ b/src/common/micro/mode_ice4_sedimentation_split_momentum.f90
@@ -3,51 +3,9 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, OMOMENTUM, &
- &PSEA, PTOWN, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PINPRH, PRHT, PRHS, PFPR)
+MODULE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: OMOMENTUM ! Switch to use momentum flux
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
+CONTAINS
SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, OMOMENTUM, &
&PSEA, PTOWN, PDZZ, &
@@ -575,3 +533,5 @@ CONTAINS
END SUBROUTINE INTERNAL_SEDIM_SPLI
!
END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM
+!
+END MODULE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM
diff --git a/src/arome/micro/ice4_sedimentation_stat.F90 b/src/common/micro/mode_ice4_sedimentation_stat.F90
similarity index 92%
rename from src/arome/micro/ice4_sedimentation_stat.F90
rename to src/common/micro/mode_ice4_sedimentation_stat.F90
index 2884f0333029d22f419df9fd6f5b915be3a8a213..26b25e10350bb349df94d7d16c95a67d264e0f2a 100644
--- a/src/arome/micro/ice4_sedimentation_stat.F90
+++ b/src/common/micro/mode_ice4_sedimentation_stat.F90
@@ -1,11 +1,19 @@
+!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_SEDIMENTATION_STAT
+IMPLICIT NONE
+CONTAINS
SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, &
&PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, PINPRH, PRHT, PRHS, PFPR)
+ &PSEA, PTOWN, &
+ &PINPRH, PRHT, PRHS, PFPR)
!!
!!** PURPOSE
@@ -19,8 +27,11 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB,
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!! Ryad El Khatib 09-Oct-2019 Substantial re-write for optimization
!! (outerunrolling, vectorization, memory cache saving, unrolling)
+! P. Wautelet 21/01/2021: initialize untouched part of PFPR
!
!
!* 0. DECLARATIONS
@@ -62,8 +73,8 @@ REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
@@ -81,8 +92,6 @@ REAL, DIMENSION(KIT,KJT,0:1,2:KRR) :: ZSED ! sedimentation flux array for each
REAL :: FWSED1, FWSED2, PWSEDW, PWSEDWSUP, PINVTSTEP, PTSTEP1, PDZZ1, PRHODREF1, PRXT1
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-REAL(KIND=JPRB) :: ZHOOK_HANDLE_PRXS
-REAL(KIND=JPRB) :: ZHOOK_HANDLE_PINPRX
!
#ifndef REK
! 5 multiplications + 1 division => cost = 7X
@@ -96,6 +105,12 @@ FWSED2(PWSEDW,PTSTEP1,PDZZ1,PWSEDWSUP)=MAX(0.,1.-PDZZ1/(PTSTEP1*PWSEDW))*PWSEDWS
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT',0,ZHOOK_HANDLE)
+IF ( PRESENT( PFPR ) ) THEN
+ !Set to 0. to avoid undefined values (in files)
+ PFPR(:, :, : KKTB - 1, :) = 0.
+ PFPR(:, :, KKTE + 1 :, :) = 0.
+END IF
+
!-------------------------------------------------------------------------------
!
!* 1. compute the fluxes
@@ -178,7 +193,6 @@ DO JK = KKE , KKB, -1*KKL
ENDDO
ENDIF
- !IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:UPDATE_PRXS',0,ZHOOK_HANDLE_PRXS)
DO JJ = KJB, KJE
DO JI = KIB, KIE
PRCS(JI,JJ,JK) = PRCS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,2)-ZSED(JI,JJ,IK,2))*ZINVTSTEP
@@ -191,10 +205,8 @@ DO JK = KKE , KKB, -1*KKL
ENDIF
ENDDO
ENDDO
- !IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:UPDATE_PRXS',1,ZHOOK_HANDLE_PRXS)
IF (JK==KKB) THEN
- !IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:CP_INSTANT_PRECIP',0,ZHOOK_HANDLE_PINPRX)
DO JJ = KJB, KJE
DO JI = KIB, KIE
PINPRC(JI,JJ) = ZSED(JI,JJ,IK,2)/XRHOLW
@@ -207,7 +219,6 @@ DO JK = KKE , KKB, -1*KKL
ENDIF
ENDDO
ENDDO
- !IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:CP_INSTANT_PRECIP',1,ZHOOK_HANDLE_PINPRX)
ENDIF
! shift mechanism : current level now takes the place of previous one
@@ -387,3 +398,4 @@ CONTAINS
END SUBROUTINE SHIFT
END SUBROUTINE ICE4_SEDIMENTATION_STAT
+END MODULE MODE_ICE4_SEDIMENTATION_STAT
diff --git a/src/mesonh/micro/ice4_sedimentation_stat.f90 b/src/mesonh/micro/ice4_sedimentation_stat.f90
deleted file mode 100644
index 3cbb31493eac8295e718f2e1438e4e3a269520e7..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/ice4_sedimentation_stat.f90
+++ /dev/null
@@ -1,444 +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_SEDIMENTATION_STAT
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT,&
- &PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
-REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_STAT
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_STAT
-SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, ODEPOSC, PVDEPOSC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, &
- &PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
-
-!!
-!!** PURPOSE
-!! -------
-!! Computes the sedimentation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the plitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-! P. Wautelet 21/01/2021: initialize untouched part of PFPR
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-
-USE MODE_MSG
-
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
-REAL, INTENT(IN) :: PVDEPOSC! Droplet deposition velocity
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-!
-!* 0.2 declaration of local variables
-!
-!
-INTEGER :: JK
-!
-REAL :: ZINVTSTEP
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZW ! work array
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
- :: ZWSED ! sedimentation fluxes
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
-!
-!
-!-------------------------------------------------------------------------------
-!
-ZINVTSTEP=1./PTSTEP
-
-IF ( PRESENT( PFPR ) ) THEN
- !Set to 0. to avoid undefined values (in files)
- PFPR(:, :, : KKTB - 1, :) = 0.
- PFPR(:, :, KKTE + 1 :, :) = 0.
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 1. compute the fluxes
-!
-!
-DO JK = KKTB , KKTE
- ZW(:,:,JK) =PTSTEP/(PRHODREF(:,:,JK)* PDZZ(:,:,JK) )
-END DO
-!
-!* 2.1 for cloud
-!
-IF (OSEDIC) THEN
- CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &2, &
- &PRCT, PRCS, ZWSED, PSEA, PTOWN)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,2)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRC(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-ENDIF
-!
-!
-!* 2.1bis DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
-!
-IF (ODEPOSC) THEN
- GDEP(:,:) = .FALSE.
- GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
- WHERE (GDEP)
- PRCS(:,:,KKB) = PRCS(:,:,KKB) - PVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB)
- PINPRC(:,:) = PINPRC(:,:) + PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
- PINDEP(:,:) = PVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
- END WHERE
-END IF
-!
-!* 2.2 for rain
-!
-CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &3, &
- &PRRT, PRRS, ZWSED)
-IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,3)=ZWSED(:,:,JK)
- ENDDO
-ENDIF
-PINPRR(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-!
-!* 2.3 for pristine ice
-!
-CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &4, &
- &PRIT, PRIS, ZWSED)
-IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,4)=ZWSED(:,:,JK)
- ENDDO
-ENDIF
-PINPRI(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-!
-!* 2.4 for aggregates/snow
-!
-CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &5, &
- &PRST, PRSS, ZWSED)
-IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,5)=ZWSED(:,:,JK)
- ENDDO
-ENDIF
-PINPRS(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-!
-!* 2.5 for graupeln
-!
-CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &6, &
- &PRGT, PRGS, ZWSED)
-IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,6)=ZWSED(:,:,JK)
- ENDDO
-ENDIF
-PINPRG(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-!
-!* 2.6 for hail
-!
-IF ( KRR == 7 ) THEN
- CALL INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, ZW, PPABST, PTHT, PTSTEP, &
- &7, &
- &PRHT, PRHS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,7)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRH(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
-ENDIF
-!
-!
-CONTAINS
- SUBROUTINE INTERNAL_SEDIM_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKTB, KKTE, KKL, &
- &PRHODREF, PDZZ, PTSORHODZ, PPABST, PTHT, PTSTEP, &
- &KSPE, &
- &PRXT, PRXS, PWSED, PSEA, PTOWN)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- use mode_tools, only: Countjv
-
- USE MODD_RAIN_ICE_DESCR
- USE MODD_RAIN_ICE_PARAM
-
- USE MODI_GAMMA
-
- IMPLICIT NONE
- !
- !* 0.1 Declarations of dummy arguments :
- !
- INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKT, KKE, KKTB, KKTE, KKL
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTSORHODZ ! TimeStep Over (Rhodref times delta Z)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
- REAL, INTENT(IN) :: PTSTEP
- INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRXT ! mr of specy X
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
- REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux
- REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
- REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
- !
- !* 0.2 declaration of local variables
- !
- !
- character(len=10) :: yspe ! String for error message
- INTEGER :: JK, JCOUNT, JL, JI, JJ
- INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
- :: ZWSEDW1, ZWSEDW2 ! sedimentation speed
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZQP
- REAL :: ZINVTSTEP, ZH, ZP1, ZP2, ZZWLBDA, ZZWLBDC, ZZCC
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: &
- ZRAY, & ! Cloud Mean radius
- ZLBC, & ! XLBC weighted by sea fraction
- ZFSEDC
- REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) &
- :: ZCONC_TMP ! Weighted concentration
- REAL :: ZFSED, ZEXSED
- !
- !-------------------------------------------------------------------------------
- !
- !
- !* 1. Parameters for cloud sedimentation
- !
- IF(KSPE==2) THEN
- ZRAY(:,:,:) = 0.
- ZLBC(:,:,:) = XLBC(1)
- ZFSEDC(:,:,:) = XFSEDC(1)
- ZCONC3D(:,:,:)= XCONC_LAND
- ZCONC_TMP(:,:)= XCONC_LAND
- IF (PRESENT(PSEA)) THEN
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
- DO JK=KKTB,KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
- ELSE
- ZCONC3D(:,:,:) = XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
- END IF
- ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
- ENDIF
- !
- !* 2. compute the fluxes
- !
- !
- ZINVTSTEP = 1./PTSTEP
- PWSED(:,:,:) = 0.
- ZWSEDW1(:,:,:) = 0.
- ZWSEDW2(:,:,:) = 0.
- ! calculation of ZP1, ZP2 and sedimentation flux
- DO JK = KKE , KKB, -1*KKL
- !estimation of q' taking into account incomming PWSED
- ZQP(:,:)=PWSED(:,:,JK+KKL)*PTSORHODZ(:,:,JK)
- JCOUNT=COUNTJV( (PRXT(:,:,JK) > XRTMIN(KSPE)) .OR. (ZQP(:,:) > XRTMIN(KSPE)) ,I1(:),I2(:))
- IF(KSPE==2) THEN
- !******* for cloud
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- IF(PRXT(JI,JJ,JK) > XRTMIN(KSPE)) THEN
- ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
- ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
- &/(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)))**XLBEXC
- ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
- ZWSEDW1 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
- & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
- ENDIF
- IF ( ZQP(JI,JJ) > XRTMIN(KSPE) ) THEN
- ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
- ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
- &/(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)))**XLBEXC
- ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
- ZWSEDW2 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
- & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
- ENDIF
- ENDDO
- ELSEIF(KSPE==4) THEN
- ! ******* for pristine ice
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- IF ( PRXT(JI,JJ,JK) > MAX(XRTMIN(KSPE),1.0E-7 ) ) THEN
- ZWSEDW1 (JI,JJ,JK)= XFSEDI * &
- & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
- ENDIF
- IF ( ZQP(JI,JJ) > MAX(XRTMIN(KSPE),1.0E-7 ) ) THEN
- ZWSEDW2 (JI,JJ,JK)= XFSEDI * &
- & PRHODREF(JI,JJ,JK)**(-XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) )**XEXCSEDI
- ENDIF
- ENDDO
- ELSE
- ! ******* for other species
- IF(KSPE==3) THEN
- ZFSED=XFSEDR
- ZEXSED=XEXSEDR
- ELSEIF(KSPE==5) THEN
- ZFSED=XFSEDS
- ZEXSED=XEXSEDS
- ELSEIF(KSPE==6) THEN
- ZFSED=XFSEDG
- ZEXSED=XEXSEDG
- ELSEIF(KSPE==7) THEN
- ZFSED=XFSEDH
- ZEXSED=XEXSEDH
- ELSE
- write( yspe, '( I10 )' ) kspe
- call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_STAT', &
- 'no sedimentation parameter for KSPE='//trim(yspe) )
- ENDIF
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- IF ( PRXT(JI,JJ,JK) > XRTMIN(KSPE) ) THEN
- ZWSEDW1 (JI,JJ,JK)= ZFSED *PRXT(JI,JJ,JK)**(ZEXSED-1)* &
- PRHODREF(JI,JJ,JK)**(ZEXSED-XCEXVT-1)
- ENDIF
- IF ( ZQP(JI,JJ) > XRTMIN(KSPE) ) THEN
- ZWSEDW2 (JI,JJ,JK)= ZFSED *ZQP(JI,JJ)**(ZEXSED-1)* &
- PRHODREF(JI,JJ,JK)**(ZEXSED-XCEXVT-1)
- ENDIF
- ENDDO
- ENDIF
- DO JJ = KJB, KJE
- DO JI = KIB, KIE
- ZH=PDZZ(JI,JJ,JK)
- ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
- IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
- ZP2 = MAX(0.,1 - ZH &
- & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
- ELSE
- ZP2 = 0.
- ENDIF
- PWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
- &ZH*PRXT(JI,JJ,JK)&
- &* ZINVTSTEP+ ZP2 * PWSED (JI,JJ,JK+KKL)
- ENDDO
- ENDDO
- ENDDO
- DO JK = KKTB , KKTE
- PRXS(:,:,JK) = PRXS(:,:,JK) + &
- & PTSORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))*ZINVTSTEP
- ENDDO
- END SUBROUTINE INTERNAL_SEDIM_STAT
- !
-END SUBROUTINE ICE4_SEDIMENTATION_STAT